-- Copyright (c) 2004 Thomas Jaeger
-- Copyright (c) 2005-6 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)

-- | Keep track of IRC users.
module Lambdabot.Plugin.Social.Seen (seenPlugin) where

import Lambdabot.Bot
import Lambdabot.Compat.AltTime
import Lambdabot.Compat.PackedNick
import Lambdabot.IRC
import Lambdabot.Logging
import qualified Lambdabot.Message as G
import Lambdabot.Monad
import Lambdabot.Nick
import Lambdabot.Plugin
import Lambdabot.Util

import Lambdabot.Plugin.Social.Seen.StopWatch
import Lambdabot.Plugin.Social.Seen.UserStatus

import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Data.Binary
import qualified Data.ByteString.Char8 as P
import qualified Data.ByteString.Lazy as L
import Data.Char
import Data.List
import qualified Data.Map.Strict as M
import Text.Printf

type SeenState = (MaxMap, SeenMap)
type SeenMap   = M.Map PackedNick UserStatus
type MaxMap    = M.Map Channel Int

type Seen = ModuleT SeenState LB

------------------------------------------------------------------------

seenPlugin :: Module (M.Map Channel Int, M.Map PackedNick UserStatus)
seenPlugin :: Module (Map PackedNick Int, Map PackedNick UserStatus)
seenPlugin = forall st. Module st
newModule
    { moduleDefState :: LB (Map PackedNick Int, Map PackedNick UserStatus)
moduleDefState = forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Map k a
M.empty,forall k a. Map k a
M.empty)

    , moduleCmds :: ModuleT
  (Map PackedNick Int, Map PackedNick UserStatus) LB [Command Seen]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"users")
            { help :: Cmd Seen ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"users [chan]. Report the maximum number of users seen in a channel, and active users in the last 30 minutes"
            , process :: String -> Cmd Seen ()
process = String -> Cmd Seen ()
doUsers
            }
        , (String -> Command Identity
command String
"seen")
            { help :: Cmd Seen ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"seen <user>. Report if a user has been seen by the bot"
            , process :: String -> Cmd Seen ()
process = String -> Cmd Seen ()
doSeen
            }
        ]

    , moduleInit :: ModuleT (Map PackedNick Int, Map PackedNick UserStatus) LB ()
moduleInit = do
        forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
            [ forall st. String -> Callback st -> ModuleT st LB ()
registerCallback String
signal (forall a.
Message a =>
String
-> (a
    -> ClockTime
    -> PackedNick
    -> Map PackedNick UserStatus
    -> Either String (Map PackedNick UserStatus))
-> a
-> ModuleT (Map PackedNick Int, Map PackedNick UserStatus) LB ()
withSeenFM String
signal IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
cb)
            | (String
signal, IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
cb) <- forall a b. [a] -> [b] -> [(a, b)]
zip
                [String
"JOIN", String
"PART", String
"QUIT", String
"NICK", String
"353",      String
"PRIVMSG"]
                [IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
joinCB, IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
partCB, IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
quitCB, IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
nickCB, IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
joinChanCB, IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
msgCB]
            ]

        Maybe String
c <- forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb forall a b. (a -> b) -> a -> b
$ String -> LB (Maybe String)
findLBFileForReading String
"seen"
        PackedNick
s <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PackedNick
P.pack String
"")) (forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO PackedNick
P.readFile) Maybe String
c
        let ls :: ByteString
ls = PackedNick -> ByteString
L.fromStrict PackedNick
s
        Either
  SomeException (Map PackedNick Int, Map PackedNick UserStatus)
mbDecoded <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a. Binary a => ByteString -> a
decode ByteString
ls
        case Either
  SomeException (Map PackedNick Int, Map PackedNick UserStatus)
mbDecoded of
            Left exc :: SomeException
exc@SomeException{} -> do
                -- try reading the old format (slightly different type... oh, "binary"...)
                Either SomeException (Map String Int, Map PackedNick UserStatus)
mbOld <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a. Binary a => ByteString -> a
decode ByteString
ls
                case Either SomeException (Map String Int, Map PackedNick UserStatus)
mbOld of
                    Left SomeException{} ->
                        forall (m :: * -> *). MonadLogging m => String -> m ()
warningM (String
"WARNING: failed to read Seen module state: "  forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SomeException
exc)
                    Right (Map String Int
maxMap, Map PackedNick UserStatus
seenMap) ->
                        forall (m :: * -> *). MonadLBState m => LBState m -> m ()
