module Network.IRC.Fun.Bot.Internal.MsgCount
( startCountingAll
, startCountingChan
, startCountingChans
, stopCountingAll
, stopCountingChan
, stopCountingChans
, getCountLogs
, getCountLog
, chanIsCounted
, everParted
, everJoined
, countMsgs
, msgsSinceParted
, recordMsg
, recordJoin
, recordPart
, recordQuit
, countEvent
)
where
import Control.Monad (liftM, when)
import Control.Monad.Trans.RWS (modify, gets)
import Data.Foldable (any, foldl)
import Data.Sequence (Seq, ViewR (..), (|>))
import Network.IRC.Fun.Bot.Internal.Nicks (presence)
import Network.IRC.Fun.Bot.Internal.State
import Network.IRC.Fun.Bot.Internal.Types
import Prelude hiding (any, foldl)
import qualified Data.HashMap.Lazy as M
import qualified Data.Sequence as Q
import qualified Data.Sequence.Util as QU
import qualified Network.IRC.Fun.Client.Events as C (Event (..))
set :: Bool -> ChanState -> ChanState
set b cs = cs { csCounting = b }
enable :: ChanState -> ChanState
enable = set True
disable :: ChanState -> ChanState
disable = set False
startCountingAll :: Session e s ()
startCountingAll = modifyChans $ M.map enable
startCountingChan :: String -> Session e s ()
startCountingChan chan = modifyChans $ M.adjust enable chan
startCountingChans :: [String] -> Session e s ()
startCountingChans chans = do
chanmapAll <- getChans
let given = M.fromList (zip chans (repeat ()))
chanmapG = chanmapAll `M.intersection` given
chanmapD = M.filter (not . csCounting) chanmapG
chanmapE = M.map enable chanmapD
chanmapAllE = chanmapE `M.union` chanmapAll
putChans chanmapAllE
stopCountingAll :: Session e s ()
stopCountingAll =
modify $ \ bstate -> bstate
{ bsMsgCountLog = M.empty
, bsChannels = M.map disable $ bsChannels bstate
}
stopCountingChan :: String -> Session e s ()
stopCountingChan chan =
modify $ \ bstate -> bstate
{ bsMsgCountLog = M.delete chan $ bsMsgCountLog bstate
, bsChannels = M.adjust disable chan $ bsChannels bstate
}
stopCountingChans :: [String] -> Session e s ()
stopCountingChans chans =
modify $ \ bstate -> bstate
{ bsMsgCountLog =
bsMsgCountLog bstate
`M.difference`
M.fromList (zip chans (repeat ()))
, bsChannels =
let chanmap = bsChannels bstate
chanmapE = M.filter csCounting chanmap
chanmapD = M.map disable chanmapE
in chanmapD `M.union` chanmap
}
getCountLogs :: Session e s (M.HashMap String (Seq MsgCountEntry))
getCountLogs = gets bsMsgCountLog
getCountLog :: String -> Session e s (Seq MsgCountEntry)
getCountLog chan = liftM (M.lookupDefault Q.empty chan) getCountLogs
chanIsCounted :: String -> Session e s Bool
chanIsCounted chan = liftM (maybe False csCounting . M.lookup chan) getChans
everParted :: String -> String -> Session e s Bool
nick `everParted` chan =
let p (MsgCountPart n) = n == nick
p _ = False
in liftM (any p) $ getCountLog chan
everJoined :: String -> String -> Session e s Bool
nick `everJoined` chan =
let p (MsgCountJoin n) = n == nick
p _ = False
in liftM (any p) $ getCountLog chan
countMsgs :: Seq MsgCountEntry -> Int
countMsgs =
let f n (MsgCountMsgs m) = n + m
f n (MsgCountJoin _) = n
f n (MsgCountPart _) = n
in foldl f 0
msgsSinceParted :: String -> String -> Session e s (Either Int Int)
msgsSinceParted nick chan = do
cl <- getCountLog chan
let p (MsgCountPart n) = n == nick
p _ = False
(after, until) = Q.breakr p cl
count = countMsgs after
return $ if Q.null until
then Left count
else Right count
modifyLog :: String
-> (Seq MsgCountEntry -> Seq MsgCountEntry)
-> Session e s ()
modifyLog chan f = do
t <- chanIsCounted chan
when t $ do
n <- askConfigS cfgMaxMsgCount
let g logs =
let prev = M.lookupDefault Q.empty chan logs
new = f prev
fixed = if Q.length new > n then QU.tail new else new
in M.insert chan fixed logs
modify $ \ bstate -> bstate
{ bsMsgCountLog = g $ bsMsgCountLog bstate
}
recordMsg :: String -> Session e s ()
recordMsg chan =
let f q =
case Q.viewr q of
EmptyR -> Q.singleton $ MsgCountMsgs 1
l :> MsgCountMsgs n -> l |> MsgCountMsgs (n + 1)
_ :> _ -> q |> MsgCountMsgs 1
in modifyLog chan f
recordJoin :: String -> String -> Session e s ()
recordJoin nick chan =
let f = (|> (MsgCountJoin nick))
in modifyLog chan f
recordPart :: String -> String -> Session e s ()
recordPart nick chan =
let f = (|> (MsgCountPart nick))
in modifyLog chan f
recordQuit :: String -> Session e s ()
recordQuit nick = do
chans <- presence nick
let chansPresent = M.fromList $ zip chans (repeat ())
chansCounted <- liftM (M.filter csCounting) getChans
let chansAct = chansPresent `M.intersection` chansCounted
logs <- getCountLogs
let logsAct = logs `M.intersection` chansAct
n <- askConfigS cfgMaxMsgCount
let f q =
let new = q |> MsgCountPart nick
in if Q.length new > n then QU.tail new else new
logsNew = M.map f logsAct
modify $ \ bstate -> bstate
{ bsMsgCountLog = logsNew `M.union` bsMsgCountLog bstate
}
countEvent :: C.Event -> Maybe (Msg a)
countEvent (C.Join chan nick) = Just $ MsgCountLogJoin nick chan
countEvent (C.Part chan nick _) = Just $ MsgCountLogPart nick chan
countEvent (C.Quit nick _) = Just $ MsgCountLogQuit nick
countEvent (C.ChannelMessage chan _ _ _) = Just $ MsgCountLogMsg chan
countEvent (C.ChannelAction chan _ _) = Just $ MsgCountLogMsg chan
countEvent _ = Nothing