{-# options_haddock prune #-} -- |Description: Monitor Implementations, Internal module Polysemy.Conc.Monitor where import qualified Polysemy.Time as Time import Polysemy.Time (Minutes (Minutes), NanoSeconds, Seconds (Seconds), Time, TimeUnit, convert) import Torsor (Torsor, difference, minus) import Polysemy.Conc.Effect.Monitor (MonitorCheck (MonitorCheck)) -- |Config for 'monitorClockSkew'. data ClockSkewConfig = ClockSkewConfig { interval :: NanoSeconds, tolerance :: NanoSeconds } deriving stock (Eq, Show) -- |Smart constructor for 'ClockSkewConfig' that takes arbitrary 'TimeUnit's. clockSkewConfig :: TimeUnit u1 => TimeUnit u2 => u1 -> u2 -> ClockSkewConfig clockSkewConfig i t = ClockSkewConfig (convert i) (convert t) instance Default ClockSkewConfig where def = clockSkewConfig (Minutes 1) (Seconds 5) -- |Check for 'Polysemy.Conc.Effect.Monitor' that checks every @interval@ whether the difference between the current -- time and the time at the last check is larger than @interval@ + @tolerance@. -- Can be used to detect that the operating system suspended and resumed. monitorClockSkew :: ∀ t d diff r . Torsor t diff => TimeUnit diff => Members [AtomicState (Maybe t), Time t d, Embed IO] r => ClockSkewConfig -> MonitorCheck r monitorClockSkew (ClockSkewConfig interval tolerance) = MonitorCheck interval \ signal -> do atomicGet >>= \case Just prev -> do now <- Time.now @t @d when (minus (convert (difference now prev)) tolerance > interval) (void (embed @IO (tryPutMVar signal ()))) atomicPut (Just now) Nothing -> do now <- Time.now @t @d atomicPut (Just now)