IrcLog.hs

{- This file is part of irc-fun-bot.
 -
 - Written in 2015, 2016 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ 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 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