Add EuphApi.Utils.Listing module

src/EuphApi.hs

@@ -17,6 +17,7 @@
 -- ["EuphApi.Utils"] Reexports a few util modules useful for creating bots.
 -- ["EuphApi.Utils.Botrulez"] <https://github.com/jedevc/botrulez 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

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

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 <http://api.euphoria.io/#message>.
 --

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
 

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 <http://api.euphoria.io/#nick-event>)
+-- 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

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 BotSpecific        = ()
-type Command = E.Command () ()
+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 (E.EuphEvent e) = E.autorunCommands myCommands e
 myBotHandler _               = return ()
 
-myBotConfig :: E.BotConfig () ()
+myBotConfig :: String -> Config
-myBotConfig = E.BotConfig
+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 " <room>"