From 8024285e2e143155e23782ca5a545237aa4c0489 Mon Sep 17 00:00:00 2001 From: Joscha Date: Mon, 19 Feb 2018 21:30:39 +0000 Subject: [PATCH] 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 | 12 +++--- src/EuphApi/Utils.hs | 32 +++++++++------ src/EuphApi/Utils/Botrulez.hs | 48 ++++++++++++++++++++++ test/bot_with_botrulez.hs | 57 +++++++++++++++++++++++++++ test/connection_reacting_to_events.hs | 6 +-- 5 files changed, 134 insertions(+), 21 deletions(-) create mode 100644 src/EuphApi/Utils/Botrulez.hs create mode 100644 test/bot_with_botrulez.hs diff --git a/src/EuphApi/Bot.hs b/src/EuphApi/Bot.hs index c063373..d595714 100644 --- a/src/EuphApi/Bot.hs +++ b/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 diff --git a/src/EuphApi/Utils.hs b/src/EuphApi/Utils.hs index 16f24a6..807f40e 100644 --- a/src/EuphApi/Utils.hs +++ b/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 diff --git a/src/EuphApi/Utils/Botrulez.hs b/src/EuphApi/Utils/Botrulez.hs new file mode 100644 index 0000000..2cb161d --- /dev/null +++ b/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 diff --git a/test/bot_with_botrulez.hs b/test/bot_with_botrulez.hs new file mode 100644 index 0000000..c626c3d --- /dev/null +++ b/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 diff --git a/test/connection_reacting_to_events.hs b/test/connection_reacting_to_events.hs index 75404b3..5431775 100644 --- a/test/connection_reacting_to_events.hs +++ b/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