irc-fun-bot 0.4.0.0 → 0.5.0.0

raw patch · 18 files changed

+856/−147 lines, 18 filesdep +auto-updatedep +containersdep ~irc-fun-clientPVP ok

version bump matches the API change (PVP)

Dependencies added: auto-update, containers

Dependency ranges changed: irc-fun-client

API changes (from Hackage documentation)

Files

• NEWS +28/−0
• irc-fun-bot.cabal +10/−3
• src/Data/Sequence/Util.hs +30/−0
• src/Network/IRC/Fun/Bot.hs +96/−35
• src/Network/IRC/Fun/Bot/Chat.hs +1/−0
• src/Network/IRC/Fun/Bot/Internal/Chat.hs +137/−28
• src/Network/IRC/Fun/Bot/Internal/ChatExt.hs +34/−0
• src/Network/IRC/Fun/Bot/Internal/Event.hs +5/−5
• src/Network/IRC/Fun/Bot/Internal/History.hs +65/−0
• src/Network/IRC/Fun/Bot/Internal/IrcLog.hs +8/−8
• src/Network/IRC/Fun/Bot/Internal/MsgCount.hs +227/−0
• src/Network/IRC/Fun/Bot/Internal/Nicks.hs +11/−11
• src/Network/IRC/Fun/Bot/Internal/Persist.hs +23/−23
• src/Network/IRC/Fun/Bot/Internal/State.hs +34/−13
• src/Network/IRC/Fun/Bot/Internal/Types.hs +102/−19
• src/Network/IRC/Fun/Bot/MsgCount.hs +39/−0
• src/Network/IRC/Fun/Bot/State.hs +3/−1
• src/Network/IRC/Fun/Bot/Types.hs +3/−1

@@ -3,6 +3,34 @@   +irc-fun-bot 0.5.0.0 -- 2015-12-17+=================================++General, build and documentation changes:++* (None)++New APIs, features and enhancements:++* Debug log+* History logging (moved code from funbot)+* Per-channel history lines limit+* Message delay thread with configurable delay+* Prefix `Config` fields+* Message counting system++Bug fixes:++* Log and remember bot's own messages, otherwise logs were incomplete++Dependency changes:++* Require irc-fun-client >= 0.4+++++ irc-fun-bot 0.4.0.0 -- 2015-10-17 ================================= 

@@ -1,5 +1,5 @@ name:                irc-fun-bot-version:             0.4.0.0+version:             0.5.0.0 synopsis:            Library for writing fun IRC bots. description:   One day an idea came up on the #freepost IRC channel: We didn't need much of@@ -35,25 +35,32 @@                      , Network.IRC.Fun.Bot.EventMatch                      , Network.IRC.Fun.Bot.IrcLog                      , Network.IRC.Fun.Bot.Logger+                     , Network.IRC.Fun.Bot.MsgCount                      , Network.IRC.Fun.Bot.Nicks                      , Network.IRC.Fun.Bot.State                      , Network.IRC.Fun.Bot.Types                      , Network.IRC.Fun.Bot.Util-  other-modules:       Network.IRC.Fun.Bot.Internal.Chat+  other-modules:       Data.Sequence.Util+                     , Network.IRC.Fun.Bot.Internal.Chat+                     , Network.IRC.Fun.Bot.Internal.ChatExt                      , Network.IRC.Fun.Bot.Internal.Event                      , Network.IRC.Fun.Bot.Internal.Failure+                     , Network.IRC.Fun.Bot.Internal.History                      , Network.IRC.Fun.Bot.Internal.IrcLog                      , Network.IRC.Fun.Bot.Internal.Logger+                     , Network.IRC.Fun.Bot.Internal.MsgCount                      , Network.IRC.Fun.Bot.Internal.Nicks                      , Network.IRC.Fun.Bot.Internal.Persist                      , Network.IRC.Fun.Bot.Internal.State                      , Network.IRC.Fun.Bot.Internal.Types   -- other-extensions:       build-depends:       aeson+                     , auto-update                      , base                 >=4.7 && <5                      , clock                >=0.5+                     , containers           >=0.5                      , fast-logger-                     , irc-fun-client       >=0.3+                     , irc-fun-client       >=0.4                      , irc-fun-messages     >=0.2                      , json-state                      , time

