Restructure modules
This should hopefully make it easier to create bots.
This commit is contained in:
Joscha
parent
db69f168de
commit
94df5fb8f2
7 changed files with 265 additions and 245 deletions
|
|
@ -4,14 +4,8 @@
|
|||
-- | This module lets you create bots, although it only contains the bare minimum necessary.
|
||||
-- It defines the 'Bot' monad which takes care of a few things common to most bots.
|
||||
--
|
||||
-- The module is meant to be imported qualified, under a different name than all the
|
||||
-- other EuphApi modules.
|
||||
-- For example:
|
||||
--
|
||||
-- > import qualified EuphApi.Bot as B
|
||||
-- > import qualified EuphApi.Connection as E
|
||||
-- > import qualified EuphApi.Types as E
|
||||
-- > import qualified EuphApi.Utils as E
|
||||
-- The module exports some types from "EuphApi.Connection" for convenience.
|
||||
-- Don't import both modules unless you know what you're doing.
|
||||
--
|
||||
-- = The 'Bot' monad
|
||||
--
|
||||
|
|
@ -94,9 +88,17 @@ module EuphApi.Bot (
|
|||
, who
|
||||
-- * Exceptions
|
||||
, BotException(..)
|
||||
-- * Misc
|
||||
, E.EventType(..)
|
||||
, E.Event(..)
|
||||
) where
|
||||
|
||||
-- TODO: Add 'AuthenticationFailed' exception.
|
||||
-- TODO: Reorganize library:
|
||||
-- - export events from Bot module
|
||||
-- - add EuphApi module to export Bot module and some other convenience modules,
|
||||
-- and to introduce people to the different parts of the library
|
||||
-- - maybe separate utils into more modules and have Utils import some of them
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Exception
|
||||
|
|
@ -276,8 +278,8 @@ runBot ioConfig = do
|
|||
config <- ioConfig
|
||||
result <- runBotOnce config
|
||||
case result of
|
||||
Stopping -> void $ noticeM "Bot has stopped."
|
||||
Restarting -> noticeM "Bot has restarted." >> runBot ioConfig
|
||||
Stopping -> void $ noticeM "Bot has stopped."
|
||||
Restarting -> noticeM "Bot has restarted." >> runBot ioConfig
|
||||
|
||||
reconnect :: Integer -> Bot b c ExitState
|
||||
reconnect retries = do
|
||||
|
|
|
|||
|
|
@ -1,206 +1,7 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | Some useful functions for bots.
|
||||
|
||||
module EuphApi.Utils (
|
||||
-- * Nick manipulation
|
||||
mention
|
||||
, atMention
|
||||
, mentionReduce
|
||||
, similar
|
||||
-- * Time manipulation
|
||||
, printUTCTime
|
||||
, printNominalDiffTime
|
||||
, printUptime
|
||||
-- * Commands
|
||||
, Command
|
||||
, CommandName
|
||||
, runCommands
|
||||
-- ** Creating commands
|
||||
, command
|
||||
, specificCommand
|
||||
, commandFromParser
|
||||
-- ** Useful parsers
|
||||
, mentionParser
|
||||
, atMentionParser
|
||||
, commandParser
|
||||
, specificCommandParser
|
||||
module EuphApi.Utils
|
||||
( module EuphApi.Utils.Misc
|
||||
, module EuphApi.Utils.Commands
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Data.Char
|
||||
import Data.Function
|
||||
import Data.Void
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Data.Time
|
||||
import qualified Text.Megaparsec as P
|
||||
import qualified Text.Megaparsec.Char as P
|
||||
|
||||
import qualified EuphApi.Bot as B
|
||||
import qualified EuphApi.Types as E
|
||||
|
||||
{-
|
||||
- Nick manipulation
|
||||
-}
|
||||
|
||||
-- | Convert a nick to an @-mentionable version.
|
||||
-- Use this function when you want to @-mention somebody.
|
||||
--
|
||||
-- This removes spaces and some extra characters, while trying to stay close to
|
||||
-- the original nick.
|
||||
mention :: T.Text -> T.Text
|
||||
mention = T.filter (\c -> not (isSpace c) && notElem c (".!?;&<'\"" :: String))
|
||||
|
||||
-- | Same as 'atMention', but prepends an `@` character.
|
||||
atMention :: T.Text -> T.Text
|
||||
atMention = T.cons '@' . mention
|
||||
|
||||
-- | Reduces a nick to a normal form such that all nicks that get @-mentioned
|
||||
-- by the same @-mention are reduced to the same normal form.
|
||||
--
|
||||
-- Use this function when you want to compare two nicks.
|
||||
mentionReduce :: T.Text -> T.Text
|
||||
mentionReduce = T.map toLower . mention
|
||||
|
||||
-- | Compare two nicks using 'mentionReduce'.
|
||||
similar :: T.Text -> T.Text -> Bool
|
||||
similar = (==) `on` mentionReduce
|
||||
|
||||
{-
|
||||
- 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 = 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 n =
|
||||
let nr = abs $ round n :: Integer
|
||||
(w, wr) = nr `quotRem` (60 * 60 * 24 * 7)
|
||||
(d, dr) = wr `quotRem` (60 * 60 * 24 )
|
||||
(h, hr) = dr `quotRem` (60 * 60 )
|
||||
(m, s ) = hr `quotRem` 60
|
||||
ws = if w /= 0 then show w ++ "w " else ""
|
||||
ds = if d /= 0 then show d ++ "d " else ""
|
||||
hs = if h /= 0 then show h ++ "h " else ""
|
||||
ms = if m /= 0 then show m ++ "m " else ""
|
||||
ss = show s ++ "s"
|
||||
sign = if n < 0 then "-" else ""
|
||||
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 start now =
|
||||
let diff = diffUTCTime now start
|
||||
upSince = printUTCTime start
|
||||
upFor = printNominalDiffTime diff
|
||||
in "/me has been up since " ++ upSince ++ " (" ++ upFor ++ ")."
|
||||
|
||||
{-
|
||||
- Commands
|
||||
-}
|
||||
|
||||
-- | A simple function that is to be called with the content of received messages.
|
||||
--
|
||||
-- If you just want to add a simple command, see 'command' and 'specificCommand'.
|
||||
-- For more flexibility/more regex-like functionality, see 'commandFromParser'.
|
||||
type Command b c = E.Message -> B.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 -> B.Bot b c ()
|
||||
-- runCommands cs m = mapM_ B.fork $ map ($m) cs
|
||||
-- runCommands cs m = mapM_ B.fork $ cs <*> pure m
|
||||
-- runCommands cs = mapM_ B.fork . sequence cs
|
||||
runCommands cs m = mapM_ (B.fork . ($m)) cs
|
||||
|
||||
withNick :: (T.Text -> a) -> B.Bot b c a
|
||||
withNick f = (f . E.sessName) <$> B.getOwnView
|
||||
|
||||
-- | 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)
|
||||
=> B.Bot b c (P.Parsec e T.Text a)
|
||||
-> (a -> E.Message -> B.Bot b c ())
|
||||
-> Command b c
|
||||
commandFromParser p f m = do
|
||||
let content = E.msgContent m
|
||||
parser <- p
|
||||
forM_ (P.parseMaybe parser content) (`f` m)
|
||||
|
||||
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 c f =
|
||||
commandFromParser (return (commandParser c :: Parser () ))
|
||||
(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 c f =
|
||||
commandFromParser (withNick (specificCommandParser c :: T.Text -> Parser () ))
|
||||
(const f)
|
||||
|
||||
{-
|
||||
- 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 = P.label "mention"
|
||||
$ 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 = P.label "atMention" $ P.char '@' *> mentionParser
|
||||
|
||||
-- | Parse a general command: @!command@
|
||||
commandParser :: (Ord e) => T.Text -> 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 ()
|
||||
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 `similar` nick
|
||||
P.space
|
||||
P.eof
|
||||
import EuphApi.Utils.Commands
|
||||
import EuphApi.Utils.Misc
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ import Control.Monad.IO.Class
|
|||
import qualified Data.Text as T
|
||||
import Data.Time
|
||||
|
||||
import qualified EuphApi.Bot as B
|
||||
import qualified EuphApi.Bot as E
|
||||
import qualified EuphApi.Types as E
|
||||
import qualified EuphApi.Utils as E
|
||||
|
||||
|
|
@ -33,14 +33,14 @@ import qualified EuphApi.Utils as E
|
|||
-- Bots __should implement__ this command.
|
||||
pingCommand :: T.Text -> E.Command b c
|
||||
pingCommand pingText = E.specificCommand "ping" $ \msg ->
|
||||
void $ B.reply (E.msgID msg) pingText
|
||||
void $ E.reply (E.msgID msg) pingText
|
||||
|
||||
-- | General version of 'pingCommand': @!ping@
|
||||
--
|
||||
-- Bots __should implement__ this command.
|
||||
generalPingCommand :: T.Text -> E.Command b c
|
||||
generalPingCommand pingText = E.command "ping" $ \msg ->
|
||||
void $ B.reply (E.msgID msg) pingText
|
||||
void $ E.reply (E.msgID msg) pingText
|
||||
|
||||
-- | Specific help command: @!help \@botname@
|
||||
--
|
||||
|
|
@ -49,7 +49,7 @@ generalPingCommand pingText = E.command "ping" $ \msg ->
|
|||
-- Bots __should implement__ this command.
|
||||
helpCommand :: T.Text -> E.Command b c
|
||||
helpCommand helpText = E.specificCommand "help" $ \msg ->
|
||||
void $ B.reply (E.msgID msg) helpText
|
||||
void $ E.reply (E.msgID msg) helpText
|
||||
|
||||
-- | General version of 'helpCommand': @!help@
|
||||
--
|
||||
|
|
@ -58,13 +58,13 @@ helpCommand helpText = E.specificCommand "help" $ \msg ->
|
|||
-- Bots __may implement__ this command.
|
||||
generalHelpCommand :: T.Text -> E.Command b c
|
||||
generalHelpCommand helpText = E.command "help" $ \msg ->
|
||||
void $ B.reply (E.msgID msg) helpText
|
||||
void $ E.reply (E.msgID msg) helpText
|
||||
|
||||
uptime :: E.Message -> B.Bot b c ()
|
||||
uptime :: E.Message -> E.Bot b c ()
|
||||
uptime msg = do
|
||||
startTime <- B.getStartTime
|
||||
startTime <- E.getStartTime
|
||||
curTime <- liftIO getCurrentTime
|
||||
void $ B.reply (E.msgID msg) (T.pack $ E.printUptime startTime curTime)
|
||||
void $ E.reply (E.msgID msg) (T.pack $ E.printUptime startTime curTime)
|
||||
|
||||
-- | Specific uptime command: @!uptime \@botname@
|
||||
--
|
||||
|
|
@ -88,12 +88,12 @@ generalUptimeCommand = E.command "uptime" uptime
|
|||
-- Bots __may implement__ this command.
|
||||
killCommand :: T.Text -> E.Command b c
|
||||
killCommand t = E.specificCommand "kill" $ \msg -> do
|
||||
void $ B.reply (E.msgID msg) t
|
||||
B.stop
|
||||
void $ E.reply (E.msgID msg) t
|
||||
E.stop
|
||||
|
||||
-- | Version of 'killCommand' where the bot does not reply to the message which kills it.
|
||||
killCommandSilent :: E.Command b c
|
||||
killCommandSilent = E.specificCommand "kill" $ const B.stop
|
||||
killCommandSilent = E.specificCommand "kill" $ const E.stop
|
||||
|
||||
-- | Specific restart command: @!restart \@botname@
|
||||
--
|
||||
|
|
@ -103,10 +103,10 @@ killCommandSilent = E.specificCommand "kill" $ const B.stop
|
|||
-- Bots __may implement__ this command.
|
||||
restartCommand :: T.Text -> E.Command b c
|
||||
restartCommand t = E.specificCommand "restart" $ \msg -> do
|
||||
void $ B.reply (E.msgID msg) t
|
||||
B.restart
|
||||
void $ E.reply (E.msgID msg) t
|
||||
E.restart
|
||||
|
||||
-- | Version of 'restartCommand' where the bot does not reply to the message
|
||||
-- which restarts it.
|
||||
restartCommandSilent :: E.Command b c
|
||||
restartCommandSilent = E.specificCommand "restart" $ const B.restart
|
||||
restartCommandSilent = E.specificCommand "restart" $ const E.restart
|
||||
|
|
|
|||
119
src/EuphApi/Utils/Commands.hs
Normal file
119
src/EuphApi/Utils/Commands.hs
Normal file
|
|
@ -0,0 +1,119 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module EuphApi.Utils.Commands
|
||||
( Command
|
||||
, CommandName
|
||||
, runCommands
|
||||
-- * Creating commands
|
||||
, command
|
||||
, specificCommand
|
||||
, commandFromParser
|
||||
-- * Useful parsers
|
||||
, mentionParser
|
||||
, atMentionParser
|
||||
, commandParser
|
||||
, specificCommandParser
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Data.Char
|
||||
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.Misc as E
|
||||
|
||||
-- | A simple function that is to be called with the content of received messages.
|
||||
--
|
||||
-- If you just want to add a simple command, see 'command' and 'specificCommand'.
|
||||
-- For more flexibility/more regex-like functionality, see 'commandFromParser'.
|
||||
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
|
||||
|
||||
withNick :: (T.Text -> a) -> E.Bot b c a
|
||||
withNick f = (f . E.sessName) <$> E.getOwnView
|
||||
|
||||
-- | Creates a 'Command' from a parser and a bot action.
|
||||
--
|
||||
-- > commandFromParser parser action
|
||||
--
|
||||
-- The parser is enclosed in a 'E.Bot' so that it may access the bot's current state,
|
||||
-- for example the bot's current nick.
|
||||
commandFromParser :: (Ord e)
|
||||
=> E.Bot b c (P.Parsec e T.Text a)
|
||||
-> (a -> E.Message -> E.Bot b c ())
|
||||
-> Command b c
|
||||
commandFromParser p f m = do
|
||||
let content = E.msgContent m
|
||||
parser <- p
|
||||
forM_ (P.parseMaybe parser content) (`f` m)
|
||||
|
||||
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 -> E.Bot b c ()) -> Command b c
|
||||
command c f =
|
||||
commandFromParser (return (commandParser c :: Parser () ))
|
||||
(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 -> E.Bot b c ()) -> Command b c
|
||||
specificCommand c f =
|
||||
commandFromParser (withNick (specificCommandParser c :: T.Text -> Parser () ))
|
||||
(const f)
|
||||
|
||||
{-
|
||||
- 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 = P.label "mention"
|
||||
$ 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 = P.label "atMention" $ P.char '@' *> mentionParser
|
||||
|
||||
-- | Parse a general command: @!command@
|
||||
commandParser :: (Ord e) => T.Text -> 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 ()
|
||||
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
|
||||
89
src/EuphApi/Utils/Misc.hs
Normal file
89
src/EuphApi/Utils/Misc.hs
Normal file
|
|
@ -0,0 +1,89 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module EuphApi.Utils.Misc (
|
||||
-- * Nick manipulation
|
||||
mention
|
||||
, atMention
|
||||
, mentionReduce
|
||||
, similar
|
||||
-- * Time manipulation
|
||||
, printUTCTime
|
||||
, printNominalDiffTime
|
||||
, printUptime
|
||||
) where
|
||||
|
||||
import Data.Char
|
||||
import Data.Function
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Data.Time
|
||||
|
||||
{-
|
||||
- Nick manipulation
|
||||
-}
|
||||
|
||||
-- | Convert a nick to an @-mentionable version.
|
||||
-- Use this function when you want to @-mention somebody.
|
||||
--
|
||||
-- This removes spaces and some extra characters, while trying to stay close to
|
||||
-- the original nick.
|
||||
mention :: T.Text -> T.Text
|
||||
mention = T.filter (\c -> not (isSpace c) && notElem c (".!?;&<'\"" :: String))
|
||||
|
||||
-- | Same as 'atMention', but prepends an `@` character.
|
||||
atMention :: T.Text -> T.Text
|
||||
atMention = T.cons '@' . mention
|
||||
|
||||
-- | Reduces a nick to a normal form such that all nicks that get @-mentioned
|
||||
-- by the same @-mention are reduced to the same normal form.
|
||||
--
|
||||
-- Use this function when you want to compare two nicks.
|
||||
mentionReduce :: T.Text -> T.Text
|
||||
mentionReduce = T.map toLower . mention
|
||||
|
||||
-- | Compare two nicks using 'mentionReduce'.
|
||||
similar :: T.Text -> T.Text -> Bool
|
||||
similar = (==) `on` mentionReduce
|
||||
|
||||
{-
|
||||
- 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 = 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 n =
|
||||
let nr = abs $ round n :: Integer
|
||||
(w, wr) = nr `quotRem` (60 * 60 * 24 * 7)
|
||||
(d, dr) = wr `quotRem` (60 * 60 * 24 )
|
||||
(h, hr) = dr `quotRem` (60 * 60 )
|
||||
(m, s ) = hr `quotRem` 60
|
||||
ws = if w /= 0 then show w ++ "w " else ""
|
||||
ds = if d /= 0 then show d ++ "d " else ""
|
||||
hs = if h /= 0 then show h ++ "h " else ""
|
||||
ms = if m /= 0 then show m ++ "m " else ""
|
||||
ss = show s ++ "s"
|
||||
sign = if n < 0 then "-" else ""
|
||||
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 start now =
|
||||
let diff = diffUTCTime now start
|
||||
upSince = printUTCTime start
|
||||
upFor = printNominalDiffTime diff
|
||||
in "/me has been up since " ++ upSince ++ " (" ++ upFor ++ ")."
|
||||
Loading…
Add table
Add a link
Reference in a new issue