IrcLog.hs

{- 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 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