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