module Network.IRC.Fun.Client.ChannelLogger
( Logger ()
, ChanLogEvent (..)
, LogEvent (..)
, logFilePath
, newLogger
, removeLogger
, logEvent
, fromClientEvent
)
where
import Control.Monad (liftM)
import Data.Monoid ((<>))
import Network.IRC.Fun.Client.Events (Event (..))
import Network.IRC.Fun.Messages.TypeAliases (NickName, ChannelName)
import System.Log.FastLogger
data Logger = Logger
{ loggerSet :: LoggerSet
, loggerGetTime :: IO String
}
data ChanLogEvent
= EnterChan NickName
| LeaveChan NickName
| MessageChan NickName String
| RenameInChan NickName NickName
deriving Show
data LogEvent
= Enter NickName ChannelName
| Leave NickName ChannelName
| LeaveAll NickName
| Message NickName ChannelName String
| Rename NickName NickName
deriving Show
logFilePath :: FilePath
-> String
-> ChannelName
-> FilePath
logFilePath dir server chan = dir ++ "/" ++ server ++ "." ++ chan ++ ".irc"
newLogger :: IO String
-> FilePath
-> IO Logger
newLogger getTime path = do
lset <- newFileLoggerSet defaultBufSize path
return $ Logger
{ loggerSet = lset
, loggerGetTime = getTime
}
removeLogger :: Logger -> IO ()
removeLogger logger = rmLoggerSet $ loggerSet logger
formatEvent :: ChanLogEvent -> LogStr
formatEvent e = case e of
EnterChan nick -> "|-->| " <> toLogStr nick <> " has joined"
LeaveChan nick -> "|<--| " <> toLogStr nick <> " has left"
MessageChan nick msg -> "<" <> toLogStr nick <> "> " <> toLogStr msg
RenameInChan old new -> "|---| " <> toLogStr old <> " is now known as "
<> toLogStr new
formatLine :: IO String -> ChanLogEvent -> IO LogStr
formatLine getTime event = do
t <- getTime
return $ toLogStr t <> " " <> formatEvent event
logEvent :: Logger -> ChanLogEvent -> IO ()
logEvent logger event = do
line <- formatLine (loggerGetTime logger) event
pushLogStrLn (loggerSet logger) line
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
NickChange old new -> Just $ Rename old new
_ -> Nothing