diff --git a/app/Main.hs b/app/Main.hs index de1c1ab..0b43628 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,124 @@ +{-# LANGUAGE OverloadedStrings #-} + module Main where -import Lib +import Control.Monad +import Control.Monad.IO.Class +import Data.Monoid +import System.Environment +import System.IO + +import Control.Concurrent.STM +import qualified Data.Text as T +import qualified EuphApi as E +import qualified EuphApi.Utils.Listing as EL +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 InfoBot + +type BotSpecific = () +type ConnectionSpecific = TVar EL.Listing +type Bot = E.Bot BotSpecific ConnectionSpecific +type Config = E.BotConfig BotSpecific ConnectionSpecific +type Command = E.Command BotSpecific ConnectionSpecific + +{- + - Commands + -} + +recountCommand :: Command +recountCommand = E.specificCommand "recount" $ \msg -> do + lVar <- E.getConnectionInfo + myID <- E.sessSessionID <$> E.getOwnView + list <- E.who + let l = EL.remove myID $ EL.fromList list + liftIO $ atomically $ writeTVar lVar l + void $ E.nick $ nameFromListing l + void $ E.replyTo msg "Recalibrated!" + +myHelp :: T.Text -> T.Text +myHelp name = + "Displays information about the clients in a room in its nick:\n\ + \(P B L N)\n\ + \!recount " <> E.atMention name <> " - recalibrates the bot\n\n\ + \Created by @Garmy using https://github.com/Garmelon/EuphApi.\n" + +myCommands :: [Command] +myCommands = + [ E.pingCommand "Pong!" + , E.generalPingCommand "Pong!" + , E.helpCommand myHelp + , E.generalHelpCommand (const "I show how many people, bots, lurkers etc. are online.") + , E.uptimeCommand + , E.generalUptimeCommand -- most bots don't do this + , E.killCommand "Bye!" + , E.restartCommand "brb" + -- non-botrulez commands + , recountCommand + ] + +{- + - Handler + -} + +myBotHandler :: E.EventType -> Bot () +myBotHandler (E.EuphEvent e) = do + -- run commands + E.autorunCommands myCommands e + -- update listing + lVar <- E.getConnectionInfo + EL.update lVar e + -- InfoBot logic + handleEvent e +myBotHandler _ = return () + +handleEvent :: E.Event -> Bot () +-- Set nick as soon as you have access to the room. +handleEvent (E.SnapshotEvent _ _ _ _) = updateNick +handleEvent (E.JoinEvent _) = updateNick +handleEvent (E.PartEvent _) = updateNick +handleEvent _ = return () + +updateNick :: Bot () +updateNick = do + lVar <- E.getConnectionInfo + l <- liftIO $ atomically $ readTVar lVar + void $ E.nick $ nameFromListing l + +{- + - Config + -} + +myBotConfig :: String -> Config +myBotConfig room = E.BotConfig + { E.botAddress = "euphoria.io" + , E.botRoom = room + , E.botPassword = Nothing + , E.botNick = "InfoBot" + , E.botHandler = myBotHandler + , E.botInfo = () + , E.botNewConnectionInfo = atomically $ newTVar EL.empty + , E.botReconnectPolicy = E.defaultReconnectPolicy + } main :: IO () -main = someFunc +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) + + -- 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 " " diff --git a/package.yaml b/package.yaml index 291365f..ba053f6 100644 --- a/package.yaml +++ b/package.yaml @@ -21,6 +21,10 @@ description: Please see the README on Github at = 4.7 && < 5 +- euph-api +- hslogger +- stm +- text library: source-dirs: src diff --git a/src/InfoBot.hs b/src/InfoBot.hs new file mode 100644 index 0000000..e3eecf1 --- /dev/null +++ b/src/InfoBot.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE OverloadedStrings #-} + +module InfoBot + ( nameFromListing + ) where + +import Data.Monoid + +import qualified Data.Text as T +import qualified EuphApi.Types as E +import qualified EuphApi.Utils.Listing as EL + +count :: (E.SessionView -> Bool) -> EL.Listing -> Int +count f = length . filter f . EL.toList + +hasNick :: E.SessionView -> Bool +hasNick = not . T.null . E.sessName + +isPeople :: E.SessionView -> Bool +isPeople s = + case E.userType $ E.sessID s of + E.Bot -> False + _ -> True + +people :: EL.Listing -> Int +people = count (\s -> hasNick s && isPeople s) + +bots :: EL.Listing -> Int +bots = count (\s -> hasNick s && not (isPeople s)) + +lurkers :: EL.Listing -> Int +lurkers = count (\s -> not (hasNick s) && isPeople s) + +botLurkers :: EL.Listing -> Int +botLurkers = count (\s -> not (hasNick s) && not (isPeople s)) + +nameFromListing :: EL.Listing -> T.Text +nameFromListing listing = + let tshow = T.pack . show + format f s = if f listing > 0 then [tshow (f listing) <> s] else [] + p = format people "P" + b = [tshow (bots listing + 1) <> "B"] + l = format lurkers "L" + n = format botLurkers "N" + info = p ++ b ++ l ++ n + in "\SOH(" <> (T.intercalate " " info) <> ")" diff --git a/src/Lib.hs b/src/Lib.hs deleted file mode 100644 index d36ff27..0000000 --- a/src/Lib.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Lib - ( someFunc - ) where - -someFunc :: IO () -someFunc = putStrLn "someFunc" diff --git a/stack.yaml b/stack.yaml index a2eaa02..21b8c74 100644 --- a/stack.yaml +++ b/stack.yaml @@ -37,6 +37,7 @@ resolver: lts-10.7 # will not be run. This is useful for tweaking upstream packages. packages: - . +- ../../libs/euph-api/ # Dependency packages to be pulled from upstream that are not in the resolver # (e.g., acme-missiles-0.3) # extra-deps: [] @@ -63,4 +64,4 @@ packages: # extra-lib-dirs: [/path/to/dir] # # Allow a newer minor version of GHC than the snapshot specifies -# compiler-check: newer-minor \ No newline at end of file +# compiler-check: newer-minor