Update custom commands in help after they changed

src/Bot/CustomCommand.hs

@@ -8,11 +8,12 @@ module Bot.CustomCommand
   , updateCustomCommand
   , showCustomCommand
   , timesCustomCommand
-  , CustomCommand(..)
   ) where
 
+import Bot.CustomCommandType
 import Bot.Expr
 import Bot.Flip
+import Bot.Help
 import Bot.Replies
 import Command
 import Control.Monad
@@ -32,38 +33,19 @@ import Reaction
 import Text.InterpolatedString.QM
 import Transport
 
-data CustomCommand = CustomCommand
-  { customCommandName :: T.Text
-  , customCommandMessage :: T.Text
-  , customCommandTimes :: Int
-  }
-
-instance IsEntity CustomCommand where
-  nameOfEntity _ = "CustomCommand"
-  toProperties customCommand =
-    M.fromList
-      [ ("name", PropertyText $ customCommandName customCommand)
-      , ("message", PropertyText $ customCommandMessage customCommand)
-      , ("times", PropertyInt $ customCommandTimes customCommand)
-      ]
-  fromProperties properties =
-    CustomCommand <$> extractProperty "name" properties <*>
-    extractProperty "message" properties <*>
-    pure (fromMaybe 0 $ extractProperty "times" properties)
-
 customCommandByName :: T.Text -> MaybeT Effect (Entity CustomCommand)
 customCommandByName name =
   MaybeT $
   fmap listToMaybe $
   selectEntities Proxy $ Filter (PropertyEquals "name" $ PropertyText name) All
 
--- TODO(#815): CRUD custom command should update help page now they're listed there as well.
 addCustomCommand :: CommandTable -> Reaction Message (T.Text, T.Text)
 addCustomCommand builtinCommands =
-  Reaction $ \Message {messageSender = sender, messageContent = (name, message)} -> do
-    customCommand <- runMaybeT $ customCommandByName name
-    let builtinCommand = M.lookup name builtinCommands
-    case (customCommand, builtinCommand) of
+  Reaction $ \mesg@Message { messageSender = sender
+                           , messageContent = (name, message)
+                           } -> do
+    res <- refreshHelpAndUnpack builtinCommands (fst <$> mesg)
+    case res of
       (Just _, Nothing) ->
         replyToSender sender [qms|Command '{name}' already exists|]
       (Nothing, Just _) ->
@@ -83,12 +65,21 @@ addCustomCommand builtinCommands =
               }
         replyToSender sender [qms|Added command '{name}'|]
 
+refreshHelpAndUnpack ::
+     CommandTable
+  -> Message T.Text
+  -> Effect (Maybe (Entity CustomCommand), Maybe BuiltinCommand)
+refreshHelpAndUnpack builtinCommands mesg@Message {messageContent = name} = do
+  runReaction refreshHelpGistId mesg
+  customCommand <- runMaybeT $ customCommandByName name
+  let builtinCommand = M.lookup name builtinCommands
+  pure (customCommand, builtinCommand)
+
 deleteCustomCommand :: CommandTable -> Reaction Message T.Text
 deleteCustomCommand builtinCommands =
-  Reaction $ \Message {messageSender = sender, messageContent = name} -> do
-    customCommand <- runMaybeT $ customCommandByName name
-    let builtinCommand = M.lookup name builtinCommands
-    case (customCommand, builtinCommand) of
+  Reaction $ \mesg@Message {messageSender = sender, messageContent = name} -> do
+    res <- refreshHelpAndUnpack builtinCommands mesg
+    case res of
       (Just _, Nothing) -> do
         void $
           deleteEntities (Proxy :: Proxy CustomCommand) $
@@ -155,10 +146,11 @@ timesCustomCommand builtinCommands =
 
 updateCustomCommand :: CommandTable -> Reaction Message (T.Text, T.Text)
 updateCustomCommand builtinCommands =
-  Reaction $ \Message {messageSender = sender, messageContent = (name, message)} -> do
-    customCommand <- runMaybeT $ customCommandByName name
-    let builtinCommand = M.lookup name builtinCommands
-    case (customCommand, builtinCommand) of
+  Reaction $ \mesg@Message { messageSender = sender
+                           , messageContent = (name, message)
+                           } -> do
+    res <- refreshHelpAndUnpack builtinCommands (fst <$> mesg)
+    case res of
       (Just cmd, Nothing) -> do
         void $ updateEntityById (replaceCustomCommandMessage message <$> cmd)
         replyToSender sender [qms|Command '{name}' has been updated|]

src/Bot/CustomCommandType.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Moved out of CustomCommand to break dependency cycle:
+--   Help depends on this type, but custom commands needs
+--   to refresh Help and therefore also this type.
+module Bot.CustomCommandType
+  ( CustomCommand(..)
+  ) where
+
+import qualified Data.Map as M
+import Data.Maybe
+import qualified Data.Text as T
+import Entity
+import Property
+
+data CustomCommand = CustomCommand
+  { customCommandName :: T.Text
+  , customCommandMessage :: T.Text
+  , customCommandTimes :: Int
+  }
+
+instance IsEntity CustomCommand where
+  nameOfEntity _ = "CustomCommand"
+  toProperties customCommand =
+    M.fromList
+      [ ("name", PropertyText $ customCommandName customCommand)
+      , ("message", PropertyText $ customCommandMessage customCommand)
+      , ("times", PropertyInt $ customCommandTimes customCommand)
+      ]
+  fromProperties properties =
+    CustomCommand <$> extractProperty "name" properties <*>
+    extractProperty "message" properties <*>
+    pure (fromMaybe 0 $ extractProperty "times" properties)

src/Bot/Help.hs

@@ -8,7 +8,7 @@ module Bot.Help
   , startRefreshHelpGistTimer
   ) where
 
-import Bot.CustomCommand
+import Bot.CustomCommandType
 import Bot.GitHub
 import Bot.Replies
 import Command

src/Bot/Poll.hs

@@ -204,7 +204,7 @@ currentPollCommand =
 currentPoll :: Effect (Maybe (Entity Poll))
 currentPoll = do
   currentTime <- now
-  fmap (listToMaybe . filter (isPollAlive currentTime)) $
+  fmap (find (isPollAlive currentTime)) $
     selectEntities Proxy $ Take 1 $ SortBy "startedAt" Desc All
 
 startPoll :: Sender -> [T.Text] -> Int -> Effect Int

src/Schedule.hs

@@ -230,6 +230,5 @@ eventsFrom day schedule@Schedule { scheduleTimezone = timezone
 nextEvent :: Schedule -> UTCTime -> Either String Event
 nextEvent schedule timePoint =
   maybeToEither "No events found" $
-  listToMaybe $
-  filter ((> timePoint) . eventUTCTime (scheduleTimezone schedule)) $
+  find ((> timePoint) . eventUTCTime (scheduleTimezone schedule)) $
   eventsFrom (utctDay timePoint) schedule