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

    , moduleCmds :: ModuleT
  (Map Channel Int, Map Channel UserStatus)
  LB
  [Command (ModuleT (Map Channel Int, Map Channel UserStatus) LB)]
moduleCmds = [Command (ModuleT (Map Channel Int, Map Channel UserStatus) LB)]
-> ModuleT
     (Map Channel Int, Map Channel UserStatus)
     LB
     [Command (ModuleT (Map Channel Int, Map Channel UserStatus) LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"users")
            { help :: Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
help = String
-> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
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 (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
process = String
-> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
doUsers
            }
        , (String -> Command Identity
command String
"seen")
            { help :: Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
help = String
-> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"seen <user>. Report if a user has been seen by the bot"
            , process :: String
-> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
process = String
-> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
doSeen
            }
        ]

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

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

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

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

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

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

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

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

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

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

        recent :: ClockTime -> Bool
recent ClockTime
t = ClockTime -> ClockTime -> TimeDiff
diffClockTimes ClockTime
s ClockTime
t TimeDiff -> TimeDiff -> Bool
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
p Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ a -> Double
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 = String -> a -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%d (%0.1f%%)" a
p (a -> a -> Double
forall a a. (Integral a, Integral a) => a -> a -> Double
percent a
p a
q)

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

doSeen :: String -> Cmd Seen ()
doSeen :: String
-> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
doSeen String
rest = (forall a.
 Message a =>
 a -> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ())
-> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
forall (m :: * -> *) t.
Monad m =>
(forall a. Message a => a -> Cmd m t) -> Cmd m t
withMsg ((forall a.
  Message a =>
  a -> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ())
 -> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ())
-> (forall a.
    Message a =>
    a -> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ())
-> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
forall a b. (a -> b) -> a -> b
$ \a
msg -> do
    Nick
target <- Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getTarget
    (Map Channel Int
_,Map Channel UserStatus
seenFM) <- Cmd
  (ModuleT (Map Channel Int, Map Channel UserStatus) LB)
  (Map Channel Int, Map Channel UserStatus)
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
    ClockTime
now        <- IO ClockTime
-> Cmd
     (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ClockTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
    let ([String]
txt,Bool
safe) = (a
-> String
-> Map Channel UserStatus
-> ClockTime
-> ([String], Bool)
forall a.
Message a =>
a
-> String
-> Map Channel UserStatus
-> ClockTime
-> ([String], Bool)
getAnswer a
msg String
rest Map Channel UserStatus
seenFM ClockTime
now)
    if Bool
safe Bool -> Bool -> Bool
|| Bool -> Bool
not (String
"#" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Nick -> String
nName Nick
target)
        then (String
 -> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ())
-> [String]
-> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String
-> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say [String]
txt
        else LB ()
-> Cmd (ModuleT (Map Channel Int, Map Channel UserStatus) LB) ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (Nick -> String -> LB ()
ircPrivmsg (a -> Nick
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 :: a
-> String
-> Map Channel UserStatus
-> ClockTime
-> ([String], Bool)
getAnswer a
msg String
rest Map Channel UserStatus
seenFM ClockTime
now
    | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
nick' =
        let people :: [Channel]
people  = ((Channel, UserStatus) -> Channel)
-> [(Channel, UserStatus)] -> [Channel]
forall a b. (a -> b) -> [a] -> [b]
map (Channel, UserStatus) -> Channel
forall a b. (a, b) -> a
fst ([(Channel, UserStatus)] -> [Channel])
-> [(Channel, UserStatus)] -> [Channel]
forall a b. (a -> b) -> a -> b
$ ((Channel, UserStatus) -> Bool)
-> [(Channel, UserStatus)] -> [(Channel, UserStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Channel, UserStatus) -> Bool
forall a. (a, UserStatus) -> Bool
isActive ([(Channel, UserStatus)] -> [(Channel, UserStatus)])
-> [(Channel, UserStatus)] -> [(Channel, UserStatus)]
forall a b. (a -> b) -> a -> b
$ Map Channel UserStatus -> [(Channel, UserStatus)]
forall k a. Map k a -> [(k, a)]
M.toList Map Channel UserStatus
seenFM
            isActive :: (a, UserStatus) -> Bool
isActive (a
_nick,UserStatus
state) = case UserStatus
state of
                (Present (Just (ClockTime
ct,TimeDiff
_td)) [Channel]
_cs) -> ClockTime -> Bool
recent ClockTime
ct
                UserStatus
_ -> Bool
False
            recent :: ClockTime -> Bool
recent ClockTime
t = ClockTime -> ClockTime -> TimeDiff
diffClockTimes ClockTime
now ClockTime
t TimeDiff -> TimeDiff -> Bool
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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if [Channel] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Channel]
people then String
"nobody"
                 else String -> [String] -> String
listToStr String
"and" ((Channel -> String) -> [Channel] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Channel -> String
upAndShow [Channel]
people)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."], Bool
False)

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

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

    | Bool
otherwise        = (String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (case Channel -> Map Channel UserStatus -> Maybe UserStatus
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Nick -> Channel
packNick Nick
pnick) Map Channel UserStatus
seenFM of
        Just (Present LastSpoke
mct [Channel]
cs)            -> LastSpoke -> [String] -> [String]
nickPresent LastSpoke
mct ((Channel -> String) -> [Channel] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Channel -> String
upAndShow [Channel]
cs)
        Just (NotPresent ClockTime
ct StopWatch
td [Channel]
chans)    -> ClockTime -> StopWatch -> [String] -> [String]
nickNotPresent ClockTime
ct StopWatch
td ((Channel -> String) -> [Channel] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Channel -> String
upAndShow [Channel]
chans)
        Just (WasPresent ClockTime
ct StopWatch
sw LastSpoke
_ [Channel]
chans)  -> ClockTime -> StopWatch -> [String] -> [String]
nickWasPresent ClockTime
ct StopWatch
sw ((Channel -> String) -> [Channel] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Channel -> String
upAndShow [Channel]
chans)
        Just (NewNick Channel
newnick)           -> Channel -> [String]
nickIsNew Channel
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 :: Channel -> String
upAndShow = String -> Nick -> String
fmtNick (a -> String
forall a. Message a => a -> String
G.server a
msg) (Nick -> String) -> (Channel -> Nick) -> Channel -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel -> Nick
unpackNick
        nickPresent :: LastSpoke -> [String] -> [String]
nickPresent LastSpoke
mct [String]
cs =
            [ if Bool
you then String
"You are" else String
nick String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is"
            , String
" in ", String -> [String] -> String
listToStr String
"and" [String]
cs, String
"."
            , case LastSpoke
mct of
                LastSpoke
Nothing          -> [String] -> String
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) -> StopWatch -> String -> String -> String
forall p p. StopWatch -> p -> p -> String
prettyMissed (TimeDiff -> StopWatch
Stopped TimeDiff
missed)
                       ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
" I last heard ", String
nick, String
" speak ",
                                String
lastSpoke {-, ", but "-}])
                       (String
" Last spoke " String -> String -> String
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, StopWatch -> String -> String -> String
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
            , StopWatch -> String -> String -> String
forall p p. StopWatch -> p -> p -> String
prettyMissed StopWatch
sw String
", and " String
""
            ]
        nickIsNew :: Channel -> [String]
nickIsNew Channel
newnick =
            [ if Bool
you then String
"You have" else String
nickString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" has"
            , String
" changed nick to ", String
us, String
"."
            ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ([String], Bool) -> [String]
forall a b. (a, b) -> a
fst (a
-> String
-> Map Channel UserStatus
-> ClockTime
-> ([String], Bool)
forall a.
Message a =>
a
-> String
-> Map Channel UserStatus
-> ClockTime
-> ([String], Bool)
getAnswer a
msg String
us Map Channel UserStatus
seenFM ClockTime
now)
            where
                us :: String
us = Channel -> String
upAndShow (Channel -> String) -> Channel -> String
forall a b. (a -> b) -> a -> b
$ Channel -> Channel
findFunc Channel
newnick
                findFunc :: Channel -> Channel
findFunc Channel
pstr = case Channel -> Map Channel UserStatus -> Maybe UserStatus
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Channel
pstr Map Channel UserStatus
seenFM of
                    Just (NewNick Channel
pstr') -> Channel -> Channel
findFunc Channel
pstr'
                    Just UserStatus
_               -> Channel
pstr
                    Maybe UserStatus
Nothing              -> String -> Channel
forall a. HasCallStack => String -> a
error String
"SeenModule.nickIsNew: Nothing"

        nick' :: String
nick' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
rest
        you :: Bool
you   = Nick
pnick Nick -> Nick -> Bool
forall a. Eq a => a -> a -> Bool
== Nick -> Nick
lcNick (a -> Nick
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 (Nick -> Nick) -> Nick -> Nick
forall a b. (a -> b) -> a -> b
$ String -> String -> Nick
parseNick (a -> String
forall a. Message a => a -> String
G.server a
msg) String
nick'
        clockDifference :: ClockTime -> String
clockDifference ClockTime
past
            | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') String
diff = String
"just now"
            | Bool
otherwise        = String
diff String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ago"
            where diff :: String
diff = TimeDiff -> String
timeDiffPretty (TimeDiff -> String)
-> (ClockTime -> TimeDiff) -> ClockTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClockTime -> ClockTime -> TimeDiff
diffClockTimes ClockTime
now (ClockTime -> String) -> ClockTime -> String
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 :: a -> [Channel]
msgChans = (Nick -> Channel) -> [Nick] -> [Channel]
forall a b. (a -> b) -> [a] -> [b]
map (Nick -> Channel
packNick (Nick -> Channel) -> (Nick -> Nick) -> Nick -> Channel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Nick
lcNick) ([Nick] -> [Channel]) -> (a -> [Nick]) -> a -> [Channel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Nick]
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
-> Channel
-> Map Channel UserStatus
-> Either String (Map Channel UserStatus)
joinCB IrcMessage
msg ClockTime
_ct Channel
nick Map Channel UserStatus
fm
    | Channel
nick Channel -> Channel -> Bool
forall a. Eq a => a -> a -> Bool
== Channel
lbNick = Map Channel UserStatus -> Either String (Map Channel UserStatus)
forall a b. b -> Either a b
Right Map Channel UserStatus
fm
    | Bool
otherwise      = Map Channel UserStatus -> Either String (Map Channel UserStatus)
forall a b. b -> Either a b
Right (Map Channel UserStatus -> Either String (Map Channel UserStatus))
-> Map Channel UserStatus -> Either String (Map Channel UserStatus)
forall a b. (a -> b) -> a -> b
$! (UserStatus -> UserStatus)
-> Channel
-> UserStatus
-> Map Channel UserStatus
-> Map Channel UserStatus
forall k a. Ord k => (a -> a) -> k -> a -> Map k a -> Map k a
insertUpd (Maybe ClockTime -> [Channel] -> UserStatus -> UserStatus
updateJ Maybe ClockTime
forall a. Maybe a
Nothing [Channel]
chans) Channel
nick UserStatus
newInfo Map Channel UserStatus
fm
    where
        insertUpd :: (a -> a) -> k -> a -> Map k a -> Map k a
insertUpd a -> a
f = (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\a
_ -> a -> a
f)
        lbNick :: Channel
lbNick  = Nick -> Channel
packNick (Nick -> Channel) -> Nick -> Channel
forall a b. (a -> b) -> a -> b
$ IrcMessage -> Nick
forall a. Message a => a -> Nick
G.lambdabotName IrcMessage
msg
        newInfo :: UserStatus
newInfo = LastSpoke -> [Channel] -> UserStatus
Present LastSpoke
forall a. Maybe a
Nothing [Channel]
chans
        chans :: [Channel]
chans   = IrcMessage -> [Channel]
forall a. Message a => a -> [Channel]
msgChans IrcMessage
msg

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

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

-- | when somebody quits
quitCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
quitCB :: IrcMessage
-> ClockTime
-> Channel
-> Map Channel UserStatus
-> Either String (Map Channel UserStatus)
quitCB IrcMessage
_ ClockTime
ct Channel
nick Map Channel UserStatus
fm = case Channel -> Map Channel UserStatus -> Maybe UserStatus
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Channel
nick Map Channel UserStatus
fm of
    Just (Present LastSpoke
_ct [Channel]
xs) -> Map Channel UserStatus -> Either String (Map Channel UserStatus)
forall a b. b -> Either a b
Right (Map Channel UserStatus -> Either String (Map Channel UserStatus))
-> Map Channel UserStatus -> Either String (Map Channel UserStatus)
forall a b. (a -> b) -> a -> b
$! Channel
-> UserStatus -> Map Channel UserStatus -> Map Channel UserStatus
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Channel
nick (ClockTime -> StopWatch -> [Channel] -> UserStatus
NotPresent ClockTime
ct StopWatch
zeroWatch [Channel]
xs) Map Channel UserStatus
fm
    Maybe UserStatus
_                     -> String -> Either String (Map Channel 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
-> Channel
-> Map Channel UserStatus
-> Either String (Map Channel UserStatus)
nickCB IrcMessage
msg ClockTime
_ Channel
nick Map Channel UserStatus
fm = case Channel -> Map Channel UserStatus -> Maybe UserStatus
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Channel
nick Map Channel UserStatus
fm of
    Just UserStatus
status -> Map Channel UserStatus -> Either String (Map Channel UserStatus)
forall a b. b -> Either a b
Right (Map Channel UserStatus -> Either String (Map Channel UserStatus))
-> Map Channel UserStatus -> Either String (Map Channel UserStatus)
forall a b. (a -> b) -> a -> b
$! Channel
-> UserStatus -> Map Channel UserStatus -> Map Channel UserStatus
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Channel
lcnewnick UserStatus
status
                          (Map Channel UserStatus -> Map Channel UserStatus)
-> Map Channel UserStatus -> Map Channel UserStatus
forall a b. (a -> b) -> a -> b
$ Channel
-> UserStatus -> Map Channel UserStatus -> Map Channel UserStatus
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Channel
nick (Channel -> UserStatus
NewNick Channel
lcnewnick) Map Channel UserStatus
fm
    Maybe UserStatus
_           -> String -> Either String (Map Channel UserStatus)
forall a b. a -> Either a b
Left String
"someone who isn't here changed nick"
    where
        newnick :: String
newnick = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head (IrcMessage -> [String]
ircMsgParams IrcMessage
msg)
        lcnewnick :: Channel
lcnewnick = Nick -> Channel
packNick (Nick -> Channel) -> Nick -> Channel
forall a b. (a -> b) -> a -> b
$ Nick -> Nick
lcNick (Nick -> Nick) -> Nick -> Nick
forall a b. (a -> b) -> a -> b
$ String -> String -> Nick
parseNick (IrcMessage -> String
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
-> Channel
-> Map Channel UserStatus
-> Either String (Map Channel UserStatus)
joinChanCB IrcMessage
msg ClockTime
now Channel
_nick Map Channel UserStatus
fm
    = Map Channel UserStatus -> Either String (Map Channel UserStatus)
forall a b. b -> Either a b
Right (Map Channel UserStatus -> Either String (Map Channel UserStatus))
-> Map Channel UserStatus -> Either String (Map Channel UserStatus)
forall a b. (a -> b) -> a -> b
$! (UserStatus -> UserStatus)
-> Map Channel UserStatus -> Map Channel UserStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ClockTime -> Channel -> UserStatus -> UserStatus
updateNP ClockTime
now Channel
chan) ((Map Channel UserStatus -> Channel -> Map Channel UserStatus)
-> Map Channel UserStatus -> [Channel] -> Map Channel UserStatus
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map Channel UserStatus -> Channel -> Map Channel UserStatus
insertNick Map Channel UserStatus
fm [Channel]
chanUsers)
    where
        l :: [String]
l = IrcMessage -> [String]
ircMsgParams IrcMessage
msg
        chan :: Channel
chan = Nick -> Channel
packNick (Nick -> Channel) -> Nick -> Channel
forall a b. (a -> b) -> a -> b
$ Nick -> Nick
lcNick (Nick -> Nick) -> Nick -> Nick
forall a b. (a -> b) -> a -> b
$ String -> String -> Nick
parseNick (IrcMessage -> String
forall a. Message a => a -> String
G.server IrcMessage
msg) (String -> Nick) -> String -> Nick
forall a b. (a -> b) -> a -> b
$ [String]
l [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
2
        chanUsers :: [Channel]
chanUsers = (String -> Channel) -> [String] -> [Channel]
forall a b. (a -> b) -> [a] -> [b]
map (Nick -> Channel
packNick (Nick -> Channel) -> (String -> Nick) -> String -> Channel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Nick
lcNick (Nick -> Nick) -> (String -> Nick) -> String -> Nick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Nick
parseNick (IrcMessage -> String
forall a. Message a => a -> String
G.server IrcMessage
msg)) ([String] -> [Channel]) -> [String] -> [Channel]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 ([String]
l [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
3)) -- remove ':'
        unUserMode :: Nick -> Nick
unUserMode Nick
nick = String -> String -> Nick
Nick (Nick -> String
nTag Nick
nick) ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"@+") (String -> String) -> String -> 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 = (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\a
_ -> a -> a
f)
        insertNick :: Map Channel UserStatus -> Channel -> Map Channel UserStatus
insertNick Map Channel UserStatus
fm' Channel
u = (UserStatus -> UserStatus)
-> Channel
-> UserStatus
-> Map Channel UserStatus
-> Map Channel UserStatus
forall k a. Ord k => (a -> a) -> k -> a -> Map k a -> Map k a
insertUpd (Maybe ClockTime -> [Channel] -> UserStatus -> UserStatus
updateJ (ClockTime -> Maybe ClockTime
forall a. a -> Maybe a
Just ClockTime
now) [Channel
chan])
            (Nick -> Channel
packNick (Nick -> Channel) -> (Channel -> Nick) -> Channel -> Channel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Nick
unUserMode (Nick -> Nick) -> (Channel -> Nick) -> Channel -> Nick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Nick
lcNick (Nick -> Nick) -> (Channel -> Nick) -> Channel -> Nick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel -> Nick
unpackNick (Channel -> Channel) -> Channel -> Channel
forall a b. (a -> b) -> a -> b
$ Channel
u)
            (LastSpoke -> [Channel] -> UserStatus
Present LastSpoke
forall a. Maybe a
Nothing [Channel
chan]) Map Channel UserStatus
fm'

-- | when somebody speaks, update their clocktime
msgCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap
msgCB :: IrcMessage
-> ClockTime
-> Channel
-> Map Channel UserStatus
-> Either String (Map Channel UserStatus)
msgCB IrcMessage
_ ClockTime
ct Channel
nick Map Channel UserStatus
fm =
    case Channel -> Map Channel UserStatus -> Maybe UserStatus
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Channel
nick Map Channel UserStatus
fm of
        Just (Present LastSpoke
_ [Channel]
xs) -> Map Channel UserStatus -> Either String (Map Channel UserStatus)
forall a b. b -> Either a b
Right (Map Channel UserStatus -> Either String (Map Channel UserStatus))
-> Map Channel UserStatus -> Either String (Map Channel UserStatus)
forall a b. (a -> b) -> a -> b
$!
            Channel
-> UserStatus -> Map Channel UserStatus -> Map Channel UserStatus
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Channel
nick (LastSpoke -> [Channel] -> UserStatus
Present ((ClockTime, TimeDiff) -> LastSpoke
forall a. a -> Maybe a
Just (ClockTime
ct, TimeDiff
noTimeDiff)) [Channel]
xs) Map Channel UserStatus
fm
        Maybe UserStatus
_ -> String -> Either String (Map Channel 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 :: String
-> (a
    -> ClockTime
    -> Channel
    -> Map Channel UserStatus
    -> Either String (Map Channel UserStatus))
-> a
-> ModuleT (Map Channel Int, Map Channel UserStatus) LB ()
withSeenFM String
signal a
-> ClockTime
-> Channel
-> Map Channel UserStatus
-> Either String (Map Channel UserStatus)
f a
msg = do
    let chan :: Channel
chan = Nick -> Channel
packNick (Nick -> Channel) -> (a -> Nick) -> a -> Channel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Nick
lcNick (Nick -> Nick) -> (a -> Nick) -> a -> Nick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Nick] -> Nick
forall a. [a] -> a
head ([Nick] -> Nick) -> (a -> [Nick]) -> a -> Nick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Nick]
forall a. Message a => a -> [Nick]
G.channels (a -> Channel) -> a -> Channel
forall a b. (a -> b) -> a -> b
$! a
msg
        nick :: Channel
nick = Nick -> Channel
packNick (Nick -> Channel) -> (a -> Nick) -> a -> Channel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> Nick
lcNick (Nick -> Nick) -> (a -> Nick) -> a -> Nick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Nick
forall a. Message a => a -> Nick
G.nick (a -> Channel) -> a -> Channel
forall a b. (a -> b) -> a -> b
$ a
msg

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

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

                Map Channel Int
newMax Map Channel Int
-> ModuleT (Map Channel Int, Map Channel UserStatus) LB ()
-> ModuleT (Map Channel Int, Map Channel UserStatus) LB ()
`seq` Map Channel UserStatus
newstate Map Channel UserStatus
-> ModuleT (Map Channel Int, Map Channel UserStatus) LB ()
-> ModuleT (Map Channel Int, Map Channel UserStatus) LB ()
`seq` LBState (ModuleT (Map Channel Int, Map Channel UserStatus) LB)
-> ModuleT (Map Channel Int, Map Channel UserStatus) LB ()
writer (Map Channel Int
newMax, Map Channel UserStatus
newstate)