{-# 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 {
    ClockSkewConfig -> NanoSeconds
interval :: NanoSeconds,
    ClockSkewConfig -> NanoSeconds
tolerance :: NanoSeconds
  }
  deriving stock (ClockSkewConfig -> ClockSkewConfig -> Bool
(ClockSkewConfig -> ClockSkewConfig -> Bool)
-> (ClockSkewConfig -> ClockSkewConfig -> Bool)
-> Eq ClockSkewConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClockSkewConfig -> ClockSkewConfig -> Bool
== :: ClockSkewConfig -> ClockSkewConfig -> Bool
$c/= :: ClockSkewConfig -> ClockSkewConfig -> Bool
/= :: ClockSkewConfig -> ClockSkewConfig -> Bool
Eq, Int -> ClockSkewConfig -> ShowS
[ClockSkewConfig] -> ShowS
ClockSkewConfig -> String
(Int -> ClockSkewConfig -> ShowS)
-> (ClockSkewConfig -> String)
-> ([ClockSkewConfig] -> ShowS)
-> Show ClockSkewConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClockSkewConfig -> ShowS
showsPrec :: Int -> ClockSkewConfig -> ShowS
$cshow :: ClockSkewConfig -> String
show :: ClockSkewConfig -> String
$cshowList :: [ClockSkewConfig] -> ShowS
showList :: [ClockSkewConfig] -> ShowS
Show)

-- | Smart constructor for 'ClockSkewConfig' that takes arbitrary 'TimeUnit's.
clockSkewConfig ::
  TimeUnit u1 =>
  TimeUnit u2 =>
  u1 ->
  u2 ->
  ClockSkewConfig
clockSkewConfig :: forall u1 u2.
(TimeUnit u1, TimeUnit u2) =>
u1 -> u2 -> ClockSkewConfig
clockSkewConfig u1
i u2
t =
  NanoSeconds -> NanoSeconds -> ClockSkewConfig
ClockSkewConfig (u1 -> NanoSeconds
forall a b. (TimeUnit a, TimeUnit b) => a -> b
convert u1
i) (u2 -> NanoSeconds
forall a b. (TimeUnit a, TimeUnit b) => a -> b
convert u2
t)

instance Default ClockSkewConfig where
  def :: ClockSkewConfig
def =
    Minutes -> Seconds -> ClockSkewConfig
forall u1 u2.
(TimeUnit u1, TimeUnit u2) =>
u1 -> u2 -> ClockSkewConfig
clockSkewConfig (Int64 -> Minutes
Minutes Int64
1) (Int64 -> Seconds
Seconds Int64
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 :: forall t d diff (r :: EffectRow).
(Torsor t diff, TimeUnit diff,
 Members '[AtomicState (Maybe t), Time t d, Embed IO] r) =>
ClockSkewConfig -> MonitorCheck r
monitorClockSkew (ClockSkewConfig NanoSeconds
interval NanoSeconds
tolerance) =
  NanoSeconds -> Sem r Bool -> MonitorCheck r
forall (r :: EffectRow).
NanoSeconds -> Sem r Bool -> MonitorCheck r
MonitorCheck NanoSeconds
interval do
    t
now <- forall t d (r :: EffectRow). Member (Time t d) r => Sem r t
Time.now @t @d
    (Maybe t -> (Maybe t, Bool)) -> Sem r Bool
forall s a (r :: EffectRow).
Member (AtomicState s) r =>
(s -> (s, a)) -> Sem r a
atomicState \ Maybe t
s -> (t -> Maybe t
forall a. a -> Maybe a
Just t
now, Bool -> (t -> Bool) -> Maybe t -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (t -> t -> Bool
skewed t
now) Maybe t
s)
  where
    skewed :: t -> t -> Bool
skewed t
now t
prev = NanoSeconds -> NanoSeconds -> NanoSeconds
forall v. Additive v => v -> v -> v
minus (diff -> NanoSeconds
forall a b. (TimeUnit a, TimeUnit b) => a -> b
convert (t -> t -> diff
forall p v. Torsor p v => p -> p -> v
difference t
now t
prev)) NanoSeconds
tolerance NanoSeconds -> NanoSeconds -> Bool
forall a. Ord a => a -> a -> Bool
> NanoSeconds
interval