From d818aba337c15805a315a7b958a4e9eca605c6e2 Mon Sep 17 00:00:00 2001
From: Joscha <brummer@migejolise.de>
Date: Mon, 26 Feb 2018 16:05:13 +0000
Subject: [PATCH] Add EuphApi.Utils.DetailedHelp module

---
 src/EuphApi.hs                    |  2 ++
 src/EuphApi/Utils/Commands.hs     | 60 +++++++++++++++++++------------
 src/EuphApi/Utils/DetailedHelp.hs | 56 +++++++++++++++++++++++++++++
 3 files changed, 95 insertions(+), 23 deletions(-)
 create mode 100644 src/EuphApi/Utils/DetailedHelp.hs

diff --git a/src/EuphApi.hs b/src/EuphApi.hs
index 5e828a1..4517642 100644
--- a/src/EuphApi.hs
+++ b/src/EuphApi.hs
@@ -17,6 +17,8 @@
 -- ["EuphApi.Utils"] Reexports a few util modules useful for creating bots.
 -- ["EuphApi.Utils.Botrulez"] <https://github.com/jedevc/botrulez botrulez> commands.
 -- ["EuphApi.Utils.Commands"] General and specific bot commands.
+-- ["EuphApi.Utils.DetailedHelp"] Help command for more detailed help about special topics:
+--                                @!help \@botname \<topic\>@
 -- ["EuphApi.Utils.Listing"] Track which clients are connected to the room.
 -- ["EuphApi.Utils.Misc"] Functions for dealing with nicks and time formats.
 
diff --git a/src/EuphApi/Utils/Commands.hs b/src/EuphApi/Utils/Commands.hs
index 6a6d23e..a94c249 100644
--- a/src/EuphApi/Utils/Commands.hs
+++ b/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
diff --git a/src/EuphApi/Utils/DetailedHelp.hs b/src/EuphApi/Utils/DetailedHelp.hs
new file mode 100644
index 0000000..3038928
--- /dev/null
+++ b/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