{- This file is part of irc-fun-bot. - - Written in 2015 by fr33domlover . - - ♡ 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 - . -} 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 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 import qualified Data.HashMap.Lazy as M makeLogger :: BotEnv e s -> String -> IO Logger makeLogger env chan = let timeGetter = beGetTime env logdir = logDir $ beConfig 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