{- This file is part of irc-fun-bot. - - Written in 2015, 2016 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 Data.Maybe (isJust) import Data.Text (unpack) import Data.Traversable (traverse) import Network.IRC.Fun.Bot.Internal.Monad (ask) import Network.IRC.Fun.Bot.Internal.State import Network.IRC.Fun.Bot.Internal.Types hiding (Logger) import Network.IRC.Fun.Client.ChannelLogger import Network.IRC.Fun.Types (Channel (..)) import qualified Data.HashMap.Lazy as M makeLogger :: BotEnv e s -> Channel -> IO Logger makeLogger env chan = let timeGetter = beGetTime env logdir = cfgLogDir $ beConfig env file = logFilePath logdir "server" (unpack $ unChannel chan) in newLogger (liftM snd timeGetter) file enable :: Channel -> ChanState -> Session e s ChanState enable chan cstate = if isJust $ csLogger cstate then return cstate else do env <- ask logger <- liftIO $ makeLogger env chan return cstate { csLogger = Just logger } disable :: ChanState -> Session e s ChanState disable cstate = case csLogger cstate of Just logger -> do liftIO $ removeLogger logger return cstate { csLogger = Nothing } Nothing -> return cstate -- | Check whether a given channel is being logged. channelIsLogged :: Channel -> Session e s Bool channelIsLogged chan = do chans <- getChans return $ isJust $ M.lookup chan chans >>= csLogger -- | 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 :: Channel -> 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 :: [Channel] -> 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 :: Channel -> 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 :: [Channel] -> 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