{-# 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))
import Polysemy (Tactical)
import Polysemy.Internal.Tactics (runTactics)

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 forall (m :: * -> *).
Monad m =>
(forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a
m) =
  (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 -> (forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a
forall (m :: * -> *).
Monad m =>
(forall x. Union (e : r) (Sem (e : r)) x -> m x) -> m a
m ((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 'runScoped' 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

-- |Variant of 'runScoped' that takes a higher-order handler instead of an interpreter.
interpretScopedH ::
  ∀ resource effect r .
  (∀ x . (resource -> Sem r x) -> Sem r x) ->
  (∀ r0 x . resource -> effect (Sem r0) x -> Tactical effect (Sem r0) r x) ->
  InterpreterFor (Scoped resource effect) r
interpretScopedH :: (forall x. (resource -> Sem r x) -> Sem r x)
-> (forall (r0 :: EffectRow) x.
    resource -> effect (Sem r0) x -> Tactical effect (Sem r0) r x)
-> InterpreterFor (Scoped resource effect) r
interpretScopedH forall x. (resource -> Sem r x) -> Sem r x
withResource forall (r0 :: EffectRow) x.
resource -> effect (Sem r0) x -> Tactical effect (Sem r0) r x
scopedHandler =
  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 ->
          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
<$> f ()
-> (forall x. f (Sem rInitial x) -> Sem (effect : r) (f x))
-> (forall x. f x -> Maybe x)
-> (forall x. f (Sem rInitial x) -> Sem r (f x))
-> Sem (Tactics f (Sem rInitial) (effect : r) : r) (f a)
-> Sem r (f a)
forall (f :: * -> *) (m :: * -> *) (r2 :: EffectRow)
       (r :: EffectRow) a.
Functor f =>
f ()
-> (forall x. f (m x) -> Sem r2 (f x))
-> (forall x. f x -> Maybe x)
-> (forall x. f (m x) -> Sem r (f x))
-> Sem (Tactics f m r2 : r) a
-> Sem r a
runTactics 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) forall x. f x -> Maybe x
ins (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) (resource
-> effect (Sem rInitial) a -> Tactical effect (Sem rInitial) r a
forall (r0 :: EffectRow) x.
resource -> effect (Sem r0) x -> Tactical effect (Sem r0) r x
scopedHandler resource
resource effect (Sem rInitial) a
act)
        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 'runScoped' that takes a handler instead of an interpreter.
interpretScoped ::
  ∀ resource effect r .
  (∀ x . (resource -> Sem r x) -> Sem r x) ->
  (∀ r0 x . resource -> effect (Sem r0) x -> Sem r x) ->
  InterpreterFor (Scoped resource effect) r
interpretScoped :: (forall x. (resource -> Sem r x) -> Sem r x)
-> (forall (r0 :: EffectRow) x.
    resource -> effect (Sem r0) x -> Sem r x)
-> InterpreterFor (Scoped resource effect) r
interpretScoped forall x. (resource -> Sem r x) -> Sem r x
withResource forall (r0 :: EffectRow) x.
resource -> effect (Sem r0) x -> Sem r x
scopedHandler =
  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
_) -> case Scoped resource effect (Sem rInitial) a
effect of
        Run resource act -> do
          a
x <- resource -> effect (Sem rInitial) a -> Sem r a
forall (r0 :: EffectRow) x.
resource -> effect (Sem r0) x -> Sem r x
scopedHandler resource
resource effect (Sem rInitial) a
act
          pure (f a -> x
ex (a
x a -> f () -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s))
        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 'interpretScoped' in which the resource allocator is a plain action.
interpretScopedAs ::
  ∀ resource effect r .
  Sem r resource ->
  (∀ r0 x . resource -> effect (Sem r0) x -> Sem r x) ->
  InterpreterFor (Scoped resource effect) r
interpretScopedAs :: Sem r resource
-> (forall (r0 :: EffectRow) x.
    resource -> effect (Sem r0) x -> Sem r x)
-> InterpreterFor (Scoped resource effect) r
interpretScopedAs Sem r resource
resource =
  (forall x. (resource -> Sem r x) -> Sem r x)
-> (forall (r0 :: EffectRow) x.
    resource -> effect (Sem r0) x -> Sem r x)
-> InterpreterFor (Scoped resource effect) r
forall resource (effect :: Effect) (r :: EffectRow).
(forall x. (resource -> Sem r x) -> Sem r x)
-> (forall (r0 :: EffectRow) x.
    resource -> effect (Sem r0) x -> Sem r x)
-> InterpreterFor (Scoped resource effect) r
interpretScoped \ 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