writeMS (forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys String -> PackedNick
P.pack Map String Int
maxMap, Map PackedNick UserStatus
seenMap)
            Right (Map PackedNick Int, Map PackedNick UserStatus)
decoded -> forall (m :: * -> *). MonadLBState m => LBState m -> m ()
writeMS (Map PackedNick Int, Map PackedNick UserStatus)
decoded

    , moduleExit :: ModuleT (Map PackedNick Int, Map PackedNick UserStatus) LB ()
moduleExit = do
        [Nick]
chans <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ LB [Nick]
ircGetChannels
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Nick]
chans) forall a b. (a -> b) -> a -> b
$ do
            ClockTime
ct    <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
            forall (m :: * -> *).
MonadLBState m =>
(LBState m -> LBState m) -> m ()
modifyMS forall a b. (a -> b) -> a -> b
$ \(Map PackedNick Int
n,Map PackedNick UserStatus
m) -> (Map PackedNick Int
n, ClockTime
-> [PackedNick]
-> Map PackedNick UserStatus
-> Map PackedNick UserStatus
botPart ClockTime
ct (forall a b. (a -> b) -> [a] -> [b]
map Nick -> PackedNick
packNick [Nick]
chans) Map PackedNick UserStatus
m)

        -- and write out our state:
        forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS forall a b. (a -> b) -> a -> b
$ \LBState Seen
s LBState Seen
-> ModuleT (Map PackedNick Int, Map PackedNick UserStatus) LB ()
_ -> forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (String -> LB String
findLBFileForWriting String
"seen") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ String
c -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (forall a. Binary a => String -> a -> IO ()
encodeFile String
c LBState Seen
s)
    }

lcNick :: Nick -> Nick
lcNick :: Nick -> Nick
lcNick (Nick String
svr String
nck) = String -> String -> Nick
Nick String
svr (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
nck)

------------------------------------------------------------------------

doUsers :: String -> Cmd Seen ()
doUsers :: String -> Cmd Seen ()
doUsers String
rest = forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg forall a b. (a -> b) -> a -> b
$ \a
msg -> do
    -- first step towards tracking the maximum number of users
    Nick
chan <- forall (m :: * -> *). Monad m => Cmd m Nick
getTarget
    (Map PackedNick Int
m, Map PackedNick UserStatus
seenFM) <- forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
    ClockTime
s <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
    let who :: PackedNick
who = Nick -> PackedNick
packNick forall a b. (a -> b) -> a -> b
$ Nick -> Nick
lcNick forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest then Nick
chan else String -> String -> Nick
parseNick (forall a. Message a => a -> String
G.server a
msg) String
rest
        now :: Int
now = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ () | (PackedNick
_,Present LastSpoke
_ [PackedNick]
chans) <- forall k a. Map k a -> [(k, a)]
M.toList Map PackedNick UserStatus
seenFM
                          , PackedNick
who forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackedNick]
chans ]

        n :: Int
n = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackedNick
who Map PackedNick Int
m of Maybe Int
Nothing -> Int
1; Just Int
n' -> Int
n'

        active :: Int
active = forall (t :: * -> *) a. Foldable t => t a -> Int
length [() | (PackedNick
_,st :: UserStatus
st@(Present LastSpoke
_ [PackedNick]
chans)) <- forall k a. Map k a -> [(k, a)]
M.toList Map PackedNick UserStatus
seenFM
                            , PackedNick
who forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackedNick]
chans Bool -> Bool -> Bool
&& UserStatus -> Bool
isActive UserStatus
st ]

        isActive :: UserStatus -> Bool
isActive (Present (Just (ClockTime
ct,TimeDiff
_td)) [PackedNick]
_cs) = ClockTime -> Bool
recent ClockTime
ct
        isActive UserStatus
_                             = Bool
False

        recent :: ClockTime -> Bool
recent ClockTime
t = ClockTime -> ClockTime -> TimeDiff
diffClockTimes ClockTime
s ClockTime
t forall a. Ord a => a -> a -> Bool
< TimeDiff
gap_minutes
        gap_minutes :: TimeDiff
gap_minutes = NominalDiffTime -> TimeDiff
TimeDiff NominalDiffTime
1800 -- 30 minutes

        percent :: a -> a -> Double
