module Effectful.Zoo.Lazy.Dynamic
  ( Lazy(..),
    runLazy,
    lazyAsk,
  ) where

import Effectful
import Effectful.Concurrent.MVar
import Effectful.Dispatch.Dynamic
import Effectful.Zoo.Core
import HaskellWorks.Prelude

data Lazy i :: Effect where
  LazyAsk
    :: Lazy i m i

type instance DispatchOf (Lazy i) = Dynamic

runLazy :: forall i a r. ()
  => r <: Concurrent
  => Eff r i
  -> Eff (Lazy i : r) a
  -> Eff r a
runLazy :: forall i a (r :: [Effect]).
(r <: Concurrent) =>
Eff r i -> Eff (Lazy i : r) a -> Eff r a
runLazy Eff r i
f Eff (Lazy i : r) a
h = do
  MVar (Maybe i)
mvCache <- forall (es :: [Effect]) a.
(Concurrent :> es) =>
a -> Eff es (MVar a)
newMVar @_ @(Maybe i) Maybe i
forall a. Maybe a
Nothing
  EffectHandler (Lazy i) r -> Eff (Lazy i : r) a -> Eff r a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
EffectHandler e es -> Eff (e : es) a -> Eff es a
interpret
    do \LocalEnv localEs r
_ -> \case
        Lazy i (Eff localEs) a
LazyAsk -> do
          Maybe i
resultOrRunning <- MVar (Maybe i) -> Eff r (Maybe i)
forall (es :: [Effect]) a. (Concurrent :> es) => MVar a -> Eff es a
takeMVar MVar (Maybe i)
mvCache
          case Maybe i
resultOrRunning of
            Just i
result -> do
              MVar (Maybe i) -> Maybe i -> Eff r ()
forall (es :: [Effect]) a.
(Concurrent :> es) =>
MVar a -> a -> Eff es ()
putMVar MVar (Maybe i)
mvCache (i -> Maybe i
forall a. a -> Maybe a
Just i
result)
              return i
a
result
            Maybe i
Nothing -> do
              i
result <- Eff r i
f
              MVar (Maybe i) -> Maybe i -> Eff r ()
forall (es :: [Effect]) a.
(Concurrent :> es) =>
MVar a -> a -> Eff es ()
putMVar MVar (Maybe i)
mvCache (i -> Maybe i
forall a. a -> Maybe a
Just i
result)
              return i
a
result
    do Eff (Lazy i : r) a
h

lazyAsk :: ()
  => r <: Lazy i
  => Eff r i
lazyAsk :: forall (r :: [Effect]) i. (r <: Lazy i) => Eff r i
lazyAsk =
  Lazy i (Eff r) i -> Eff r i
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Lazy i (Eff r) i
forall i (m :: * -> *). Lazy i m i
LazyAsk