Add botrulez support

This commit includes:
 - Some cleaned up debug messages
 - New and updated examples (they're all fixed again :D)

src/EuphApi/Bot.hs

@@ -293,7 +293,6 @@ eventLoop retries = do
   con     <- getConnection
   handler <- asks bHandler
   event   <- liftIO $ E.getEvent con
-  liftIO $ debugM $ "Received event: " ++ show event
   handler event
   case event of
     E.ConnectionFailed -> reconnect (retries + 1)
@@ -315,13 +314,12 @@ handleNickStuff :: E.Event -> Bot b c ()
 handleNickStuff (E.SnapshotEvent _ _ _ maybeNick) = do
   myNickVar <- asks bNick
   myNick    <- liftIO $ atomically $ readTVar myNickVar
-  con       <- getConnection
   case maybeNick of
-    Nothing -> fork $ liftIO $ E.nick con myNick
+    Nothing -> fork $ nick myNick
     Just curNick ->
       if curNick == myNick
         then return ()
-        else fork $ liftIO $ E.nick con myNick
+        else fork $ nick myNick
 handleNickStuff _ = return ()
 
 handlePasswordStuff :: E.Event -> Bot b c ()
@@ -339,9 +337,11 @@ handlePasswordStuff _ = return ()
 handleOwnViewStuff :: E.Event -> Bot b c ()
 handleOwnViewStuff (E.HelloEvent view _ _) = do
   var <- asks bOwnView
+  liftIO $ debugM $ "Received new own view on HelloEvent: " ++ show view
   liftIO $ atomically $ writeTVar var (Just view)
 handleOwnViewStuff (E.SnapshotEvent _ _ _ (Just curNick)) = do
   var <- asks bOwnView
+  liftIO $ debugM $ "SnapshotEvent reported a nick. This should not happen in a bot."
   liftIO $ atomically $ changeOwnNick var curNick
 handleOwnViewStuff _ = return ()
 
@@ -364,6 +364,7 @@ stop = do
   liftIO $ do
     atomically $ writeTVar stopping False
     E.disconnect con
+    noticeM "Bot was stopped."
 
 -- | Send a new message.
 send :: T.Text -> Bot b c E.Message
@@ -385,7 +386,8 @@ nick newNick = do
   con    <- asks bConnection
   liftIO $ do
     atomically $ writeTVar myNick newNick
-    r@(_, to) <- E.nick con newNick
+    r@(from, to) <- E.nick con newNick
+    infoM $ "Changed own nick from " ++ show from ++ " to " ++ show to ++ "."
     atomically $ changeOwnNick var to
     return r
 

src/EuphApi/Utils.hs

@@ -7,6 +7,7 @@ module EuphApi.Utils (
     mention
   , atMention
   , mentionReduce
+  , similar
   -- * Commands
   , Command
   , CommandName
@@ -91,21 +92,24 @@ withNick f = (f . E.sessName) <$> B.getOwnView
 -- | Creates a 'Command' from a parser and a bot action.
 commandFromParser :: (Ord e)
                   => B.Bot b c (P.Parsec e T.Text a)
-                  -> (a -> B.Bot b c ())
+                  -> (a -> E.Message -> B.Bot b c ())
                   -> Command b c
-commandFromParser p f = withContent $ \t -> do
+commandFromParser p f m = do
+  let content = E.msgContent m
   parser <- p
-  forM_ (P.parseMaybe parser t) f
+  forM_ (P.parseMaybe parser content) (`f` m)
 
 type Parser = P.Parsec Void T.Text
 
-command :: T.Text -> (T.Text -> B.Bot b c ()) -> Command b c
-command c = commandFromParser
-          $ return (commandParser c :: Parser T.Text)
+command :: T.Text -> (E.Message -> B.Bot b c ()) -> Command b c
+command c f =
+  commandFromParser (return (commandParser c :: Parser () ))
+                    (const f)
 
-specificCommand :: T.Text -> (T.Text -> B.Bot b c ()) -> Command b c
-specificCommand c = commandFromParser
-                  $ withNick (specificCommandParser c :: T.Text -> Parser T.Text)
+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
@@ -118,17 +122,19 @@ mentionParser = P.label "mention"
 atMentionParser :: (Ord e) => P.Parsec e T.Text T.Text
 atMentionParser = P.label "atMention" $ P.char '@' *> mentionParser
 
-commandParser :: (Ord e) => T.Text -> P.Parsec e T.Text T.Text
+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.eof) P.<|> (P.space1 *> P.takeRest)
+  P.space
+  P.eof
 
-specificCommandParser :: (Ord e) => T.Text -> T.Text -> P.Parsec e T.Text T.Text
+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.eof) P.<|> (P.space1 *> P.takeRest)
+  P.space
+  P.eof