percent a
p a
q = Double
100 forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
p forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
q) :: Double

        total :: a -> a -> String
total   a
0 a
0 = String
"0"
        total   a
p a
q = forall r. PrintfType r => String -> r
printf String
"%d (%0.1f%%)" a
p (forall {a} {a}. (Integral a, Integral a) => a -> a -> Double
percent a
p a
q)

    forall (m :: * -> *). Monad m => String -> Cmd m ()
say forall a b. (a -> b) -> a -> b
$! forall r. PrintfType r => String -> r
printf String
"Maximum users seen in %s: %d, currently: %s, active: %s"
        (String -> Nick -> String
fmtNick (forall a. Message a => a -> String
G.server a
msg) forall a b. (a -> b) -> a -> b
$ PackedNick -> Nick
unpackNick PackedNick
who) Int
n (forall {a} {a}.
(PrintfArg a, Integral a, Integral a) =>
a -> a -> String
total Int
now Int
n) (forall {a} {a}.
(PrintfArg a, Integral a, Integral a) =>
a -> a -> String
total Int
active Int
now)

doSeen :: String -> Cmd Seen ()
doSeen :: String -> Cmd Seen ()
doSeen String
rest = forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg forall a b. (a -> b) -> a -> b
$ \a
msg -> do
    Nick
target <- forall (m :: * -> *). Monad m => Cmd m Nick
getTarget
    (Map PackedNick Int
_,Map PackedNick UserStatus
seenFM) <- forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
    ClockTime
now        <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
    let ([String]
txt,Bool
safe) = (forall a.
Message a =>
a
-> String
-> Map PackedNick UserStatus
-> ClockTime
-> ([String], Bool)
getAnswer a
msg String
rest Map PackedNick UserStatus
seenFM ClockTime
now)
    if Bool
safe Bool -> Bool -> Bool
|| Bool -> Bool
not (String
"#" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Nick -> String
nName Nick
target)
        then forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). Monad m => String -> Cmd m ()
say [String]
txt
        else forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (Nick -> String -> LB ()
ircPrivmsg (forall a. Message a => a -> Nick
G.nick a
msg) ([String] -> String
unlines [String]
txt))

getAnswer :: G.Message a => a -> String -> SeenMap -> ClockTime -> ([String], Bool)
getAnswer :: forall a.
Message a =>
a
-> String
-> Map PackedNick UserStatus
-> ClockTime
-> ([String], Bool)
getAnswer a
msg String
rest Map PackedNick UserStatus
seenFM ClockTime
now
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
nick' =
        let people :: [PackedNick]
people  = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (a, UserStatus) -> Bool
isActive forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map PackedNick UserStatus
seenFM
            isActive :: (a, UserStatus) -> Bool
isActive (a
_nick,UserStatus
state) = case UserStatus
state of
                (Present (Just (ClockTime
ct,TimeDiff
_td)) [PackedNick]
_cs) -> ClockTime -> Bool
recent ClockTime
ct
                UserStatus
_ -> Bool
False
            recent :: ClockTime -> Bool
recent ClockTime
t = ClockTime -> ClockTime -> TimeDiff
diffClockTimes ClockTime
now ClockTime
t forall a. Ord a => a -> a -> Bool
< TimeDiff
gap_minutes
            gap_minutes :: TimeDiff
gap_minutes = NominalDiffTime -> TimeDiff
TimeDiff NominalDiffTime
900 -- 15 minutes
         in ([String
"Lately, I have seen " forall a. [a] -> [a] -> [a]
++ (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackedNick]
people then String
"nobody"
                 else String -> [String] -> String
listToStr String
"and" (forall a b. (a -> b) -> [a] -> [b]
map PackedNick -> String
upAndShow [PackedNick]
people)) forall a. [a] -> [a] -> [a]
++ String
"."], Bool
False)

    | Nick
pnick forall a. Eq a => a -> a -> Bool
== forall a. Message a => a -> Nick
G.lambdabotName a
msg =
        case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Nick -> PackedNick
packNick Nick
pnick) Map PackedNick UserStatus
seenFM of
            Just (Present LastSpoke
_ [PackedNick]
cs) ->
                ([String
"Yes, I'm here. I'm in " forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
listToStr String
"and" (forall a b. (a -> b) -> [a] -> [b]
map PackedNick -> String
upAndShow [PackedNick]
cs)], Bool
True)
            Maybe UserStatus