@@ -0,0 +1,30 @@+{- This file is part of irc-fun-bot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Data.Sequence.Util+    ( tail+    )+where++import Data.Sequence (Seq, ViewL (..))+import Prelude hiding (tail)++import qualified Data.Sequence as Q++tail :: Seq a -> Seq a+tail s =+    case Q.viewl s of+        EmptyL -> s+        _ :< t -> t

@@ -25,20 +25,23 @@ import Control.Concurrent (threadDelay, forkIO) import Control.Concurrent.Chan import Control.Concurrent.MVar-import Control.Monad (liftM, void, when)+import Control.Monad (liftM, forever, void, when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS (ask) import Data.List (transpose)-import Data.Maybe (catMaybes, fromMaybe)+import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Time.Interval import Data.Time.Units+import Network.IRC.Fun.Bot.Internal.Chat (sendIO) import Network.IRC.Fun.Bot.Internal.Event+import Network.IRC.Fun.Bot.Internal.History import Network.IRC.Fun.Bot.Internal.Logger+import Network.IRC.Fun.Bot.Internal.MsgCount import Network.IRC.Fun.Bot.Internal.Types import Network.IRC.Fun.Bot.Chat (login, joinConfig, run) import Network.IRC.Fun.Bot.Types (Connection (..)) import Network.IRC.Fun.Client.ChannelLogger (fromClientEvent)-import Network.IRC.Fun.Client.Events (hGetIrcEvents)+import Network.IRC.Fun.Client.Events (hGetIrcEvents, hGetIrcEvents') import Network.IRC.Fun.Client.IO (hPutIrc) import Network.IRC.Fun.Messages.Types (Message (PingMessage)) import System.Clock@@ -56,22 +59,25 @@ -- incrementing the library's major version and breaking compatibility. defConfig :: Config defConfig = Config-    { connection = Connection-        { server   = "irc.freenode.net"-        , port     = 6667-        , tls      = False -- not supported yet-        , nick     = "bot_test_joe"-        , password = Nothing+    { cfgConnection = Connection+        { connServer   = "irc.freenode.net"+        , connPort     = 6667+        , connTls      = False -- not supported yet+        , connNick     = "bot_test_joe"+        , connPassword = Nothing         }-    , channels        = ["#freepost-bot-test"]-    , logDir          = "state/chanlogs"-    , stateRepo       = Nothing-    , stateFile       = "state/state.json"-    , saveInterval    = time (3 :: Second)-    , botEventLogFile = "state/bot.log"-    , maxMsgChars     = Nothing-    , lagCheck        = Just $ time (1 :: Minute)-    , lagMax          = time (5 :: Minute)+    , cfgChannels        = ["#freepost-bot-test"]+    , cfgLogDir          = "state/chanlogs"+    , cfgStateRepo       = Nothing+    , cfgStateFile       = "state/state.json"+    , cfgSaveInterval    = time (3 :: Second)+    , cfgBotEventLogFile = "state/bot.log"+    , cfgIrcErrorLogFile = Nothing+    , cfgMaxMsgChars     = Nothing+    , cfgLagCheck        = Just $ time (1 :: Minute)+    , cfgLagMax          = time (5 :: Minute)+    , cfgMaxMsgCount     = 1000+    , cfgMsgDelay        = time (100 :: Millisecond)     }  -- Get the bot ready for listening to IRC messages.@@ -87,13 +93,34 @@ listenToEvent :: Chan (Msg a)       -- Chan from which to read events               -> EventHandler e s a -- Handler for external events               -> Session e s Bool-listenToEvent chan handler = do-    msg <- liftIO $ readChan chan-    case msg of-        MsgLogEvent event -> handleEvent (Left event) >> return True-        MsgBotEvent event -> handleEvent (Right event) >> return True-        MsgExtEvent event -> handler event >> return True-        MsgQuit           -> return False+listenToEvent q handler = do+    m <- liftIO $ readChan q+    case m of+        MsgLogEvent event -> do+            handleEvent $ Left event+            return True+        MsgHistoryEvent nick chan msg action -> do+            rememberMsg chan nick msg action+            return True+        MsgCountLogMsg chan -> do+            recordMsg chan+            return True+        MsgCountLogJoin nick chan -> do+            recordJoin nick chan+            return True+        MsgCountLogPart nick chan -> do+            recordPart nick chan+            return True+        MsgCountLogQuit nick -> do+            recordQuit nick+            return True+        MsgBotEvent event -> do+            handleEvent $ Right event+            return True+        MsgExtEvent event -> do+            handler event+            return True+        MsgQuit -> return False  -- Get time since epoch. getNow :: IO TimeSpec@@ -108,21 +135,37 @@             -> IO () listenToIrc ms bot chan pongvar = do     logger <--        newLogger (liftM snd $ beGetTime bot) (botEventLogFile $ beConfig bot)+        newLogger+            (liftM snd $ beGetTime bot)+            (cfgBotEventLogFile $ beConfig bot)+    elogger <-+        case cfgIrcErrorLogFile $ beConfig bot of+            Just path -> fmap Just $ newLogger (liftM snd $ beGetTime bot) path+            Nothing ->   return Nothing     putStrLn "Bot: IRC event source listening to IRC events"     let match e = matchEvent ms e (beConfig bot) (commandSets $ beBehavior bot)+        getEvents =+            if isJust elogger+                then hGetIrcEvents'+                else \ h -> liftM (\ es -> ([], es)) $ hGetIrcEvents h         loop = do-            r <- tryIOError $ hGetIrcEvents $ beHandle bot+            r <- tryIOError $ getEvents $ beHandle bot             case r of                 Left e -> do                     putStrLn "Bot: IRC event listener hGetIrcEvents IO error"                     print e                     writeChan chan MsgQuit-                Right ircEvents -> do+                Right (errs, ircEvents) -> do                     let botEvents = map match ircEvents-                        logEvents = catMaybes $ map fromClientEvent ircEvents-                        interleave logs bots = concat $ transpose-                            [map MsgLogEvent logs, map MsgBotEvent bots]+                        logEvents = mapMaybe fromClientEvent ircEvents+                        hisEvents = mapMaybe checkEvent ircEvents+                        cntEvents = mapMaybe countEvent ircEvents+                        interleaved = concat $ transpose+                            [ map MsgLogEvent logEvents+                            , hisEvents+                            , cntEvents+                            , map MsgBotEvent botEvents+                            ]                         isPong (C.Pong _ _) = True                         isPong _            = False                     when (any isPong ircEvents) $ do@@ -130,7 +173,10 @@                         void $ tryTakeMVar pongvar                         putMVar pongvar now                     mapM_ (logLine logger . show) botEvents-                    writeList2Chan chan $ interleave logEvents botEvents+                    case elogger of+                        Nothing -> return ()+                        Just lg -> mapM_ (logLine lg) errs+                    writeList2Chan chan interleaved                     loop     loop @@ -151,11 +197,11 @@           -> MVar TimeSpec           -> IO () manageLag bot chan pongvar =-    case lagCheck $ beConfig bot of+    case cfgLagCheck $ beConfig bot of         Nothing -> return ()         Just iv -> do             putStrLn "Bot: IRC lag manager thread running"-            let maxdiff = intervalToSpec $ lagMax $ beConfig bot+            let maxdiff = intervalToSpec $ cfgLagMax $ beConfig bot                 loop prev = do                     mpong <- tryTakeMVar pongvar                     let pong = fromMaybe prev mpong@@ -165,12 +211,26 @@                             putStrLn "Bot: IRC max lag reached"                             writeChan chan MsgQuit                         else do-                            let serv = server $ connection $ beConfig bot+                            let serv =+                                    connServer $ cfgConnection $ beConfig bot                             hPutIrc (beHandle bot) $ PingMessage serv Nothing                             threadDelay $ fromInteger $ microseconds iv                             loop pong             loop =<< getNow +-- Wait for requests to send IRC messages, and send them while maintaining a+-- delay to avoid flood.+sendMessages :: BotEnv e s -> IO ()+sendMessages bot = do+    putStrLn "Bot: IRC message sending scheduler thread running"+    let q = beMsgQueue bot+        h = beHandle bot+        delay = fromInteger $ microseconds $ cfgMsgDelay $ beConfig bot+    forever $ do+        msg <- readChan q+        sendIO h msg+        threadDelay delay+ -- Connect, login, join. Then listen to events and handle them, forever. botSession :: [EventMatcher e s]            -> [EventSource e s a]@@ -182,6 +242,7 @@     chan <- liftIO newChan     bot <- ask     pongvar <- liftIO newEmptyMVar+    liftIO $ void $ forkIO $ sendMessages bot     liftIO $ void $ forkIO $ listenToIrc matchers bot chan pongvar     liftIO $ void $ forkIO $ manageLag bot chan pongvar     let launch s = forkIO $ s (beConfig bot)

@@ -44,4 +44,5 @@ where  import Network.IRC.Fun.Bot.Internal.Chat+import Network.IRC.Fun.Bot.Internal.ChatExt import Network.IRC.Fun.Bot.Internal.Failure

@@ -26,27 +26,37 @@     , partChannel     , partMulti     , partAll+    , sendIO     , sendToUser+    , sendToUserNow     , sendToChannel+    , sendToChannelNow     , sendBack-    , putIrc+    , sendBackNow     ) where +import Control.AutoUpdate+import Control.Concurrent.Chan import Control.Exception (bracket) import Control.Monad (liftM) import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.RWS (gets, runRWST)+import Control.Monad.Trans.RWS (asks, gets, runRWST) import Data.Char (isSpace) import Data.List (union)+import Network.IRC.Fun.Bot.Internal.History (rememberMsg)+import Network.IRC.Fun.Bot.Internal.MsgCount (recordMsg) import Network.IRC.Fun.Bot.Internal.Persist import Network.IRC.Fun.Bot.Internal.State import Network.IRC.Fun.Bot.Internal.Types+import Network.IRC.Fun.Client.ChannelLogger (logEvent, ChanLogEvent (..)) import Network.IRC.Fun.Client.Commands-import Network.IRC.Fun.Client.IO (ircConnect, ircDisconnect, hPutIrc)+import Network.IRC.Fun.Client.IO import Network.IRC.Fun.Client.Time (currentTimeGetter) import Network.IRC.Fun.Messages.Types (Message)+import System.Clock +import qualified Data.HashMap.Lazy as M (lookup) import qualified Data.HashSet as S (toList)  -------------------------------------------------------------------------------@@ -97,12 +107,17 @@ run conf beh env state session = do     timeGetter <- currentTimeGetter     save <- mkSaveBotState conf+    getMin <- mkAutoUpdate defaultUpdateSettings+        { updateFreq   = 1000000 * 60 -- 60 seconds+        , updateAction = liftM ((`div` 60) . sec) $ getTime Realtime+        }+    mq <- newChan     putStrLn "Bot: Connecting to IRC server"     bracket-        (ircConnect $ connection conf)+        (ircConnect $ cfgConnection conf)         ircDisconnect         (\ h -> do-            let botEnv = BotEnv conf beh h timeGetter save env+            let botEnv = BotEnv conf beh h timeGetter getMin save mq env             putStrLn "Bot: Loading state from file"             botState <- loadBotState botEnv state             runSession botEnv botState session@@ -113,7 +128,7 @@ login :: Session e s () login = do     h <- askHandle-    conn <- askConfigS connection+    conn <- askConfigS cfgConnection     liftIO $ ircLogin h conn False False  -- | IRC servers send PING messages at regular intervals to test the presence@@ -155,7 +170,7 @@ -- joined. joinConfig :: Session e s () joinConfig = do-    chansC <- askConfigS channels+    chansC <- askConfigS cfgChannels     chansP <- liftM S.toList $ gets bsSelChans     let chans = union chansC chansP     joinMulti $ map (flip (,) Nothing) chans@@ -202,37 +217,125 @@ makeLines :: String -> Session e s [String] makeLines msg = do     let ls = lines msg-    maybelen <- askConfigS maxMsgChars+    maybelen <- askConfigS cfgMaxMsgChars     case maybelen of         Nothing     -> return ls         Just maxlen -> return $ concatMap (splitN maxlen) ls +-- Log a channel message event.+logChanMsg :: String -> String -> String -> Session e s ()+logChanMsg nick chan msg = do+    cstates <- gets bsChannels+    case M.lookup chan cstates >>= csLogger of+        Nothing -> return ()+        Just lg -> liftIO $ logEvent lg (MessageChan nick msg)++sendToChannelIO :: Handle -> String -> [String] -> IO ()+sendToChannelIO h chan = mapM_ $ ircSendToChannel h chan++sendToUserIO :: Handle -> String -> [String] -> IO ()+sendToUserIO h nick = mapM_ $ ircSendToUser h nick++sendIO :: Handle -> IrcMsg -> IO ()+sendIO h msg =+    case msgRecip msg of+        Left nick  -> sendToUserIO h nick $ msgLines msg+        Right chan -> sendToChannelIO h chan $ msgLines msg++sendToChannelHere :: String -> [String] -> Session e s ()+sendToChannelHere chan lines = do+    h <- askHandle+    liftIO $ sendToChannelIO h chan lines++sendToUserHere :: String -> [String] -> Session e s ()+sendToUserHere nick lines = do+    h <- askHandle+    liftIO $ sendToUserIO h nick lines++sendToChannelDefer :: String -> [String] -> Session e s ()+sendToChannelDefer chan lines = do+    q <- asks beMsgQueue+    let msg = IrcMsg+            { msgRecip = Right chan+            , msgLines = lines+            }+    liftIO $ writeChan q msg++sendToUserDefer :: String -> [String] -> Session e s ()+sendToUserDefer nick lines = do+    q <- asks beMsgQueue+    let msg = IrcMsg+            { msgRecip = Left nick+            , msgLines = lines+            }+    liftIO $ writeChan q msg++sendToChannelImpl :: (String -> [String] -> Session e s ())+                  -> String+                  -> String+                  -> Session e s ()+sendToChannelImpl send chan msg = do+    msgs <- makeLines msg+    send chan msgs+    self <- askConfigS $ connNick . cfgConnection+    let remember s = do+            rememberMsg chan self s False+            recordMsg chan+            logChanMsg self chan s+    mapM_ remember msgs++sendToUserImpl :: (String -> [String] -> Session e s ())+               -> String+               -> String+               -> Session e s ()+sendToUserImpl send nick msg = do+    msgs <- makeLines msg+    send nick msgs+ -- | Send a message to an IRC channel. -- -- This usually requires that the bot joins the channel first, because many -- channels have the +n flag set. This flag forbids sending a messages into -- a channel from outside it.-sendToChannel :: String -- ^ The channel name-              -> String -- ^ The message to send. It may contain newlines, in-                        --   which case it will be split into multiple messages-                        --   and sent sequentially.-              -> Session e s ()-sendToChannel channel msg = do-    h <- askHandle-    msgs <- makeLines msg-    liftIO $ mapM_ (ircSendToChannel h channel) msgs+--+-- This function doesn't instantly send the message, but instead queues it for+-- sending by the sending scheduler thread, which adds delay to avoid flood. If+-- you want to send instantly, see 'sendToChannelNow'.+sendToChannel+    :: String -- ^ The channel name+    -> String -- ^ The message to send. It may contain newlines, in which case+              -- it will be split into multiple messages and sent sequentially.+    -> Session e s ()+sendToChannel = sendToChannelImpl sendToChannelDefer +-- | A variant of 'sendToChannel' which sends instantly, without any delay.+sendToChannelNow+    :: String -- ^ The channel name+    -> String -- ^ The message to send. It may contain newlines, in which case+              -- it will be split into multiple messages and sent sequentially.+    -> Session e s ()+sendToChannelNow = sendToChannelImpl sendToChannelHere+ -- | Send a private message to an IRC user.+--+-- This function doesn't instantly send the message, but instead queues it for+-- sending by the sending scheduler thread, which adds delay to avoid flood. If+-- you want to send instantly, see 'sendToUserNow'. sendToUser :: String -- ^ The user's nickname            -> String -- ^ The message to send. It may contain newlines, in                      --   which case it will be split into multiple messages                      --   and sent sequentially.            -> Session e s ()-sendToUser nick msg = do-    h <- askHandle-    msgs <- makeLines msg-    liftIO $ mapM_ (ircSendToUser h nick) msgs+sendToUser = sendToUserImpl sendToUserDefer +-- | A variant of 'sendToUser' which sends instantly, without any delay.+sendToUserNow :: String -- ^ The user's nickname+              -> String -- ^ The message to send. It may contain newlines, in+                        --   which case it will be split into multiple messages+                        --   and sent sequentially.+              -> Session e s ()+sendToUserNow = sendToUserImpl sendToUserHere+ -- | Send a message back to the sender. If a channel is specified, send to the -- channel. If not, send a private message. sendBack :: Maybe String -- ^ Channel name, specify if replying to a message@@ -245,14 +348,20 @@ sendBack (Just chan) _nick msg = sendToChannel chan msg sendBack Nothing     nick  msg = sendToUser nick msg +-- | A variant of 'sendBack' which sends instantly, without any delay.+sendBackNow+    :: Maybe String -- ^ Channel name, specify if replying to a message sent in+                    --   a channel. Otherwise pass 'Nothing'.+    -> String       -- ^ The sender user's nickname+    -> String       -- ^ The message to send. It may contain newlines, in which+                    --   case it will be split into multiple messages and sent+                    --   sequentially.+    -> Session e s ()+sendBackNow (Just chan) _nick msg = sendToChannelNow chan msg+sendBackNow Nothing     nick  msg = sendToUserNow nick msg+ ------------------------------------------------------------------------------- -- Other Utilities ------------------------------------------------------------------------------- --- | Send an IRC message to the server. This should only be used if the other--- wrappers don't provide what you need. If that's the case, it may be a good--- idea for reusability to add a new wrapper.-putIrc :: Message -> Session e s ()-putIrc msg = do-    h <- askHandle-    liftIO $ hPutIrc h msg+-- See the ChatExt module.

@@ -0,0 +1,34 @@+{- This file is part of irc-fun-bot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Network.IRC.Fun.Bot.Internal.ChatExt+    ( putIrc+    )+where+++import Control.Monad.IO.Class (liftIO)+import Network.IRC.Fun.Bot.Internal.State (askHandle)+import Network.IRC.Fun.Bot.Internal.Types (Session)+import Network.IRC.Fun.Client.IO (hPutIrc)+import Network.IRC.Fun.Messages.Types (Message)++-- | Send an IRC message to the server. This should only be used if the other+-- wrappers don't provide what you need. If that's the case, it may be a good+-- idea for reusability to add a new wrapper.+putIrc :: Message -> Session e s ()+putIrc msg = do+    h <- askHandle+    liftIO $ hPutIrc h msg

@@ -49,7 +49,7 @@ import Network.IRC.Fun.Bot.Internal.Types hiding (Logger) import Network.IRC.Fun.Bot.Behavior (findCmd, findCmdInSet) import Network.IRC.Fun.Client.ChannelLogger hiding (LogEvent (..))-import Network.IRC.Fun.Client.IO (nick)+import Network.IRC.Fun.Client.IO (connNick) import Network.IRC.Fun.Client.Util (mentions)  import qualified Data.HashMap.Lazy as M@@ -107,7 +107,7 @@  detectRef :: Config -> String -> Maybe String detectRef conf msg =-    let bnick = nick (connection conf)+    let bnick = connNick (cfgConnection conf)         dw = Just . dropWhile isSpace     in  case stripPrefix bnick msg of             Nothing        -> Nothing@@ -382,7 +382,7 @@         C.Names priv chan pnicks -> Just $ Names chan priv pnicks         _ -> Nothing     where-    bnick = nick (connection conf)+    bnick = connNick (cfgConnection conf)  combineMatchers :: [EventMatcher e s] -> EventMatcher e s combineMatchers []     _event _conf _csets = Nothing@@ -452,7 +452,7 @@         Join chan user -> do             tracked <- channelIsTracked chan             when tracked $ addMember chan user-            self <- askConfigS $ nick . connection+            self <- askConfigS $ connNick . cfgConnection             when (user == self) $ addCurrChan chan             handleJoin b chan user         Part chan nick why -> do@@ -489,7 +489,7 @@ -- set of channel loggers and channel-specific log events to write into them. detectLogEvents :: L.LogEvent -> Session e s [(Logger, ChanLogEvent)] detectLogEvents e =-    let detect event cstate = fmap (\ cl -> (cl, event)) $ chanLogger cstate+    let detect event cstate = fmap (\ cl -> (cl, event)) $ csLogger cstate         detectOne chan event = do             cstates <- gets bsChannels             return $ maybeToList $ M.lookup chan cstates >>= detect event

@@ -0,0 +1,65 @@+{- This file is part of irc-fun-bot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Network.IRC.Fun.Bot.Internal.History+    ( rememberMsg+    , checkEvent+    )+where++import Control.Monad (liftM, when)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.RWS (modify)+import Data.Sequence ((|>), Seq, ViewL (..))+import Network.IRC.Fun.Bot.Internal.State+import Network.IRC.Fun.Bot.Internal.Types++import qualified Data.HashMap.Lazy as M+import qualified Data.Sequence as Q+import qualified Data.Sequence.Util as QU+import qualified Network.IRC.Fun.Client.Events as C (Event (..))++-- | Remember someone said something, for use later when quoting.+rememberMsg :: String -- ^ Channel+            -> String -- ^ User nickname+            -> String -- ^ Message+            -> Bool   -- ^ Whether a /me action (True) or regular message (False)+            -> Session e s ()+rememberMsg chan nick msg action = do+    maxlines <- liftM (maybe 0 csHistoryLines . M.lookup chan) getChans+    when (maxlines > 0) $ do+        h <- getHistory+        t <- askTimeGetter >>= liftIO . liftM snd+        m <- getMinutes+        let hl = HistoryLine+                { hlTime    = t+                , hlNick    = nick+                , hlMessage = msg+                , hlAction  = action+                , hlMinute  = m+                }+            shorten s = if Q.length s > maxlines then QU.tail s else s+            hls' = case M.lookup chan h of+                Just hls -> shorten $ hls |> hl+                Nothing  -> Q.singleton hl+        modify $ \ s -> s { bsHistory = M.insert chan hls' h }++-- | If a client event is a message to remember, get details.+checkEvent :: C.Event -> Maybe (Msg a)+checkEvent (C.ChannelMessage chan nick msg _) =+    Just $ MsgHistoryEvent nick chan msg False+checkEvent (C.ChannelAction chan nick msg) =+    Just $ MsgHistoryEvent nick chan msg True+checkEvent _ = Nothing

@@ -39,32 +39,32 @@ makeLogger :: BotEnv e s -> String -> IO Logger makeLogger env chan =     let timeGetter = beGetTime env-        logdir = logDir $ beConfig env+        logdir = cfgLogDir $ beConfig env         file = logFilePath logdir "server" chan     in  newLogger (liftM snd timeGetter) file -enable :: String -> ChannelState -> Session e s ChannelState+enable :: String -> ChanState -> Session e s ChanState enable chan cstate =-    if isJust $ chanLogger cstate+    if isJust $ csLogger cstate         then return cstate         else do             env <- ask             logger <- liftIO $ makeLogger env chan-            return cstate { chanLogger = Just logger }+            return cstate { csLogger = Just logger } -disable :: ChannelState -> Session e s ChannelState+disable :: ChanState -> Session e s ChanState disable cstate =-    case chanLogger cstate of+    case csLogger cstate of         Just logger -> do             liftIO $ removeLogger logger-            return cstate { chanLogger = Nothing }+            return cstate { csLogger = Nothing }         Nothing -> return cstate  -- | Check whether a given channel is being logged. channelIsLogged :: String -> Session e s Bool channelIsLogged chan = do     chans <- getChans-    return $ isJust $ M.lookup chan chans >>= chanLogger+    return $ isJust $ M.lookup chan chans >>= csLogger  -- | Start logging all the channels the bot has joined which aren't -- being logged.

@@ -0,0 +1,227 @@+{- This file is part of irc-fun-bot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++module Network.IRC.Fun.Bot.Internal.MsgCount+    ( startCountingAll+    , startCountingChan+    , startCountingChans+    , stopCountingAll+    , stopCountingChan+    , stopCountingChans+    , getCountLogs+    , getCountLog+    , chanIsCounted+    , everParted+    , everJoined+    , countMsgs+    , msgsSinceParted+    , recordMsg+    , recordJoin+    , recordPart+    , recordQuit+    , countEvent+    )+where++import Control.Monad (liftM, when)+import Control.Monad.Trans.RWS (modify, gets)+import Data.Foldable (any, foldl)+import Data.Sequence (Seq, ViewR (..), (|>))+import Network.IRC.Fun.Bot.Internal.Nicks (presence)+import Network.IRC.Fun.Bot.Internal.State+import Network.IRC.Fun.Bot.Internal.Types+import Prelude hiding (any, foldl)++import qualified Data.HashMap.Lazy as M+import qualified Data.Sequence as Q+import qualified Data.Sequence.Util as QU+import qualified Network.IRC.Fun.Client.Events as C (Event (..))++set :: Bool -> ChanState -> ChanState+set b cs = cs { csCounting = b }++enable :: ChanState -> ChanState+enable = set True++disable :: ChanState -> ChanState+disable = set False++-- | Start counting in all the channels the bot has joined which aren't+-- being counted.+startCountingAll :: Session e s ()+startCountingAll = modifyChans $ M.map enable++-- | Start counting in the given channel, if not counted already.+startCountingChan :: String -> Session e s ()+startCountingChan chan = modifyChans $ M.adjust enable chan++-- | Start counting in the channels not counted, among the ones given.+startCountingChans :: [String] -> Session e s ()+startCountingChans chans = do+    chanmapAll <- getChans+    let given = M.fromList (zip chans (repeat ()))+        chanmapG = chanmapAll `M.intersection` given+        chanmapD = M.filter (not . csCounting) chanmapG+        chanmapE = M.map enable chanmapD+        chanmapAllE = chanmapE `M.union` chanmapAll+    putChans chanmapAllE++-- | Stop counting in all counted channels.+stopCountingAll :: Session e s ()+stopCountingAll =+    modify $ \ bstate -> bstate+        { bsMsgCountLog  = M.empty+        , bsChannels     = M.map disable $ bsChannels bstate+        }++-- | Stop counting in the given channel, if counted.+stopCountingChan :: String -> Session e s ()+stopCountingChan chan =+    modify $ \ bstate -> bstate+        { bsMsgCountLog = M.delete chan $ bsMsgCountLog bstate+        , bsChannels    = M.adjust disable chan $ bsChannels bstate+        }++-- | Stop counting in the counted channels among the ones given.+stopCountingChans :: [String] -> Session e s ()+stopCountingChans chans =+    modify $ \ bstate -> bstate+        { bsMsgCountLog  =+            bsMsgCountLog bstate+            `M.difference`+            M.fromList (zip chans (repeat ()))+        , bsChannels     =+            let chanmap = bsChannels bstate+                chanmapE = M.filter csCounting chanmap+                chanmapD = M.map disable chanmapE+            in  chanmapD `M.union` chanmap+        }++-- | Get a mapping between channel names and sequences of their message+-- counting data.+getCountLogs :: Session e s (M.HashMap String (Seq MsgCountEntry))+getCountLogs = gets bsMsgCountLog++-- | Get the count log for a specific channel. If there is none, an empty log+-- is returned.+getCountLog :: String -> Session e s (Seq MsgCountEntry)+getCountLog chan = liftM (M.lookupDefault Q.empty chan) getCountLogs++-- | Check whether a given channel is being counted.+chanIsCounted :: String -> Session e s Bool+chanIsCounted chan = liftM (maybe False csCounting . M.lookup chan) getChans++-- | Check whether a given user ever parted the channel, as far as the count+-- log remembers.+everParted :: String -> String -> Session e s Bool+nick `everParted` chan =+    let p (MsgCountPart n) = n == nick+        p _                = False+    in  liftM (any p) $ getCountLog chan++-- | Check whether a given user ever joined the channel, as far as the count+-- log remembers.+everJoined :: String -> String -> Session e s Bool+nick `everJoined` chan =+    let p (MsgCountJoin n) = n == nick+        p _                = False+    in  liftM (any p) $ getCountLog chan++-- | Determine how many messages a log sequence has recorded.+countMsgs :: Seq MsgCountEntry -> Int+countMsgs =+    let f n (MsgCountMsgs m) = n + m+        f n (MsgCountJoin _) = n+        f n (MsgCountPart _) = n+    in  foldl f 0++-- | Find out how many messages the channel had since the given user parted it.+-- On success, return 'Right' it. Otherwise, i.e. if no parting of the user is+-- recorded, return 'Left' the total recorded messages.+msgsSinceParted :: String -> String -> Session e s (Either Int Int)+msgsSinceParted nick chan = do+    cl <- getCountLog chan+    let p (MsgCountPart n) = n == nick+        p _                = False+        (after, until) = Q.breakr p cl+        count = countMsgs after+    return $ if Q.null until+        then Left count+        else Right count++modifyLog :: String+          -> (Seq MsgCountEntry -> Seq MsgCountEntry)+          -> Session e s ()+modifyLog chan f = do+    t <- chanIsCounted chan+    when t $ do+        n <- askConfigS cfgMaxMsgCount+        let g logs =+                let prev = M.lookupDefault Q.empty chan logs+                    new = f prev+                    fixed = if Q.length new > n then QU.tail new else new+                in  M.insert chan fixed logs+        modify $ \ bstate -> bstate+            { bsMsgCountLog = g $ bsMsgCountLog bstate+            }++-- | Count a message in the channel's count log.+recordMsg :: String -> Session e s ()+recordMsg chan =+    let f q =+            case Q.viewr q of+                EmptyR              -> Q.singleton $ MsgCountMsgs 1+                l :> MsgCountMsgs n -> l |> MsgCountMsgs (n + 1)+                _ :> _              -> q |> MsgCountMsgs 1+    in  modifyLog chan f++-- | Count a join in the channel's count log.+recordJoin :: String -> String -> Session e s ()+recordJoin nick chan =+    let f = (|> (MsgCountJoin nick))+    in  modifyLog chan f++-- | Count a part (i.e. leave one channel) in the channel's count log.+recordPart :: String -> String -> Session e s ()+recordPart nick chan =+    let f = (|> (MsgCountPart nick))+    in  modifyLog chan f++-- | Count a quit (i.e. leave all channels) in the channel's count log.+recordQuit :: String -> Session e s ()+recordQuit nick = do+    chans <- presence nick+    let chansPresent = M.fromList $ zip chans (repeat ())+    chansCounted <- liftM (M.filter csCounting) getChans+    let chansAct = chansPresent `M.intersection` chansCounted+    logs <- getCountLogs+    let logsAct = logs `M.intersection` chansAct+    n <- askConfigS cfgMaxMsgCount+    let f q =+            let new = q |> MsgCountPart nick+            in  if Q.length new > n then QU.tail new else new+        logsNew = M.map f logsAct+    modify $ \ bstate -> bstate+        { bsMsgCountLog = logsNew `M.union` bsMsgCountLog bstate+        }++-- | If en event needs to be considered in message counting, handle it.+countEvent :: C.Event -> Maybe (Msg a)+countEvent (C.Join chan nick)            = Just $ MsgCountLogJoin nick chan+countEvent (C.Part chan nick _)          = Just $ MsgCountLogPart nick chan+countEvent (C.Quit nick _)               = Just $ MsgCountLogQuit nick+countEvent (C.ChannelMessage chan _ _ _) = Just $ MsgCountLogMsg chan+countEvent (C.ChannelAction chan _ _)    = Just $ MsgCountLogMsg chan+countEvent _                             = Nothing

@@ -36,7 +36,7 @@ import Control.Monad (unless) import Control.Monad.Trans.RWS import Data.Maybe (fromMaybe)-import Network.IRC.Fun.Bot.Internal.Chat (putIrc)+import Network.IRC.Fun.Bot.Internal.ChatExt (putIrc) import Network.IRC.Fun.Bot.Internal.State import Network.IRC.Fun.Bot.Internal.Types import Network.IRC.Fun.Messages.TypeAliases (ChannelName)@@ -45,24 +45,24 @@ import qualified Data.HashMap.Lazy as M import qualified Network.IRC.Fun.Client.NickTracker as NT -enable :: ChannelState -> ChannelState-enable cstate = cstate { chanTracking = True }+enable :: ChanState -> ChanState+enable cstate = cstate { csTracking = True } -disable :: ChannelState -> ChannelState-disable cstate = cstate { chanTracking = False }+disable :: ChanState -> ChanState+disable cstate = cstate { csTracking = False }  -- | Check whether a given channel is being tracked. channelIsTracked :: String -> Session e s Bool channelIsTracked chan = do     chans <- getChans-    return $ fromMaybe False $ fmap chanTracking $ M.lookup chan chans+    return $ fromMaybe False $ fmap csTracking $ M.lookup chan chans  -- | Start tracking nicks in all the channels the bot has joined which aren't -- being tracked. startTrackingAll :: Session e s () startTrackingAll = do     chans <- getChans-    let chansD = [chan | (chan, ChannelState False _) <- M.toList chans]+    let chansD = [chan | (chan, ChanState False _ _ _) <- M.toList chans]         chansAllE = M.map enable chans     putChans chansAllE     unless (null chansD) $ putIrc $ NamesMessage chansD Nothing@@ -72,8 +72,8 @@ startTrackingChannel chan = do     chans <- getChans     case M.lookup chan chans of-        Just cstate -> unless (chanTracking cstate) $ do-            let chansE = M.insert chan (cstate { chanTracking = True }) chans+        Just cstate -> unless (csTracking cstate) $ do+            let chansE = M.insert chan (cstate { csTracking = True }) chans             putChans chansE             putIrc $ NamesMessage [chan] Nothing         Nothing -> return ()@@ -84,7 +84,7 @@     chanmapAll <- getChans     let given = M.fromList (zip chans (repeat ()))         chanmapG = chanmapAll `M.intersection` given-        chanmapD = M.filter (not . chanTracking) chanmapG+        chanmapD = M.filter (not . csTracking) chanmapG         chansD = M.keys chanmapD         chanmapE = M.map enable chanmapD         chanmapAllE = chanmapE `M.union` chanmapAll@@ -114,7 +114,7 @@         { bsTracker  = NT.removeChannels chans $ bsTracker bstate         , bsChannels =             let chanmap = bsChannels bstate-                chanmapE = M.filter chanTracking chanmap+                chanmapE = M.filter csTracking chanmap                 chanmapD = M.map disable chanmapE             in  chanmapD `M.union` chanmap         }

@@ -31,7 +31,6 @@ import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS import Data.Aeson-import Data.Maybe (isJust) import Data.JsonState import Data.List (union) import Data.Time.Interval@@ -44,41 +43,42 @@ import qualified Data.HashMap.Lazy as M import qualified Data.HashSet as S -data ChannelStateJ = ChannelStateJ Bool Bool--data BotStateJ = BotStateJ (M.HashMap String ChannelStateJ) (S.HashSet String)+data BotStateJ = BotStateJ (M.HashMap String ChanInfo) (S.HashSet String)  toJ :: BotState s -> BotStateJ-toJ bstate = BotStateJ (M.map f $ bsChannels bstate) (bsSelChans bstate)-    where-    f (ChannelState track mlogger) = ChannelStateJ track (isJust mlogger)+toJ bstate =+    BotStateJ (M.map stateToInfo $ bsChannels bstate) (bsSelChans bstate)  fromJ :: BotEnv e s -> BotStateJ -> s -> IO (BotState s) fromJ env (BotStateJ stateJ selJ) pub = do-    let f chan (ChannelStateJ tracking logging) = do+    let f chan (ChanInfo tracking counting logging hls) = do             mlogger <-                 if logging                     then fmap Just $ makeLogger env chan                     else return Nothing-            return $ ChannelState tracking mlogger-        defstate = ChannelStateJ False False-        chansConf = S.toList selJ `union` channels (beConfig env)+            return $ ChanState tracking counting mlogger hls+        defstate = ChanInfo False False False 0+        chansConf = S.toList selJ `union` cfgChannels (beConfig env)         stateConf = M.fromList $ zip chansConf (repeat defstate)         stateAll = stateJ `M.union` stateConf     cstate <- M.traverseWithKey f stateAll-    return $ BotState newNetwork cstate S.empty selJ pub+    return $ BotState newNetwork cstate S.empty selJ M.empty M.empty pub -instance FromJSON ChannelStateJ where+instance FromJSON ChanInfo where     parseJSON (Object o) =-        ChannelStateJ <$>+        ChanInfo <$>         o .: "track" <*>-        o .: "log"+        o .: "count" <*>+        o .: "log" <*>+        o .: "history-lines"     parseJSON _          = mzero -instance ToJSON ChannelStateJ where-    toJSON (ChannelStateJ tracking logging) = object-        [ "track" .= tracking-        , "log"   .= logging+instance ToJSON ChanInfo where+    toJSON (ChanInfo tracking counting logging hls) = object+        [ "track"         .= tracking+        , "count"         .= counting+        , "log"           .= logging+        , "history-lines" .= hls         ]  instance FromJSON BotStateJ where@@ -100,7 +100,7 @@ loadBotState :: BotEnv e s -> s -> IO (BotState s) loadBotState env pub = do     let conf = beConfig env-    r <- loadState $ stateFilePath (stateFile conf) (stateRepo conf)+    r <- loadState $ stateFilePath (cfgStateFile conf) (cfgStateRepo conf)     case r of         Left (False, e) -> error $ "Failed to read state file: " ++ e         Left (True, e)  -> error $ "Failed to parse state file: " ++ e@@ -108,9 +108,9 @@  mkSaveBotState :: Config -> IO (BotState s -> IO ()) mkSaveBotState conf =-    let iv = fromInteger $ microseconds $ saveInterval conf :: Microsecond+    let iv = fromInteger $ microseconds $ cfgSaveInterval conf :: Microsecond         msg = "auto commit by irc-fun-bot"-    in  mkSaveStateChoose iv (stateFile conf) (stateRepo conf) msg+    in  mkSaveStateChoose iv (cfgStateFile conf) (cfgStateRepo conf) msg  saveBotState :: Session e s () saveBotState = do@@ -145,5 +145,5 @@ addChannelState chan = do     chans <- getChans     unless (chan `M.member` chans) $ do-        putChans $ M.insert chan (ChannelState False Nothing) chans+        putChans $ M.insert chan (ChanState False False Nothing 0) chans         saveBotState

@@ -22,11 +22,15 @@     , askEnvS     , askHandle     , askTimeGetter+    , askMinuteGetter+    , getMinutes     , getState     , getStateS     , putState     , modifyState-    , getChannelState+    , getHistory+    , stateToInfo+    , getChanInfo     , getChans     , putChans     , modifyChans@@ -39,9 +43,12 @@ where  import Control.Monad (liftM)+import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS import Data.HashMap.Lazy (HashMap)+import Data.Int (Int64) import Data.Maybe (isJust)+import Data.Sequence (Seq) import Data.Time.Clock (UTCTime) import Network.IRC.Fun.Bot.Internal.Types import Network.IRC.Fun.Client.IO (Handle)@@ -86,6 +93,18 @@ askTimeGetter :: Session e s (IO (UTCTime, String)) askTimeGetter = asks beGetTime +-- | Fetch the minute getter. The actual data is cached and updated at most+-- once per minute depending on need. You can safely use it at any frequency+-- withou overloading IO and time formatting.+askMinuteGetter :: Session e s (IO Int64)+askMinuteGetter = asks beGetMinute++-- | Get the number of minutes since the epoch using an auto updating counter.+getMinutes :: Session e s Int64+getMinutes = do+    getMin <- askMinuteGetter+    liftIO getMin+ -- | Fetch the current value of the state within the session. getState :: Session e s s getState = gets bsPublic@@ -105,28 +124,30 @@ modifyState f =     modify $ \ old@(BotState { bsPublic = st }) -> old { bsPublic = f st } +-- | Get a mapping between channel names and sequences of their last messages.+getHistory :: Session e s (HashMap String (Seq HistoryLine))+getHistory = gets bsHistory++-- Create channel info from its state+stateToInfo :: ChanState -> ChanInfo+stateToInfo (ChanState track count mlogger hls) =+    ChanInfo track count (isJust mlogger) hls+ -- | Get channel state information, in the form of a mapping from channel names -- to their data.------ Channel data is a pair of two booleans. The first says whether channel--- tracking is enabled. The second says whether channel logging info a file is--- enabled.-getChannelState :: Session e s (HashMap String (Bool, Bool))-getChannelState = do-    chans <- getChans-    let f cstate = (chanTracking cstate, isJust $ chanLogger cstate)-    return $ M.map f chans+getChanInfo :: Session e s (HashMap String ChanInfo)+getChanInfo = liftM (M.map stateToInfo) getChans  -- Get the channel state map.-getChans :: Session e s (HashMap String ChannelState)+getChans :: Session e s (HashMap String ChanState) getChans = gets bsChannels  -- Set a new value for the channel state map.-putChans :: HashMap String ChannelState -> Session e s ()+putChans :: HashMap String ChanState -> Session e s () putChans chans = modify $ \ s -> s { bsChannels = chans }  -- Update the channel state map value with the result of applying a function.-modifyChans :: (HashMap String ChannelState -> HashMap String ChannelState)+modifyChans :: (HashMap String ChanState -> HashMap String ChanState)             -> Session e s () modifyChans f = modify $ \ s -> s { bsChannels = f $ bsChannels s } 

@@ -19,8 +19,12 @@     , Failure (..)     , Command (..)     , CommandSet (..)+    , IrcMsg (..)     , BotEnv (..)-    , ChannelState (..)+    , MsgCountEntry (..)+    , ChanState (..)+    , ChanInfo (..)+    , HistoryLine (..)     , BotState (..)     , Session     , ChannelPrivacy (..)@@ -37,15 +41,19 @@     ) where +import Control.Concurrent.Chan (Chan) import Control.Monad.Trans.RWS (RWST) import Data.HashMap.Lazy (HashMap) import Data.HashSet (HashSet)+import Data.Int (Int64)+import Data.Sequence (Seq) import Data.Time.Clock (UTCTime) import Data.Time.Interval (TimeInterval) import Network.IRC.Fun.Client.ChannelLogger (LogEvent) import Network.IRC.Fun.Client.IO (Connection, Handle) import Network.IRC.Fun.Client.Events (ChannelPrivacy (..), Privilege (..)) import Network.IRC.Fun.Client.NickTracker (NetworkTracker)+import Network.IRC.Fun.Messages.TypeAliases (NickName, ChannelName) import System.Log.FastLogger (LoggerSet)  import qualified Network.IRC.Fun.Client.ChannelLogger as L (Logger)@@ -54,44 +62,63 @@ -- | Configuration for the bot connection to IRC. data Config = Config     { -- | Connection details, including nickname and optional password-      connection      :: Connection+      cfgConnection      :: Connection       -- | The list of channels for the bot to join is generally set in the       -- state file, but when the bot launches it joins both the channels       -- listed there and the ones listed here. This list is intended to be       -- used as hard-coded backup, i.e. the bot will always join these       -- channels regardless of what the state file says.-    , channels        :: [String]+    , cfgChannels        :: [String]       -- | Directory path under which IRC log files will be placed. Relative to       -- the bot process working directory, or absolute.-    , logDir          :: FilePath+    , cfgLogDir          :: FilePath       -- | Directory path for the state file. This enables Git commits of the       -- state file. A relative (to the bot process working dir) or absolute       -- path to the Git repository. You must create the directory yourself if       -- it doesn't exist, but repo will be auto-created for you if needed.-    , stateRepo       :: Maybe FilePath+    , cfgStateRepo       :: Maybe FilePath       -- | Filename into the bot state managed by this library will be stored.       -- The custom part of the state isn't handled. If 'stateDir' is       -- 'Nothing', this is a path relative to the bot process working       -- directory, or absolute. Otherwise, it's relative to the 'stateDir'.-    , stateFile       :: FilePath+    , cfgStateFile       :: FilePath       -- | Minimal time interval between state saves. For example, to say       -- \"don't write state to file more than once per three seconds\", set       -- this field to 3 seconds, i.e. @time (3 :: Second)@.-    , saveInterval    :: TimeInterval+    , cfgSaveInterval    :: TimeInterval       -- | Filename for the bot's main event log, i.e. produced by the IRC       -- event source.-    , botEventLogFile :: FilePath+    , cfgBotEventLogFile :: FilePath+      -- | Filename for writing error messages generated by invalid IRC lines+      -- or errors in their analysis or in event detection. Useful for+      -- debugging.+    , cfgIrcErrorLogFile :: Maybe FilePath       -- | Maximal number of characters in a message the bot can send to a user       -- or a channel. Longer messages will be split. 'Nothing' means no limit,       -- i.e. let the IRC server truncate long messages. This limit applies to       -- 'sendToUser' and 'sendToChannel' and all the functions which use them.       -- A safe default if you want to set a limit is 400.-    , maxMsgChars     :: Maybe Int+    , cfgMaxMsgChars     :: Maybe Int       -- | Time interval for sending PINGs to the server, to make sure the       -- connection is alive. 'Nothing' means no PINGs sent.-    , lagCheck        :: Maybe TimeInterval+    , cfgLagCheck        :: Maybe TimeInterval       -- | Maximal lag time allowed before the bot quits.-    , lagMax          :: TimeInterval+    , cfgLagMax          :: TimeInterval+      -- | Maximal number of messages to count per channel in the message+      -- counter. Possibly a bit more will be counted, in cases it doesn't+      -- require more memory anyway. If a user misses more than that number N,+      -- they will simply be notified \"you missed at least N messages!\".+      --+      -- TODO actually right now this is the maximal length of the per-channel+      -- log, which includes messages, joins and parts. It's just a tool to+      -- limit memory usage, nothing more.+    , cfgMaxMsgCount     :: Int+      -- | IRC messages can be sent to users or channels either instantly, or+      -- through a dedicated sender thread. That thread creates a delay+      -- between messages, to avoid flooding, since that may result with the+      -- server blocking some of the messages. This option sets the time to+      -- wait between messages.+    , cfgMsgDelay        :: TimeInterval     }     deriving Show @@ -169,6 +196,13 @@     , csetCommands :: [Command e s]     } +-- An IRC message to send to a user or a channel.+data IrcMsg = IrcMsg+    { msgRecip :: Either NickName ChannelName+    , msgLines :: [String]+    }+    deriving (Show)+ -- Read-only bot environment. -- -- The full environment is exposed to commands, which is both power and@@ -185,29 +219,73 @@     , beBehavior  :: Behavior e s     , beHandle    :: Handle     , beGetTime   :: IO (UTCTime, String)+      -- An 'IO' action which reads a periodically updated counter of the+      -- number of minutes since the epoch.+    , beGetMinute :: IO Int64     , beSaveState :: BotState s -> IO ()+    , beMsgQueue  :: Chan IrcMsg     , beCustom    :: e     } +-- | Message counter log entry.+data MsgCountEntry+    -- | Number of messages sent in a channel+    = MsgCountMsgs Int+    -- | User joined the channel+    | MsgCountJoin String+    -- | User left the channel+    | MsgCountPart String+ -- Per-channel modifiable state-data ChannelState = ChannelState-    { chanTracking :: Bool-    , chanLogger   :: Maybe L.Logger+data ChanState = ChanState+    { -- Whether user-in-channel tracking is enabled for this channel+      csTracking     :: Bool+      -- Whether message counting is enabled for this channel+    , csCounting     :: Bool+      -- An optional channel-activity-to-text-file logger+    , csLogger       :: Maybe L.Logger+      -- Maximal number of channel message history lines to remember+    , csHistoryLines :: Int     } +-- | Per-channel information to return to the API user+data ChanInfo = ChanInfo+    { -- | Whether user-in-channel tracking is enabled for this channel+      ciTrack        :: Bool+      -- | Whether message counting is enabled for this channel+    , ciCount        :: Bool+      -- | Whether logging-to-file is enabled for this channel+    , ciLog          :: Bool+      -- | Maximal number of channel message history lines to remember+    , ciHistoryLines :: Int+    }++-- | A message sent previously by an IRC user into a channel.+data HistoryLine = HistoryLine+    { hlTime    :: String+    , hlNick    :: String+    , hlMessage :: String+    , hlAction  :: Bool+    , hlMinute  :: Int64+    }+ -- Readable and writable bot state. Contains internal state used by this -- library, and public state managed by the bot's behavior logic. data BotState s = BotState     { -- Keeps track of which users are in which channels-      bsTracker   :: NetworkTracker+      bsTracker     :: NetworkTracker       -- Per-channel persistent state-    , bsChannels  :: HashMap String ChannelState+    , bsChannels    :: HashMap String ChanState       -- Channels of which the bot is currently a member-    , bsCurrChans :: HashSet String+    , bsCurrChans   :: HashSet String       -- Channels the bot should join when it launches-    , bsSelChans  :: HashSet String+    , bsSelChans    :: HashSet String+      -- Per-channel last messages+    , bsHistory     :: HashMap String (Seq HistoryLine)+      -- Per-channel message counter log+    , bsMsgCountLog :: HashMap String (Seq MsgCountEntry)       -- Custom state-    , bsPublic    :: s+    , bsPublic      :: s     }  -- | Bot monad. It provides read-only bot environment (e.g. the configuration),@@ -315,6 +393,11 @@ -- An event passed to the main thread (event handler) from other threads. data Msg a     = MsgLogEvent LogEvent+    | MsgHistoryEvent String String String Bool+    | MsgCountLogMsg String+    | MsgCountLogJoin String String+    | MsgCountLogPart String String+    | MsgCountLogQuit String     | MsgBotEvent Event     | MsgExtEvent a     | MsgQuit

@@ -0,0 +1,39 @@+{- This file is part of irc-fun-bot.+ -+ - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++-- | The module gives access to the message count. For each channel with+-- counting enabled, the counter system maintains a log which lists counts of+-- message made in the channel, and user join/part events. This log can then+-- be used to determine how many messages were made between events.+module Network.IRC.Fun.Bot.MsgCount+    ( -- * Counter Control+      startCountingAll+    , startCountingChan+    , startCountingChans+    , stopCountingAll+    , stopCountingChan+    , stopCountingChans+      -- * Queries+    , getCountLogs+    , getCountLog+    , chanIsCounted+    , everParted+    , everJoined+    , countMsgs+    , msgsSinceParted+    )+where++import Network.IRC.Fun.Bot.Internal.MsgCount

@@ -21,13 +21,15 @@     , askBehavior     , askBehaviorS     , askTimeGetter+    , getMinutes     , askEnv     , askEnvS     , getState     , getStateS     , putState     , modifyState-    , getChannelState+    , getHistory+    , getChanInfo     , selectChannel     , unselectChannel     , channelSelected

@@ -17,10 +17,12 @@ module Network.IRC.Fun.Bot.Types     ( Connection (..)     , Config (..)-    --, Room (..)     , Failure (..)     , Command (..)     , CommandSet (..)+    , HistoryLine (..)+    , ChanInfo (..)+    , MsgCountEntry (..)     , Session     , EventMatchSpace (..)     , Behavior (..)