module Lambdabot.Plugin.IRC.Log (logPlugin) where
import Lambdabot.Compat.FreenodeNick
import Lambdabot.IRC
import Lambdabot.Monad
import qualified Lambdabot.Message as Msg
import Lambdabot.Nick
import Lambdabot.Plugin
import Lambdabot.Util
import Control.Monad
import qualified Data.Map as M
import Data.Time
import System.Directory (createDirectoryIfMissing)
import System.FilePath
import System.IO
type Channel = Nick
type DateStamp = (Int, Int, Integer)
data ChanState = CS { ChanState -> Handle
chanHandle :: Handle,
ChanState -> DateStamp
chanDate :: DateStamp }
deriving (Int -> ChanState -> ShowS
[ChanState] -> ShowS
ChanState -> String
(Int -> ChanState -> ShowS)
-> (ChanState -> String)
-> ([ChanState] -> ShowS)
-> Show ChanState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChanState] -> ShowS
$cshowList :: [ChanState] -> ShowS
show :: ChanState -> String
$cshow :: ChanState -> String
showsPrec :: Int -> ChanState -> ShowS
$cshowsPrec :: Int -> ChanState -> ShowS
Show, ChanState -> ChanState -> Bool
(ChanState -> ChanState -> Bool)
-> (ChanState -> ChanState -> Bool) -> Eq ChanState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChanState -> ChanState -> Bool
$c/= :: ChanState -> ChanState -> Bool
== :: ChanState -> ChanState -> Bool
$c== :: ChanState -> ChanState -> Bool
Eq)
type LogState = M.Map Channel ChanState
type Log = ModuleT LogState LB
data Event =
Said Nick UTCTime String
| Joined Nick String UTCTime
| Parted Nick String UTCTime
| Kicked Nick Nick String UTCTime String
| Renick Nick String UTCTime Nick
| Mode Nick String UTCTime String
deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq)
instance Show Event where
show :: Event -> String
show (Said nick :: Nick
nick ct :: UTCTime
ct what :: String
what) = UTCTime -> String
timeStamp UTCTime
ct String -> ShowS
forall a. [a] -> [a] -> [a]
++ " <" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Nick -> String
nName Nick
nick String -> ShowS
forall a. [a] -> [a] -> [a]
++ "> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
what
show (Joined nick :: Nick
nick usr :: String
usr ct :: UTCTime
ct) = UTCTime -> String
timeStamp UTCTime
ct String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FreenodeNick -> String
forall a. Show a => a -> String
show (Nick -> FreenodeNick
FreenodeNick Nick
nick)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ " (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
usr String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") joined."
show (Parted nick :: Nick
nick usr :: String
usr ct :: UTCTime
ct) = UTCTime -> String
timeStamp UTCTime
ct String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FreenodeNick -> String
forall a. Show a => a -> String
show (Nick -> FreenodeNick
FreenodeNick Nick
nick)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ " (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
usr String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") left."
show (Kicked nick :: Nick
nick op :: Nick
op usrop :: String
usrop ct :: UTCTime
ct reason :: String
reason) = UTCTime -> String
timeStamp UTCTime
ct String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FreenodeNick -> String
forall a. Show a => a -> String
show (Nick -> FreenodeNick
FreenodeNick Nick
nick)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ " was kicked by " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FreenodeNick -> String
forall a. Show a => a -> String
show (Nick -> FreenodeNick
FreenodeNick Nick
op)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ " (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
usrop String -> ShowS
forall a. [a] -> [a] -> [a]
++ "): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
reason String -> ShowS
forall a. [a] -> [a] -> [a]
++ "."
show (Renick nick :: Nick
nick usr :: String
usr ct :: UTCTime
ct new :: Nick
new) = UTCTime -> String
timeStamp UTCTime
ct String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FreenodeNick -> String
forall a. Show a => a -> String
show (Nick -> FreenodeNick
FreenodeNick Nick
nick)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ " (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
usr String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") is now " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FreenodeNick -> String
forall a. Show a => a -> String
show (Nick -> FreenodeNick
FreenodeNick Nick
new) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "."
show (Mode nick :: Nick
nick usr :: String
usr ct :: UTCTime
ct mode :: String
mode) = UTCTime -> String
timeStamp UTCTime
ct String -> ShowS
forall a. [a] -> [a] -> [a]
++ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ FreenodeNick -> String
forall a. Show a => a -> String
show (Nick -> FreenodeNick
FreenodeNick Nick
nick)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ " (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
usr String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") changed mode to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mode String -> ShowS
forall a. [a] -> [a] -> [a]
++ "."
logPlugin :: Module (M.Map Channel ChanState)
logPlugin :: Module (Map Nick ChanState)
logPlugin = Module (Map Nick ChanState)
forall st. Module st
newModule
{ moduleDefState :: LB (Map Nick ChanState)
moduleDefState = Map Nick ChanState -> LB (Map Nick ChanState)
forall (m :: * -> *) a. Monad m => a -> m a
return Map Nick ChanState
forall k a. Map k a
M.empty
, moduleExit :: ModuleT (Map Nick ChanState) LB ()
moduleExit = ModuleT (Map Nick ChanState) LB ()
cleanLogState
, moduleInit :: ModuleT (Map Nick ChanState) LB ()
moduleInit = do
let doLog :: (t -> a -> a)
-> t -> Handle -> a -> ModuleT (Map Nick ChanState) LB ()
doLog f :: t -> a -> a
f m :: t
m hdl :: Handle
hdl = Handle -> String -> ModuleT (Map Nick ChanState) LB ()
logString Handle
hdl (String -> ModuleT (Map Nick ChanState) LB ())
-> (a -> String) -> a -> ModuleT (Map Nick ChanState) LB ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show (a -> String) -> (a -> a) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> a -> a
f t
m
connect :: String
-> (IrcMessage -> UTCTime -> a)
-> ModuleT (Map Nick ChanState) LB ()
connect signal :: String
signal cb :: IrcMessage -> UTCTime -> a
cb = String
-> Callback (Map Nick ChanState)
-> ModuleT (Map Nick ChanState) LB ()
forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
signal (Callback (Map Nick ChanState)
-> ModuleT (Map Nick ChanState) LB ())
-> Callback (Map Nick ChanState)
-> ModuleT (Map Nick ChanState) LB ()
forall a b. (a -> b) -> a -> b
$ \msg :: IrcMessage
msg -> do
UTCTime
now <- IO UTCTime -> ModuleT (Map Nick ChanState) LB UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO UTCTime
getCurrentTime
(Nick -> ModuleT (Map Nick ChanState) LB ())
-> [Nick] -> ModuleT (Map Nick ChanState) LB ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Handle -> UTCTime -> ModuleT (Map Nick ChanState) LB ())
-> UTCTime -> Nick -> ModuleT (Map Nick ChanState) LB ()
forall a. (Handle -> UTCTime -> Log a) -> UTCTime -> Nick -> Log a
withValidLog ((IrcMessage -> UTCTime -> a)
-> IrcMessage
-> Handle
-> UTCTime
-> ModuleT (Map Nick ChanState) LB ()
forall a t a.
Show a =>
(t -> a -> a)
-> t -> Handle -> a -> ModuleT (Map Nick ChanState) LB ()
doLog IrcMessage -> UTCTime -> a
cb IrcMessage
msg) UTCTime
now) (IrcMessage -> [Nick]
forall a. Message a => a -> [Nick]
Msg.channels IrcMessage
msg)
String
-> (IrcMessage -> UTCTime -> Event)
-> ModuleT (Map Nick ChanState) LB ()
forall a.
Show a =>
String
-> (IrcMessage -> UTCTime -> a)
-> ModuleT (Map Nick ChanState) LB ()
connect "PRIVMSG" IrcMessage -> UTCTime -> Event
msgCB
String
-> (IrcMessage -> UTCTime -> Event)
-> ModuleT (Map Nick ChanState) LB ()
forall a.
Show a =>
String
-> (IrcMessage -> UTCTime -> a)
-> ModuleT (Map Nick ChanState) LB ()
connect "JOIN" IrcMessage -> UTCTime -> Event
joinCB
String
-> (IrcMessage -> UTCTime -> Event)
-> ModuleT (Map Nick ChanState) LB ()
forall a.
Show a =>
String
-> (IrcMessage -> UTCTime -> a)
-> ModuleT (Map Nick ChanState) LB ()
connect "PART" IrcMessage -> UTCTime -> Event
partCB
String
-> (IrcMessage -> UTCTime -> Event)
-> ModuleT (Map Nick ChanState) LB ()
forall a.
Show a =>
String
-> (IrcMessage -> UTCTime -> a)
-> ModuleT (Map Nick ChanState) LB ()
connect "KICK" IrcMessage -> UTCTime -> Event
kickCB
String
-> (IrcMessage -> UTCTime -> Event)
-> ModuleT (Map Nick ChanState) LB ()
forall a.
Show a =>
String
-> (IrcMessage -> UTCTime -> a)
-> ModuleT (Map Nick ChanState) LB ()
connect "NICK" IrcMessage -> UTCTime -> Event
nickCB
String
-> (IrcMessage -> UTCTime -> Event)
-> ModuleT (Map Nick ChanState) LB ()
forall a.
Show a =>
String
-> (IrcMessage -> UTCTime -> a)
-> ModuleT (Map Nick ChanState) LB ()
connect "MODE" IrcMessage -> UTCTime -> Event
modeCB
}
showWidth :: Int
-> Int
-> String
showWidth :: Int -> Int -> String
showWidth width :: Int
width n :: Int
n = String
zeroes String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
num
where num :: String
num = Int -> String
forall a. Show a => a -> String
show Int
n
zeroes :: String
zeroes = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
num) '0'
timeStamp :: UTCTime -> String
timeStamp :: UTCTime -> String
timeStamp (UTCTime _ ct :: DiffTime
ct) =
(Int -> Int -> String
showWidth 2 (Int
hours Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 24)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++
(Int -> Int -> String
showWidth 2 (Int
mins Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 60)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ":" String -> ShowS
forall a. [a] -> [a] -> [a]
++
(Int -> Int -> String
showWidth 2 (Int
secs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 60))
where
secs :: Int
secs = DiffTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round DiffTime
ct :: Int
mins :: Int
mins = Int
secs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 60
hours :: Int
hours = Int
mins Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 60
dateToString :: DateStamp -> String
dateToString :: DateStamp -> String
dateToString (d :: Int
d, m :: Int
m, y :: Integer
y) = (Int -> Int -> String
showWidth 2 (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
y) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++
(Int -> Int -> String
showWidth 2 (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "-" String -> ShowS
forall a. [a] -> [a] -> [a]
++
(Int -> Int -> String
showWidth 2 Int
d)
dateStamp :: UTCTime -> DateStamp
dateStamp :: UTCTime -> DateStamp
dateStamp (UTCTime day :: Day
day _) = (Int
d, Int
m, Integer
y)
where (y :: Integer
y,m :: Int
m,d :: Int
d) = Day -> (Integer, Int, Int)
toGregorian Day
day
cleanLogState :: Log ()
cleanLogState :: ModuleT (Map Nick ChanState) LB ()
cleanLogState =
(LBState (ModuleT (Map Nick ChanState) LB)
-> (LBState (ModuleT (Map Nick ChanState) LB)
-> ModuleT (Map Nick ChanState) LB ())
-> ModuleT (Map Nick ChanState) LB ())
-> ModuleT (Map Nick ChanState) LB ()
forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS ((LBState (ModuleT (Map Nick ChanState) LB)
-> (LBState (ModuleT (Map Nick ChanState) LB)
-> ModuleT (Map Nick ChanState) LB ())
-> ModuleT (Map Nick ChanState) LB ())
-> ModuleT (Map Nick ChanState) LB ())
-> (LBState (ModuleT (Map Nick ChanState) LB)
-> (LBState (ModuleT (Map Nick ChanState) LB)
-> ModuleT (Map Nick ChanState) LB ())
-> ModuleT (Map Nick ChanState) LB ())
-> ModuleT (Map Nick ChanState) LB ()
forall a b. (a -> b) -> a -> b
$ \state :: LBState (ModuleT (Map Nick ChanState) LB)
state writer :: LBState (ModuleT (Map Nick ChanState) LB)
-> ModuleT (Map Nick ChanState) LB ()
writer -> do
IO () -> ModuleT (Map Nick ChanState) LB ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> ModuleT (Map Nick ChanState) LB ())
-> IO () -> ModuleT (Map Nick ChanState) LB ()
forall a b. (a -> b) -> a -> b
$ (ChanState -> IO () -> IO ())
-> IO () -> Map Nick ChanState -> IO ()
forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr (\cs :: ChanState
cs iom :: IO ()
iom -> IO ()
iom IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose (ChanState -> Handle
chanHandle ChanState
cs)) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Map Nick ChanState
LBState (ModuleT (Map Nick ChanState) LB)
state
LBState (ModuleT (Map Nick ChanState) LB)
-> ModuleT (Map Nick ChanState) LB ()
writer LBState (ModuleT (Map Nick ChanState) LB)
forall k a. Map k a
M.empty
getChannel :: Channel -> Log ChanState
getChannel :: Nick -> Log ChanState
getChannel c :: Nick
c = (ModuleT (Map Nick ChanState) LB (Map Nick ChanState)
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS ModuleT (Map Nick ChanState) LB (Map Nick ChanState)
-> (Map Nick ChanState -> Log ChanState) -> Log ChanState
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) ((Map Nick ChanState -> Log ChanState) -> Log ChanState)
-> (Nick -> Map Nick ChanState -> Log ChanState)
-> Nick
-> Log ChanState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Map Nick ChanState -> Log ChanState
forall (m :: * -> *) k a.
(MonadFail m, Ord k) =>
k -> Map k a -> m a
mLookup (Nick -> Log ChanState) -> Nick -> Log ChanState
forall a b. (a -> b) -> a -> b
$ Nick
c
where mLookup :: k -> Map k a -> m a
mLookup k :: k
k = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "getChannel: not found") a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m a) -> (Map k a -> Maybe a) -> Map k a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k
getDate :: Channel -> Log DateStamp
getDate :: Nick -> Log DateStamp
getDate c :: Nick
c = (ChanState -> DateStamp) -> Log ChanState -> Log DateStamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChanState -> DateStamp
chanDate (Log ChanState -> Log DateStamp)
-> (Nick -> Log ChanState) -> Nick -> Log DateStamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Log ChanState
getChannel (Nick -> Log DateStamp) -> Nick -> Log DateStamp
forall a b. (a -> b) -> a -> b
$ Nick
c
getHandle :: Channel -> Log Handle
getHandle :: Nick -> Log Handle
getHandle c :: Nick
c = (ChanState -> Handle) -> Log ChanState -> Log Handle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChanState -> Handle
chanHandle (Log ChanState -> Log Handle)
-> (Nick -> Log ChanState) -> Nick -> Log Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Log ChanState
getChannel (Nick -> Log Handle) -> Nick -> Log Handle
forall a b. (a -> b) -> a -> b
$ Nick
c
putHdlAndDS :: Channel -> Handle -> DateStamp -> Log ()
putHdlAndDS :: Nick -> Handle -> DateStamp -> ModuleT (Map Nick ChanState) LB ()
putHdlAndDS c :: Nick
c hdl :: Handle
hdl ds :: DateStamp
ds =
(LBState (ModuleT (Map Nick ChanState) LB)
-> LBState (ModuleT (Map Nick ChanState) LB))
-> ModuleT (Map Nick ChanState) LB ()
forall (m :: * -> *).
MonadLBState m =>
(LBState m -> LBState m) -> m ()
modifyMS ((ChanState -> ChanState)
-> Nick -> Map Nick ChanState -> Map Nick ChanState
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\cs :: ChanState
cs -> ChanState
cs {chanHandle :: Handle
chanHandle = Handle
hdl, chanDate :: DateStamp
chanDate = DateStamp
ds}) Nick
c)
openChannelFile :: Channel -> UTCTime -> Log Handle
openChannelFile :: Nick -> UTCTime -> Log Handle
openChannelFile chan :: Nick
chan ct :: UTCTime
ct = do
String
logDir <- LB String -> ModuleT (Map Nick ChanState) LB String
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB String -> ModuleT (Map Nick ChanState) LB String)
-> LB String -> ModuleT (Map Nick ChanState) LB String
forall a b. (a -> b) -> a -> b
$ String -> LB String
findLBFileForWriting "Log"
let dir :: String
dir = String
logDir String -> ShowS
</> Nick -> String
nTag Nick
chan String -> ShowS
</> Nick -> String
nName Nick
chan
file :: String
file = String
dir String -> ShowS
</> (DateStamp -> String
dateToString DateStamp
date) String -> ShowS
<.> "txt"
IO Handle -> Log Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Handle -> Log Handle) -> IO Handle -> Log Handle
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir IO () -> IO Handle -> IO Handle
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IOMode -> IO Handle
openFile String
file IOMode
AppendMode
where date :: DateStamp
date = UTCTime -> DateStamp
dateStamp UTCTime
ct
reopenChannelMaybe :: Channel -> UTCTime -> Log ()
reopenChannelMaybe :: Nick -> UTCTime -> ModuleT (Map Nick ChanState) LB ()
reopenChannelMaybe chan :: Nick
chan ct :: UTCTime
ct = do
DateStamp
date <- Nick -> Log DateStamp
getDate Nick
chan
Bool
-> ModuleT (Map Nick ChanState) LB ()
-> ModuleT (Map Nick ChanState) LB ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DateStamp
date DateStamp -> DateStamp -> Bool
forall a. Eq a => a -> a -> Bool
/= UTCTime -> DateStamp
dateStamp UTCTime
ct) (ModuleT (Map Nick ChanState) LB ()
-> ModuleT (Map Nick ChanState) LB ())
-> ModuleT (Map Nick ChanState) LB ()
-> ModuleT (Map Nick ChanState) LB ()
forall a b. (a -> b) -> a -> b
$ do
Handle
hdl <- Nick -> Log Handle
getHandle Nick
chan
IO () -> ModuleT (Map Nick ChanState) LB ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> ModuleT (Map Nick ChanState) LB ())
-> IO () -> ModuleT (Map Nick ChanState) LB ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
hdl
Handle
hdl' <- Nick -> UTCTime -> Log Handle
openChannelFile Nick
chan UTCTime
ct
Nick -> Handle -> DateStamp -> ModuleT (Map Nick ChanState) LB ()
putHdlAndDS Nick
chan Handle
hdl' (UTCTime -> DateStamp
dateStamp UTCTime
ct)
initChannelMaybe :: Nick -> UTCTime -> Log ()
initChannelMaybe :: Nick -> UTCTime -> ModuleT (Map Nick ChanState) LB ()
initChannelMaybe chan :: Nick
chan ct :: UTCTime
ct = do
Bool
chanp <- (Map Nick ChanState -> Bool)
-> ModuleT (Map Nick ChanState) LB (Map Nick ChanState)
-> ModuleT (Map Nick ChanState) LB Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Nick -> Map Nick ChanState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Nick
chan) ModuleT (Map Nick ChanState) LB (Map Nick ChanState)
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
Bool
-> ModuleT (Map Nick ChanState) LB ()
-> ModuleT (Map Nick ChanState) LB ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
chanp (ModuleT (Map Nick ChanState) LB ()
-> ModuleT (Map Nick ChanState) LB ())
-> ModuleT (Map Nick ChanState) LB ()
-> ModuleT (Map Nick ChanState) LB ()
forall a b. (a -> b) -> a -> b
$ do
Handle
hdl <- Nick -> UTCTime -> Log Handle
openChannelFile Nick
chan UTCTime
ct
(LBState (ModuleT (Map Nick ChanState) LB)
-> LBState (ModuleT (Map Nick ChanState) LB))
-> ModuleT (Map Nick ChanState) LB ()
forall (m :: * -> *).
MonadLBState m =>
(LBState m -> LBState m) -> m ()
modifyMS (Nick -> ChanState -> Map Nick ChanState -> Map Nick ChanState
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Nick
chan (ChanState
-> LBState (ModuleT (Map Nick ChanState) LB)
-> LBState (ModuleT (Map Nick ChanState) LB))
-> ChanState
-> LBState (ModuleT (Map Nick ChanState) LB)
-> LBState (ModuleT (Map Nick ChanState) LB)
forall a b. (a -> b) -> a -> b
$ Handle -> DateStamp -> ChanState
CS Handle
hdl (UTCTime -> DateStamp
dateStamp UTCTime
ct))
withValidLog :: (Handle -> UTCTime -> Log a) -> UTCTime -> Channel -> Log a
withValidLog :: (Handle -> UTCTime -> Log a) -> UTCTime -> Nick -> Log a
withValidLog f :: Handle -> UTCTime -> Log a
f ct :: UTCTime
ct chan :: Nick
chan = do
Nick -> UTCTime -> ModuleT (Map Nick ChanState) LB ()
initChannelMaybe Nick
chan UTCTime
ct
Nick -> UTCTime -> ModuleT (Map Nick ChanState) LB ()
reopenChannelMaybe Nick
chan UTCTime
ct
Handle
hdl <- Nick -> Log Handle
getHandle Nick
chan
a
rv <- Handle -> UTCTime -> Log a
f Handle
hdl UTCTime
ct
a -> Log a
forall (m :: * -> *) a. Monad m => a -> m a
return a
rv
logString :: Handle -> String -> Log ()
logString :: Handle -> String -> ModuleT (Map Nick ChanState) LB ()
logString hdl :: Handle
hdl str :: String
str = IO () -> ModuleT (Map Nick ChanState) LB ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> ModuleT (Map Nick ChanState) LB ())
-> IO () -> ModuleT (Map Nick ChanState) LB ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
hdl String
str IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
hdl
joinCB :: IrcMessage -> UTCTime -> Event
joinCB :: IrcMessage -> UTCTime -> Event
joinCB msg :: IrcMessage
msg ct :: UTCTime
ct = Nick -> String -> UTCTime -> Event
Joined (IrcMessage -> Nick
forall a. Message a => a -> Nick
Msg.nick IrcMessage
msg) (IrcMessage -> String
forall a. Message a => a -> String
Msg.fullName IrcMessage
msg) UTCTime
ct
partCB :: IrcMessage -> UTCTime -> Event
partCB :: IrcMessage -> UTCTime -> Event
partCB msg :: IrcMessage
msg ct :: UTCTime
ct = Nick -> String -> UTCTime -> Event
Parted (IrcMessage -> Nick
forall a. Message a => a -> Nick
Msg.nick IrcMessage
msg) (IrcMessage -> String
forall a. Message a => a -> String
Msg.fullName IrcMessage
msg) UTCTime
ct
kickCB :: IrcMessage -> UTCTime -> Event
kickCB :: IrcMessage -> UTCTime -> Event
kickCB msg :: IrcMessage
msg ct :: UTCTime
ct = Nick -> Nick -> String -> UTCTime -> String -> Event
Kicked (IrcMessage -> Nick
forall a. Message a => a -> Nick
Msg.nick IrcMessage
msg) { nName :: String
nName = [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
tail ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ IrcMessage -> [String]
ircMsgParams IrcMessage
msg }
(IrcMessage -> Nick
forall a. Message a => a -> Nick
Msg.nick IrcMessage
msg)
(IrcMessage -> String
forall a. Message a => a -> String
Msg.fullName IrcMessage
msg)
UTCTime
ct
(ShowS
forall a. [a] -> [a]
tail ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
tail ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
tail ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ IrcMessage -> [String]
ircMsgParams IrcMessage
msg)
nickCB :: IrcMessage -> UTCTime -> Event
nickCB :: IrcMessage -> UTCTime -> Event
nickCB msg :: IrcMessage
msg ct :: UTCTime
ct = Nick -> String -> UTCTime -> Nick -> Event
Renick (IrcMessage -> Nick
forall a. Message a => a -> Nick
Msg.nick IrcMessage
msg) (IrcMessage -> String
forall a. Message a => a -> String
Msg.fullName IrcMessage
msg) UTCTime
ct
(String -> String -> Nick
parseNick (IrcMessage -> String
forall a. Message a => a -> String
Msg.server IrcMessage
msg) (String -> Nick) -> String -> Nick
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop 1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ IrcMessage -> [String]
ircMsgParams IrcMessage
msg)
modeCB :: IrcMessage -> UTCTime -> Event
modeCB :: IrcMessage -> UTCTime -> Event
modeCB msg :: IrcMessage
msg ct :: UTCTime
ct = Nick -> String -> UTCTime -> String -> Event
Mode (IrcMessage -> Nick
forall a. Message a => a -> Nick
Msg.nick IrcMessage
msg) (IrcMessage -> String
forall a. Message a => a -> String
Msg.fullName IrcMessage
msg) UTCTime
ct
([String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
tail ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ IrcMessage -> [String]
ircMsgParams IrcMessage
msg)
msgCB :: IrcMessage -> UTCTime -> Event
msgCB :: IrcMessage -> UTCTime -> Event
msgCB msg :: IrcMessage
msg ct :: UTCTime
ct = Nick -> UTCTime -> String -> Event
Said (IrcMessage -> Nick
forall a. Message a => a -> Nick
Msg.nick IrcMessage
msg) UTCTime
ct
(ShowS
forall a. [a] -> [a]
tail ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
tail ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ IrcMessage -> [String]
ircMsgParams IrcMessage
msg)