_ -> forall a. HasCallStack => String -> a
error String
"I'm here, but not here. And very confused!"

    | forall a. [a] -> a
head (Nick -> String
nName Nick
pnick) forall a. Eq a => a -> a -> Bool
== Char
'#' =
        let people :: [PackedNick]
people  = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (a, UserStatus) -> Bool
inChan forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map PackedNick UserStatus
seenFM
            inChan :: (a, UserStatus) -> Bool
inChan (a
_nick,UserStatus
state) = case UserStatus
state of
                (Present (Just (ClockTime, TimeDiff)
_) [PackedNick]
cs)
                    -> Nick -> PackedNick
packNick Nick
pnick forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackedNick]
cs
                UserStatus
_   -> Bool
False
         in ([String
"In "forall a. [a] -> [a] -> [a]
++String
nick'forall a. [a] -> [a] -> [a]
++String
" I can see "
            forall a. [a] -> [a] -> [a]
++ (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackedNick]
people then String
"nobody"    -- todo, how far back does this go?
               else String -> [String] -> String
listToStr String
"and" (forall a b. (a -> b) -> [a] -> [b]
map PackedNick -> String
upAndShow [PackedNick]
people)) forall a. [a] -> [a] -> [a]
++ String
"."], Bool
False)

    | Bool
otherwise        = (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Nick -> PackedNick
packNick Nick
pnick) Map PackedNick UserStatus
seenFM of
        Just (Present LastSpoke
mct [PackedNick]
cs)            -> LastSpoke -> [String] -> [String]
nickPresent LastSpoke
mct (forall a b. (a -> b) -> [a] -> [b]
map PackedNick -> String
upAndShow [PackedNick]
cs)
        Just (NotPresent ClockTime
ct StopWatch
td [PackedNick]
chans)    -> ClockTime -> StopWatch -> [String] -> [String]
nickNotPresent ClockTime
ct StopWatch
td (forall a b. (a -> b) -> [a] -> [b]
map PackedNick -> String
upAndShow [PackedNick]
chans)
        Just (WasPresent ClockTime
ct StopWatch
sw LastSpoke
_ [PackedNick]
chans)  -> ClockTime -> StopWatch -> [String] -> [String]
nickWasPresent ClockTime
ct StopWatch
sw (forall a b. (a -> b) -> [a] -> [b]
map PackedNick -> String
upAndShow [PackedNick]
chans)
        Just (NewNick PackedNick
newnick)           -> PackedNick -> [String]
nickIsNew PackedNick
newnick
        Maybe UserStatus
_ -> [String
"I haven't seen ", String
nick, String
"."]), Bool
True)
    where
        -- I guess the only way out of this spagetty hell are printf-style responses.
        upAndShow :: PackedNick -> String
upAndShow = String -> Nick -> String
fmtNick (forall a. Message a => a -> String
G.server a
msg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedNick -> Nick
unpackNick
        nickPresent :: LastSpoke -> [String] -> [String]
nickPresent LastSpoke
mct [String]
cs =
            [ if Bool
you then String
"You are" else String
nick forall a. [a] -> [a] -> [a]
++ String
" is"
            , String
" in ", String -> [String] -> String
listToStr String
"and" [String]
cs, String
"."
            , case LastSpoke
mct of
                LastSpoke
Nothing          -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
" I don't know when ", String
nick, String
" last spoke."]
                Just (ClockTime
ct,TimeDiff
missed) -> forall {p} {p}. StopWatch -> p -> p -> String
prettyMissed (TimeDiff -> StopWatch
Stopped TimeDiff
missed)
                       (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
" I last heard ", String
nick, String
" speak ",
                                String
lastSpoke {-, ", but "-}])
                       (String
" Last spoke " forall a. [a] -> [a] -> [a]
++ String
lastSpoke)
                    where lastSpoke :: String
lastSpoke = ClockTime -> String
clockDifference ClockTime
ct
            ]
        nickNotPresent :: ClockTime -> StopWatch -> [String] -> [String]
nickNotPresent ClockTime
ct StopWatch
missed [String]
chans =
            [ String
"I saw ", String
nick, String
" leaving ", String -> [String] -> String
listToStr String
"and" [String]
chans, String
" "
            , ClockTime -> String
clockDifference ClockTime
ct, forall {p} {p}. StopWatch -> p -> p -> String
prettyMissed StopWatch
missed String
", and " String
""
            ]
        nickWasPresent :: ClockTime -> StopWatch -> [String] -> [String]
