module Lambdabot.Plugin.Social.Seen.UserStatus where
import Control.Applicative
import Data.Binary
import qualified Data.ByteString as BS
import Data.List
import Lambdabot.Compat.AltTime
import Lambdabot.Compat.PackedNick
import Lambdabot.Plugin.Social.Seen.StopWatch
type Channel = BS.ByteString
type LastSpoke = Maybe (ClockTime, TimeDiff)
data UserStatus
= Present !LastSpoke [Channel]
| NotPresent !ClockTime !StopWatch [Channel]
| WasPresent !ClockTime !StopWatch !LastSpoke [Channel]
| NewNick !PackedNick
deriving (Int -> UserStatus -> ShowS
[UserStatus] -> ShowS
UserStatus -> String
(Int -> UserStatus -> ShowS)
-> (UserStatus -> String)
-> ([UserStatus] -> ShowS)
-> Show UserStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserStatus] -> ShowS
$cshowList :: [UserStatus] -> ShowS
show :: UserStatus -> String
$cshow :: UserStatus -> String
showsPrec :: Int -> UserStatus -> ShowS
$cshowsPrec :: Int -> UserStatus -> ShowS
Show, ReadPrec [UserStatus]
ReadPrec UserStatus
Int -> ReadS UserStatus
ReadS [UserStatus]
(Int -> ReadS UserStatus)
-> ReadS [UserStatus]
-> ReadPrec UserStatus
-> ReadPrec [UserStatus]
-> Read UserStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserStatus]
$creadListPrec :: ReadPrec [UserStatus]
readPrec :: ReadPrec UserStatus
$creadPrec :: ReadPrec UserStatus
readList :: ReadS [UserStatus]
$creadList :: ReadS [UserStatus]
readsPrec :: Int -> ReadS UserStatus
$creadsPrec :: Int -> ReadS UserStatus
Read)
instance Binary UserStatus where
put :: UserStatus -> Put
put (Present LastSpoke
sp [Channel]
ch) = Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LastSpoke -> Put
forall t. Binary t => t -> Put
put LastSpoke
sp Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Channel] -> Put
forall t. Binary t => t -> Put
put [Channel]
ch
put (NotPresent ClockTime
ct StopWatch
sw [Channel]
ch) = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ClockTime -> Put
forall t. Binary t => t -> Put
put ClockTime
ct Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StopWatch -> Put
forall t. Binary t => t -> Put
put StopWatch
sw Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Channel] -> Put
forall t. Binary t => t -> Put
put [Channel]
ch
put (WasPresent ClockTime
ct StopWatch
sw LastSpoke
sp [Channel]
ch) = Word8 -> Put
putWord8 Word8
2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ClockTime -> Put
forall t. Binary t => t -> Put
put ClockTime
ct Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StopWatch -> Put
forall t. Binary t => t -> Put
put StopWatch
sw Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LastSpoke -> Put
forall t. Binary t => t -> Put
put LastSpoke
sp Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Channel] -> Put
forall t. Binary t => t -> Put
put [Channel]
ch
put (NewNick Channel
n) = Word8 -> Put
putWord8 Word8
3 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Channel -> Put
forall t. Binary t => t -> Put
put Channel
n
get :: Get UserStatus
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get UserStatus) -> Get UserStatus
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
h -> case Word8
h of
Word8
0 -> LastSpoke -> [Channel] -> UserStatus
Present (LastSpoke -> [Channel] -> UserStatus)
-> Get LastSpoke -> Get ([Channel] -> UserStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get LastSpoke
forall t. Binary t => Get t
get Get ([Channel] -> UserStatus) -> Get [Channel] -> Get UserStatus
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Channel]
forall t. Binary t => Get t
get
Word8
1 -> ClockTime -> StopWatch -> [Channel] -> UserStatus
NotPresent (ClockTime -> StopWatch -> [Channel] -> UserStatus)
-> Get ClockTime -> Get (StopWatch -> [Channel] -> UserStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClockTime
forall t. Binary t => Get t
get Get (StopWatch -> [Channel] -> UserStatus)
-> Get StopWatch -> Get ([Channel] -> UserStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get StopWatch
forall t. Binary t => Get t
get Get ([Channel] -> UserStatus) -> Get [Channel] -> Get UserStatus
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Channel]
forall t. Binary t => Get t
get
Word8
2 -> ClockTime -> StopWatch -> LastSpoke -> [Channel] -> UserStatus
WasPresent (ClockTime -> StopWatch -> LastSpoke -> [Channel] -> UserStatus)
-> Get ClockTime
-> Get (StopWatch -> LastSpoke -> [Channel] -> UserStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ClockTime
forall t. Binary t => Get t
get Get (StopWatch -> LastSpoke -> [Channel] -> UserStatus)
-> Get StopWatch -> Get (LastSpoke -> [Channel] -> UserStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get StopWatch
forall t. Binary t => Get t
get Get (LastSpoke -> [Channel] -> UserStatus)
-> Get LastSpoke -> Get ([Channel] -> UserStatus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get LastSpoke
forall t. Binary t => Get t
get Get ([Channel] -> UserStatus) -> Get [Channel] -> Get UserStatus
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [Channel]
forall t. Binary t => Get t
get
Word8
3 -> Channel -> UserStatus
NewNick (Channel -> UserStatus) -> Get Channel -> Get UserStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Channel
forall t. Binary t => Get t
get
Word8
_ -> String -> Get UserStatus
forall a. HasCallStack => String -> a
error String
"Seen.UserStatus.get"
updateJ :: Maybe ClockTime
-> [Channel]
-> UserStatus
-> UserStatus
updateJ :: Maybe ClockTime -> [Channel] -> UserStatus -> UserStatus
updateJ Maybe ClockTime
_ [Channel]
c (Present LastSpoke
ct [Channel]
cs) = LastSpoke -> [Channel] -> UserStatus
Present LastSpoke
ct ([Channel] -> UserStatus) -> [Channel] -> UserStatus
forall a b. (a -> b) -> a -> b
$ [Channel] -> [Channel]
forall a. Eq a => [a] -> [a]
nub ([Channel]
c [Channel] -> [Channel] -> [Channel]
forall a. [a] -> [a] -> [a]
++ [Channel]
cs)
updateJ (Just ClockTime
now) [Channel]
cs (WasPresent ClockTime
lastSeen StopWatch
_ (Just (ClockTime
lastSpoke, TimeDiff
missed)) [Channel]
channels)
| [Channel] -> Channel
forall a. [a] -> a
head [Channel]
channels Channel -> [Channel] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Channel]
cs
= let newMissed :: TimeDiff
newMissed = TimeDiff -> ClockTime -> ClockTime
addToClockTime TimeDiff
missed ClockTime
now ClockTime -> ClockTime -> TimeDiff
`diffClockTimes` ClockTime
lastSeen
in TimeDiff
newMissed TimeDiff -> UserStatus -> UserStatus
`seq` LastSpoke -> [Channel] -> UserStatus
Present ((ClockTime, TimeDiff) -> LastSpoke
forall a. a -> Maybe a
Just (ClockTime
lastSpoke, TimeDiff
newMissed)) [Channel]
cs
updateJ Maybe ClockTime
_ [Channel]
cs UserStatus
_ = LastSpoke -> [Channel] -> UserStatus
Present LastSpoke
forall a. Maybe a
Nothing [Channel]
cs
updateNP :: ClockTime -> Channel -> UserStatus -> UserStatus
updateNP :: ClockTime -> Channel -> UserStatus -> UserStatus
updateNP ClockTime
now Channel
_ (NotPresent ClockTime
ct StopWatch
missed [Channel]
c)
= ClockTime -> StopWatch -> [Channel] -> UserStatus
NotPresent ClockTime
ct (ClockTime -> StopWatch -> StopWatch
stopWatch ClockTime
now StopWatch
missed) [Channel]
c
updateNP ClockTime
now Channel
chan (WasPresent ClockTime
lastSeen StopWatch
missed LastSpoke
_ [Channel]
cs)
| [Channel] -> Channel
forall a. [a] -> a
head [Channel]
cs Channel -> Channel -> Bool
forall a. Eq a => a -> a -> Bool
== Channel
chan = ClockTime -> StopWatch -> LastSpoke -> [Channel] -> UserStatus
WasPresent ClockTime
lastSeen (ClockTime -> StopWatch -> StopWatch
stopWatch ClockTime
now StopWatch
missed) LastSpoke
forall a. Maybe a
Nothing [Channel]
cs
updateNP ClockTime
_ Channel
_ UserStatus
status = UserStatus
status