diff --git a/src/EuphApi.hs b/src/EuphApi.hs index 1b40506..5e828a1 100644 --- a/src/EuphApi.hs +++ b/src/EuphApi.hs @@ -17,6 +17,7 @@ -- ["EuphApi.Utils"] Reexports a few util modules useful for creating bots. -- ["EuphApi.Utils.Botrulez"] commands. -- ["EuphApi.Utils.Commands"] General and specific bot commands. +-- ["EuphApi.Utils.Listing"] Track which clients are connected to the room. -- ["EuphApi.Utils.Misc"] Functions for dealing with nicks and time formats. module EuphApi diff --git a/src/EuphApi/Connection.hs b/src/EuphApi/Connection.hs index 5180609..3caa92b 100644 --- a/src/EuphApi/Connection.hs +++ b/src/EuphApi/Connection.hs @@ -496,7 +496,7 @@ data Event -- connected to the same server id/era combo. -- -- > NetworkEvent server_id server_era - | NickEvent E.Nick E.Nick + | NickEvent E.SessionID E.Nick E.Nick -- ^ A @NickEvent@ announces a nick change by another session in the room. -- -- > NickEvent from to @@ -564,7 +564,7 @@ instance FromJSON Event where pNetworkEvent = withObject "NetworkEvent" $ \o -> NetworkEvent <$> o .: "server_id" <*> o .: "server_era" pNickEvent = withObject "NickEvent" $ \o -> - NickEvent <$> o .: "from" <*> o .: "to" + NickEvent <$> o .: "session_id" <*> o .: "from" <*> o .: "to" pEditMessageEvent v = EditMessageEvent <$> parseJSON v pPartEvent v = PartEvent <$> parseJSON v pPingEvent = withObject "PingEvent" $ \o -> diff --git a/src/EuphApi/Types.hs b/src/EuphApi/Types.hs index e5c82ef..cbeddb9 100644 --- a/src/EuphApi/Types.hs +++ b/src/EuphApi/Types.hs @@ -41,7 +41,7 @@ type Nick = T.Text data UserID = UserID { userType :: UserType , userSnowflake :: Snowflake - } deriving (Show, Eq) + } deriving (Show, Eq, Ord) instance FromJSON UserID where parseJSON = withText "UserID" $ \t -> @@ -66,7 +66,7 @@ data UserType = Agent | Account | Bot | Other - deriving (Show, Eq) + deriving (Show, Eq, Ord) -- | Represents . -- diff --git a/src/EuphApi/Utils/Commands.hs b/src/EuphApi/Utils/Commands.hs index 6cb5f89..6a6d23e 100644 --- a/src/EuphApi/Utils/Commands.hs +++ b/src/EuphApi/Utils/Commands.hs @@ -11,6 +11,7 @@ module EuphApi.Utils.Commands ( Command , CommandName , runCommands + , autorunCommands -- * Creating commands , command , specificCommand @@ -50,6 +51,11 @@ runCommands :: [Command b c] -> E.Message -> E.Bot b c () -- runCommands cs = mapM_ E.fork . sequence cs runCommands cs m = mapM_ (E.fork . ($m)) cs +-- | Atomatically run commands as necessary, according to the 'E.Event' given. +autorunCommands :: [Command b c] -> E.Event -> E.Bot b c () +autorunCommands cs (E.SendEvent msg) = runCommands cs msg +autorunCommands _ _ = return () + withNick :: (T.Text -> a) -> E.Bot b c a withNick f = (f . E.sessName) <$> E.getOwnView diff --git a/src/EuphApi/Utils/Listing.hs b/src/EuphApi/Utils/Listing.hs new file mode 100644 index 0000000..775b05b --- /dev/null +++ b/src/EuphApi/Utils/Listing.hs @@ -0,0 +1,93 @@ +-- | This module helps with maintaining a list of connected clients. +-- +-- It is supposed to be imported qualified under a different alias than +-- the other EuphApi modules, for example: +-- +-- > import qualified EuphApi as E +-- > import qualified EuphApi.Utils.Listing as EL + +module EuphApi.Utils.Listing + ( Listing + , empty + , toList + , fromList + -- * Update listing + , update + , add + , remove + , changeNick + ) where + +import Control.Monad +import Control.Monad.IO.Class + +import Control.Concurrent.STM +import qualified Data.Map as M + +import qualified EuphApi.Bot as E +import qualified EuphApi.Types as E + +-- | Represents a listing (see ) +-- in an easy-to-update way. +-- +-- Usually, a bot does not track itself through this listing. +-- To include the bot, it must explicitly be 'add'ed and nick changes +-- must be tracked using 'changeNick'. +newtype Listing = Listing (M.Map E.SessionID E.SessionView) + +-- | An empty listing. +empty :: Listing +empty = Listing M.empty + +-- | Convert a listing to a list of 'E.SessionView's. +toList :: Listing -> [E.SessionView] +toList (Listing m) = map snd $ M.toList m + +-- | Convert a list of 'E.SessionView's to a listing. +fromList :: [E.SessionView] -> Listing +fromList = Listing . M.fromList . map (\s -> (E.sessSessionID s, s)) + +-- TODO: Add some error checking and run 'E.who' when own Listing and server +-- response don't match. + +-- | Updates a listing inside a 'TVar' according to the 'E.Event' given. +-- +-- This function should be called inside your bot's event handler function. +-- The 'TVar' containing the listing should be a part of the connection specific +-- bot data. +update :: TVar Listing -> E.Event -> E.Bot b c () +update lVar (E.SnapshotEvent _ list _ _) = + liftIO $ atomically $ writeTVar lVar (fromList list) +update lVar (E.JoinEvent s) = + withAskWho lVar $ liftIO $ atomically $ do + (Listing m) <- readTVar lVar + modifyTVar lVar (add s) + return $ M.member (E.sessSessionID s) m +update lVar (E.PartEvent s) = + withAskWho lVar $ liftIO $ atomically $ do + (Listing m) <- readTVar lVar + modifyTVar lVar (remove $ E.sessSessionID s) + return $ not $ M.member (E.sessSessionID s) m +update lVar (E.NickEvent sid _ to) = + withAskWho lVar $ liftIO $ atomically $ do + (Listing m) <- readTVar lVar + modifyTVar lVar (changeNick sid to) + return $ not $ M.member sid m +update _ _ = return () + +withAskWho :: TVar Listing -> E.Bot b c Bool -> E.Bot b c () +withAskWho lVar f = do + ask <- f + when ask $ E.fork $ E.who >>= (liftIO . atomically . writeTVar lVar . fromList) + +-- | Add a new 'E.SessionView' to the listing (call on a 'E.JoinEvent'). +add :: E.SessionView -> Listing -> Listing +add s (Listing m) = Listing $ M.insert (E.sessSessionID s) s m + +-- | Remove a 'E.SessionView' from the listing (call on a 'E.PartEvent'). +remove :: E.SessionID -> Listing -> Listing +remove sid (Listing m) = Listing $ M.delete sid m + +-- | Set a new nick for a specific 'E.SessionView' (call on a 'E.NickEvent'). +changeNick :: E.SessionID -> E.Nick -> Listing -> Listing +changeNick sid to (Listing m) = Listing $ M.adjust (\s -> s{E.sessName=to}) sid m diff --git a/test/bot_with_botrulez.hs b/test/bot_with_botrulez.hs index 83ac360..3d8454e 100644 --- a/test/bot_with_botrulez.hs +++ b/test/bot_with_botrulez.hs @@ -2,6 +2,7 @@ import Control.Monad import Data.Monoid +import System.Environment import System.IO import qualified System.Log.Formatter as LF @@ -11,8 +12,12 @@ import qualified System.Log.Logger as L import qualified EuphApi as E -type Bot = E.Bot () () -type Command = E.Command () () +type BotSpecific = () +type ConnectionSpecific = () +type Bot = E.Bot BotSpecific ConnectionSpecific +type Config = E.BotConfig BotSpecific ConnectionSpecific +type Command = E.Command BotSpecific ConnectionSpecific + myCommands :: [Command] myCommands = @@ -27,13 +32,13 @@ myCommands = ] myBotHandler :: E.EventType -> Bot () -myBotHandler (E.EuphEvent (E.SendEvent msg)) = E.runCommands myCommands msg -myBotHandler _ = return () +myBotHandler (E.EuphEvent e) = E.autorunCommands myCommands e +myBotHandler _ = return () -myBotConfig :: E.BotConfig () () -myBotConfig = E.BotConfig +myBotConfig :: String -> Config +myBotConfig room = E.BotConfig { E.botAddress = "euphoria.io" - , E.botRoom = "test" + , E.botRoom = room , E.botPassword = Nothing , E.botNick = "EuphApi test bot" , E.botHandler = myBotHandler @@ -43,9 +48,19 @@ myBotConfig = E.BotConfig } main = do + -- Set up logging with custom message style myHandler <- LH.verboseStreamHandler stdout L.INFO 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.INFO) - E.runBot (return myBotConfig) + + -- Use args to determine room and start the bot + args <- getArgs + case args of + [room] -> E.runBot (return $ myBotConfig room) + _ -> do + name <- getProgName + putStrLn " USAGE:" + putStr name + putStrLn " "