nickWasPresent ClockTime
ct StopWatch
sw [String]
chans =
            [ String
"Last time I saw ", String
nick, String
" was when I left "
            , String -> [String] -> String
listToStr String
"and" [String]
chans , String
" ", ClockTime -> String
clockDifference ClockTime
ct
            , forall {p} {p}. StopWatch -> p -> p -> String
prettyMissed StopWatch
sw String
", and " String
""
            ]
        nickIsNew :: PackedNick -> [String]
nickIsNew PackedNick
newnick =
            [ if Bool
you then String
"You have" else String
nickforall a. [a] -> [a] -> [a]
++String
" has"
            , String
" changed nick to ", String
us, String
"."
            ] forall a. [a] -> [a] -> [a]
++ forall a b. (a, b) -> a
fst (forall a.
Message a =>
a
-> String
-> Map PackedNick UserStatus
-> ClockTime
-> ([String], Bool)
getAnswer a
msg String
us Map PackedNick UserStatus
seenFM ClockTime
now)
            where
                us :: String
us = PackedNick -> String
upAndShow forall a b. (a -> b) -> a -> b
$ PackedNick -> PackedNick
findFunc PackedNick
newnick
                findFunc :: PackedNick -> PackedNick
findFunc PackedNick
pstr = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackedNick
pstr Map PackedNick UserStatus
seenFM of
                    Just (NewNick PackedNick
pstr') -> PackedNick -> PackedNick
findFunc PackedNick
pstr'
                    Just UserStatus
_               -> PackedNick
pstr
                    Maybe UserStatus
Nothing              -> forall a. HasCallStack => String -> a
error String
"SeenModule.nickIsNew: Nothing"

        nick' :: String
nick' = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
rest
        you :: Bool
you   = Nick
pnick forall a. Eq a => a -> a -> Bool
== Nick -> Nick
lcNick (forall a. Message a => a -> Nick
G.nick a
msg)
        nick :: String
nick  = if Bool
you then String
"you" else String
nick'
        pnick :: Nick
pnick = Nick -> Nick
lcNick forall a b. (a -> b) -> a -> b
$ String -> String -> Nick
parseNick (forall a. Message a => a -> String
G.server a
msg) String
nick'
        clockDifference :: ClockTime -> String
clockDifference ClockTime
past
            | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==Char
' ') String
diff = String
"just now"
            | Bool
otherwise        = String
diff forall a. [a] -> [a] -> [a]
++ String
" ago"
            where diff :: String
diff = TimeDiff -> String
timeDiffPretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClockTime -> ClockTime -> TimeDiff
diffClockTimes ClockTime
now forall a b. (a -> b) -> a -> b
$ ClockTime
past

        prettyMissed :: StopWatch -> p -> p -> String
prettyMissed (Stopped TimeDiff
_) p
_ifMissed p
_     = String
"." -- ifMissed ++ "."
        prettyMissed StopWatch
_           p
_ p
_ifNotMissed  = String
"." -- ifNotMissed ++ "."

{-
        prettyMissed (Stopped missed) ifMissed _
            | missedPretty <- timeDiffPretty missed
            , any (/=' ') missedPretty
            = concat [ifMissed, "I have missed ", missedPretty, " since then."]

        prettyMissed _ _ ifNotMissed = ifNotMissed ++ "."
-}

-- | extract channels from message as packed, lower cased, strings.
msgChans :: G.Message a => a -> [Channel]
msgChans :: forall a. Message a => a -> [PackedNick]
msgChans = forall a b. (a -> b) -> [a] -> [b]
map (Nick -> PackedNick
packNick forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Nick
lcNick) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Message a => a -> [Nick]
G.channels

-- | Callback for when somebody joins. If it is not the bot that joins, record
--   that we have a new user in our state tree and that we have never seen the
--   user speaking.
joinCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
joinCB :: IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
joinCB IrcMessage
msg ClockTime
_ct PackedNick
nick Map PackedNick UserStatus
fm
    | PackedNick
nick forall a. Eq a => a -> a -> Bool
== PackedNick
lbNick = forall a b. b -> Either a b
Right Map PackedNick UserStatus
fm
    | Bool
