Pass paper planes flying by

Author: easafe

src/Client/Experiments/Update.purs

@@ -53,7 +53,25 @@ update model =
             TogglePaperPlaneSection section → togglePaperPlaneSection section model
             DisplayFlyingPaperPlanes planes → displayFlyingPaperPlanes planes model
             CatchPaperPlane id → catchPaperPlane id model
-            AfterCatchPlane id  → afterCatchPlane id  model
+            AfterCatchPlane id → afterCatchPlane id model
+            PassPaperPlane id → passPaperPlane id model
+            AfterPassPlane id → afterPassPlane id model
+
+afterPassPlane ∷ Int → ExperimentsModel → ExperimentsModel /\ (Array (Aff (Maybe ExperimentsMessage)))
+afterPassPlane id model =
+      model
+            { paperPlane = model.paperPlane
+                    { loading = false
+                    , flyingBy = DA.filter ((_ /= id) <<< _.id) model.paperPlane.flyingBy
+                    }
+            } /\ []
+
+passPaperPlane ∷ Int → ExperimentsModel → ExperimentsModel /\ (Array (Aff (Maybe ExperimentsMessage)))
+passPaperPlane id model = model { paperPlane = model.paperPlane { loading = true } } /\ [ setIt ]
+      where
+      setIt = do
+            void <<< CCN.silentResponse $ request.experiments.pass { body: { id } }
+            pure <<< Just $ AfterPassPlane id
 
 afterCatchPlane ∷ Int → ExperimentsModel → ExperimentsModel /\ (Array (Aff (Maybe ExperimentsMessage)))
 afterCatchPlane id model =

src/Server/Experiments/Action.purs

@@ -53,5 +53,8 @@ throwPlane loggedUserId message = do
 catchPlane ∷ Int → Int → ServerEffect Unit
 catchPlane loggedUserId id = SED.updatePlaneStatus loggedUserId id Caught
 
+passPlane ∷ Int → Int → ServerEffect Unit
+passPlane loggedUserId id = SED.updatePlaneBy loggedUserId id
+
 flyingPlanes ∷ Int → ServerEffect (Array PaperPlane)
 flyingPlanes loggedUserId = SED.fetchPaperPlanesFlying loggedUserId

src/Server/Experiments/Database.purs

@@ -74,6 +74,9 @@ countPaperPlanes loggedUserId = do
 updatePlaneStatus ∷ Int → Int -> PaperPlaneStatus -> ServerEffect Unit
 updatePlaneStatus loggedUserId id status = SD.execute $ update paper_planes # set (_status .=. status) # wher (_id .=. id .&&. _by .=.  loggedUserId)
 
+updatePlaneBy ∷ Int → Int -> ServerEffect Unit
+updatePlaneBy loggedUserId id  = SD.execute $ update paper_planes # set (_by .=. Nothing) # wher (_id .=. id .&&. _by .=.  loggedUserId)
+
 fetchPaperPlanes ∷ Int → ServerEffect (Array PaperPlane)
 fetchPaperPlanes loggedUserId = SD.query $ select (_id /\ _message /\ _status) # from paper_planes # wher (_thrower .=. loggedUserId .&&. _status .<>. Crashed) # orderBy _created
 

src/Server/Experiments/Handler.purs

@@ -34,6 +34,11 @@ catch request = do
       SEA.catchPlane request.guards.loggedUserId request.body.id
       pure Empty
 
+pass ∷ { guards ∷ { loggedUserId ∷ Int }, body ∷ { id :: Int} } → ServerEffect Empty
+pass request = do
+      SEA.passPlane request.guards.loggedUserId request.body.id
+      pure Empty
+
 flying ∷ { guards ∷ { loggedUserId ∷ Int } } → ServerEffect (Array PaperPlane)
 flying request = SEA.flyingPlanes request.guards.loggedUserId
 

src/Server/Handler.purs

@@ -121,6 +121,7 @@ handlers reading =
               , answer: runJson reading SEH.answer
               , throw: runJson reading SEH.throw
               , catch: runJson reading SEH.catch
+              , pass: runJson reading SEH.pass
               , flying: runJson reading SEH.flying
               }
       , sw

src/Shared/Experiments/PaperPlane.purs

@@ -51,7 +51,7 @@ flyingBy model =
                     [ HE.div [ HA.class' "paper-flown-message" ] [ HE.text plane.message ]
                     ]
             , HE.div [ HA.class' "paper-thrown-options" ]
-                    [ HE.a [ HA.class' "paper-catch" ] [ HE.text "Pass" ]
+                    [ HE.a [ HA.class' "paper-catch", HA.onClick $ PassPaperPlane plane.id ] [ HE.text "Pass" ]
                     , HE.a [ HA.class' "paper-catch", HA.onClick $ CatchPaperPlane plane.id ] [ HE.text "Catch!" ]
                     ]
             ]

src/Shared/Experiments/Types.purs

@@ -50,6 +50,8 @@ data ExperimentsMessage
       | DisplayFlyingPaperPlanes (Array PaperPlane)
       | CatchPaperPlane Int
       | AfterCatchPlane Int
+      | PassPaperPlane Int
+      | AfterPassPlane Int
 
 type Match =
       { name ∷ String

src/Shared/Spec.purs

@@ -321,6 +321,12 @@ spec ∷
                                                 , body ∷ { id ∷ Int }
                                                 , response ∷ Empty
                                                 }
+                                 , pass ∷
+                                          POST "/pass"
+                                                { guards ∷ Guards ("loggedUserId" : Nil)
+                                                , body ∷ { id ∷ Int }
+                                                , response ∷ Empty
+                                                }
                                   , flying ∷
                                           GET "/flying"
                                                 { guards ∷ Guards ("loggedUserId" : Nil)