MsgCount.hs

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

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

-- | Start counting in all the channels the bot has joined which aren't
-- being counted.
startCountingAll :: Session e s ()
startCountingAll = modifyChans $ M.map enable

-- | Start counting in the given channel, if not counted already.
startCountingChan :: String -> Session e s ()
startCountingChan chan = modifyChans $ M.adjust enable chan

-- | Start counting in the channels not counted, among the ones given.
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

-- | Stop counting in all counted channels.
stopCountingAll :: Session e s ()
stopCountingAll =
    modify $ \ bstate -> bstate
        { bsMsgCountLog  = M.empty
        , bsChannels     = M.map disable $ bsChannels bstate
        }

-- | Stop counting in the given channel, if counted.
stopCountingChan :: String -> Session e s ()
stopCountingChan chan =
    modify $ \ bstate -> bstate
        { bsMsgCountLog = M.delete chan $ bsMsgCountLog bstate
        , bsChannels    = M.adjust disable chan $ bsChannels bstate
        }

-- | Stop counting in the counted channels among the ones given.
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
        }

-- | Get a mapping between channel names and sequences of their message
-- counting data.
getCountLogs :: Session e s (M.HashMap String (Seq MsgCountEntry))
getCountLogs = gets bsMsgCountLog

-- | Get the count log for a specific channel. If there is none, an empty log
-- is returned.
getCountLog :: String -> Session e s (Seq MsgCountEntry)
getCountLog chan = liftM (M.lookupDefault Q.empty chan) getCountLogs

-- | Check whether a given channel is being counted.
chanIsCounted :: String -> Session e s Bool
chanIsCounted chan = liftM (maybe False csCounting . M.lookup chan) getChans

-- | Check whether a given user ever parted the channel, as far as the count
-- log remembers.
everParted :: String -> String -> Session e s Bool
nick `everParted` chan =
    let p (MsgCountPart n) = n == nick
        p _                = False
    in  liftM (any p) $ getCountLog chan

-- | Check whether a given user ever joined the channel, as far as the count
-- log remembers.
everJoined :: String -> String -> Session e s Bool
nick `everJoined` chan =
    let p (MsgCountJoin n) = n == nick
        p _                = False
    in  liftM (any p) $ getCountLog chan

-- | Determine how many messages a log sequence has recorded.
countMsgs :: Seq MsgCountEntry -> Int
countMsgs =
    let f n (MsgCountMsgs m) = n + m
        f n (MsgCountJoin _) = n
        f n (MsgCountPart _) = n
    in  foldl f 0

-- | Find out how many messages the channel had since the given user parted it.
-- On success, return 'Right' it. Otherwise, i.e. if no parting of the user is
-- recorded, return 'Left' the total recorded messages.
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
            }

-- | Count a message in the channel's count log.
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

-- | Count a join in the channel's count log.
recordJoin :: String -> String -> Session e s ()
recordJoin nick chan =
    let f = (|> (MsgCountJoin nick))
    in  modifyLog chan f

-- | Count a part (i.e. leave one channel) in the channel's count log.
recordPart :: String -> String -> Session e s ()
recordPart nick chan =
    let f = (|> (MsgCountPart nick))
    in  modifyLog chan f

-- | Count a quit (i.e. leave all channels) in the channel's count log.
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
        }

-- | If en event needs to be considered in message counting, handle it.
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