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 = cfgLogDir $ beConfig env
file = logFilePath logdir "server" chan
in newLogger (liftM snd timeGetter) file
enable :: String -> 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
channelIsLogged :: String -> Session e s Bool
channelIsLogged chan = do
chans <- getChans
return $ isJust $ M.lookup chan chans >>= csLogger
startLoggingAll :: Session e s ()
startLoggingAll = do
chanmap <- getChans
chanmapE <- M.traverseWithKey enable chanmap
putChans chanmapE
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 ()
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
stopLoggingAll :: Session e s ()
stopLoggingAll = do
chanmap <- getChans
chanmapE <- M.traverseWithKey enable chanmap
putChans chanmapE
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 ()
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