otherwise      = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! forall {k} {a}. Ord k => (a -> a) -> k -> a -> Map k a -> Map k a
insertUpd (Maybe ClockTime -> [PackedNick] -> UserStatus -> UserStatus
updateJ forall a. Maybe a
Nothing [PackedNick]
chans) PackedNick
nick UserStatus
newInfo Map PackedNick UserStatus
fm
    where
        insertUpd :: (a -> a) -> k -> a -> Map k a -> Map k a
insertUpd a -> a
f = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\a
_ -> a -> a
f)
        lbNick :: PackedNick
lbNick  = Nick -> PackedNick
packNick forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> Nick
G.lambdabotName IrcMessage
msg
        newInfo :: UserStatus
newInfo = LastSpoke -> [PackedNick] -> UserStatus
Present forall a. Maybe a
Nothing [PackedNick]
chans
        chans :: [PackedNick]
chans   = forall a. Message a => a -> [PackedNick]
msgChans IrcMessage
msg

-- | Update the state to reflect the bot leaving channel(s)
botPart :: ClockTime -> [Channel] -> SeenMap -> SeenMap
botPart :: ClockTime
-> [PackedNick]
-> Map PackedNick UserStatus
-> Map PackedNick UserStatus
botPart ClockTime
ct [PackedNick]
cs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UserStatus -> UserStatus
botPart'
    where
        botPart' :: UserStatus -> UserStatus
botPart' (Present LastSpoke
mct [PackedNick]
xs) = case [PackedNick]
xs forall a. Eq a => [a] -> [a] -> [a]
\\ [PackedNick]
cs of
            [] -> ClockTime -> StopWatch -> LastSpoke -> [PackedNick] -> UserStatus
WasPresent ClockTime
ct (ClockTime -> StopWatch -> StopWatch
startWatch ClockTime
ct StopWatch
zeroWatch) LastSpoke
mct [PackedNick]
cs
            [PackedNick]
ys -> LastSpoke -> [PackedNick] -> UserStatus
Present LastSpoke
mct [PackedNick]
ys
        botPart' (NotPresent ClockTime
ct' StopWatch
missed [PackedNick]
c)
            | forall a. [a] -> a
head [PackedNick]
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackedNick]
cs = ClockTime -> StopWatch -> [PackedNick] -> UserStatus
NotPresent ClockTime
ct' (ClockTime -> StopWatch -> StopWatch
startWatch ClockTime
ct StopWatch
missed) [PackedNick]
c
        botPart' (WasPresent ClockTime
ct' StopWatch
missed LastSpoke
mct [PackedNick]
c)
            | forall a. [a] -> a
head [PackedNick]
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackedNick]
cs = ClockTime -> StopWatch -> LastSpoke -> [PackedNick] -> UserStatus
WasPresent ClockTime
ct' (ClockTime -> StopWatch -> StopWatch
startWatch ClockTime
ct StopWatch
missed) LastSpoke
mct [PackedNick]
c
        botPart' UserStatus
us = UserStatus
us

-- | when somebody parts
partCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
partCB :: IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
partCB IrcMessage
msg ClockTime
ct PackedNick
nick Map PackedNick UserStatus
fm
    | PackedNick
nick forall a. Eq a => a -> a -> Bool
== PackedNick
lbNick = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ClockTime
-> [PackedNick]
-> Map PackedNick UserStatus
-> Map PackedNick UserStatus
botPart ClockTime
ct (forall a. Message a => a -> [PackedNick]
msgChans IrcMessage
msg) Map PackedNick UserStatus
fm
    | Bool
otherwise      = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackedNick
nick Map PackedNick UserStatus
fm of
        Just (Present LastSpoke
mct [PackedNick]
xs) ->
            case [PackedNick]
xs forall a. Eq a => [a] -> [a] -> [a]
\\ (forall a. Message a => a -> [PackedNick]
msgChans IrcMessage
msg) of
                [] -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert PackedNick
nick (ClockTime -> StopWatch -> [PackedNick] -> UserStatus
NotPresent ClockTime
ct StopWatch
zeroWatch [PackedNick]
xs) Map PackedNick UserStatus
fm
                [PackedNick]
ys -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert PackedNick
nick (LastSpoke -> [PackedNick] -> UserStatus
Present LastSpoke
mct [PackedNick]
ys)             Map PackedNick UserStatus
fm
        Maybe UserStatus
