{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Database.EventStore.Internal.TimerService
( timerService ) where
import Data.Typeable
import Database.EventStore.Internal.Communication
import Database.EventStore.Internal.Control
import Database.EventStore.Internal.Logger
import Database.EventStore.Internal.Prelude
import Database.EventStore.Internal.Types
data Internal =
Internal { _stopped :: IORef Bool }
timerService :: Hub -> IO ()
timerService mainBus = do
internal <- Internal <$> newIORef False
subscribe mainBus (onInit internal)
subscribe mainBus (onShutdown internal)
subscribe mainBus (onNew internal)
delayed :: Typeable e
=> Internal
-> e
-> Duration
-> Bool
-> EventStore ()
delayed Internal{..} msg (Duration timespan) oneOff = () <$ fork (go timespan)
where
go n = do
when (n > 0) $ do
let waiting = min n (fromIntegral (maxBound :: Int))
threadDelay $ fromIntegral waiting
go (timespan - waiting)
publish msg
stopped <- readIORef _stopped
unless (oneOff || stopped) $ go timespan
onInit ::Internal -> SystemInit -> EventStore ()
onInit Internal{..} _ = publish (Initialized TimerService)
onShutdown :: Internal -> SystemShutdown -> EventStore ()
onShutdown Internal{..} _ = do
$logInfo "Shutting down..."
atomicWriteIORef _stopped True
publish (ServiceTerminated TimerService)
onNew :: Internal -> NewTimer -> EventStore ()
onNew self (NewTimer msg duration oneOff) = delayed self msg duration oneOff