src/EuphApi/Utils/Botrulez.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module EuphApi.Utils.Botrulez
+  ( pingCommand
+  , generalPingCommand
+  , helpCommand
+  , generalHelpCommand
+  , uptimeCommand
+  , generalUptimeCommand
+  , killCommand
+  ) where
+
+import           Control.Monad
+
+import qualified Data.Text     as T
+
+import qualified EuphApi.Bot   as B
+import qualified EuphApi.Types as E
+import qualified EuphApi.Utils as E
+
+pingCommand :: E.Command b c
+pingCommand = E.specificCommand "ping" $ \msg ->
+  void $ B.reply (E.msgID msg) "Pong!"
+
+generalPingCommand :: E.Command b c
+generalPingCommand = E.command "ping" $ \msg ->
+  void $ B.reply (E.msgID msg) "Pong!"
+
+helpCommand :: T.Text -> E.Command b c
+helpCommand helpText = E.specificCommand "help" $ \msg ->
+  void $ B.reply (E.msgID msg) helpText
+
+generalHelpCommand :: T.Text -> E.Command b c
+generalHelpCommand helpText = E.command "help" $ \msg ->
+  void $ B.reply (E.msgID msg) helpText
+
+uptimeCommand :: E.Command b c
+uptimeCommand = E.specificCommand "uptime" $ \msg ->
+  void $ B.reply (E.msgID msg) "uptime placeholder"
+
+generalUptimeCommand :: E.Command b c
+generalUptimeCommand = E.command "uptime" $ \msg ->
+  void $ B.reply (E.msgID msg) "uptime placeholder"
+
+killCommand :: E.Command b c
+killCommand = E.specificCommand "kill" $ \msg -> do
+  void $ B.reply (E.msgID msg) "Bye!"
+  B.stop

test/bot_with_botrulez.hs

@@ -0,0 +1,57 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import           Control.Monad
+import           Control.Monad.IO.Class
+import           Data.Monoid
+import           System.IO
+
+import qualified Data.Text                 as T
+import qualified System.Log.Formatter      as LF
+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.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]
+myCommands =
+  [ E.pingCommand
+  , E.generalPingCommand
+  , E.helpCommand "Some specific placeholder help"
+  , E.generalHelpCommand "I help test @Garmy's EuphApi"
+  , E.uptimeCommand
+  , E.generalUptimeCommand
+  , E.command "whatsmynick" (\msg -> do
+      nick <- E.sessName <$> B.getOwnView
+      let content = nick <> "\n" <> E.mention nick <> "\n" <> E.atMention nick <> "\n" <> E.mentionReduce nick
+      void $ B.reply (E.msgID msg) content
+    )
+  ]
+
+myBotHandler :: E.EventType -> B.Bot b c ()
+myBotHandler (E.EuphEvent (E.SendEvent msg)) = E.runCommands myCommands msg
+myBotHandler _                               = return ()
+
+myBotConfig :: B.BotConfig () ()
+myBotConfig = B.BotConfig
+  { B.botAddress           = "euphoria.io"
+  , B.botRoom              = "test"
+  , B.botPassword          = Nothing
+  , B.botNick              = "EuphApi test bot"
+  , B.botHandler           = myBotHandler
+  , B.botInfo              = ()
+  , B.botNewConnectionInfo = return ()
+  , B.botReconnectPolicy   = B.defaultReconnectPolicy
+  }
+
+main = do
+  myHandler <- LH.verboseStreamHandler stdout L.DEBUG
+  let myFormatter        = LF.simpleLogFormatter "<$time> [$loggername/$prio] $msg"
+      myFormattedHandler = LH.setFormatter myHandler myFormatter
+  L.updateGlobalLogger L.rootLoggerName (L.setHandlers [myFormattedHandler])
+  L.updateGlobalLogger L.rootLoggerName (L.setLevel L.DEBUG)
+  B.runBot myBotConfig

test/connection_reacting_to_events.hs

@@ -6,8 +6,8 @@ import           System.Environment
 
 import qualified Data.Text          as T
 
-import qualified EuphApi            as E
 import qualified EuphApi.Connection as E
+import qualified EuphApi.Types      as E
 
 
 runBot :: String -> IO ()
@@ -27,10 +27,10 @@ handleEuphEvent :: E.Connection -> E.Event -> IO ()
 handleEuphEvent con (E.PingEvent time _) = do
   E.pingReply con time
   putStrLn "Pong!"
-handleEuphEvent con (E.BounceEvent _ _) = do
+handleEuphEvent con E.BounceEvent{} = do
   E.disconnect con
   putStrLn "Room is private. And I don't have a password."
-handleEuphEvent con (E.HelloEvent _ _ _) = do
+handleEuphEvent con E.HelloEvent{} = do
   void $ E.nick con "EuphApi test bot"
   putStrLn "Set nick"
 handleEuphEvent con (E.JoinEvent sess) = do