_ -> forall a b. a -> Either a b
Left String
"someone who isn't known parted"
    where lbNick :: PackedNick
lbNick = Nick -> PackedNick
packNick forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> Nick
G.lambdabotName IrcMessage
msg

-- | when somebody quits
quitCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
quitCB :: IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
quitCB IrcMessage
_ ClockTime
ct PackedNick
nick Map PackedNick UserStatus
fm = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackedNick
nick Map PackedNick UserStatus
fm of
    Just (Present LastSpoke
_ct [PackedNick]
xs) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert PackedNick
nick (ClockTime -> StopWatch -> [PackedNick] -> UserStatus
NotPresent ClockTime
ct StopWatch
zeroWatch [PackedNick]
xs) Map PackedNick UserStatus
fm
    Maybe UserStatus
_                     -> forall a b. a -> Either a b
Left String
"someone who isn't known has quit"

-- | when somebody changes his\/her name
nickCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
nickCB :: IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
nickCB IrcMessage
msg ClockTime
_ PackedNick
nick Map PackedNick UserStatus
fm = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackedNick
nick Map PackedNick UserStatus
fm of
    Just UserStatus
status -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert PackedNick
lcnewnick UserStatus
status
                          forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert PackedNick
nick (PackedNick -> UserStatus
NewNick PackedNick
lcnewnick) Map PackedNick UserStatus
fm
    Maybe UserStatus
_           -> forall a b. a -> Either a b
Left String
"someone who isn't here changed nick"
    where
        newnick :: String
newnick = forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head (IrcMessage -> [String]
ircMsgParams IrcMessage
msg)
        lcnewnick :: PackedNick
lcnewnick = Nick -> PackedNick
packNick forall a b. (a -> b) -> a -> b
$ Nick -> Nick
lcNick forall a b. (a -> b) -> a -> b
$ String -> String -> Nick
parseNick (forall a. Message a => a -> String
G.server IrcMessage
msg) String
newnick

-- | when the bot joins a channel
joinChanCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
joinChanCB :: IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
joinChanCB IrcMessage
msg ClockTime
now PackedNick
_nick Map PackedNick UserStatus
fm
    = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ClockTime -> PackedNick -> UserStatus -> UserStatus
updateNP ClockTime
now PackedNick
chan) (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map PackedNick UserStatus
-> PackedNick -> Map PackedNick UserStatus
insertNick Map PackedNick UserStatus
fm [PackedNick]
chanUsers)
    where
        l :: [String]
l = IrcMessage -> [String]
ircMsgParams IrcMessage
msg
        chan :: PackedNick
chan = Nick -> PackedNick
packNick forall a b. (a -> b) -> a -> b
$ Nick -> Nick
lcNick forall a b. (a -> b) -> a -> b
$ String -> String -> Nick
parseNick (forall a. Message a => a -> String
G.server IrcMessage
msg) forall a b. (a -> b) -> a -> b
$ [String]
l forall a. [a] -> Int -> a
!! Int
2
        chanUsers :: [PackedNick]
chanUsers = forall a b. (a -> b) -> [a] -> [b]
map (Nick -> PackedNick
packNick forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Nick
lcNick forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Nick
parseNick (forall a. Message a => a -> String
G.server IrcMessage
msg)) forall a b. (a -> b) -> a -> b
$ String -> [String]
words (forall a. Int -> [a] -> [a]
drop Int
1 ([String]
l forall a. [a] -> Int -> a
!! Int
3)) -- remove ':'
        unUserMode :: Nick -> Nick
unUserMode Nick
nick = String -> String -> Nick
Nick (Nick -> String
nTag Nick
nick) (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"@+") forall a b. (a -> b) -> a -> b
$ Nick -> String
nName Nick
nick)
        insertUpd :: (a -> a) -> k -> a -> Map k a -> Map k a
insertUpd a -> a
f = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\a
_ -> a -> a
f)
        insertNick :: Map PackedNick UserStatus
-> PackedNick -> Map PackedNick UserStatus
insertNick Map PackedNick UserStatus
fm' PackedNick
u = forall {k} {a}. Ord k => (a -> a) -> k -> a -> Map k a -> Map k a
insertUpd (Maybe ClockTime -> [PackedNick] -> UserStatus -> UserStatus
updateJ (forall a. a -> Maybe a
Just ClockTime
now) [PackedNick
chan])
            (Nick -> PackedNick
packNick forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Nick
unUserMode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Nick
lcNick forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedNick -> Nick
unpackNick forall a b. (a -> b) -> a -> b
$ PackedNick
u)
            (LastSpoke -> [PackedNick] -> UserStatus
Present forall a. Maybe a
Nothing [PackedNick
chan]) Map PackedNick UserStatus
fm'

