packages feed

irc-fun-bot 0.1.0.0 → 0.2.0.0

raw patch · 19 files changed

+1219/−116 lines, 19 filesdep +aesondep +fast-loggerdep +settingsdep ~irc-fun-clientPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, fast-logger, settings, time, time-interval, time-units, unordered-containers

Dependency ranges changed: irc-fun-client

API changes (from Hackage documentation)

+ Network.IRC.Fun.Bot.EventMatch: defaultMatch :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchNotice :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchNoticeC :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchNoticeP :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchPlainPrivateCommand :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchPrefixedCommand :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchPrefixedCommandC :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchPrefixedCommandP :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRef :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefC :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommand :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandC :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandFromNames :: [String] -> EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandFromNamesC :: [String] -> EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandFromNamesP :: [String] -> EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandFromSet :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandFromSetC :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandFromSetP :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefCommandP :: EventMatcher e s
+ Network.IRC.Fun.Bot.EventMatch: matchRefP :: EventMatcher e s
+ Network.IRC.Fun.Bot.IrcLog: channelIsLogged :: String -> Session e s Bool
+ Network.IRC.Fun.Bot.IrcLog: startLoggingAll :: Session e s ()
+ Network.IRC.Fun.Bot.IrcLog: startLoggingChannel :: String -> Session e s ()
+ Network.IRC.Fun.Bot.IrcLog: startLoggingChannels :: [String] -> Session e s ()
+ Network.IRC.Fun.Bot.IrcLog: stopLoggingAll :: Session e s ()
+ Network.IRC.Fun.Bot.IrcLog: stopLoggingChannel :: String -> Session e s ()
+ Network.IRC.Fun.Bot.IrcLog: stopLoggingChannels :: [String] -> Session e s ()
+ Network.IRC.Fun.Bot.Logger: data Logger
+ Network.IRC.Fun.Bot.Logger: logLine :: ToLogStr s => Logger -> s -> IO ()
+ Network.IRC.Fun.Bot.Logger: newLogger :: IO String -> FilePath -> IO Logger
+ Network.IRC.Fun.Bot.Logger: newLogger' :: FilePath -> Session e s Logger
+ Network.IRC.Fun.Bot.Logger: removeLogger :: Logger -> IO ()
+ Network.IRC.Fun.Bot.Nicks: channelIsTracked :: String -> Session e s Bool
+ Network.IRC.Fun.Bot.Nicks: isInChannel :: String -> String -> Session e s Bool
+ Network.IRC.Fun.Bot.Nicks: presence :: String -> Session e s [ChannelName]
+ Network.IRC.Fun.Bot.Nicks: startTrackingAll :: Session e s ()
+ Network.IRC.Fun.Bot.Nicks: startTrackingChannel :: String -> Session e s ()
+ Network.IRC.Fun.Bot.Nicks: startTrackingChannels :: [String] -> Session e s ()
+ Network.IRC.Fun.Bot.Nicks: stopTrackingAll :: Session e s ()
+ Network.IRC.Fun.Bot.Nicks: stopTrackingChannel :: String -> Session e s ()
+ Network.IRC.Fun.Bot.Nicks: stopTrackingChannels :: [String] -> Session e s ()
+ Network.IRC.Fun.Bot.State: askTimeGetter :: Session e s (IO (UTCTime, String))
+ Network.IRC.Fun.Bot.State: getChannelState :: Session e s (HashMap String (Bool, Bool))
+ Network.IRC.Fun.Bot.State: saveBotState :: Session e s ()
+ Network.IRC.Fun.Bot.Types: botEventLogFile :: Config -> FilePath
+ Network.IRC.Fun.Bot.Types: logDir :: Config -> FilePath
+ Network.IRC.Fun.Bot.Types: saveInterval :: Config -> TimeInterval
+ Network.IRC.Fun.Bot.Types: stateFile :: Config -> FilePath
- Network.IRC.Fun.Bot: runBot :: Config -> Behavior e s -> [EventSource e s a] -> EventHandler e s a -> e -> s -> IO ()
+ Network.IRC.Fun.Bot: runBot :: Config -> [EventMatcher e s] -> Behavior e s -> [EventSource e s a] -> EventHandler e s a -> e -> s -> Session e s () -> IO ()
- Network.IRC.Fun.Bot.Types: Config :: Connection -> [String] -> Config
+ Network.IRC.Fun.Bot.Types: Config :: Connection -> [String] -> FilePath -> FilePath -> TimeInterval -> FilePath -> Config
- Network.IRC.Fun.Bot.Types: type EventSource e s a = Config -> e -> (a -> IO ()) -> ([a] -> IO ()) -> IO ()
+ Network.IRC.Fun.Bot.Types: type EventSource e s a = Config -> e -> (a -> IO ()) -> ([a] -> IO ()) -> (FilePath -> IO Logger) -> IO ()

Files

