{-# LANGUAGE AllowAmbiguousTypes #-}

-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.

{- |
Copyright   :  (c) 2024 Sayo Koyoneda
License     :  MPL-2.0 (see the file LICENSE)
Maintainer  :  ymdfield@outlook.jp

Effects for controlling time-related operations.
-}
module Data.Effect.Concurrent.Timer where

import Control.Monad (when)
import Data.Effect.Coroutine (Yield, yield)
import Data.Function (fix)
import Data.Functor ((<&>))
import Data.Time (DiffTime)

-- | An effect for time-related operations.
data Timer a where
    -- | Retrieves the current relative time from an arbitrary fixed reference point.
    --   The reference point does not change within the context of that scope.
    Clock :: Timer DiffTime
    -- | Temporarily suspends computation for the specified duration.
    Sleep :: DiffTime -> Timer ()

makeEffectF [''Timer]

{- |
Creates a scope where elapsed time can be obtained.
An action to retrieve the elapsed time, re-zeroed at the start of the scope, is passed to the scope.
-}
withElapsedTime
    :: (Timer <: m, Monad m)
    => (m DiffTime -> m a)
    -- ^ A scope where the elapsed time can be obtained.
    -- An action to retrieve the elapsed time is passed as an argument.
    -> m a
withElapsedTime :: forall (m :: * -> *) a.
(Timer <: m, Monad m) =>
(m DiffTime -> m a) -> m a
withElapsedTime m DiffTime -> m a
f = do
    DiffTime
start <- m DiffTime
forall (f :: * -> *). SendFOE Timer f => f DiffTime
clock
    m DiffTime -> m a
f (m DiffTime -> m a) -> m DiffTime -> m a
forall a b. (a -> b) -> a -> b
$ m DiffTime
forall (f :: * -> *). SendFOE Timer f => f DiffTime
clock m DiffTime -> (DiffTime -> DiffTime) -> m DiffTime
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
`subtract` DiffTime
start)

-- | Returns the time taken for a computation along with the result as a pair.
measureTime :: (Timer <: m, Monad m) => m a -> m (DiffTime, a)
measureTime :: forall (m :: * -> *) a.
(Timer <: m, Monad m) =>
m a -> m (DiffTime, a)
measureTime m a
m = (m DiffTime -> m (DiffTime, a)) -> m (DiffTime, a)
forall (m :: * -> *) a.
(Timer <: m, Monad m) =>
(m DiffTime -> m a) -> m a
withElapsedTime \m DiffTime
elapsedTime -> do
    a
r <- m a
m
    m DiffTime
elapsedTime m DiffTime -> (DiffTime -> (DiffTime, a)) -> m (DiffTime, a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,a
r)

{- |
Temporarily suspends computation until the relative time from the fixed reference point in the current scope's context, as given by the argument.
If the specified resume time has already passed, returns the elapsed time (positive value) in `Just`.
-}
sleepUntil :: (Timer <: m, Monad m) => DiffTime -> m (Maybe DiffTime)
sleepUntil :: forall (m :: * -> *).
(Timer <: m, Monad m) =>
DiffTime -> m (Maybe DiffTime)
sleepUntil DiffTime
t = do
    DiffTime
now <- m DiffTime
forall (f :: * -> *). SendFOE Timer f => f DiffTime
clock
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiffTime
t DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> DiffTime
now) do
        DiffTime -> m ()
forall (f :: * -> *). SendFOE Timer f => DiffTime -> f ()
sleep (DiffTime -> m ()) -> DiffTime -> m ()
forall a b. (a -> b) -> a -> b
$ DiffTime
t DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
- DiffTime
now
    Maybe DiffTime -> m (Maybe DiffTime)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure if DiffTime
t DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< DiffTime
now then DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just (DiffTime
now DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
- DiffTime
t) else Maybe DiffTime
forall a. Maybe a
Nothing

{- |
Repeats a computation indefinitely. Controls so that each loop occurs at a specific time interval.
If the computation time exceeds and the requested interval cannot be realized, the excess delay occurs, which accumulates and is not canceled.
-}
runCyclic
    :: (Timer <: m, Monad m)
    => m DiffTime
    -- ^ An action called at the start of each loop to determine the time interval until the next loop.
    --   For example, @pure 1@ would control the loop to have a 1-second interval.
    -> m ()
    -- ^ The computation to repeat.
    -> m a
