-- SPDX-License-Identifier: MPL-2.0

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

Interpreters for the [Timer]("Data.Effect.Concurrent.Timer") effects.
-}
module Control.Monad.Hefty.Concurrent.Timer (
    module Control.Monad.Hefty.Concurrent.Timer,
    module Data.Effect.Concurrent.Timer,
)
where

import Control.Monad.Hefty (
    Eff,
    FOEs,
    interpret,
    raise,
    raiseUnder,
    (&),
    (:>),
 )
import Control.Monad.Hefty.Coroutine (runCoroutine)
import Control.Monad.Hefty.State (evalState)
import Data.Effect.Concurrent.Timer
import Data.Effect.Coroutine (Status (Continue, Done))
import Data.Effect.State (get, put)
import Data.Time (DiffTime)
import Data.Void (Void, absurd)

runCyclicTimer
    :: forall a es
     . (Timer :> es, FOEs es)
    => Eff (CyclicTimer ': es) a
    -> Eff es a
runCyclicTimer :: forall a (es :: [Effect]).
(Timer :> es, FOEs es) =>
Eff (CyclicTimer : es) a -> Eff es a
runCyclicTimer Eff (CyclicTimer : es) a
a = do
    Status (Eff Freer es) () DiffTime Void
timer0 :: Status (Eff es) () DiffTime Void <- Eff (Yield () DiffTime : es) Void
-> Eff es (Status (Eff Freer es) () DiffTime Void)
forall ans a b (es :: [Effect]).
FOEs es =>
Eff (Yield a b : es) ans -> Eff es (Status (Eff es) a b ans)
runCoroutine Eff (Yield () DiffTime : es) Void
forall a (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Timer :> es, Yield () DiffTime :> es, Monad (Eff ff es),
 Free c ff) =>
Eff ff es a
cyclicTimer
    Eff (CyclicTimer : es) a
a
        Eff (CyclicTimer : es) a
-> (Eff (CyclicTimer : es) a
    -> Eff
         Freer
         (CyclicTimer : State (Status (Eff Freer es) () DiffTime Void) : es)
         a)
-> Eff
     Freer
     (CyclicTimer : State (Status (Eff Freer es) () DiffTime Void) : es)
     a
forall a b. a -> (a -> b) -> b
& Eff (CyclicTimer : es) a
-> Eff
     Freer
     (CyclicTimer : State (Status (Eff Freer es) () DiffTime Void) : es)
     a
forall (e0 :: Effect) (e1 :: Effect) (es :: [Effect]) a
       (ff :: Effect) (c :: (* -> *) -> Constraint).
Free c ff =>
Eff ff (e0 : es) a -> Eff ff (e0 : e1 : es) a
raiseUnder
        Eff
  Freer
  (CyclicTimer : State (Status (Eff Freer es) () DiffTime Void) : es)
  a
-> (Eff
      Freer
      (CyclicTimer : State (Status (Eff Freer es) () DiffTime Void) : es)
      a
    -> Eff
         Freer (State (Status (Eff Freer es) () DiffTime Void) : es) a)
-> Eff
     Freer (State (Status (Eff Freer es) () DiffTime Void) : es) a
forall a b. a -> (a -> b) -> b
& (CyclicTimer
 ~~> Eff
       Freer (State (Status (Eff Freer es) () DiffTime Void) : es))
-> Eff
     Freer
     (CyclicTimer : State (Status (Eff Freer es) () DiffTime Void) : es)
     a
-> Eff
     Freer (State (Status (Eff Freer es) () DiffTime Void) : es) a
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret \case
            Wait DiffTime
delta ->
                forall s (a :: * -> *) (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, State s :> es) =>
a s
get @(Status (Eff es) () DiffTime Void) Eff
  Freer
  (State (Status (Eff Freer es) () DiffTime Void) : es)
  (Status (Eff Freer es) () DiffTime Void)
-> (Status (Eff Freer es) () DiffTime Void
    -> Eff
         Freer (State (Status (Eff Freer es) () DiffTime Void) : es) x)
-> Eff
     Freer (State (Status (Eff Freer es) () DiffTime Void) : es) x
forall a b.
Eff Freer (State (Status (Eff Freer es) () DiffTime Void) : es) a
-> (a
    -> Eff
         Freer (State (Status (Eff Freer es) () DiffTime Void) : es) b)
-> Eff
     Freer (State (Status (Eff Freer es) () DiffTime Void) : es) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Done Void
x -> Void
-> Eff
     Freer (State (Status (Eff Freer es) () DiffTime Void) : es) x
forall a. Void -> a
absurd Void
x
                    Continue () DiffTime -> Eff es (Status (Eff Freer es) () DiffTime Void)
k -> Status (Eff Freer es) () DiffTime Void
-> Eff
     Freer (State (Status (Eff Freer es) () DiffTime Void) : es) x
Status (Eff Freer es) () DiffTime Void
-> Eff
     Freer (State (Status (Eff Freer es) () DiffTime Void) : es) ()
forall s (a :: * -> *) (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, State s :> es) =>
s -> a ()
put (Status (Eff Freer es) () DiffTime Void
 -> Eff
      Freer (State (Status (Eff Freer es) () DiffTime Void) : es) x)
-> Eff
     Freer
     (State (Status (Eff Freer es) () DiffTime Void) : es)
     (Status (Eff Freer es) () DiffTime Void)
-> Eff
     Freer (State (Status (Eff Freer es) () DiffTime Void) : es) x
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Eff es (Status (Eff Freer es) () DiffTime Void)
-> Eff
     Freer
     (State (Status (Eff Freer es) () DiffTime Void) : es)
     (Status (Eff Freer es) () DiffTime Void)
forall (e :: Effect) (es :: [Effect]) a (ff :: Effect)
       (c :: (* -> *) -> Constraint).
Free c ff =>
Eff ff es a -> Eff ff (e : es) a
raise (DiffTime -> Eff es (Status (Eff Freer es) () DiffTime Void)
k DiffTime
delta)
        Eff Freer (State (Status (Eff Freer es) () DiffTime Void) : es) a
-> (Eff
      Freer (State (Status (Eff Freer es) () DiffTime Void) : es) a
    -> Eff es a)
-> Eff es a
forall a b. a -> (a -> b) -> b
& Status (Eff Freer es) () DiffTime Void
-> FOEs es =>
   Eff Freer (State (Status (Eff Freer es) () DiffTime Void) : es) a
   -> Eff es a
forall s (es :: [Effect]) a.
s -> FOEs es => Eff (State s : es) a -> Eff es a
evalState Status (Eff Freer es) () DiffTime Void
timer0