{-# 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 ()