--------------------------------------------------------------------------------
-- |
-- Module : Database.EventStore.Internal.Stopwatch
-- Copyright : (C) 2017 Yorick Laupa
-- License : (see the file LICENSE)
--
-- Maintainer : Yorick Laupa <yo.eight@gmail.com>
-- Stability : provisional
-- Portability : non-portable
--
--------------------------------------------------------------------------------
module Database.EventStore.Internal.Stopwatch
  ( Stopwatch
  , newStopwatch
  , stopwatchElapsed
  ) where

--------------------------------------------------------------------------------
import Data.Time

--------------------------------------------------------------------------------
import Database.EventStore.Internal.Prelude

--------------------------------------------------------------------------------
data Internal =
  Internal { Internal -> UTCTime
_lastTime :: !UTCTime
           , Internal -> NominalDiffTime
_acc      :: !NominalDiffTime
           }

--------------------------------------------------------------------------------
initInternal :: UTCTime -> Internal
initInternal :: UTCTime -> Internal
initInternal UTCTime
now = UTCTime -> NominalDiffTime -> Internal
Internal UTCTime
now NominalDiffTime
0

--------------------------------------------------------------------------------
update :: UTCTime -> Internal -> Internal
update :: UTCTime -> Internal -> Internal
update UTCTime
now (Internal UTCTime
before NominalDiffTime
acc) = UTCTime -> NominalDiffTime -> Internal
Internal UTCTime
now NominalDiffTime
acc'
  where
    acc' :: NominalDiffTime
acc' = NominalDiffTime
acc forall a. Num a => a -> a -> a
+ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now UTCTime
before

--------------------------------------------------------------------------------
newtype Stopwatch = Stopwatch (MVar Internal)

--------------------------------------------------------------------------------
newStopwatch :: MonadBase IO m => m Stopwatch
newStopwatch :: forall (m :: * -> *). MonadBase IO m => m Stopwatch
newStopwatch =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MVar Internal -> Stopwatch
Stopwatch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadBase IO m => a -> m (MVar a)
newMVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Internal
initInternal forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase IO UTCTime
getCurrentTime

--------------------------------------------------------------------------------
stopwatchElapsed :: MonadBaseControl IO m => Stopwatch -> m NominalDiffTime
stopwatchElapsed :: forall (m :: * -> *).
MonadBaseControl IO m =>
Stopwatch -> m NominalDiffTime
stopwatchElapsed (Stopwatch MVar Internal
var) =
  forall (m :: * -> *) a b.
MonadBaseControl IO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar MVar Internal
var forall a b. (a -> b) -> a -> b
$ \Internal
prev -> do
    UTCTime
now <- forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase IO UTCTime
getCurrentTime
    let next :: Internal
next = UTCTime -> Internal -> Internal
update UTCTime
now Internal
prev
    forall (m :: * -> *) a. Monad m => a -> m a
return (Internal
next, Internal -> NominalDiffTime
_acc Internal
next)