runCyclic :: forall (m :: * -> *) a.
(Timer <: m, Monad m) =>
m DiffTime -> m () -> m a
runCyclic m DiffTime
deltaTime m ()
a = do
    DiffTime
t0 <- m DiffTime
forall (f :: * -> *). SendFOE Timer f => f DiffTime
clock
    (((DiffTime -> m a) -> DiffTime -> m a) -> DiffTime -> m a)
-> DiffTime -> ((DiffTime -> m a) -> DiffTime -> m a) -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((DiffTime -> m a) -> DiffTime -> m a) -> DiffTime -> m a
forall a. (a -> a) -> a
fix DiffTime
t0 \DiffTime -> m a
next DiffTime
t -> do
        DiffTime
t' <- (DiffTime
t +) (DiffTime -> DiffTime) -> m DiffTime -> m DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m DiffTime
deltaTime
        m ()
a
        Maybe DiffTime
delay <- DiffTime -> m (Maybe DiffTime)
forall (m :: * -> *).
(Timer <: m, Monad m) =>
DiffTime -> m (Maybe DiffTime)
sleepUntil DiffTime
t'
        DiffTime -> m a
next (DiffTime -> m a) -> DiffTime -> m a
forall a b. (a -> b) -> a -> b
$ DiffTime -> (DiffTime -> DiffTime) -> Maybe DiffTime -> DiffTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DiffTime
t' (DiffTime
t' +) Maybe DiffTime
delay

{- |
Controls to repeat a specified computation at fixed time intervals. A specialized version of `runCyclic`.
If the computation time exceeds and the requested interval cannot be realized, the excess delay occurs, which accumulates and is not canceled.
-}
runPeriodic
    :: (Timer <: m, Monad m)
    => DiffTime
    -- ^ Loop interval
    -> m ()
    -- ^ The computation to repeat.
    -> m a
runPeriodic :: forall (m :: * -> *) a.
(Timer <: m, Monad m) =>
DiffTime -> m () -> m a
runPeriodic DiffTime
interval = m DiffTime -> m () -> m a
forall (m :: * -> *) a.
(Timer <: m, Monad m) =>
m DiffTime -> m () -> m a
runCyclic (DiffTime -> m DiffTime
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DiffTime
interval)
{-# INLINE runPeriodic #-}

{- |
Calls `yield` of a coroutine at fixed intervals.
If the computation time exceeds and the requested interval cannot be realized, the excess delay occurs, which accumulates and is not canceled.
-}
periodicTimer :: forall m a. (Timer <: m, Yield () () <: m, Monad m) => DiffTime -> m a
periodicTimer :: forall (m :: * -> *) a.
(Timer <: m, Yield () () <: m, Monad m) =>
DiffTime -> m a
periodicTimer DiffTime
interval = DiffTime -> m () -> m a
forall (m :: * -> *) a.
(Timer <: m, Monad m) =>
DiffTime -> m () -> m a
runPeriodic DiffTime
interval (m () -> m a) -> m () -> m a
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a b (f :: * -> *). SendFOE (Yield a b) f => a -> f b
yield ()
{-# INLINE periodicTimer #-}

{- |
Calls `yield` of a coroutine at specific intervals.
Controls so that the time returned by `yield` becomes the time interval until the next loop.
If the computation time exceeds and the requested interval cannot be realized, the excess delay occurs, which accumulates and is not canceled.
-}
cyclicTimer :: forall m a. (Timer <: m, Yield () DiffTime <: m, Monad m) => m a
cyclicTimer :: forall (m :: * -> *) a.
(Timer <: m, Yield () DiffTime <: m, Monad m) =>
m a
cyclicTimer = m DiffTime -> m () -> m a
forall (m :: * -> *) a.
(Timer <: m, Monad m) =>
m DiffTime -> m () -> m a
runCyclic (() -> m DiffTime
forall a b (f :: * -> *). SendFOE (Yield a b) f => a -> f b
yield ()) (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# INLINE cyclicTimer #-}

-- | An effect that realizes control of wait times such that the specified time becomes the interval until the next @wait@ when @wait@ is executed repeatedly.
data CyclicTimer a where
    -- | Controls the wait time so that when @wait@ is executed repeatedly, the specified time becomes the interval until the next @wait@.
    Wait :: DiffTime -> CyclicTimer ()

makeEffectF [''CyclicTimer]