{-# LANGUAGE TemplateHaskell #-}

module Wire.Sem.Delay where

import Imports
import Polysemy

data Delay m a where
  Delay :: Int -> Delay m ()

makeSem ''Delay

runDelay :: (Member (Embed IO) r) => Sem (Delay ': r) a -> Sem r a
runDelay :: forall (r :: EffectRow) a.
Member (Embed IO) r =>
Sem (Delay : r) a -> Sem r a
runDelay = (forall (rInitial :: EffectRow) x.
 Delay (Sem rInitial) x -> Sem r x)
-> Sem (Delay : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  Delay (Sem rInitial) x -> Sem r x)
 -> Sem (Delay : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Delay (Sem rInitial) x -> Sem r x)
-> Sem (Delay : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Delay Int
i -> Int -> Sem r ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay Int
i

runControlledDelay :: forall r a. (Member (Embed IO) r) => MVar Int -> Sem (Delay : r) a -> Sem r a
runControlledDelay :: forall (r :: EffectRow) a.
Member (Embed IO) r =>
MVar Int -> Sem (Delay : r) a -> Sem r a
runControlledDelay MVar Int
tickSource = (forall (rInitial :: EffectRow) x.
 Delay (Sem rInitial) x -> Sem r x)
-> Sem (Delay : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  Delay (Sem rInitial) x -> Sem r x)
 -> Sem (Delay : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Delay (Sem rInitial) x -> Sem r x)
-> Sem (Delay : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Delay Int
n -> Int -> Sem r ()
waitForTicks Int
n
  where
    waitForTicks :: Int -> Sem r ()
    waitForTicks :: Int -> Sem r ()
waitForTicks Int
0 = () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    waitForTicks Int
remaining0 = do
      Int
passedTicks <- MVar Int -> Sem r Int
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar Int
tickSource
      let remaining :: Int
remaining = Int
remaining0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
passedTicks
      if Int
remaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
        then () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        else Int -> Sem r ()
waitForTicks Int
remaining

runDelayInstantly :: Sem (Delay : r) a -> Sem r a
runDelayInstantly :: forall (r :: EffectRow) a. Sem (Delay : r) a -> Sem r a
runDelayInstantly = (forall (rInitial :: EffectRow) x.
 Delay (Sem rInitial) x -> Sem r x)
-> Sem (Delay : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  Delay (Sem rInitial) x -> Sem r x)
 -> Sem (Delay : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Delay (Sem rInitial) x -> Sem r x)
-> Sem (Delay : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Delay Int
_ -> x -> Sem r x
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()