Add documentation for Utils and Botrulez
This commit is contained in:
parent
02487f0d60
commit
c9e80b2df4
3 changed files with 74 additions and 7 deletions
|
|
@ -91,7 +91,7 @@ module EuphApi.Bot (
|
||||||
, messageLogAfter
|
, messageLogAfter
|
||||||
, who
|
, who
|
||||||
-- * Exceptions
|
-- * Exceptions
|
||||||
, BotException
|
, BotException(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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!"
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue