ChannelLogger.hs

{- This file is part of irc-fun-client.
 -
 - 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/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

module Network.IRC.Fun.Client.ChannelLogger
    ( Logger ()
    , ChanLogEvent (..)
    , LogEvent (..)
    , logFilePath
    , newLogger
    , removeLogger
    , logEvent
    , fromClientEvent
    )
where

import Control.Monad (liftM)
import Data.Monoid ((<>))
import Data.Text (Text)
import Network.IRC.Fun.Client.Events (Event (..))
import Network.IRC.Fun.Types
import System.Log.FastLogger

data Logger = Logger
    { loggerSet     :: LoggerSet
    , loggerGetTime :: IO Text
    }

data ChanLogEvent
    = EnterChan Nickname
    | LeaveChan Nickname
    | MessageChan Nickname MsgContent
    | ActInChan Nickname MsgContent
    | RenameInChan Nickname Nickname
    deriving Show

data LogEvent
    = Enter Nickname Channel
    | Leave Nickname Channel
    | LeaveAll Nickname
    | Message Nickname Channel MsgContent
    | Action Nickname Channel MsgContent
    | Rename Nickname Nickname
    deriving Show

-- | Utility for constructing a log file path.
logFilePath :: FilePath    -- ^ Directory in which to place log files. Relative
                           -- to the program's working directory, or absolute.
            -> String      -- ^ Server label, e.g. @\"freenode\"@
            -> String      -- ^ IRC channel name, e.g. @\"#freepost\"@
            -> FilePath
logFilePath dir server chan = dir ++ "/" ++ server ++ "." ++ chan ++ ".irc"

-- | Create a logger for a given IRC channel.
newLogger :: IO Text   -- ^ Action which returns a formatted time string. You
                       -- can use "Network.IRC.Fun.Client.Time" to create such
                       -- an action.
          -> FilePath  -- ^ Path of the log file
          -> IO Logger
newLogger getTime path = do
    lset <- newFileLoggerSet defaultBufSize path
    return $ Logger
        { loggerSet     = lset
        , loggerGetTime = getTime
        }

-- | Flush buffers and release resources.
--
-- When the logger is paused for a long period of time (i.e. not momentarily -
-- e.g. by a user disabling channel logging via UI), you can use this to
-- release resources. Later, when logging is needed again, create a fresh new
-- logger.
--
-- If your client joins many channels but log few of them, you can save
-- resources by keeping open loggers only for the few logged channels.
removeLogger :: Logger -> IO ()
removeLogger logger = rmLoggerSet $ loggerSet logger

formatEvent :: ChanLogEvent -> LogStr
formatEvent e = case e of
    EnterChan (Nickname nick) ->
        "|-->| " <> toLogStr nick <> " has joined"
    LeaveChan (Nickname nick) ->
        "|<--| " <> toLogStr nick <> " has left"
    MessageChan (Nickname nick) (MsgContent msg) ->
        "<" <> toLogStr nick <> "> " <> toLogStr msg
    ActInChan (Nickname nick) (MsgContent msg) ->
        "* " <> toLogStr nick <> " " <> toLogStr msg
    RenameInChan (Nickname old) (Nickname new) ->
        "|---| " <> toLogStr old <> " is now known as " <> toLogStr new

formatLine :: IO Text -> ChanLogEvent -> IO LogStr
formatLine getTime event = do
    t <- getTime
    return $ toLogStr t <> " " <> formatEvent event

-- | Write a log message corresponding to a given event.
logEvent :: Logger -> ChanLogEvent -> IO ()
logEvent logger event = do
    line <- formatLine (loggerGetTime logger) event
    pushLogStrLn (loggerSet logger) line

-- | If an IRC client event can be logged, return a matching log event and the
-- channel in which the event has occured.
fromClientEvent :: Event -> Maybe LogEvent
fromClientEvent event = case event of
    Join chan nick                       -> Just $ Enter nick chan
    Part chan nick _reason               -> Just $ Leave nick chan
    Quit nick _reason                    -> Just $ LeaveAll nick
    ChannelMessage chan nick msg _notice -> Just $ Message nick chan msg
    ChannelAction chan nick msg          -> Just $ Action nick chan msg
    NickChange old new                   -> Just $ Rename old new
    _                                    -> Nothing