{-# LANGUAGE NumericUnderscores #-}

-- |
-- Module        : Control.Antikythera
-- Copyright     : Gautier DI FOLCO
-- License       : ISC
--
-- Maintainer    : Gautier DI FOLCO <gautier.difolco@gmail.com>
-- Stability     : Stable
-- Portability   : Portable
--
-- Run an action given a 'Periodicity'
--
-- > import Control.Antikythera
-- >
-- > runPeriodicityZonedTime (inclusiveRange (Min 8) (Max 23) hour .&& every 30 minute) $
-- >   putStrLn "Don't forget to hydrate"
module Control.Antikythera.Scheduling
  ( -- * 'Periodicity' runners
    runPeriodicityUTCTime,
    runPeriodicityZonedTime,
    runPeriodicityZonedTime',
    runPeriodicity,
    runPeriodicityWithHooks,

    -- * Position in time
    PositionInTime (..),
    utcTime,
    zonedTime,
    zonedTime',
  )
where

import Control.Antikythera.Periodicity
import Control.Antikythera.Unit.Time
import Control.Concurrent.Thread.Delay (delay)
import Control.Monad (forM_)
import Data.Time

-- * 'Periodicity' runners

-- | Run an action given a 'Periodicity' using system's 'UTCTime'
--
-- Note: the action is run in the loop, consider using a dedicated thread as any exception would break it
runPeriodicityUTCTime :: Periodicity UTCTime -> IO () -> IO ()
runPeriodicityUTCTime :: Periodicity UTCTime -> IO () -> IO ()
runPeriodicityUTCTime = PositionInTime UTCTime -> Periodicity UTCTime -> IO () -> IO ()
forall t. PositionInTime t -> Periodicity t -> IO () -> IO ()
runPeriodicity PositionInTime UTCTime
utcTime

-- | Run an action given a 'Periodicity' using system's 'ZonedTime' (wrapped to accomodate combination operators)
--
-- Note: the action is run in the loop, consider using a dedicated thread as any exception would break it
runPeriodicityZonedTime :: Periodicity ZonedTimeWrapped -> IO () -> IO ()
runPeriodicityZonedTime :: Periodicity ZonedTimeWrapped -> IO () -> IO ()
runPeriodicityZonedTime = PositionInTime ZonedTimeWrapped
-> Periodicity ZonedTimeWrapped -> IO () -> IO ()
forall t. PositionInTime t -> Periodicity t -> IO () -> IO ()
runPeriodicity PositionInTime ZonedTimeWrapped
zonedTime

-- | Run an action given a 'Periodicity' using system's 'ZonedTime'
--
-- Note: the action is run in the loop, consider using a dedicated thread as any exception would break it
runPeriodicityZonedTime' :: Periodicity ZonedTime -> IO () -> IO ()
runPeriodicityZonedTime' :: Periodicity ZonedTime -> IO () -> IO ()
runPeriodicityZonedTime' = PositionInTime ZonedTime -> Periodicity ZonedTime -> IO () -> IO ()
forall t. PositionInTime t -> Periodicity t -> IO () -> IO ()
runPeriodicity PositionInTime ZonedTime
zonedTime'

-- | Run an action given a 'Periodicity'
--
-- Note: the action is run in the loop, consider using a dedicated thread as any exception would break it
runPeriodicity ::
  -- | Fetch the time and compute the delay time
  PositionInTime t ->
  Periodicity t ->
  IO () ->
  IO ()
runPeriodicity :: forall t. PositionInTime t -> Periodicity t -> IO () -> IO ()
runPeriodicity =
  (t -> IO ())
-> IO ()
-> (() -> IO ())
-> PositionInTime t
-> Periodicity t
-> IO ()
-> IO ()
forall t a.
(t -> IO ())
-> IO ()
-> (a -> IO ())
-> PositionInTime t
-> Periodicity t
-> IO a
-> IO ()
runPeriodicityWithHooks
    (IO () -> t -> IO ()
forall a b. a -> b -> a
const (IO () -> t -> IO ()) -> IO () -> t -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    (IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Run an action given a 'Periodicity' with hooks
--
-- Note: the action is run in the loop, consider using a dedicated thread as any exception would break it
runPeriodicityWithHooks ::
  -- | Hooks planned
  (t -> IO ()) ->
  -- | Hooks at time (before running the action)
  IO () ->
  -- | Hooks done
  (a -> IO ()) ->
  -- | Fetch the time and compute the delay time
  PositionInTime t ->
  Periodicity t ->
  IO a ->
  IO ()
runPeriodicityWithHooks :: forall t a.
(t -> IO ())
-> IO ()
-> (a -> IO ())
-> PositionInTime t
-> Periodicity t
-> IO a
-> IO ()
runPeriodicityWithHooks t -> IO ()
hookPlanned IO ()
hookBefore a -> IO ()
hookAfter PositionInTime t
pit Periodicity t
p IO a
f = do
  t
now <- PositionInTime t
pit.getTime
  Maybe t -> (t -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Periodicity t
p.nextPeriod t
now) ((t -> IO ()) -> IO ()) -> (t -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \t
next -> do
    t -> IO ()
hookPlanned t
next
    Integer -> IO ()
delay (Integer -> IO ()) -> Integer -> IO ()
forall a b. (a -> b) -> a -> b
$ PositionInTime t
pit.delayMicroSeconds t
now t
next
    IO ()
hookBefore
    IO a
f IO a -> (a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO ()
hookAfter
    (t -> IO ())
-> IO ()
-> (a -> IO ())
-> PositionInTime t
-> Periodicity t
-> IO a
-> IO ()
forall t a.
(t -> IO ())
-> IO ()
-> (a -> IO ())
-> PositionInTime t
-> Periodicity t
-> IO a
-> IO ()
runPeriodicityWithHooks t -> IO ()
hookPlanned IO ()
hookBefore a -> IO ()
hookAfter PositionInTime t
pit Periodicity t
p IO a
f

-- * Position in time

-- | Fetch the time and compute the delay time
data PositionInTime t = PositionInTime
  { forall t. PositionInTime t -> IO t
getTime :: IO t,
    -- | now -> nextPeriod -> µs
    forall t. PositionInTime t -> t -> t -> Integer
delayMicroSeconds :: t -> t -> Integer
  }

-- | System's 'UTCTime'
utcTime :: PositionInTime UTCTime
utcTime :: PositionInTime UTCTime
utcTime =
  PositionInTime
    { $sel:getTime:PositionInTime :: IO UTCTime
getTime = IO UTCTime
getCurrentTime,
      $sel:delayMicroSeconds:PositionInTime :: UTCTime -> UTCTime -> Integer
delayMicroSeconds = \UTCTime
now UTCTime
next ->
        Pico -> Integer
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Pico -> Integer) -> Pico -> Integer
forall a b. (a -> b) -> a -> b
$ Pico
1_000_000 Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* NominalDiffTime -> Pico
nominalDiffTimeToSeconds (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
next UTCTime
now)
    }

-- | System's 'ZonedTime' (wrapped to accomodate combination operators)
zonedTime :: PositionInTime ZonedTimeWrapped
zonedTime :: PositionInTime ZonedTimeWrapped
zonedTime =
  PositionInTime
    { $sel:getTime:PositionInTime :: IO ZonedTimeWrapped
getTime = ZonedTime -> ZonedTimeWrapped
ZonedTimeWrapped (ZonedTime -> ZonedTimeWrapped)
-> IO ZonedTime -> IO ZonedTimeWrapped
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ZonedTime
getZonedTime,
      $sel:delayMicroSeconds:PositionInTime :: ZonedTimeWrapped -> ZonedTimeWrapped -> Integer
delayMicroSeconds = \(ZonedTimeWrapped ZonedTime
now) (ZonedTimeWrapped ZonedTime
next) ->
        Pico -> Integer
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Pico -> Integer) -> Pico -> Integer
forall a b. (a -> b) -> a -> b
$ Pico
1_000_000 Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* NominalDiffTime -> Pico
nominalDiffTimeToSeconds (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
next) (ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
now))
    }

-- | System's 'ZonedTime'
zonedTime' :: PositionInTime ZonedTime
zonedTime' :: PositionInTime ZonedTime
zonedTime' =
  PositionInTime
    { $sel:getTime:PositionInTime :: IO ZonedTime
getTime = IO ZonedTime
getZonedTime,
      $sel:delayMicroSeconds:PositionInTime :: ZonedTime -> ZonedTime -> Integer
delayMicroSeconds = \ZonedTime
now ZonedTime
next ->
        Pico -> Integer
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Pico -> Integer) -> Pico -> Integer
forall a b. (a -> b) -> a -> b
$ Pico
1_000_000 Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* NominalDiffTime -> Pico
nominalDiffTimeToSeconds (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
next) (ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
now))
    }