{-# options_haddock prune #-}
-- |Description: Scoped Interpreters, Internal
module Polysemy.Conc.Interpreter.Scoped where

import Polysemy.Internal (Sem (Sem, runSem), liftSem)
import Polysemy.Internal.Union (Weaving (Weaving), decomp, hoist, injWeaving)

import Polysemy.Conc.Effect.Scoped (Scoped (InScope, Run))

interpretH' ::
  ∀ e r .
  (∀ x . Weaving e (Sem (e : r)) x -> Sem r x) ->
  InterpreterFor e r
interpretH' :: (forall x. Weaving e (Sem (e : r)) x -> Sem r x)
-> InterpreterFor e r
interpretH' forall x. Weaving e (Sem (e : r)) x -> Sem r x
h Sem (e : r) a
sem =
  (forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem \ forall x. Union r (Sem r) x -> m x
k -> Sem (e : r) a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem (e : r) a
sem ((forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a)
-> (forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a
forall a b. (a -> b) -> a -> b
$ Union (e : r) (Sem (e : r)) x
-> Either (Union r (Sem (e : r)) x) (Weaving e (Sem (e : r)) x)
forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp (Union (e : r) (Sem (e : r)) x
 -> Either (Union r (Sem (e : r)) x) (Weaving e (Sem (e : r)) x))
-> (Either (Union r (Sem (e : r)) x) (Weaving e (Sem (e : r)) x)
    -> m x)
-> Union (e : r) (Sem (e : r)) x
-> m x
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
    Right Weaving e (Sem (e : r)) x
wav -> Sem r x -> (forall x. Union r (Sem r) x -> m x) -> m x
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem (Weaving e (Sem (e : r)) x -> Sem r x
forall x. Weaving e (Sem (e : r)) x -> Sem r x
h Weaving e (Sem (e : r)) x
wav) forall x. Union r (Sem r) x -> m x
k
    Left Union r (Sem (e : r)) x
g -> Union r (Sem r) x -> m x
forall x. Union r (Sem r) x -> m x
k (Union r (Sem r) x -> m x) -> Union r (Sem r) x -> m x
forall a b. (a -> b) -> a -> b
$ InterpreterFor e r -> Union r (Sem (e : r)) x -> Union r (Sem r) x
forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist ((forall x. Weaving e (Sem (e : r)) x -> Sem r x)
-> InterpreterFor e r
forall (e :: Effect) (r :: EffectRow).
(forall x. Weaving e (Sem (e : r)) x -> Sem r x)
-> InterpreterFor e r
interpretH' forall x. Weaving e (Sem (e : r)) x -> Sem r x
h) Union r (Sem (e : r)) x
g


-- |Interpreter for 'Scoped', taking a @resource@ allocation function and a parameterized interpreter for the plain
-- @effect@.
--
-- @withResource@ is a callback function, allowing the user to acquire the resource for each program from other effects.
--
-- @scopedInterpreter@ is a regular interpreter that is called with the @resource@ argument produced by @scope@.
-- /Note/: This function will be called for each action in the program, so if the interpreter allocates any resources,
-- they will be scoped to a single action. Move them to @withResource@ instead.
runScoped ::
  ∀ resource effect r .
  (∀ x . (resource -> Sem r x) -> Sem r x) ->
  (resource -> InterpreterFor effect r) ->
  InterpreterFor (Scoped resource effect) r
runScoped :: (forall x. (resource -> Sem r x) -> Sem r x)
-> (resource -> InterpreterFor effect r)
-> InterpreterFor (Scoped resource effect) r
runScoped forall x. (resource -> Sem r x) -> Sem r x
withResource resource -> InterpreterFor effect r
scopedInterpreter =
  Sem (Scoped resource effect : r) a -> Sem r a
InterpreterFor (Scoped resource effect) r
run
  where
    run :: InterpreterFor (Scoped resource effect) r
    run :: Sem (Scoped resource effect : r) a -> Sem r a
run =
      (forall x.
 Weaving
   (Scoped resource effect) (Sem (Scoped resource effect : r)) x
 -> Sem r x)
-> InterpreterFor (Scoped resource effect) r
forall (e :: Effect) (r :: EffectRow).
(forall x. Weaving e (Sem (e : r)) x -> Sem r x)
-> InterpreterFor e r
interpretH' \ (Weaving Scoped resource effect (Sem rInitial) a
effect f ()
s forall x.
f (Sem rInitial x) -> Sem (Scoped resource effect : r) (f x)
wv f a -> x
ex forall x. f x -> Maybe x
ins) -> case Scoped resource effect (Sem rInitial) a
effect of
        Run resource act ->
          resource -> Sem (effect : r) x -> Sem r x
resource -> InterpreterFor effect r
scopedInterpreter resource
resource (Union (effect : r) (Sem (effect : r)) x -> Sem (effect : r) x
forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem (Union (effect : r) (Sem (effect : r)) x -> Sem (effect : r) x)
-> Union (effect : r) (Sem (effect : r)) x -> Sem (effect : r) x
forall a b. (a -> b) -> a -> b
$ Weaving effect (Sem (effect : r)) x
-> Union (effect : r) (Sem (effect : r)) x
forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving (Weaving effect (Sem (effect : r)) x
 -> Union (effect : r) (Sem (effect : r)) x)
-> Weaving effect (Sem (effect : r)) x
-> Union (effect : r) (Sem (effect : r)) x
forall a b. (a -> b) -> a -> b
$ effect (Sem rInitial) a
-> f ()
-> (forall x. f (Sem rInitial x) -> Sem (effect : r) (f x))
-> (f a -> x)
-> (forall x. f x -> Maybe x)
-> Weaving effect (Sem (effect : r)) x
forall (f :: * -> *) (e :: Effect) (rInitial :: EffectRow) a
       resultType (mAfter :: * -> *).
Functor f =>
e (Sem rInitial) a
-> f ()
-> (forall x. f (Sem rInitial x) -> mAfter (f x))
-> (f a -> resultType)
-> (forall x. f x -> Maybe x)
-> Weaving e mAfter resultType
Weaving effect (Sem rInitial) a
act f ()
s (Sem r (f x) -> Sem (effect : r) (f x)
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise (Sem r (f x) -> Sem (effect : r) (f x))
-> (f (Sem rInitial x) -> Sem r (f x))
-> f (Sem rInitial x)
-> Sem (effect : r) (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Scoped resource effect : r) (f x) -> Sem r (f x)
InterpreterFor (Scoped resource effect) r
run (Sem (Scoped resource effect : r) (f x) -> Sem r (f x))
-> (f (Sem rInitial x) -> Sem (Scoped resource effect : r) (f x))
-> f (Sem rInitial x)
-> Sem r (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Sem rInitial x) -> Sem (Scoped resource effect : r) (f x)
forall x.
f (Sem rInitial x) -> Sem (Scoped resource effect : r) (f x)
wv) f a -> x
ex forall x. f x -> Maybe x
ins)
        InScope main ->
          f a -> x
ex (f a -> x) -> Sem r (f a) -> Sem r x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (resource -> Sem r (f a)) -> Sem r (f a)
forall x. (resource -> Sem r x) -> Sem r x
withResource \ resource
resource -> Sem (Scoped resource effect : r) (f a) -> Sem r (f a)
InterpreterFor (Scoped resource effect) r
run (f (Sem rInitial a) -> Sem (Scoped resource effect : r) (f a)
forall x.
f (Sem rInitial x) -> Sem (Scoped resource effect : r) (f x)
wv (resource -> Sem rInitial a
main resource
resource Sem rInitial a -> f () -> f (Sem rInitial a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s))

-- |Variant of 'Scoped' in which the resource allocator is a plain action.
runScopedAs ::
  ∀ resource effect r .
  Sem r resource ->
  (resource -> InterpreterFor effect r) ->
  InterpreterFor (Scoped resource effect) r
runScopedAs :: Sem r resource
-> (resource -> InterpreterFor effect r)
-> InterpreterFor (Scoped resource effect) r
runScopedAs Sem r resource
resource =
  (forall x. (resource -> Sem r x) -> Sem r x)
-> (resource -> InterpreterFor effect r)
-> InterpreterFor (Scoped resource effect) r
forall resource (effect :: Effect) (r :: EffectRow).
(forall x. (resource -> Sem r x) -> Sem r x)
-> (resource -> InterpreterFor effect r)
-> InterpreterFor (Scoped resource effect) r
runScoped \ resource -> Sem r x
f -> resource -> Sem r x
f (resource -> Sem r x) -> Sem r resource -> Sem r x
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r resource
resource