Restructure modules

This should hopefully make it easier to create bots.

src/EuphApi.hs

@@ -0,0 +1,9 @@
+module EuphApi
+  ( module EuphApi.Bot
+  , module EuphApi.Types
+  , module EuphApi.Utils
+  ) where
+
+import           EuphApi.Bot
+import           EuphApi.Types
+import           EuphApi.Utils

src/EuphApi/Bot.hs

@@ -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
+-- The module exports some types from "EuphApi.Connection" for convenience.
--- other EuphApi modules.
+-- Don't import both modules unless you know what you're doing.
--- 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 '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."
+    Stopping   -> void $ noticeM "Bot has stopped."
-    Restarting   -> noticeM "Bot has restarted." >> runBot ioConfig
+    Restarting -> noticeM "Bot has restarted." >> runBot ioConfig
 
 reconnect :: Integer -> Bot b c ExitState
 reconnect retries = do

src/EuphApi/Utils.hs

@@ -1,206 +1,7 @@
-{-# LANGUAGE OverloadedStrings #-}
+module EuphApi.Utils
-
+  ( module EuphApi.Utils.Misc
--- | Some useful functions for bots.
+  , module EuphApi.Utils.Commands
-
-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
   ) where
 
-import           Control.Monad
+import           EuphApi.Utils.Commands
-import           Data.Char
+import           EuphApi.Utils.Misc
-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

src/EuphApi/Utils/Botrulez.hs

@@ -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
+  void $ E.reply (E.msgID msg) t
-  B.stop
+  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
+  void $ E.reply (E.msgID msg) t
-  B.restart
+  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

src/EuphApi/Utils/Commands.hs

@@ -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

src/EuphApi/Utils/Misc.hs

@@ -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 ++ ")."

test/bot_with_botrulez.hs

@@ -9,13 +9,13 @@ import qualified System.Log.Handler        as LH
 import qualified System.Log.Handler.Simple as LH
 import qualified System.Log.Logger         as L
 
-import qualified EuphApi.Bot               as B
+import qualified EuphApi                   as E
-import qualified EuphApi.Connection        as E
-import qualified EuphApi.Types             as E
-import qualified EuphApi.Utils             as E
 import qualified EuphApi.Utils.Botrulez    as E
 
-myCommands :: [E.Command b c]
+type Bot = E.Bot () ()
+type Command = E.Command () ()
+
+myCommands :: [Command]
 myCommands =
   [ E.pingCommand "Pong!"
   , E.generalPingCommand "Pong!"
@@ -27,20 +27,20 @@ myCommands =
   , E.restartCommand "brb"
   ]
 
-myBotHandler :: E.EventType -> B.Bot b c ()
+myBotHandler :: E.EventType -> Bot ()
 myBotHandler (E.EuphEvent (E.SendEvent msg)) = E.runCommands myCommands msg
 myBotHandler _                               = return ()
 
-myBotConfig :: B.BotConfig () ()
+myBotConfig :: E.BotConfig () ()
-myBotConfig = B.BotConfig
+myBotConfig = E.BotConfig
-  { B.botAddress           = "euphoria.io"
+  { E.botAddress           = "euphoria.io"
-  , B.botRoom              = "test"
+  , E.botRoom              = "test"
-  , B.botPassword          = Nothing
+  , E.botPassword          = Nothing
-  , B.botNick              = "EuphApi test bot"
+  , E.botNick              = "EuphApi test bot"
-  , B.botHandler           = myBotHandler
+  , E.botHandler           = myBotHandler
-  , B.botInfo              = ()
+  , E.botInfo              = ()
-  , B.botNewConnectionInfo = return ()
+  , E.botNewConnectionInfo = return ()
-  , B.botReconnectPolicy   = B.defaultReconnectPolicy
+  , E.botReconnectPolicy   = E.defaultReconnectPolicy
   }
 
 main = do
@@ -49,4 +49,4 @@ main = do
       myFormattedHandler = LH.setFormatter myHandler myFormatter
   L.updateGlobalLogger L.rootLoggerName (L.setHandlers [myFormattedHandler])
   L.updateGlobalLogger L.rootLoggerName (L.setLevel L.INFO)
-  B.runBot (return myBotConfig)
+  E.runBot (return myBotConfig)