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
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)
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
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
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
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"
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
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 ])
(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
"."
prettyMissed StopWatch
_ p
_ p
_ifNotMissed = String
"."
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
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
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
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
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"
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
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))
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'
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"
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
= 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)