module Lambdabot.Plugin.Social.Seen.StopWatch where

import Lambdabot.Compat.AltTime

import Data.Binary

data StopWatch
    = Stopped !TimeDiff
    | Running !ClockTime
    deriving (Int -> StopWatch -> ShowS
[StopWatch] -> ShowS
StopWatch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopWatch] -> ShowS
$cshowList :: [StopWatch] -> ShowS
show :: StopWatch -> String
$cshow :: StopWatch -> String
showsPrec :: Int -> StopWatch -> ShowS
$cshowsPrec :: Int -> StopWatch -> ShowS
Show,ReadPrec [StopWatch]
ReadPrec StopWatch
Int -> ReadS StopWatch
ReadS [StopWatch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopWatch]
$creadListPrec :: ReadPrec [StopWatch]
readPrec :: ReadPrec StopWatch
$creadPrec :: ReadPrec StopWatch
readList :: ReadS [StopWatch]
$creadList :: ReadS [StopWatch]
readsPrec :: Int -> ReadS StopWatch
$creadsPrec :: Int -> ReadS StopWatch
Read)

instance Binary StopWatch where
    put :: StopWatch -> Put
put (Stopped TimeDiff
td) = Word8 -> Put
putWord8 Word8
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put TimeDiff
td
    put (Running ClockTime
ct) = Word8 -> Put
putWord8 Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put ClockTime
ct

    get :: Get StopWatch
get = Get Word8
getWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
h -> case Word8
h of
        Word8
0 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TimeDiff -> StopWatch
Stopped forall t. Binary t => Get t
get
        Word8
1 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClockTime -> StopWatch
Running forall t. Binary t => Get t
get
        Word8
_ -> forall a. HasCallStack => String -> a
error String
"Seen.StopWatch.get"

zeroWatch :: StopWatch
zeroWatch :: StopWatch
zeroWatch = TimeDiff -> StopWatch
Stopped TimeDiff
noTimeDiff

startWatch :: ClockTime -> StopWatch -> StopWatch
startWatch :: ClockTime -> StopWatch -> StopWatch
startWatch ClockTime
now (Stopped TimeDiff
td) = ClockTime -> StopWatch
Running (TimeDiff
td TimeDiff -> ClockTime -> ClockTime
`addToClockTime` ClockTime
now)
startWatch ClockTime
_ StopWatch
alreadyStarted = StopWatch
alreadyStarted

stopWatch :: ClockTime -> StopWatch -> StopWatch
stopWatch :: ClockTime -> StopWatch -> StopWatch
stopWatch ClockTime
now (Running ClockTime
t)  = TimeDiff -> StopWatch
Stopped (ClockTime
t ClockTime -> ClockTime -> TimeDiff
`diffClockTimes` ClockTime
now)
stopWatch ClockTime
_ StopWatch
alreadyStopped = StopWatch
alreadyStopped