Add EuphApi.Utils.DetailedHelp module

src/EuphApi/Utils/Commands.hs

@@ -10,12 +10,15 @@
 module EuphApi.Utils.Commands
   ( Command
   , CommandName
+  , combineCommands
+  , runCommand
   , runCommands
-  , autorunCommands
   -- * Creating commands
   , command
   , specificCommand
   , commandFromParser
+  , withNick
+  , toEnd
   -- * Useful parsers
   , mentionParser
   , atMentionParser
@@ -44,21 +47,30 @@ type Command b c = E.Message -> E.Bot b c ()
 -- | Alias for the string after the @!@, for example: @\"help\"@ for the command: @!help@.
 type CommandName = T.Text
 
--- | Runs a list of commands.
-runCommands :: [Command b c] -> E.Message -> E.Bot b c ()
--- runCommands cs m = mapM_ E.fork $ map ($m) cs
--- runCommands cs m = mapM_ E.fork $ cs <*> pure m
--- runCommands cs = mapM_ E.fork . sequence cs
-runCommands cs m = mapM_ (E.fork . ($m)) cs
+-- | Combines a list of commands into a single command.
+combineCommands :: [Command b c] -> Command b c
+-- combineCommands cs m = mapM_ E.fork $ map ($m) cs
+-- combineCommands cs m = mapM_ E.fork $ cs <*> pure m
+-- combineCommands cs = mapM_ E.fork . sequence cs
+combineCommands cs m = mapM_ (E.fork . ($m)) cs
+
+-- | Atomatically run a command as necessary, according to the 'E.Event' given.
+runCommand :: Command b c -> E.Event -> E.Bot b c ()
+runCommand c (E.SendEvent msg) = c msg
+runCommand _ _                 = return ()
 
 -- | Atomatically run commands as necessary, according to the 'E.Event' given.
-autorunCommands :: [Command b c] -> E.Event -> E.Bot b c ()
-autorunCommands cs (E.SendEvent msg) = runCommands cs msg
-autorunCommands _ _                  = return ()
+runCommands :: [Command b c] -> E.Event -> E.Bot b c ()
+runCommands = runCommand . combineCommands
 
-withNick :: (T.Text -> a) -> E.Bot b c a
+-- | Passes the current nick as an argument to the first argument.
+withNick :: (E.Nick -> a) -> E.Bot b c a
 withNick f = (f . E.sessName) <$> E.getOwnView
 
+-- | Parses spaces until the EOF (end of input).
+toEnd :: (Ord e) => P.Parsec e T.Text ()
+toEnd = P.space >> P.eof
+
 -- | Creates a 'Command' from a parser and a bot action.
 --
 -- > commandFromParser parser action
@@ -81,18 +93,20 @@ type Parser = P.Parsec Void T.Text
 -- If you want to parse arguments too, use 'commandFromParser'
 -- and write your own parser using 'commandParser'.
 command :: T.Text -> (E.Message -> E.Bot b c ()) -> Command b c
-command c f =
-  commandFromParser (return (commandParser c :: Parser () ))
-                    (const f)
+command c f = commandFromParser (return parser) (const f)
+  where
+    parser :: Parser ()
+    parser = commandParser c >> toEnd
 
 -- | Creates a specific command: @!command \@botname@
 --
 -- If you want to parse arguments too, use 'commandFromParser'
 -- and write your own parser using 'specificCommandParser'.
 specificCommand :: T.Text -> (E.Message -> E.Bot b c ()) -> Command b c
-specificCommand c f =
-  commandFromParser (withNick (specificCommandParser c :: T.Text -> Parser () ))
-                    (const f)
+specificCommand c f = commandFromParser (withNick parser) (const f)
+  where
+    parser :: E.Nick -> Parser ()
+    parser n = specificCommandParser c n >> toEnd
 
 {-
  - Parsers
@@ -113,20 +127,20 @@ atMentionParser :: (Ord e) => P.Parsec e T.Text T.Text
 atMentionParser = P.label "atMention" $ P.char '@' *> mentionParser
 
 -- | Parse a general command: @!command@
-commandParser :: (Ord e) => T.Text -> P.Parsec e T.Text ()
+--
+-- Use together with 'toEnd'.
+commandParser :: (Ord e) => CommandName -> P.Parsec e T.Text ()
 commandParser c = P.label "command" $ do
   P.space
   void $ P.char '!' >> P.string c -- command
-  P.space
-  P.eof
 
 -- | Parse a specific command: @!command \@botname@
-specificCommandParser :: (Ord e) => T.Text -> T.Text -> P.Parsec e T.Text ()
+--
+-- Use together with 'toEnd'.
+specificCommandParser :: (Ord e) => CommandName -> E.Nick -> P.Parsec e T.Text ()
 specificCommandParser c nick = P.label "specific command" $ do
   P.space
   void $ P.char '!' >> P.string c -- command
   P.space1                        -- separator
   m <- atMentionParser            -- @mention
   guard $ m `E.similar` nick
-  P.space
-  P.eof

src/EuphApi/Utils/DetailedHelp.hs

@@ -0,0 +1,56 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Help command that provides detailed help on certain topics.
+--
+-- @!help \@botname \<topic\>@
+
+module EuphApi.Utils.DetailedHelp
+  ( detailedHelpCommand
+  , detailedHelpCommands
+  , detailedHelpParser
+  ) where
+
+import           Control.Monad
+import           Data.Void
+
+import qualified Data.Text              as T
+import qualified Text.Megaparsec        as P
+import qualified Text.Megaparsec.Char   as P
+
+import qualified EuphApi.Bot            as E
+import qualified EuphApi.Types          as E
+import qualified EuphApi.Utils.Commands as E
+
+type Parser = P.Parsec Void T.Text
+
+-- | Creates a detailed help command.
+--
+-- > import qualified EuphApi.Utils.Misc as E
+-- >
+-- > detailedHelpCommand
+-- >   [ ("cheese", \n -> E.atMention n <> " likes cheese.")
+-- >   , ("cabbage", \_ -> "Why are you asking about cabbage?")
+-- >   ]
+detailedHelpCommand :: [(E.CommandName, E.Nick -> T.Text)] -> E.Command b c
+detailedHelpCommand = E.combineCommands . detailedHelpCommands
+
+-- | Like 'detailedHelpCommand', but creates a list of commands instead.
+detailedHelpCommands :: [(E.CommandName, E.Nick -> T.Text)] -> [E.Command b c]
+detailedHelpCommands = map toCommand
+
+toCommand :: (E.CommandName, E.Nick -> T.Text) -> E.Command b c
+toCommand (name, f) = E.commandFromParser (E.withNick parser) $ const $ \msg -> do
+  s <- E.sessName <$> E.getOwnView
+  void $ E.replyTo msg (f s)
+  where
+    parser :: E.Nick -> Parser ()
+    parser n = detailedHelpParser name n >> E.toEnd
+
+-- | Parse a specific help command: @!command \@botname \<topic\>@
+--
+-- Use together with 'E.toEnd'.
+detailedHelpParser :: (Ord e) => E.CommandName -> E.Nick -> P.Parsec e T.Text ()
+detailedHelpParser name nick = do
+  E.specificCommandParser "help" nick
+  P.space1
+  void $ P.string name