(#598) make dispatchCommand a Reaction

Author: rexim

src/Bot.hs

@@ -668,7 +668,7 @@ dispatchRedirect :: Effect () -> Message (Command T.Text) -> Effect ()
 dispatchRedirect effect cmd = do
   effectOutput <-
     T.strip . T.concat . concatMap (\x -> [" ", x]) <$> listen effect
-  dispatchCommand $
+  runReaction dispatchCommand $
     getCompose ((\x -> T.concat [x, effectOutput]) <$> Compose cmd)
 
 -- TODO(#414): there is not cooldown for pipes
@@ -699,18 +699,18 @@ dispatchPipe = Reaction dispatchPipe'
         pipeLimit = 10
         plebPipeLimit = 2
 
-dispatchCommand :: Message (Command T.Text) -> Effect ()
-dispatchCommand message = do
-  dispatchBuiltinCommand message
-  dispatchCustomCommand message
+dispatchCommand :: Reaction Message (Command T.Text)
+dispatchCommand = dispatchBuiltinCommand <> dispatchCustomCommand
 
-dispatchBuiltinCommand :: Message (Command T.Text) -> Effect ()
-dispatchBuiltinCommand message@Message { messageSender = _
-                                       , messageContent = Command { commandName = name
-                                                                  , commandArgs = args
-                                                                  }
-                                       } =
-  maybe
-    (return ())
-    (\bc -> runReaction (bcReaction bc) $ fmap (const args) message)
-    (M.lookup name builtinCommands)
+dispatchBuiltinCommand :: Reaction Message (Command T.Text)
+dispatchBuiltinCommand = Reaction f
+  where
+    f message@Message { messageSender = _
+                      , messageContent = Command { commandName = name
+                                                 , commandArgs = args
+                                                 }
+                      } =
+      maybe
+        (return ())
+        (\bc -> runReaction (bcReaction bc) $ fmap (const args) message)
+        (M.lookup name builtinCommands)

src/Bot/CustomCommand.hs

@@ -27,6 +27,8 @@ import Property
 import Reaction
 import Text.InterpolatedString.QM
 import Transport
+-- import HyperNerd.Parser
+-- import Bot.Expr
 
 data CustomCommand = CustomCommand
   { customCommandName :: T.Text
@@ -199,19 +201,19 @@ replaceCustomCommandMessage :: T.Text -> CustomCommand -> CustomCommand
 replaceCustomCommandMessage message customCommand =
   customCommand {customCommandMessage = message}
 
-dispatchCustomCommand :: Message (Command T.Text) -> Effect ()
-dispatchCustomCommand Message { messageContent = Command { commandName = cmd
-                                                         , commandArgs = args
-                                                         }
-                              , messageSender = sender
-                              } = do
-  customCommand <-
-    runMaybeT
-      (entityPayload <$>
-       ((fmap bumpCustomCommandTimes <$> customCommandByName cmd) >>=
-        MaybeT . updateEntityById) >>=
-       lift . expandCustomCommandVars sender args)
-  maybe
-    (return ())
-    (say (senderChannel sender) . customCommandMessage)
-    customCommand
+dispatchCustomCommand :: Reaction Message (Command T.Text)
+dispatchCustomCommand = Reaction f
+  where
+    f Message { messageContent = Command {commandName = cmd, commandArgs = args}
+              , messageSender = sender
+              } = do
+      customCommand <-
+        runMaybeT
+          (entityPayload <$>
+           ((fmap bumpCustomCommandTimes <$> customCommandByName cmd) >>=
+            MaybeT . updateEntityById) >>=
+           lift . expandCustomCommandVars sender args)
+      maybe
+        (return ())
+        (say (senderChannel sender) . customCommandMessage)
+        customCommand

src/Bot/Periodic.hs

@@ -84,7 +84,7 @@ getPeriodicCommandByName name =
   Take 1 $ Filter (PropertyEquals "name" (PropertyText name)) All
 
 startPeriodicTimer ::
-     (Message (Command T.Text) -> Effect ()) -> Channel -> Int -> Effect ()
+     Reaction Message (Command T.Text) -> Channel -> Int -> Effect ()
 startPeriodicTimer dispatchCommand channel eid =
   periodicEffect' (Just channel) $ do
     pt' <- getEntityById Proxy eid
@@ -99,15 +99,15 @@ startPeriodicTimer dispatchCommand channel eid =
          when (periodicTimerEnabled pt) $
            maybe
              (return ())
-             (dispatchCommand .
+             (runReaction dispatchCommand .
               Message (mrbotka {senderChannel = channel}) False .
               periodicCommand . entityPayload)
              pc'
          return $ Just $ fromIntegral $ periodicTimerPeriod pt)
       pt'
 
 startPeriodicCommands ::
-     Channel -> (Message (Command T.Text) -> Effect ()) -> Effect ()
+     Channel -> (Reaction Message (Command T.Text)) -> Effect ()
 startPeriodicCommands channel dispatchCommand = do
   eids <- (entityId <$>) <$> selectEntities (Proxy :: Proxy PeriodicTimer) All
   for_ eids (startPeriodicTimer dispatchCommand channel)
@@ -171,7 +171,7 @@ statusPeriodicTimerCommand =
   Reaction replyMessage
 
 addPeriodicTimerCommand ::
-     (Message (Command T.Text) -> Effect ()) -> Reaction Message Int
+     Reaction Message (Command T.Text) -> Reaction Message Int
 addPeriodicTimerCommand dispatchCommand =
   cmapR (PeriodicTimer False) $
   liftR (createEntity Proxy) $