Add documentation for Utils and Botrulez

This commit is contained in:
Joscha 2018-02-20 15:10:24 +00:00
parent 02487f0d60
commit c9e80b2df4
3 changed files with 74 additions and 7 deletions

View file

@ -91,7 +91,7 @@ module EuphApi.Bot (
, messageLogAfter , messageLogAfter
, who , who
-- * Exceptions -- * Exceptions
, BotException , BotException(..)
) where ) where
import Control.Concurrent import Control.Concurrent

View file

@ -20,8 +20,6 @@ module EuphApi.Utils (
, command , command
, specificCommand , specificCommand
, commandFromParser , commandFromParser
, withContent
, withNick
-- ** Useful parsers -- ** Useful parsers
, mentionParser , mentionParser
, atMentionParser , atMentionParser
@ -73,9 +71,17 @@ similar = (==) `on` mentionReduce
- Time manipulation - Time manipulation
-} -}
-- | Convert a 'UTCTime' into a 'String' of the format:
-- @yyyy-mm-dd HH:MM:SS UTC@.
--
-- Example: @2018-02-13 20:43:33 UTC@
printUTCTime :: UTCTime -> String printUTCTime :: UTCTime -> String
printUTCTime = formatTime defaultTimeLocale "%F %T %Z" printUTCTime = formatTime defaultTimeLocale "%F %T %Z"
-- | Convert a 'NominalDiffTime' into a 'String' of the format:
-- @[[[[w] d] h] m] s@ (weeks, days, hours, minutes, seconds)
--
-- Examples: @3h 12m 55s@ and @4w 6d 1h 0m 0s@
printNominalDiffTime :: NominalDiffTime -> String printNominalDiffTime :: NominalDiffTime -> String
printNominalDiffTime n = printNominalDiffTime n =
let nr = abs $ round n :: Integer let nr = abs $ round n :: Integer
@ -91,6 +97,12 @@ printNominalDiffTime n =
sign = if n < 0 then "-" else "" sign = if n < 0 then "-" else ""
in sign ++ ws ++ ds ++ hs ++ ms ++ ss in sign ++ ws ++ ds ++ hs ++ ms ++ ss
-- | @printUptime start now@ converts the two times @start@ and @now@
-- into a string of the following format, according to the botrulez:
--
-- @/me has been up since \<start\> (\<now - start\>).@
--
-- Example: @/me has been up since 2018-02-13 20:43:33 UTC (3h 12m 55s).@
printUptime :: UTCTime -> UTCTime -> String printUptime :: UTCTime -> UTCTime -> String
printUptime start now = printUptime start now =
let diff = diffUTCTime now start let diff = diffUTCTime now start
@ -115,15 +127,18 @@ type CommandName = T.Text
runCommands :: [Command b c] -> E.Message -> B.Bot b c () runCommands :: [Command b c] -> E.Message -> B.Bot b c ()
-- runCommands cs m = mapM_ B.fork $ map ($m) cs -- runCommands cs m = mapM_ B.fork $ map ($m) cs
-- runCommands cs m = mapM_ B.fork $ cs <*> pure m -- runCommands cs m = mapM_ B.fork $ cs <*> pure m
runCommands cs = mapM_ B.fork . sequence cs -- runCommands cs = mapM_ B.fork . sequence cs
runCommands cs m = mapM_ (B.fork . ($m)) cs
withContent :: (T.Text -> a) -> E.Message -> a
withContent f = f . E.msgContent
withNick :: (T.Text -> a) -> B.Bot b c a withNick :: (T.Text -> a) -> B.Bot b c a
withNick f = (f . E.sessName) <$> B.getOwnView withNick f = (f . E.sessName) <$> B.getOwnView
-- | Creates a 'Command' from a parser and a bot action. -- | Creates a 'Command' from a parser and a bot action.
--
-- > commandFromParser parser action
--
-- The parser is enclosed in a 'Bot' so that it may access the bot's current state,
-- for example the bot's current nick.
commandFromParser :: (Ord e) commandFromParser :: (Ord e)
=> B.Bot b c (P.Parsec e T.Text a) => B.Bot b c (P.Parsec e T.Text a)
-> (a -> E.Message -> B.Bot b c ()) -> (a -> E.Message -> B.Bot b c ())
@ -135,11 +150,19 @@ commandFromParser p f m = do
type Parser = P.Parsec Void T.Text type Parser = P.Parsec Void T.Text
-- | Creates a general command: @!command@
--
-- If you want to parse arguments too, use 'commandFromParser'
-- and write your own parser using 'commandParser'.
command :: T.Text -> (E.Message -> B.Bot b c ()) -> Command b c command :: T.Text -> (E.Message -> B.Bot b c ()) -> Command b c
command c f = command c f =
commandFromParser (return (commandParser c :: Parser () )) commandFromParser (return (commandParser c :: Parser () ))
(const f) (const f)
-- | 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 -> B.Bot b c ()) -> Command b c specificCommand :: T.Text -> (E.Message -> B.Bot b c ()) -> Command b c
specificCommand c f = specificCommand c f =
commandFromParser (withNick (specificCommandParser c :: T.Text -> Parser () )) commandFromParser (withNick (specificCommandParser c :: T.Text -> Parser () ))
@ -149,13 +172,21 @@ specificCommand c f =
- Parsers - Parsers
-} -}
-- | Parse a mention (without the @\@@).
--
-- This parser basically parses all non-space characters until the next space
-- or end of input:
--
-- @'P.takeWhile1P' (Just \"non-space character\") (not . 'isSpace')@
mentionParser :: (Ord e) => P.Parsec e T.Text T.Text mentionParser :: (Ord e) => P.Parsec e T.Text T.Text
mentionParser = P.label "mention" mentionParser = P.label "mention"
$ P.takeWhile1P (Just "non-space character") (not . isSpace) $ P.takeWhile1P (Just "non-space character") (not . isSpace)
-- | Similar to 'mentionParser', but includes the @\@@.
atMentionParser :: (Ord e) => P.Parsec e T.Text T.Text atMentionParser :: (Ord e) => P.Parsec e T.Text T.Text
atMentionParser = P.label "atMention" $ P.char '@' *> mentionParser atMentionParser = P.label "atMention" $ P.char '@' *> mentionParser
-- | Parse a general command: @!command@
commandParser :: (Ord e) => T.Text -> P.Parsec e T.Text () commandParser :: (Ord e) => T.Text -> P.Parsec e T.Text ()
commandParser c = P.label "command" $ do commandParser c = P.label "command" $ do
P.space P.space
@ -163,6 +194,7 @@ commandParser c = P.label "command" $ do
P.space P.space
P.eof P.eof
-- | Parse a specific command: @!command \@botname@
specificCommandParser :: (Ord e) => T.Text -> T.Text -> P.Parsec e T.Text () specificCommandParser :: (Ord e) => T.Text -> T.Text -> P.Parsec e T.Text ()
specificCommandParser c nick = P.label "specific command" $ do specificCommandParser c nick = P.label "specific command" $ do
P.space P.space

View file

@ -1,5 +1,8 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
-- | This module contains most of the commands specified in the
-- <https://github.com/jedevc/botrulez botrulez>.
module EuphApi.Utils.Botrulez module EuphApi.Utils.Botrulez
( pingCommand ( pingCommand
, generalPingCommand , generalPingCommand
@ -20,18 +23,36 @@ import qualified EuphApi.Bot as B
import qualified EuphApi.Types as E import qualified EuphApi.Types as E
import qualified EuphApi.Utils as E import qualified EuphApi.Utils as E
-- | Specific ping command: @!ping \@botname@
--
-- Bots should reply @\"Pong!\"@ or a similar short message.
--
-- Bots __should implement__ this command.
pingCommand :: T.Text -> E.Command b c pingCommand :: T.Text -> E.Command b c
pingCommand pingText = E.specificCommand "ping" $ \msg -> pingCommand pingText = E.specificCommand "ping" $ \msg ->
void $ B.reply (E.msgID msg) pingText void $ B.reply (E.msgID msg) pingText
-- | General version of 'pingCommand': @!ping@
--
-- Bots __should implement__ this command.
generalPingCommand :: T.Text -> E.Command b c generalPingCommand :: T.Text -> E.Command b c
generalPingCommand pingText = E.command "ping" $ \msg -> generalPingCommand pingText = E.command "ping" $ \msg ->
void $ B.reply (E.msgID msg) pingText void $ B.reply (E.msgID msg) pingText
-- | Specific help command: @!help \@botname@
--
-- Bots should reply with a detailed help message.
--
-- Bots __should implement__ this command.
helpCommand :: T.Text -> E.Command b c helpCommand :: T.Text -> E.Command b c
helpCommand helpText = E.specificCommand "help" $ \msg -> helpCommand helpText = E.specificCommand "help" $ \msg ->
void $ B.reply (E.msgID msg) helpText void $ B.reply (E.msgID msg) helpText
-- | General version of 'helpCommand': @!help@
--
-- Bots should reply with a short description of their function.
--
-- Bots __may implement__ this command.
generalHelpCommand :: T.Text -> E.Command b c generalHelpCommand :: T.Text -> E.Command b c
generalHelpCommand helpText = E.command "help" $ \msg -> generalHelpCommand helpText = E.command "help" $ \msg ->
void $ B.reply (E.msgID msg) helpText void $ B.reply (E.msgID msg) helpText
@ -42,12 +63,26 @@ uptime msg = do
curTime <- liftIO getCurrentTime curTime <- liftIO getCurrentTime
void $ B.reply (E.msgID msg) (T.pack $ E.printUptime startTime curTime) void $ B.reply (E.msgID msg) (T.pack $ E.printUptime startTime curTime)
-- | Specific uptime command: @!uptime \@botname@
--
-- Bots should reply with the time since they were started.
-- For the format this command uses, see 'E.printUptime'.
--
-- Bots __should implement__ this command.
uptimeCommand :: E.Command b c uptimeCommand :: E.Command b c
uptimeCommand = E.specificCommand "uptime" uptime uptimeCommand = E.specificCommand "uptime" uptime
-- | General version of 'uptimeCommand': @!uptime@
--
-- Bots __may implement__ this command.
generalUptimeCommand :: E.Command b c generalUptimeCommand :: E.Command b c
generalUptimeCommand = E.command "uptime" uptime generalUptimeCommand = E.command "uptime" uptime
-- | Specific kill command: @!kill \@botname@
--
-- When killed, bots should disconnect and not reconnect.
--
-- Bots __may implement__ this command.
killCommand :: E.Command b c killCommand :: E.Command b c
killCommand = E.specificCommand "kill" $ \msg -> do killCommand = E.specificCommand "kill" $ \msg -> do
void $ B.reply (E.msgID msg) "Bye!" void $ B.reply (E.msgID msg) "Bye!"