-- | when somebody speaks, update their clocktime
msgCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
msgCB :: IrcMessage
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
msgCB IrcMessage
_ ClockTime
ct PackedNick
nick Map PackedNick UserStatus
fm =
    case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackedNick
nick Map PackedNick UserStatus
fm of
        Just (Present LastSpoke
_ [PackedNick]
xs) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$!
            forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert PackedNick
nick (LastSpoke -> [PackedNick] -> UserStatus
Present (forall a. a -> Maybe a
Just (ClockTime
ct, TimeDiff
noTimeDiff)) [PackedNick]
xs) Map PackedNick UserStatus
fm
        Maybe UserStatus
_ -> forall a b. a -> Either a b
Left String
"someone who isn't here msg us"


-- | Callbacks are only allowed to use a limited knowledge of the world.
-- 'withSeenFM' is (up to trivial isomorphism) a monad morphism from the
-- restricted
--   'ReaderT (IRC.Message, ClockTime, Nick) (StateT SeenState (Error String))'
-- to the
--   'ReaderT IRC.Message (Seen IRC)'
-- monad.
withSeenFM :: G.Message a
           => String
           -> (a -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap)
           -> (a -> Seen ())

withSeenFM :: forall a.
Message a =>
String
-> (a
    -> ClockTime
    -> PackedNick
    -> Map PackedNick UserStatus
    -> Either String (Map PackedNick UserStatus))
-> a
-> ModuleT (Map PackedNick Int, Map PackedNick UserStatus) LB ()
withSeenFM String
signal a
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
f a
msg = do
    let chan :: PackedNick
chan = Nick -> PackedNick
packNick forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Nick
lcNick forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Message a => a -> [Nick]
G.channels forall a b. (a -> b) -> a -> b
$! a
msg
        nick :: PackedNick
nick = Nick -> PackedNick
packNick forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Nick
lcNick forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Message a => a -> Nick
G.nick forall a b. (a -> b) -> a -> b
$ a
msg

    forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS forall a b. (a -> b) -> a -> b
$ \(Map PackedNick Int
maxUsers,Map PackedNick UserStatus
state) LBState Seen
-> ModuleT (Map PackedNick Int, Map PackedNick UserStatus) LB ()
writer -> do
        ClockTime
ct <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
        case a
-> ClockTime
-> PackedNick
-> Map PackedNick UserStatus
-> Either String (Map PackedNick UserStatus)
f a
msg ClockTime
ct PackedNick
nick Map PackedNick UserStatus
state of
            Left String
_         -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Right Map PackedNick UserStatus
newstate -> do
                let curUsers :: Int
curUsers = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$!
                        [ () | (PackedNick
_,Present LastSpoke
_ [PackedNick]
chans) <- forall k a. Map k a -> [(k, a)]
M.toList Map PackedNick UserStatus
state
                        , PackedNick
chan forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackedNick]
chans ]

                    newMax :: Map PackedNick Int
newMax
                        | String
signal forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"JOIN", String
"353"]
                        = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackedNick
chan Map PackedNick Int
maxUsers of
                            Maybe Int
Nothing -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert PackedNick
chan Int
curUsers Map PackedNick Int
maxUsers
                            Just  Int
n -> if Int
n forall a. Ord a => a -> a -> Bool
< Int
curUsers
                                then forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert PackedNick
chan Int
curUsers Map PackedNick Int
maxUsers
                                else Map PackedNick Int
maxUsers
                        | Bool
otherwise -- ["PART", "QUIT", "NICK", "PRIVMSG"]
                        = Map PackedNick Int
maxUsers

                Map PackedNick Int
newMax seq :: forall a b. a -> b -> b
`seq` Map PackedNick UserStatus
newstate seq :: forall a b. a -> b -> b
`seq` LBState Seen
-> ModuleT (Map PackedNick Int, Map PackedNick UserStatus) LB ()
writer (Map PackedNick Int
newMax, Map PackedNick UserStatus
newstate)