NEWS view
@@ -3,6 +3,42 @@   +irc-fun-bot 0.2.0.0 -- 2015-09-10+=================================++General, build and documentation changes:++* (None)++New APIs, features and enhancements:++* Nickname tracker with control API+* Channel logger with control API+* Persistent state using JSON files+* Bot events logged into a file now, not stdout+* Event sources have access to a logging API+* Support prefix-less bot commands+* Event matching control++Bug fixes:++* (None)++Dependency changes:++* Add aeson+* Add fast-logger+* Add settings+* Add time+* Add time-interval+* Add time-units+* Add unordered-containers+* Require irc-fun-client >= 0.1.1.0+++++ irc-fun-bot 0.1.0.0 -- 2015-08-09 ================================= 
irc-fun-bot.cabal view
@@ -1,6 +1,6 @@ name:                irc-fun-bot-version:             0.1.0.0-synopsis:            Very simple library for writing fun IRC bots.+version:             0.2.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   the serious features IRC bots provide, but we could develop an IRC bot@@ -9,8 +9,9 @@   use, which is motivating when learning programming, and it's a chance to   introduce Haskell to the community.   .-  And so, this library was started. The API is inspired by the @Irc@ package-  and some other IRC client related packages.+  This library powers FunBot (which at the time of writing runs under the+  nickname /fpbot/ in Freenode) and its development is therefore driven by+  actual bot needs. homepage:            http://rel4tion.org/projects/irc-fun-bot/ bug-reports:         http://rel4tion.org/projects/irc-fun-bot/tickets/ license:             PublicDomain@@ -31,18 +32,34 @@   exposed-modules:     Network.IRC.Fun.Bot                      , Network.IRC.Fun.Bot.Behavior                      , Network.IRC.Fun.Bot.Chat+                     , Network.IRC.Fun.Bot.EventMatch+                     , Network.IRC.Fun.Bot.IrcLog+                     , Network.IRC.Fun.Bot.Logger+                     , 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                      , Network.IRC.Fun.Bot.Internal.Event                      , Network.IRC.Fun.Bot.Internal.Failure+                     , Network.IRC.Fun.Bot.Internal.IrcLog+                     , Network.IRC.Fun.Bot.Internal.Logger+                     , 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:       base             >=4.7 && <5-                     , irc-fun-client+  build-depends:       aeson+                     , base                 >=4.7 && <5+                     , fast-logger+                     , irc-fun-client       >=0.1.1.0                      , irc-fun-messages-                     , transformers     >=0.4.3+                     , settings+                     , time+                     , time-interval+                     , time-units+                     , transformers         >=0.4.3+                     , unordered-containers   hs-source-dirs:      src   default-language:    Haskell2010+  ghc-options:         -Wall
src/Network/IRC/Fun/Bot.hs view
@@ -23,12 +23,16 @@  import Control.Concurrent (forkIO) import Control.Concurrent.Chan-import Control.Monad (forever)+import Control.Monad (forever, liftM, void) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS (ask)-import Network.IRC.Fun.Bot.Internal.Event (matchEvent, handleEvent)+import Data.List (transpose)+import Data.Maybe (catMaybes)+import Network.IRC.Fun.Bot.Internal.Event+import Network.IRC.Fun.Bot.Internal.Logger import Network.IRC.Fun.Bot.Internal.Types import Network.IRC.Fun.Bot.Chat (login, joinConfig, run)+import Network.IRC.Fun.Client.ChannelLogger (LogEvent, fromClientEvent) import Network.IRC.Fun.Client.Events (hGetIrcEvents)  -- Get the bot ready for listening to IRC messages.@@ -40,33 +44,48 @@     joinConfig  -- Wait for an IRC event, then handle it according to bot behavior definition.-listenToEvent :: Chan (Either Event a) -> EventHandler e s a -> Session e s ()+listenToEvent :: Chan (Either (Either LogEvent Event) a)+              -> EventHandler e s a+              -> Session e s () listenToEvent chan handler = do     event <- liftIO $ readChan chan     either handleEvent handler event  -- Collect IRC events from the server and push into a 'Chan' for the main -- thread to handle.-listenToIrc :: BotEnv e s -> Chan (Either Event a) -> IO ()-listenToIrc bot chan = do+listenToIrc :: [EventMatcher e s]+            -> BotEnv e s+            -> Chan (Either (Either LogEvent Event) a)+            -> IO ()+listenToIrc ms bot chan = do+    logger <-+        newLogger (liftM snd $ getTime bot) (botEventLogFile $ config bot)     putStrLn "Bot: IRC event source listening to IRC events"+    let match e = matchEvent ms e (config bot) (commandSets $ behavior bot)     forever $ do         ircEvents <- hGetIrcEvents $ handle bot-        let match e = matchEvent e (config bot) (commandSets $ behavior bot)-            botEvents = map match ircEvents-        mapM_ print botEvents-        writeList2Chan chan $ map Left botEvents+        let botEvents = map match ircEvents+            logEvents = catMaybes $ map fromClientEvent ircEvents+            interleave l1 l2 = concat $ transpose [map Left l1, map Right l2]+        mapM_ (logLine logger . show) botEvents+        writeList2Chan chan $ map Left $ interleave logEvents botEvents  -- Connect, login, join. Then listen to events and handle them, forever.-botSession :: [EventSource e s a] -> EventHandler e s a -> Session e s ()-botSession sources handler = do+botSession :: [EventMatcher e s]+           -> [EventSource e s a]+           -> EventHandler e s a+           -> Session e s ()+           -> Session e s ()+botSession matchers sources handler actInit = do+    actInit     chan <- liftIO newChan     bot <- ask-    liftIO $ forkIO $ listenToIrc bot chan+    liftIO $ void $ forkIO $ listenToIrc matchers bot chan     let launch s = forkIO $ s (config bot)                               (custom bot)                               (writeChan chan . Right)                               (writeList2Chan chan . map Right)+                              (newLogger $ liftM snd $ getTime bot)     liftIO $ mapM_ launch sources     startBot     liftIO $ putStrLn "Bot: Event sink listening to events"@@ -76,13 +95,16 @@ -- the IRC server and other provided sources, and will respond according to the -- behavior definitions. runBot :: Config              -- ^ IRC connection configuration+       -> [EventMatcher e s]  -- ^ Event detection (high-to-low priority)        -> Behavior e s        -- ^ Behavior definition for IRC events        -> [EventSource e s a] -- ^ Additional event source threads to run        -> EventHandler e s a  -- ^ Handler for events coming from those sources        -> e                   -- ^ Custom bot environment (read-only state)        -> s                   -- ^ Initial state to hold in the background+       -> Session e s ()      -- ^ Initialization action to run at the very+                              --   beginning of the session        -> IO ()-runBot conf behavior sources handler env state = do+runBot conf matchers behav sources handler env state actInit = do     putStrLn "Bot: Starting"-    run conf behavior env state $ botSession sources handler+    run conf behav env state $ botSession matchers sources handler actInit     putStrLn "Bot: Disconnected"
src/Network/IRC/Fun/Bot/Behavior.hs view
@@ -35,7 +35,7 @@ import Data.Char (toLower) import Data.List (find, isInfixOf) import Network.IRC.Fun.Bot.Types-import Network.IRC.Fun.Bot.Util (maybeQuote, showNames)+import Network.IRC.Fun.Bot.Util (showNames)  ------------------------------------------------------------------------------- -- Defining
+ src/Network/IRC/Fun/Bot/EventMatch.hs view
@@ -0,0 +1,53 @@+{- 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/>.+ -}++-- | You can control both the detection and the handling of events coming from+-- the IRC server. This module provides tools for defining event detection+-- rules. For example, should your bot take commands through messages in IRC+-- channels, or in private messages, or both, or perhaps none?+--+-- In addition to the event matchers given here, you can easily write your own+-- custom matchers.+--+-- Event matchers with a @C@ prefix are handle only channel events.+-- Event matchers with a @P@ prefix are handle only private message events.+--+-- The 'defaultMatch' matcher matches some essential events, such as pings, and+-- you should probably use it in your matcher list (e.g. as the last item).+module Network.IRC.Fun.Bot.EventMatch+    ( matchPrefixedCommandC+    , matchPrefixedCommandP+    , matchPrefixedCommand+    , matchRefCommandC+    , matchRefCommandP+    , matchRefCommand+    , matchRefCommandFromSetC+    , matchRefCommandFromSetP+    , matchRefCommandFromSet+    , matchRefCommandFromNamesC+    , matchRefCommandFromNamesP+    , matchRefCommandFromNames+    , matchPlainPrivateCommand+    , matchNoticeC+    , matchNoticeP+    , matchNotice+    , matchRefC+    , matchRefP+    , matchRef+    , defaultMatch+    )+where++import Network.IRC.Fun.Bot.Internal.Event
src/Network/IRC/Fun/Bot/Internal/Chat.hs view
@@ -35,10 +35,12 @@ import Control.Exception (bracket) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS (runRWST)+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.Commands import Network.IRC.Fun.Client.IO (ircConnect, ircDisconnect, hPutIrc)+import Network.IRC.Fun.Client.Time (currentTimeGetter) import Network.IRC.Fun.Messages.Types (Message)  -------------------------------------------------------------------------------@@ -87,11 +89,18 @@     -> Session e s a -- ^ Session definition     -> IO a run conf beh env state session = do+    timeGetter <- currentTimeGetter+    save <- mkSaveBotState conf     putStrLn "Bot: Connecting to IRC server"     bracket         (ircConnect $ connection conf)         ircDisconnect-        (\ h -> runSession (BotEnv conf beh h env) (BotState state) session)+        (\ h -> do+            let botEnv = BotEnv conf beh h timeGetter save env+            putStrLn "Bot: Loading state from file"+            botState <- loadBotState botEnv state+            runSession botEnv botState session+        )  -- | Log in as an IRC user and identify with the bot's nickname and password. -- This is the first thing to do after 'botConnect'ing to the server.
src/Network/IRC/Fun/Bot/Internal/Event.hs view
@@ -14,101 +14,414 @@  -}  module Network.IRC.Fun.Bot.Internal.Event-    ( matchEvent+    ( matchPrefixedCommandC+    , matchPrefixedCommandP+    , matchPrefixedCommand+    , matchRefCommandC+    , matchRefCommandP+    , matchRefCommand+    , matchRefCommandFromSetC+    , matchRefCommandFromSetP+    , matchRefCommandFromSet+    , matchRefCommandFromNamesC+    , matchRefCommandFromNamesP+    , matchRefCommandFromNames+    , matchPlainPrivateCommand+    , matchNoticeC+    , matchNoticeP+    , matchNotice+    , matchRefC+    , matchRefP+    , matchRef+    , defaultMatch+    , matchEvent     , handleEvent     ) where -import Data.Char (isSpace)-import Data.List (find, isPrefixOf)-import Network.IRC.Fun.Bot.Internal.Chat (pong)-import Network.IRC.Fun.Bot.Internal.Failure (defaultRespondToChan)-import Network.IRC.Fun.Bot.Internal.State (askBehavior, askBehaviorS)-import Network.IRC.Fun.Bot.Internal.Types-import Network.IRC.Fun.Bot.Behavior (findCmd)+import           Control.Monad (when)+import           Control.Monad.IO.Class (liftIO)+import           Control.Monad.Trans.RWS+import           Data.Char (isSpace)+import qualified Data.HashMap.Lazy as M+import           Data.Maybe (catMaybes, fromMaybe, maybeToList)+import           Data.List (stripPrefix)+import           Network.IRC.Fun.Bot.Internal.Chat (pong)+import           Network.IRC.Fun.Bot.Internal.Failure (defaultRespondToChan)+import           Network.IRC.Fun.Bot.Internal.Nicks+import           Network.IRC.Fun.Bot.Internal.State (askBehavior, askBehaviorS)+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 qualified Network.IRC.Fun.Client.ChannelLogger as L import qualified Network.IRC.Fun.Client.Events as C (Event (..))-import Network.IRC.Fun.Client.IO (nick)-import Network.IRC.Fun.Client.Util (mentions)+import           Network.IRC.Fun.Client.IO (nick)+import           Network.IRC.Fun.Client.Util (mentions) -matchEvent :: C.Event -> Config -> [CommandSet e s] -> Event-matchEvent event conf csets =+-------------------------------------------------------------------------------+-- Make Events+-------------------------------------------------------------------------------++detectRef :: Config -> String -> Maybe String+detectRef conf msg =+    let bnick = nick (connection conf)+        dw = Just . dropWhile isSpace+    in  case stripPrefix bnick msg of+            Nothing        -> Nothing+            Just (',' : s) -> dw s+            Just (':' : s) -> dw s+            Just (';' : s) -> dw s+            Just (c : s)   -> if isSpace c then dw s else Nothing+            Just s         -> dw s++mkCmd :: String -> (String, [String])+mkCmd message =+    let w = words message+        name = if null w then "" else head w+        args = if null w then [] else tail w+    in  (name, args)++makePrefixedCommand :: [CommandSet e s]+                    -> MessageSource+                    -> Char+                    -> String+                    -> Maybe Event+makePrefixedCommand csets src pref msg =+    if pref `elem` map prefix csets+        then+            let (name, args) = mkCmd msg+            in  Just $ BotCommand src (Just pref) name args+        else Nothing++makeRefCommand :: Config+               -> MessageSource+               -> String+               -> Maybe Event+makeRefCommand conf src msg =+    case detectRef conf msg of+        Just s ->+            let (name, args) = mkCmd s+            in  Just $ BotCommand src Nothing name args+        Nothing -> Nothing++makeRefCommandFromSet :: Config+                      -> CommandSet e s+                      -> MessageSource+                      -> String+                      -> Maybe Event+makeRefCommandFromSet conf cset =+    makeRefCommandFromNames conf (concatMap names $ commands cset)++makeRefCommandFromNames :: Config+                        -> [String]+                        -> MessageSource+                        -> String+                        -> Maybe Event+makeRefCommandFromNames conf names src msg =+    case detectRef conf msg of+        Just s ->+            let (name, args) = mkCmd s+            in  if name `elem` names+                    then Just $ BotCommand src Nothing name args+                    else Nothing+        Nothing -> Nothing++makePlainCommand :: MessageSource+                 -> String+                 -> Maybe Event+makePlainCommand src msg =+    let (name, args) = mkCmd msg+    in  Just $ BotCommand src Nothing name args++makeRefC :: Config -> String -> String -> String -> Maybe Event+makeRefC conf chan nick msg =+    case detectRef conf msg of+        Just s  -> Just $ BotMessage chan nick s+        Nothing -> Nothing++makeRefP :: Config -> String -> String -> Maybe Event+makeRefP conf nick msg =+    case detectRef conf msg of+        Just s  -> Just $ PersonalMessage nick s+        Nothing -> Nothing++-------------------------------------------------------------------------------+-- Match Events+-------------------------------------------------------------------------------++matchPrefixedCommandC :: EventMatcher e s+matchPrefixedCommandC event _conf csets =     case event of-        C.Ping server1 server2      -> Ping server1 server2-        C.Kick channel nicks reason -> Kick channel nicks reason-        C.Join channel nick         -> Join channel nick-        C.Part channel nick reason  -> Part channel nick reason-        C.Quit nick reason          -> Quit nick reason-        C.Mode                      -> other-        C.ChannelMessage channel nick msg False-            | not (null msg) && head msg `elem` map prefix csets ->-                let w = words $ tail msg-                in  BotCommand channel nick (head msg)-                        (if null w then "" else head w)-                        (if null w then [] else tail w)-            | bnick `isPrefixOf` msg                             ->-                let msg' = drop (length bnick) msg-                    msg'' =-                        if null msg'-                            then []-                            else dropWhile isSpace $ tail msg'-                in  if null msg' || head msg' `elem` ",:"-                        then BotMessage channel nick msg''-                        else Message channel nick msg $ msg `mentions` bnick-            | otherwise                                          ->-                Message channel nick msg $ msg `mentions` bnick-        C.ChannelMessage channel nick msg True ->-            Notice (Just channel) nick msg-        C.PrivateMessage nick msg False        -> PersonalMessage nick msg-        C.PrivateMessage nick msg True         -> Notice Nothing nick msg-        C.Topic channel nick topic             ->-            TopicChange channel nick topic-        C.Invite channel nick                  -> other-        C.Names priv chan pnicks               -> Names chan priv pnicks-        C.OtherEvent s                         -> other+        C.ChannelMessage chan nick (c:cs) False ->+            makePrefixedCommand csets (Channel chan nick) c cs+        _ -> Nothing++matchPrefixedCommandP :: EventMatcher e s+matchPrefixedCommandP event _conf csets =+    case event of+        C.PrivateMessage nick (c:cs) False ->+            makePrefixedCommand csets (User nick) c cs+        _ -> Nothing++matchPrefixedCommand :: EventMatcher e s+matchPrefixedCommand event _conf csets =+    case event of+        C.ChannelMessage chan nick (c:cs) False ->+            makePrefixedCommand csets (Channel chan nick) c cs+        C.PrivateMessage nick (c:cs) False ->+            makePrefixedCommand csets (User nick) c cs+        _ -> Nothing++matchRefCommandC :: EventMatcher e s+matchRefCommandC event conf _csets =+    case event of+        C.ChannelMessage chan nick msg False ->+            makeRefCommand conf (Channel chan nick) msg+        _ -> Nothing++matchRefCommandP :: EventMatcher e s+matchRefCommandP event conf _csets =+    case event of+        C.PrivateMessage nick msg False ->+            makeRefCommand conf (User nick) msg+        _ -> Nothing++matchRefCommand :: EventMatcher e s+matchRefCommand event conf _csets =+    case event of+        C.ChannelMessage chan nick msg False ->+            makeRefCommand conf (Channel chan nick) msg+        C.PrivateMessage nick msg False ->+            makeRefCommand conf (User nick) msg+        _ -> Nothing++matchRefCommandFromSetC :: EventMatcher e s+matchRefCommandFromSetC _     _    []       = Nothing+matchRefCommandFromSetC event conf (cset:_) =+    case event of+        C.ChannelMessage chan nick msg False ->+            makeRefCommandFromSet conf cset (Channel chan nick) msg+        _ -> Nothing++matchRefCommandFromSetP :: EventMatcher e s+matchRefCommandFromSetP _     _    []       = Nothing+matchRefCommandFromSetP event conf (cset:_) =+    case event of+        C.PrivateMessage nick msg False ->+            makeRefCommandFromSet conf cset (User nick) msg+        _ -> Nothing++matchRefCommandFromSet :: EventMatcher e s+matchRefCommandFromSet _     _    []       = Nothing+matchRefCommandFromSet event conf (cset:_) =+    case event of+        C.ChannelMessage chan nick msg False ->+            makeRefCommandFromSet conf cset (Channel chan nick) msg+        C.PrivateMessage nick msg False ->+            makeRefCommandFromSet conf cset (User nick) msg+        _ -> Nothing++matchRefCommandFromNamesC :: [String] -> EventMatcher e s+matchRefCommandFromNamesC names event conf _csets =+    case event of+        C.ChannelMessage chan nick msg False ->+            makeRefCommandFromNames conf names (Channel chan nick) msg+        _ -> Nothing++matchRefCommandFromNamesP :: [String] -> EventMatcher e s+matchRefCommandFromNamesP names event conf _csets =+    case event of+        C.PrivateMessage nick msg False ->+            makeRefCommandFromNames conf names (User nick) msg+        _ -> Nothing++matchRefCommandFromNames :: [String] -> EventMatcher e s+matchRefCommandFromNames names event conf _csets =+    case event of+        C.ChannelMessage chan nick msg False ->+            makeRefCommandFromNames conf names (Channel chan nick) msg+        C.PrivateMessage nick msg False ->+            makeRefCommandFromNames conf names (User nick) msg+        _ -> Nothing++matchPlainPrivateCommand :: EventMatcher e s+matchPlainPrivateCommand event _conf _csets =+    case event of+        C.PrivateMessage nick msg False ->+            makePlainCommand (User nick) msg+        _ -> Nothing++matchNoticeC :: EventMatcher e s+matchNoticeC event _conf _csets =+    case event of+        C.ChannelMessage chan nick msg True ->+            Just $ Notice (Just chan) nick msg+        _ -> Nothing++matchNoticeP :: EventMatcher e s+matchNoticeP event _conf _csets =+    case event of+        C.PrivateMessage nick msg True ->+            Just $ Notice Nothing nick msg+        _ -> Nothing++matchNotice :: EventMatcher e s+matchNotice event _conf _csets =+    case event of+        C.ChannelMessage chan nick msg True ->+            Just $ Notice (Just chan) nick msg+        C.PrivateMessage nick msg True ->+            Just $ Notice Nothing nick msg+        _ -> Nothing++matchRefC :: EventMatcher e s+matchRefC event conf _csets =+    case event of+        C.ChannelMessage chan nick msg False -> makeRefC conf chan nick msg+        _ -> Nothing++matchRefP :: EventMatcher e s+matchRefP event conf _csets =+    case event of+        C.PrivateMessage nick msg False -> makeRefP conf nick msg+        _ -> Nothing++matchRef :: EventMatcher e s+matchRef event conf _csets =+    case event of+        C.ChannelMessage chan nick msg False -> makeRefC conf chan nick msg+        C.PrivateMessage nick msg False -> makeRefP conf nick msg+        _ -> Nothing++defaultMatch :: EventMatcher e s+defaultMatch event conf csets =+    case event of+        C.Ping server1 server2      -> Just $ Ping server1 server2+        C.Kick channel nicks reason -> Just $ Kick channel nicks reason+        C.Join channel nick         -> Just $ Join channel nick+        C.Part channel nick reason  -> Just $ Part channel nick reason+        C.Quit nick reason          -> Just $ Quit nick reason+        C.ChannelMessage channel nick msg False ->+            Just $ Message channel nick msg $ msg `mentions` bnick+        C.PrivateMessage nick msg False -> Just $ PersonalMessage nick msg+        C.Topic channel nick topic -> Just $ TopicChange channel nick topic+        C.Names priv chan pnicks -> Just $ Names chan priv pnicks+        _ -> Nothing     where     bnick = nick (connection conf)-    other = OtherEvent $ show event +combineMatchers :: [EventMatcher e s] -> EventMatcher e s+combineMatchers []     _event _conf _csets = Nothing+combineMatchers (m:ms) event  conf  csets  =+    case m event conf csets of+       ev@(Just _) -> ev+       Nothing     -> combineMatchers ms event conf csets++applyMatchers :: [EventMatcher e s]+              -> C.Event+              -> Config+              -> [CommandSet e s]+              -> Event+applyMatchers ms event conf csets =+    fromMaybe (OtherEvent $ show event) $ combineMatchers ms event conf csets++matchEvent :: [EventMatcher e s]+           -> C.Event+           -> Config+           -> [CommandSet e s]+           -> Event+matchEvent = applyMatchers++findCommand :: Maybe Char+            -> String+            -> [CommandSet e s]+            -> Maybe (Either (CommandSet e s) (Command e s))+findCommand (Just cpref) cname csets    = findCmd cpref cname csets+findCommand Nothing      _     []       = Nothing+findCommand Nothing      cname (cset:_) =+    Just $ maybe (Left cset) Right $ findCmdInSet cname cset+ -- Run the command with the given prefix character, command name and list of -- parameters. If a command with the given prefix and name isn't found, the bot -- sends a default friendly response.-runCommand :: Char     -- Command prefix-           -> String   -- Command name-           -> [String] -- List of parameters-           -> String   -- Channel in which the command was triggered-           -> String   -- Nickname of user who triggered the command+runCommand :: Maybe Char -- Command prefix, 'Nothing' picks the default prefix+           -> String     -- Command name+           -> [String]   -- List of parameters+           -> String     -- Channel in which the command was triggered+           -> String     -- Nickname of user who triggered the command            -> Session e s () runCommand cpref cname cparams channel sender = do     csets <- askBehaviorS commandSets-    case findCmd cpref cname csets of+    case findCommand cpref cname csets of         Nothing          ->             defaultRespondToChan channel cpref cname Nothing         Just (Left cset) ->-            defaultRespondToChan channel cpref cname (Just cset)+            defaultRespondToChan channel (Just $ prefix cset) cname (Just cset)         Just (Right cmd) ->             respond cmd channel sender cparams --- | React to an IRC event.-handleEvent :: Event -> Session e s ()-handleEvent event = do+-- React to a bot event.+handleBotEvent :: Event -> Session e s ()+handleBotEvent event = do     b <- askBehavior     case event of-        Ping s1 s2                               -> pong s1 s2-        Kick chan users why                      -> return ()-        Join chan nick                           -> handleJoin b chan nick-        Part chan nick why                       -> handlePart b chan nick why-        Quit nick why                            -> handleQuit b nick why-        Message chan sender msg mentioned        ->+        Ping s1 s2 -> pong s1 s2+        Kick chan users why -> return ()+        Join chan nick -> do+            tracked <- channelIsTracked chan+            when tracked $ addMember chan nick+            handleJoin b chan nick+        Part chan nick why -> do+            tracked <- channelIsTracked chan+            when tracked $ removeMemberOnce chan nick+            handlePart b chan nick why+        Quit nick why -> do+            removeMember nick+            handleQuit b nick why+        Message chan sender msg mentioned ->             handleMsg b chan sender msg mentioned-        Notice mchan sender msg                  -> return ()-        BotMessage chan sender msg               ->-            handleBotMsg b chan sender msg-        BotCommand chan sender cpref cname cargs ->+        Notice mchan sender msg -> return ()+        BotMessage chan sender msg -> handleBotMsg b chan sender msg+        BotCommand (Channel chan sender) cpref cname cargs ->             runCommand cpref cname cargs chan sender-        PersonalMessage sender msg               ->-            handlePersonalMsg b sender msg-        TopicChange chan nick topic              ->-            handleTopicChange b chan nick topic-        Names chan priv pnicks                   ->+        BotCommand _ _ _ _ -> return ()+        PersonalMessage sender msg -> handlePersonalMsg b sender msg+        TopicChange chan nick topic -> handleTopicChange b chan nick topic+        Names chan priv pnicks -> do+            tracked <- channelIsTracked chan+            let nicks = map snd pnicks+            when tracked $ addChannel chan nicks             handleNames b chan priv pnicks-        OtherEvent s                             -> return ()+        OtherEvent s -> return ()++-- Using nick tracking and logging state, determine from a general log event a+-- 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+        detectOne chan event = do+            cstates <- gets chanstate+            return $ maybeToList $ M.lookup chan cstates >>= detect event+        detectMany nick event = do+            chans <- presence nick+            cstates <- gets chanstate+            let cstatesP =+                    cstates `M.difference` M.fromList (zip chans (repeat ()))+            return $ catMaybes $ map (detect event) $ M.elems cstatesP+    in  case e of+            L.Enter nick chan       -> detectOne chan $ EnterChan nick+            L.Leave nick chan       -> detectOne chan $ LeaveChan nick+            L.LeaveAll nick         -> detectMany nick $ LeaveChan nick+            L.Message nick chan msg -> detectOne chan $ MessageChan nick msg+            L.Rename oldN newN      -> detectMany oldN $ RenameInChan oldN newN++-- Possibly write a log event into the right file(s), according to logging+-- settings.+handleLogEvent :: L.LogEvent -> Session e s ()+handleLogEvent e = do+    l <- detectLogEvents e+    liftIO $ mapM_ (\ (logger, event) -> logEvent logger event) l++-- | Handle a bot event, or log a log event into a file.+handleEvent :: Either L.LogEvent Event -> Session e s ()+handleEvent = either handleLogEvent handleBotEvent
src/Network/IRC/Fun/Bot/Internal/Failure.hs view
@@ -32,18 +32,20 @@ -- This assumes the same response is set both to channels and to users in -- private conversations, which could change in the future. Right now only -- channel commands are supported by the bot anyway.-defaultResponse :: Char                   -- Command prefix that was triggered+defaultResponse :: Maybe Char             -- Command prefix that was triggered                 -> String                 -- Command name that was triggered                 -> [CommandSet e s]       -- Available command sets                 -> Maybe (CommandSet e s) -- The command set matching the                                           -- prefix, if one was found                 -> String-defaultResponse cpref _cname csets Nothing =+defaultResponse Nothing _cname csets _ =+    "Expected to find a default command prefix, but there’s none."+defaultResponse (Just cpref) _cname csets Nothing =     printf "Expected to find a command with prefix ‘%v’, but there’s none. \            \Available prefixes are: ‘%v’."            cpref $            intercalate "’, ‘" $ map ((: []) . prefix) csets-defaultResponse cpref cname _csets (Just cset) =+defaultResponse (Just cpref) cname _csets (Just cset) =     printf "The command ‘%v%v’ isn’t available. Available commands for prefix \            \‘%v’ are: ‘%v’."            cpref@@ -54,7 +56,7 @@ -- | Send the default response to an IRC channel defaultRespondToChan     :: String                 -- Target channel-    -> Char                   -- Command prefix that was triggered+    -> Maybe Char             -- Command prefix that was triggered     -> String                 -- Command name that was triggered     -> Maybe (CommandSet e s) -- The command set matching the prefix, is one                               -- was found@@ -66,7 +68,7 @@ -- | Send the default response to an IRC user defaultRespondToUser     :: String                 -- Recipient nickname-    -> Char                   -- Command prefix that was triggered+    -> Maybe Char             -- Command prefix that was triggered     -> String                 -- Command name that was triggered     -> Maybe (CommandSet e s) -- The command set matching the prefix, is one                               -- was found
+ src/Network/IRC/Fun/Bot/Internal/IrcLog.hs view
@@ -0,0 +1,119 @@+{- 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.IrcLog+    ( makeLogger+    , channelIsLogged+    , startLoggingAll+    , startLoggingChannel+    , startLoggingChannels+    , stopLoggingAll+    , stopLoggingChannel+    , stopLoggingChannels+    )+where++import           Control.Monad (liftM)+import           Control.Monad.IO.Class (liftIO)+import           Control.Monad.Trans.RWS (ask)+import qualified Data.HashMap.Lazy as M+import           Data.Maybe (isJust)+import           Data.Traversable (traverse)+import           Network.IRC.Fun.Bot.Internal.State+import           Network.IRC.Fun.Bot.Internal.Types hiding (Logger)+import           Network.IRC.Fun.Client.ChannelLogger++makeLogger :: BotEnv e s -> String -> IO Logger+makeLogger env chan =+    let timeGetter = getTime env+        logdir = logDir $ config env+        file = logFilePath logdir "server" chan+    in  newLogger (liftM snd timeGetter) file++enable :: String -> ChannelState -> Session e s ChannelState+enable chan cstate =+    if isJust $ chanLogger cstate+        then return cstate+        else do+            env <- ask+            logger <- liftIO $ makeLogger env chan+            return cstate { chanLogger = Just logger }++disable :: ChannelState -> Session e s ChannelState+disable cstate =+    case chanLogger cstate of+        Just logger -> do+            liftIO $ removeLogger logger+            return cstate { chanLogger = 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++-- | Start logging all the channels the bot has joined which aren't+-- being logged.+startLoggingAll :: Session e s ()+startLoggingAll = do+    chanmap <- getChans+    chanmapE <- M.traverseWithKey enable chanmap+    putChans chanmapE++-- | Start logging the given channel, if not being logged already.+startLoggingChannel :: String -> Session e s ()+startLoggingChannel chan = do+    chanmap <- getChans+    case M.lookup chan chanmap of+        Just cstate -> do+            cstateE <- enable chan cstate+            putChans $ M.insert chan cstateE chanmap+        Nothing     -> return ()++-- | Start logging the channels not being logged, among the ones given.+startLoggingChannels :: [String] -> Session e s ()+startLoggingChannels chans = do+    chanmapAll <- getChans+    let given = M.fromList (zip chans (repeat ()))+        chanmapG = chanmapAll `M.intersection` given+    chanmapE <- M.traverseWithKey enable chanmapG+    putChans $ chanmapE `M.union` chanmapAll++-- | Stop logging all logged channels.+stopLoggingAll :: Session e s ()+stopLoggingAll = do+    chanmap <- getChans+    chanmapE <- M.traverseWithKey enable chanmap+    putChans chanmapE++-- | Stop logging the given channel, if being logged.+stopLoggingChannel :: String -> Session e s ()+stopLoggingChannel chan = do+    chanmap <- getChans+    case M.lookup chan chanmap of+        Just cstate -> do+            cstateD <- disable cstate+            putChans $ M.insert chan cstateD chanmap+        Nothing     -> return ()++-- | Stop logging the channels being logged among the ones given.+stopLoggingChannels :: [String] -> Session e s ()+stopLoggingChannels chans = do+    chanmapAll <- getChans+    let given = M.fromList (zip chans (repeat ()))+        chanmapG = chanmapAll `M.intersection` given+    chanmapD <- traverse disable chanmapG+    putChans $ chanmapD `M.union` chanmapAll
+ src/Network/IRC/Fun/Bot/Internal/Logger.hs view
@@ -0,0 +1,66 @@+{- 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.Logger+    ( newLogger+    , newLogger'+    , removeLogger+    , logLine+    )+where++import Control.Monad (liftM)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.RWS (asks)+import Data.Monoid ((<>))+import Network.IRC.Fun.Bot.Internal.Types+import System.Log.FastLogger++-- | Create a logger in the 'IO' monad.+newLogger :: IO String -- ^ Action which returns a formatted time string. You+          -> FilePath  -- ^ Path of the log file+          -> IO Logger+newLogger getTime path = do+    lset <- newFileLoggerSet defaultBufSize path+    return $ Logger+        { loggerSet     = lset+        , loggerGetTime = getTime+        }++-- | Create a logger inside the bot session.+newLogger' :: FilePath -> Session e s Logger+newLogger' path = do+    timeGetter <- asks getTime+    liftIO $ newLogger (liftM snd timeGetter) path++-- | Flush buffers and release resources.+--+-- When the logger is paused for a long period of time (i.e. not momentarily -+-- e.g. by a user disabling channel logging via UI), you can use this to+-- release resources. Later, when logging is needed again, create a fresh new+-- logger.+removeLogger :: Logger -> IO ()+removeLogger logger = rmLoggerSet $ loggerSet logger++formatLine :: ToLogStr s => IO String -> s -> IO LogStr+formatLine getTime line = do+    t <- getTime+    return $ toLogStr t <> toLogStr " " <> toLogStr line++-- | Write a log message.+logLine :: ToLogStr s => Logger -> s -> IO ()+logLine logger str = do+    line <- formatLine (loggerGetTime logger) str+    pushLogStrLn (loggerSet logger) line
+ src/Network/IRC/Fun/Bot/Internal/Nicks.hs view
@@ -0,0 +1,166 @@+{- 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.Nicks+    ( channelIsTracked+    , startTrackingAll+    , startTrackingChannel+    , startTrackingChannels+    , stopTrackingAll+    , stopTrackingChannel+    , stopTrackingChannels+    , isInChannel+    , presence+    , addMember+    , addChannel+    , removeMemberOnce+    , removeMember+    , removeChannel+    , removeChannels+    )+where++import           Control.Monad (unless)+import           Control.Monad.Trans.RWS+import qualified Data.HashMap.Lazy as M+import           Data.Maybe (fromMaybe)+import           Network.IRC.Fun.Bot.Internal.Chat (putIrc)+import           Network.IRC.Fun.Bot.Internal.State+import           Network.IRC.Fun.Bot.Internal.Types+import qualified Network.IRC.Fun.Client.NickTracker as NT+import           Network.IRC.Fun.Messages.TypeAliases (ChannelName)+import           Network.IRC.Fun.Messages.Types (Message (NamesMessage))++enable :: ChannelState -> ChannelState+enable cstate = cstate { chanTracking = True }++disable :: ChannelState -> ChannelState+disable cstate = cstate { chanTracking = 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++-- | 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]+        chansAllE = M.map enable chans+    putChans chansAllE+    unless (null chansD) $ putIrc $ NamesMessage chansD Nothing++-- | Start tracking nicks in the given channel, if not tracked already.+startTrackingChannel :: String -> Session e s ()+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+            putChans chansE+            putIrc $ NamesMessage [chan] Nothing+        Nothing -> return ()++-- | Start tracking nicks in the channels not tracked, among the ones given.+startTrackingChannels :: [String] -> Session e s ()+startTrackingChannels chans = do+    chanmapAll <- getChans+    let given = M.fromList (zip chans (repeat ()))+        chanmapG = chanmapAll `M.intersection` given+        chanmapD = M.filter (not . chanTracking) chanmapG+        chansD = M.keys chanmapD+        chanmapE = M.map enable chanmapD+        chanmapAllE = chanmapE `M.union` chanmapAll+    putChans chanmapAllE+    putIrc $ NamesMessage chansD Nothing++-- | Stop tracking nicks in all tracked channels.+stopTrackingAll :: Session e s ()+stopTrackingAll =+    modify $ \ bstate -> bstate+        { tracker   = NT.newNetwork+        , chanstate = M.map disable $ chanstate bstate+        }++-- | Stop tracking nicks in the given channel, if tracked.+stopTrackingChannel :: String -> Session e s ()+stopTrackingChannel chan =+    modify $ \ bstate -> bstate+        { tracker   = NT.removeChannel chan $ tracker bstate+        , chanstate = M.adjust disable chan $ chanstate bstate+        }++-- | Stop tracking nicks in the tracked channels among the ones given.+stopTrackingChannels :: [String] -> Session e s ()+stopTrackingChannels chans =+    modify $ \ bstate -> bstate+        { tracker   = NT.removeChannels chans $ tracker bstate+        , chanstate =+            let chanmap = chanstate bstate+                chanmapE = M.filter chanTracking chanmap+                chanmapD = M.map disable chanmapE+            in  chanmapD `M.union` chanmap+        }++-- | Check whether a nickname is present in a channel.+isInChannel :: String -> String -> Session e s Bool+nick `isInChannel` chan = do+    nt <- gets tracker+    return $ NT.isInChannel nick chan nt++-- | Check in which channels a nickname is present.+presence :: String -> Session e s [ChannelName]+presence nick = do+    nt <- gets tracker+    return $ NT.presence nick nt++-- | Record a nickname being present in a channel.+addMember :: String -> String -> Session e s ()+addMember chan nick = modify $ \ s -> s { tracker = f $ tracker s }+    where+    f = NT.addToChannel chan nick++-- | Record a channel with the given present nicknames.+addChannel :: String -> [String] -> Session e s ()+addChannel chan nicks = modify $ \ s -> s { tracker = f $ tracker s }+    where+    f = NT.addChannel chan nicks++-- | Record a channel not having a given nickname anymore.+removeMemberOnce :: String -> String -> Session e s ()+removeMemberOnce chan nick = modify $ \ s -> s { tracker = f $ tracker s }+    where+    f = NT.removeFromChannel chan nick++-- | Record a nickname not being present in any channel anymore.+removeMember :: String -> Session e s ()+removeMember nick = modify $ \ s -> s { tracker = f $ tracker s }+    where+    f = NT.removeFromNetwork nick++-- | Remove a channel from the records.+removeChannel :: String -> Session e s ()+removeChannel chan = modify $ \ s -> s { tracker = f $ tracker s }+    where+    f = NT.removeChannel chan++-- | Remove channels from the records.+removeChannels :: [String] -> Session e s ()+removeChannels chans = modify $ \ s -> s { tracker = f $ tracker s }+    where+    f = NT.removeChannels chans
+ src/Network/IRC/Fun/Bot/Internal/Persist.hs view
@@ -0,0 +1,107 @@+{- 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/>.+ -}++-- For JSON field names+{-# LANGUAGE OverloadedStrings #-}++module Network.IRC.Fun.Bot.Internal.Persist+    ( loadBotState+    , mkSaveBotState+    , saveBotState+    )+where++import           Control.Applicative+import           Control.Monad (mzero)+import           Control.Monad.IO.Class (liftIO)+import           Control.Monad.Trans.RWS+import           Data.Aeson+import qualified Data.HashMap.Lazy as M+import           Data.Maybe (isJust)+import           Data.Settings.Persist+import           Data.Time.Interval+import           Data.Time.Units (Microsecond)+import           Network.IRC.Fun.Bot.Internal.IrcLog (makeLogger)+import           Network.IRC.Fun.Bot.Internal.Types+import           Network.IRC.Fun.Client.NickTracker (newNetwork)++data ChannelStateJ = ChannelStateJ Bool Bool++data BotStateJ = BotStateJ (M.HashMap String ChannelStateJ)++toJ :: BotState s -> BotStateJ+toJ bstate = BotStateJ $ M.map f $ chanstate bstate+    where+    f (ChannelState track mlogger) = ChannelStateJ track (isJust mlogger)++fromJ :: BotStateJ -> BotEnv e s -> s -> IO (BotState s)+fromJ (BotStateJ chansJ) env pub = do+    let f chan (ChannelStateJ tracking logging) = do+            mlogger <-+                if logging+                    then fmap Just $ makeLogger env chan+                    else return Nothing+            return $ ChannelState tracking mlogger+        defstate = ChannelStateJ False False+        chansConf = M.fromList $ zip (channels $ config env) (repeat defstate)+        chansAll = chansJ `M.union` chansConf+    chans <- M.traverseWithKey f chansAll+    return $ BotState newNetwork chans pub++instance FromJSON ChannelStateJ where+    parseJSON (Object o) =+        ChannelStateJ <$>+        o .: "track" <*>+        o .: "log"+    parseJSON _          = mzero++instance ToJSON ChannelStateJ where+    toJSON (ChannelStateJ tracking logging) = object+        [ "track" .= tracking+        , "log"   .= logging+        ]++instance FromJSON BotStateJ where+    parseJSON (Object o) =+        BotStateJ <$>+        o .: "channels"+    parseJSON _          = mzero++instance ToJSON BotStateJ where+    toJSON (BotStateJ chans) = object+        [ "channels" .= chans+        ]++instance ToJSON (BotState s) where+    toJSON bstate = toJSON $ toJ bstate++loadBotState :: BotEnv e s -> s -> IO (BotState s)+loadBotState env pub = do+    r <- loadSettings $ stateFile $ config env+    case r of+        Left (False, e) -> error $ "Failed to read state file: " ++ e+        Left (True, e)  -> error $ "Failed to parse state file: " ++ e+        Right sj        -> fromJ sj env pub++mkSaveBotState :: Config -> IO (BotState s -> IO ())+mkSaveBotState conf =+    let iv = fromInteger $ microseconds $ saveInterval conf :: Microsecond+    in  mkSaveSettings iv (stateFile conf)++saveBotState :: Session e s ()+saveBotState = do+    bstate <- get+    save <- asks saveState+    liftIO $ save bstate
src/Network/IRC/Fun/Bot/Internal/State.hs view
@@ -21,16 +21,25 @@     , askEnv     , askEnvS     , askHandle+    , askTimeGetter     , getState     , getStateS     , putState     , modifyState+    , getChannelState+    , getChans+    , putChans+    , modifyChans     ) where -import Control.Monad.Trans.RWS-import Network.IRC.Fun.Bot.Internal.Types-import Network.IRC.Fun.Client.IO (Handle)+import           Control.Monad.Trans.RWS+import           Data.HashMap.Lazy (HashMap)+import qualified Data.HashMap.Lazy as M+import           Data.Maybe (isJust)+import           Data.Time.Clock (UTCTime)+import           Network.IRC.Fun.Bot.Internal.Types+import           Network.IRC.Fun.Client.IO (Handle)  -- | Fetch the bot configuration. askConfig :: Session e s Config@@ -60,6 +69,15 @@ askHandle :: Session e s Handle askHandle = asks handle +-- | Fetch the time getter. The actual time data is cached and updated at most+-- once per second depending on need. You can safely use it at any frequency+-- withou overloading IO and time formatting.+--+-- The second item is a formatted time string in the form+-- @2015-09-01 18:10:00@, and is always expressed in UTC.+askTimeGetter :: Session e s (IO (UTCTime, String))+askTimeGetter = asks getTime+ -- | Fetch the current value of the state within the session. getState :: Session e s s getState = gets public@@ -78,3 +96,28 @@ modifyState :: (s -> s) -> Session e s () modifyState f =     modify $ \ old@(BotState { public = st }) -> old { public = f st }++-- | 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++-- Get the channel state map.+getChans :: Session e s (HashMap String ChannelState)+getChans = gets chanstate++-- Set a new value for the channel state map.+putChans :: HashMap String ChannelState -> Session e s ()+putChans chans = modify $ \ s -> s { chanstate = chans }++-- Update the channel state map value with the result of applying a function.+modifyChans :: (HashMap String ChannelState -> HashMap String ChannelState)+            -> Session e s ()+modifyChans f = modify $ \ s -> s { chanstate = f $ chanstate s }
src/Network/IRC/Fun/Bot/Internal/Types.hs view
@@ -15,16 +15,20 @@  module Network.IRC.Fun.Bot.Internal.Types     ( Config (..)+    , MessageSource (..)     , Failure (..)     , Command (..)     , CommandSet (..)     , BotEnv (..)+    , ChannelState (..)     , BotState (..)-    , Session (..)+    , Session     , ChannelPrivacy (..)     , Privilege (..)     , Event (..)+    , EventMatcher     , Behavior (..)+    , Logger (..)     , EventSource     , EventHandler     , Quotes (..)@@ -32,18 +36,46 @@ where  import Control.Monad.Trans.RWS (RWST)+import Data.HashMap.Lazy (HashMap)+import Data.Time.Clock (UTCTime)+import Data.Time.Interval (TimeInterval)+import qualified Network.IRC.Fun.Client.ChannelLogger as L (Logger) import Network.IRC.Fun.Client.IO (Connection, Handle) import Network.IRC.Fun.Client.Events (ChannelPrivacy (..), Privilege (..))+import qualified Network.IRC.Fun.Client.Events as C (Event)+import Network.IRC.Fun.Client.NickTracker (NetworkTracker)+import System.Log.FastLogger (LoggerSet)  -- | Configuration for the bot connection to IRC. data Config = Config     { -- | Connection details, including nickname and optional password-      connection :: Connection+      connection      :: Connection       -- | List of channels to join, e.g. @["#freepost", "#rel4tion"]@-    , channels   :: [String]+    , channels        :: [String]+      -- | Directory path under which IRC log files will be placed. Relative to+      -- the bot process working directory, or absolute.+    , logDir          :: FilePath+      -- | Filename into the bot state managed by this library will be stored.+      -- The custom part of the state isn't handled. Path relative to the bot+      -- process working directory, or absolute.+    , stateFile       :: 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+      -- | Filename for the bot's main event log, i.e. produced by the IRC+      -- event source.+    , botEventLogFile :: FilePath     }-    deriving (Eq, Show)+    deriving Show +-- / A discussion space where the bot is involved. An IRC channel or a private+-- session with a specific user.+--data Room = Channel String | User String deriving (Eq, Show)++-- | A message for the bot can come privately or in a channel by a given user.+data MessageSource = Channel String String | User String deriving (Eq, Show)+ -- | Describes wrong usage of a bot command. data Failure     -- | The number of arguments given is wrong@@ -121,15 +153,27 @@ -- the password to automatically re-identify in case of any problem with -- NickServ. And so on. data BotEnv e s = BotEnv-    { config   :: Config-    , behavior :: Behavior e s-    , handle   :: Handle-    , custom   :: e+    { config    :: Config+    , behavior  :: Behavior e s+    , handle    :: Handle+    , getTime   :: IO (UTCTime, String)+    , saveState :: BotState s -> IO ()+    , custom    :: e     } +-- Per-channel modifiable state+data ChannelState = ChannelState+    { chanTracking :: Bool+    , chanLogger   :: Maybe L.Logger+    }+ -- Readable and writable bot state. Contains internal state used by this -- library, and public state managed by the bot's behavior logic.-newtype BotState s = BotState { public :: s }+data BotState s = BotState+    { tracker   :: NetworkTracker+    , chanstate :: HashMap String ChannelState+    , public    :: s+    }  -- | Bot monad. It provides read-only bot environment (e.g. the configuration), -- read-writable bot state (for use by bot commands) and IO.@@ -164,24 +208,27 @@     -- \"funbot, hello!\" then the 3rd parameter will be \"hello!\".     | BotMessage String String String     -- | A bot command, which is a message with a special prefix, was sent to-    -- a channel. Parameters: Channel, sender nickname, prefix character,+    -- a channel or privately to the bot. Parameters: Source, prefix character,     -- command name, command arguments.-    | BotCommand String String Char String [String]+    | BotCommand MessageSource (Maybe Char) String [String]     -- | A private message sent specifically to the bot, from a user with the     -- given nickname (1st parameter) and with the given content (2nd     -- parameter).     | PersonalMessage String String     -- | Channel, nickname, topic     | TopicChange String String String-    -- | Unrecognized or unimplemented event. The parameter contains (possibly-    -- empty) input.-    | OtherEvent String     -- | The server sent a list of nicknames present in a channel. Parameters:     -- Channel privacy mode, channel name, list of users. Each list item is a     -- pair of a user privilege level in the channel, and the user's nickname.     | Names String ChannelPrivacy [(Privilege, String)]+    -- | Unrecognized or unimplemented event. The parameter contains (possibly+    -- empty) input.+    | OtherEvent String     deriving Show +-- Tries to match a client event to a bot event.+type EventMatcher e s = C.Event -> Config -> [CommandSet e s] -> Maybe Event+ -- | Bot behavior definition. data Behavior e s = Behavior     { handleJoin        :: String -> String -> Session e s ()@@ -204,6 +251,11 @@                         -> Session e s ()     } +data Logger = Logger+    { loggerSet     :: LoggerSet+    , loggerGetTime :: IO String+    }+ -- | An 'IO' action, possibly running forever, which produces events for the -- bot to process. These event sources are run by the bot in dedicated threads. --@@ -223,6 +275,10 @@     -> ([a] -> IO ())     -- ^ A non-blocking 'IO' action which sends a given list of events to the     -- processing queue.+    -> (FilePath -> IO Logger)+    -- ^ An 'IO' action which creates a logger with a given target filename.+    -- An event source can use it to log events, errors, debug into, etc. into+    -- files efficiently.     -> IO ()  -- | A bot session action which reacts to a single event which came from an
+ src/Network/IRC/Fun/Bot/IrcLog.hs view
@@ -0,0 +1,28 @@+{- 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/>.+ -}++-- | This module provides controls for the IRC channel logging system.+module Network.IRC.Fun.Bot.IrcLog+    ( channelIsLogged+    , startLoggingAll+    , startLoggingChannel+    , startLoggingChannels+    , stopLoggingAll+    , stopLoggingChannel+    , stopLoggingChannels+    )+where++import Network.IRC.Fun.Bot.Internal.IrcLog
+ src/Network/IRC/Fun/Bot/Logger.hs view
@@ -0,0 +1,26 @@+{- 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.Logger+    ( Logger ()+    , newLogger+    , newLogger'+    , removeLogger+    , logLine+    )+where++import Network.IRC.Fun.Bot.Internal.Logger+import Network.IRC.Fun.Bot.Internal.Types
+ src/Network/IRC/Fun/Bot/Nicks.hs view
@@ -0,0 +1,35 @@+{- 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 nickname tracker. For each channel with+-- tracking enabled, the list of users in the channel is being maintained. It+-- is optionally used internally for logging, and can be very useful for some+-- bot features you may with your bot to have.+module Network.IRC.Fun.Bot.Nicks+    ( -- * Tracker Control+      startTrackingAll+    , startTrackingChannel+    , startTrackingChannels+    , stopTrackingAll+    , stopTrackingChannel+    , stopTrackingChannels+      -- * Queries+    , channelIsTracked+    , isInChannel+    , presence+    )+where++import Network.IRC.Fun.Bot.Internal.Nicks
src/Network/IRC/Fun/Bot/State.hs view
@@ -20,13 +20,17 @@     , askConfigS     , askBehavior     , askBehaviorS+    , askTimeGetter     , askEnv     , askEnvS     , getState     , getStateS     , putState     , modifyState+    , getChannelState+    , saveBotState     ) where +import Network.IRC.Fun.Bot.Internal.Persist import Network.IRC.Fun.Bot.Internal.State
src/Network/IRC/Fun/Bot/Types.hs view
@@ -17,6 +17,7 @@ module Network.IRC.Fun.Bot.Types     ( Connection (..)     , Config (..)+    --, Room (..)     , Failure (..)     , Command (..)     , CommandSet (..)