{-# options_haddock prune #-}
{-# options_ghc -Wno-redundant-constraints #-}

-- | Description: Interpreters for 'Resumable'.
module Polysemy.Resume.Interpreter.Resumable where

import Polysemy.Error (Error (Throw))
import Polysemy.Internal (Sem (Sem, runSem), liftSem, usingSem)
import Polysemy.Internal.CustomErrors (FirstOrder)
import Polysemy.Internal.Tactics (liftT, runTactics)
import Polysemy.Internal.Union (ElemOf, Weaving (Weaving), decomp, hoist, inj, injWeaving, membership, prjUsing, weave)

import Polysemy.Resume.Effect.Resumable (Resumable (..))
import Polysemy.Resume.Effect.Stop (Stop, stop)
import Polysemy.Resume.Interpreter.Stop (StopExc, runStop, stopOnError, stopToIOFinal)

type InterpreterTrans' eff eff' r r' =
  ∀ a b .
  (Sem (eff' : r') a -> Sem r b) ->
  Sem (eff : r) a ->
  Sem r b

type InterpreterTrans eff eff' r =
  InterpreterTrans' eff eff' r r

distribEither ::
  Functor f =>
  f () ->
  (f (Either err a) -> res) ->
  Either err (f a) ->
  res
distribEither :: forall (f :: * -> *) err a res.
Functor f =>
f () -> (f (Either err a) -> res) -> Either err (f a) -> res
distribEither f ()
initialState f (Either err a) -> res
result =
  f (Either err a) -> res
result forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Right f a
fa -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa
    Left err
err -> forall a b. a -> Either a b
Left err
err forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
initialState
{-# inline distribEither #-}

-- | Convert a bare interpreter for @eff@, which (potentially) uses 'Stop' to signal errors, into an interpreter for
-- 'Resumable'.
-- /Beware/: This will display unsound behaviour if:
-- * the interpreter is wrapped with actions of another effect, as in:
--
--   @
--   interpretEff :: InterpreterFor Eff r
--   ...
--
--   interpretEffResumable :: InterpreterFor (Resumable Text Eff) r
--   interpretEffResumable sem =
--   resumable (interpretEff (sem `finally` releaseResources))
--   @
--
--   In this case, @releaseResources@ will be called after /every/ use of @Eff@ in @sem@, not after the entire thunk.
--
-- * the interpreter of a higher-order effect uses a different interpreter after using @runT@/@bindT@.
--   In this case, it will use the original interpreter instead.
--
-- If your use case matches one of these conditions, you'll need to use 'interpretResumable'.
--
-- >>> run $ resumable interpretStopper (interpretResumer mainProgram)
-- 237
resumable ::
  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .
  InterpreterFor eff (Stop err : r) ->
  InterpreterFor (Resumable err eff) r
resumable :: forall err (eff :: Effect) (r :: EffectRow).
InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable err eff) r
resumable InterpreterFor eff (Stop err : r)
interpreter (Sem forall (m :: * -> *).
Monad m =>
(forall x.
 Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
 -> m x)
-> m a
m) =
  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 (m :: * -> *).
Monad m =>
(forall x.
 Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
 -> m x)
-> m a
m \ Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
u ->
    case forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp (forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall err (eff :: Effect) (r :: EffectRow).
InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable err eff) r
resumable InterpreterFor eff (Stop err : r)
interpreter) Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
u) of
      Right (Weaving (Resumable Weaving eff (Sem r) a1
e) f ()
s forall x. f (Sem rInitial x) -> Sem r (f x)
wv f a -> x
ex forall x. f x -> Maybe x
ins) ->
        forall (f :: * -> *) err a res.
Functor f =>
f () -> (f (Either err a) -> res) -> Either err (f a) -> res
distribEither f ()
s f a -> x
ex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem r (Either err (f a1))
resultFromEff forall x. Union r (Sem r) x -> m x
k
        where
          resultFromEff :: Sem r (Either err (f a1))
resultFromEff =
            forall err (r :: EffectRow) a.
Sem (Stop err : r) a -> Sem r (Either err a)
runStop forall a b. (a -> b) -> a -> b
$ InterpreterFor eff (Stop err : r)
interpreter forall a b. (a -> b) -> a -> b
$ forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) (n :: * -> *) (m :: * -> *) (r :: EffectRow)
       a.
(Functor s, Functor n) =>
s ()
-> (forall x. s (m x) -> n (s x))
-> (forall x. s x -> Maybe x)
-> Union r m a
-> Union r n (s a)
weave f ()
s (forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem r (f x)
wv) forall x. f x -> Maybe x
ins (forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving Weaving eff (Sem r) a1
e)
      Left Union r (Sem r) x
g ->
        forall x. Union r (Sem r) x -> m x
k Union r (Sem r) x
g
{-# inline resumable #-}

-- | Convenience combinator for turning an interpreter that doesn't use 'Stop' into a 'Resumable'.
raiseResumable ::
  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .
  InterpreterTrans (Resumable err eff) eff r
raiseResumable :: forall err (eff :: Effect) (r :: EffectRow).
InterpreterTrans (Resumable err eff) eff r
raiseResumable Sem (eff : r) a -> Sem r b
interpreter =
  Sem (eff : r) a -> Sem r b
interpreter forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpreterFor (Resumable err eff) (eff : r)
normalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder
  where
    normalize :: InterpreterFor (Resumable err eff) (eff : r)
    normalize :: InterpreterFor (Resumable err eff) (eff : r)
normalize (Sem forall (m :: * -> *).
Monad m =>
(forall x.
 Union
   (Resumable err eff : eff : r) (Sem (Resumable err eff : eff : r)) x
 -> m x)
-> m a
m) =
      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 (eff : r) (Sem (eff : r)) x -> m x
k -> forall (m :: * -> *).
Monad m =>
(forall x.
 Union
   (Resumable err eff : eff : r) (Sem (Resumable err eff : eff : r)) x
 -> m x)
-> m a
m \ Union
  (Resumable err eff : eff : r) (Sem (Resumable err eff : eff : r)) x
u ->
        case forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp (forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist InterpreterFor (Resumable err eff) (eff : r)
normalize Union
  (Resumable err eff : eff : r) (Sem (Resumable err eff : eff : r)) x
u) of
          Right (Weaving (Resumable Weaving eff (Sem r) a1
e) f ()
s forall x. f (Sem rInitial x) -> Sem (eff : r) (f x)
wv f a -> x
ex forall x. f x -> Maybe x
ins) ->
            f a -> x
ex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) (r :: EffectRow) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall x. Union (eff : r) (Sem (eff : r)) x -> m x
k forall a b. (a -> b) -> a -> b
$ forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) (n :: * -> *) (m :: * -> *) (r :: EffectRow)
       a.
(Functor s, Functor n) =>
s ()
-> (forall x. s (m x) -> n (s x))
-> (forall x. s x -> Maybe x)
-> Union r m a
-> Union r n (s a)
weave f ()
s forall x. f (Sem rInitial x) -> Sem (eff : r) (f x)
wv forall x. f x -> Maybe x
ins (forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving Weaving eff (Sem r) a1
e))
          Left Union (eff : r) (Sem (eff : r)) x
g ->
            forall x. Union (eff : r) (Sem (eff : r)) x -> m x
k Union (eff : r) (Sem (eff : r)) x
g
    {-# inline normalize #-}
{-# inline raiseResumable #-}

-- | Like 'resumable', but use exceptions instead of 'Control.Monad.Trans.ExceptT'.
resumableIO ::
  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .
  Exception (StopExc err) =>
  Member (Final IO) r =>
  InterpreterFor eff (Stop err : r) ->
  InterpreterFor (Resumable err eff) r
resumableIO :: forall err (eff :: Effect) (r :: EffectRow).
(Exception (StopExc err), Member (Final IO) r) =>
InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable err eff) r
resumableIO InterpreterFor eff (Stop err : r)
interpreter (Sem forall (m :: * -> *).
Monad m =>
(forall x.
 Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
 -> m x)
-> m a
m) =
  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 (m :: * -> *).
Monad m =>
(forall x.
 Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
 -> m x)
-> m a
m \ Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
u ->
    case forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp (forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall err (eff :: Effect) (r :: EffectRow).
InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable err eff) r
resumable InterpreterFor eff (Stop err : r)
interpreter) Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
u) of
      Right (Weaving (Resumable Weaving eff (Sem r) a1
e) f ()
s forall x. f (Sem rInitial x) -> Sem r (f x)
wv f a -> x
ex forall x. f x -> Maybe x
ins) ->
        forall (f :: * -> *) err a res.
Functor f =>
f () -> (f (Either err a) -> res) -> Either err (f a) -> res
distribEither f ()
s f a -> x
ex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem r (Either err (f a1))
resultFromEff forall x. Union r (Sem r) x -> m x
k
        where
          resultFromEff :: Sem r (Either err (f a1))
resultFromEff =
            forall err (r :: EffectRow) a.
(Exception (StopExc err), Member (Final IO) r) =>
Sem (Stop err : r) a -> Sem r (Either err a)
stopToIOFinal forall a b. (a -> b) -> a -> b
$ InterpreterFor eff (Stop err : r)
interpreter forall a b. (a -> b) -> a -> b
$ forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) (n :: * -> *) (m :: * -> *) (r :: EffectRow)
       a.
(Functor s, Functor n) =>
s ()
-> (forall x. s (m x) -> n (s x))
-> (forall x. s x -> Maybe x)
-> Union r m a
-> Union r n (s a)
weave f ()
s (forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem r (f x)
wv) forall x. f x -> Maybe x
ins (forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving Weaving eff (Sem r) a1
e)
      Left Union r (Sem r) x
g ->
        forall x. Union r (Sem r) x -> m x
k Union r (Sem r) x
g
{-# inline resumableIO #-}

-- | Like 'interpretResumable', but for higher-order effects.
interpretResumableH ::
  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) .
  -- | This handler function has @'Stop' err@ in its stack, allowing it to absorb errors.
  (∀ x r0 . eff (Sem r0) x -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x) ->
  InterpreterFor (Resumable err eff) r
interpretResumableH :: forall err (eff :: Effect) (r :: EffectRow).
(forall x (r0 :: EffectRow).
 eff (Sem r0) x
 -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumableH forall x (r0 :: EffectRow).
eff (Sem r0) x
-> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x
handler (Sem forall (m :: * -> *).
Monad m =>
(forall x.
 Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
 -> m x)
-> m a
m) =
  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 (m :: * -> *).
Monad m =>
(forall x.
 Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
 -> m x)
-> m a
m \ Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
u ->
    case forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
u of
      Left Union r (Sem (Resumable err eff : r)) x
there ->
        forall x. Union r (Sem r) x -> m x
k (forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall err (eff :: Effect) (r :: EffectRow).
(forall x (r0 :: EffectRow).
 eff (Sem r0) x
 -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumableH forall x (r0 :: EffectRow).
eff (Sem r0) x
-> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x
handler) Union r (Sem (Resumable err eff : r)) x
there)
      Right (Weaving (Resumable (Weaving eff (Sem rInitial) a
e f ()
s forall x. f (Sem rInitial x) -> Sem r (f x)
dist f a -> a1
ex forall x. f x -> Maybe x
ins)) f ()
sOuter forall x. f (Sem rInitial x) -> Sem (Resumable err eff : r) (f x)
distOuter f a -> x
exOuter forall x. f x -> Maybe x
insOuter) ->
        forall (m :: * -> *) (r :: EffectRow) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall x. Union r (Sem r) x -> m x
k (Either err (Compose f f a) -> x
exFinal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall err (r :: EffectRow) a.
Sem (Stop err : r) a -> Sem r (Either err a)
runStop (Sem
  (Tactics
     (Compose f f) (Sem rInitial) (Resumable err eff : Stop err : r)
     : Stop err : r)
  (Compose f f a)
-> Sem (Stop err : r) (Compose f f a)
tac (forall x (r0 :: EffectRow).
eff (Sem r0) x
-> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x
handler eff (Sem rInitial) a
e)))
        where
          tac :: Sem
  (Tactics
     (Compose f f) (Sem rInitial) (Resumable err eff : Stop err : r)
     : Stop err : r)
  (Compose f f a)
-> Sem (Stop err : r) (Compose f f a)
tac =
            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
            (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f ()
s forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
sOuter))
            (forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem (Resumable err eff : r) (f x)
distOuter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall x. f (Sem rInitial x) -> Sem r (f x)
dist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)
            (forall x. f x -> Maybe x
ins forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall x. f x -> Maybe x
insOuter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)
            (forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall err (eff :: Effect) (r :: EffectRow).
(forall x (r0 :: EffectRow).
 eff (Sem r0) x
 -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumableH forall x (r0 :: EffectRow).
eff (Sem r0) x
-> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x
handler forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem (Resumable err eff : r) (f x)
distOuter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall x. f (Sem rInitial x) -> Sem r (f x)
dist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)
          exFinal :: Either err (Compose f f a) -> x
exFinal = f a -> x
exOuter forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            Right (Compose f (f a)
a) -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> a1
ex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f a)
a
            Left err
err -> forall a b. a -> Either a b
Left err
err forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
sOuter
{-# inline interpretResumableH #-}

-- | Create an interpreter for @'Resumable' err eff@ by supplying a handler function for @eff@, analogous to
-- 'Polysemy.interpret'.
-- If the handler throws errors with 'Stop', they will be absorbed into 'Resumable', to be caught by
-- 'Polysemy.Resume.resume' in a downstream interpreter.
--
-- @
-- interpretStopperResumable ::
--   InterpreterFor Stopper r
-- interpretStopperResumable =
--   interpretResumable \\case
--     StopBang -> stop (Bang 13)
--     StopBoom -> stop (Boom "ouch")
-- @
--
-- >>> run $ interpretStopperResumable (interpretResumer mainProgram)
-- 237
interpretResumable ::
  ∀ (err :: Type) (eff :: Effect) r .
  FirstOrder eff "interpretResumable" =>
  (∀ x r0 . eff (Sem r0) x -> Sem (Stop err : r) x) ->
  InterpreterFor (Resumable err eff) r
interpretResumable :: forall err (eff :: Effect) (r :: EffectRow).
FirstOrder eff "interpretResumable" =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumable forall x (r0 :: EffectRow). eff (Sem r0) x -> Sem (Stop err : r) x
handler =
  forall err (eff :: Effect) (r :: EffectRow).
(forall x (r0 :: EffectRow).
 eff (Sem r0) x
 -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
interpretResumableH \ eff (Sem r0) x
e -> forall (m :: * -> *) (f :: * -> *) (r :: EffectRow) (e :: Effect)
       a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT (forall x (r0 :: EffectRow). eff (Sem r0) x -> Sem (Stop err : r) x
handler eff (Sem r0) x
e)
{-# inline interpretResumable #-}

-- | Interceptor variant of 'interpretResumableH'.
interceptResumableUsingH ::
  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type) .
  ElemOf (Resumable err eff) r ->
  (∀ x r0 . eff (Sem r0) x -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x) ->
  Sem r a ->
  Sem r a
interceptResumableUsingH :: forall err (eff :: Effect) (r :: EffectRow) a.
ElemOf (Resumable err eff) r
-> (forall x (r0 :: EffectRow).
    eff (Sem r0) x
    -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> Sem r a
-> Sem r a
interceptResumableUsingH ElemOf (Resumable err eff) r
proof forall x (r0 :: EffectRow).
eff (Sem r0) x
-> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x
handler (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> m a
m) =
  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 (m :: * -> *).
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> m a
m \ Union r (Sem r) x
u ->
    case forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
ElemOf e r -> Union r m a -> Maybe (Weaving e m a)
prjUsing ElemOf (Resumable err eff) r
proof Union r (Sem r) x
u of
      Maybe (Weaving (Resumable err eff) (Sem r) x)
Nothing ->
        forall x. Union r (Sem r) x -> m x
k (forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall err (eff :: Effect) (r :: EffectRow) a.
ElemOf (Resumable err eff) r
-> (forall x (r0 :: EffectRow).
    eff (Sem r0) x
    -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> Sem r a
-> Sem r a
interceptResumableUsingH ElemOf (Resumable err eff) r
proof forall x (r0 :: EffectRow).
eff (Sem r0) x
-> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x
handler) Union r (Sem r) x
u)
      Just (Weaving (Resumable (Weaving eff (Sem rInitial) a
e f ()
s forall x. f (Sem rInitial x) -> Sem r (f x)
dist f a -> a1
ex forall x. f x -> Maybe x
ins)) f ()
sOuter forall x. f (Sem rInitial x) -> Sem r (f x)
distOuter f a -> x
exOuter forall x. f x -> Maybe x
insOuter) ->
        forall (m :: * -> *) (r :: EffectRow) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall x. Union r (Sem r) x -> m x
k (Either err (Compose f f a) -> x
exFinal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall err (r :: EffectRow) a.
Sem (Stop err : r) a -> Sem r (Either err a)
runStop (Sem
  (Tactics
     (Compose f f) (Sem rInitial) (Resumable err eff : Stop err : r)
     : Stop err : r)
  (Compose f f a)
-> Sem (Stop err : r) (Compose f f a)
tac (forall x (r0 :: EffectRow).
eff (Sem r0) x
-> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x
handler eff (Sem rInitial) a
e)))
        where
          tac :: Sem
  (Tactics
     (Compose f f) (Sem rInitial) (Resumable err eff : Stop err : r)
     : Stop err : r)
  (Compose f f a)
-> Sem (Stop err : r) (Compose f f a)
tac =
            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
            (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f ()
s forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
sOuter))
            (forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem r (f x)
distOuter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall x. f (Sem rInitial x) -> Sem r (f x)
dist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)
            (forall x. f x -> Maybe x
ins forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall x. f x -> Maybe x
insOuter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)
            (forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall err (eff :: Effect) (r :: EffectRow) a.
ElemOf (Resumable err eff) r
-> (forall x (r0 :: EffectRow).
    eff (Sem r0) x
    -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> Sem r a
-> Sem r a
interceptResumableUsingH ElemOf (Resumable err eff) r
proof forall x (r0 :: EffectRow).
eff (Sem r0) x
-> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x
handler forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem r (f x)
distOuter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall x. f (Sem rInitial x) -> Sem r (f x)
dist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)
          exFinal :: Either err (Compose f f a) -> x
exFinal = f a -> x
exOuter forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            Right (Compose f (f a)
a) -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> a1
ex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f a)
a
            Left err
err -> forall a b. a -> Either a b
Left err
err forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
sOuter
{-# inline interceptResumableUsingH #-}

-- | Interceptor variant of 'interpretResumable'.
interceptResumableUsing ::
  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type) .
  FirstOrder eff "interceptResumableUsing" =>
  ElemOf (Resumable err eff) r ->
  (∀ x r0 . eff (Sem r0) x -> Sem (Stop err : r) x) ->
  Sem r a ->
  Sem r a
interceptResumableUsing :: forall err (eff :: Effect) (r :: EffectRow) a.
FirstOrder eff "interceptResumableUsing" =>
ElemOf (Resumable err eff) r
-> (forall x (r0 :: EffectRow).
    eff (Sem r0) x -> Sem (Stop err : r) x)
-> Sem r a
-> Sem r a
interceptResumableUsing ElemOf (Resumable err eff) r
proof forall x (r0 :: EffectRow). eff (Sem r0) x -> Sem (Stop err : r) x
f =
  forall err (eff :: Effect) (r :: EffectRow) a.
ElemOf (Resumable err eff) r
-> (forall x (r0 :: EffectRow).
    eff (Sem r0) x
    -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> Sem r a
-> Sem r a
interceptResumableUsingH ElemOf (Resumable err eff) r
proof \ eff (Sem r0) x
e ->
    forall (m :: * -> *) (f :: * -> *) (r :: EffectRow) (e :: Effect)
       a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT (forall x (r0 :: EffectRow). eff (Sem r0) x -> Sem (Stop err : r) x
f eff (Sem r0) x
e)
{-# inline interceptResumableUsing #-}

-- | Interceptor variant of 'interpretResumableH'.
interceptResumableH ::
  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type) .
  Member (Resumable err eff) r =>
  (∀ x r0 . eff (Sem r0) x -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x) ->
  Sem r a ->
  Sem r a
interceptResumableH :: forall err (eff :: Effect) (r :: EffectRow) a.
Member (Resumable err eff) r =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x
 -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> Sem r a -> Sem r a
interceptResumableH =
  forall err (eff :: Effect) (r :: EffectRow) a.
ElemOf (Resumable err eff) r
-> (forall x (r0 :: EffectRow).
    eff (Sem r0) x
    -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> Sem r a
-> Sem r a
interceptResumableUsingH forall (e :: Effect) (r :: EffectRow). Member e r => ElemOf e r
membership
{-# inline interceptResumableH #-}

-- | Interceptor variant of 'interpretResumable'.
interceptResumable ::
  ∀ (err :: Type) (eff :: Effect) (r :: EffectRow) (a :: Type) .
  Member (Resumable err eff) r =>
  FirstOrder eff "interceptResumable" =>
  (∀ x r0 . eff (Sem r0) x -> Sem (Stop err : r) x) ->
  Sem r a ->
  Sem r a
interceptResumable :: forall err (eff :: Effect) (r :: EffectRow) a.
(Member (Resumable err eff) r,
 FirstOrder eff "interceptResumable") =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x -> Sem (Stop err : r) x)
-> Sem r a -> Sem r a
interceptResumable forall x (r0 :: EffectRow). eff (Sem r0) x -> Sem (Stop err : r) x
f =
  forall err (eff :: Effect) (r :: EffectRow) a.
Member (Resumable err eff) r =>
(forall x (r0 :: EffectRow).
 eff (Sem r0) x
 -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> Sem r a -> Sem r a
interceptResumableH \ eff (Sem r0) x
e ->
    forall (m :: * -> *) (f :: * -> *) (r :: EffectRow) (e :: Effect)
       a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT (forall x (r0 :: EffectRow). eff (Sem r0) x -> Sem (Stop err : r) x
f eff (Sem r0) x
e)
{-# inline interceptResumable #-}

-- | Convert an interpreter for @eff@ that uses 'Error' into one using 'Stop' and wrap it using 'resumable'.
resumableError ::
  ∀ (err :: Type) (eff :: Effect) r .
  InterpreterFor eff (Error err : Stop err : r) ->
  InterpreterFor (Resumable err eff) r
resumableError :: forall err (eff :: Effect) (r :: EffectRow).
InterpreterFor eff (Error err : Stop err : r)
-> InterpreterFor (Resumable err eff) r
resumableError InterpreterFor eff (Error err : Stop err : r)
interpreter =
  forall err (eff :: Effect) (r :: EffectRow).
InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable err eff) r
resumable (forall err (r :: EffectRow) a.
Member (Stop err) r =>
Sem (Error err : r) a -> Sem r a
stopOnError forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpreterFor eff (Error err : Stop err : r)
interpreter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder)
{-# inline resumableError #-}

-- | Convert an interpreter for @eff@ that throws errors of type @err@ into a @Resumable@, but limiting the errors
-- handled by consumers to the type @handled@, which rethrowing 'Error's of type @unhandled@.
--
-- The function @canHandle@ determines how the errors are split.
--
-- @
-- newtype Blip =
--   Blip { unBlip :: Int }
--   deriving (Eq, Show)
--
-- bangOnly :: Boom -> Either Text Blip
-- bangOnly = \\case
--   Bang n -> Right (Blip n)
--   Boom msg -> Left msg
--
-- interpretResumerPartial ::
--   Member (Resumable Blip Stopper) r =>
--   InterpreterFor Resumer r
-- interpretResumerPartial =
--   interpret \\ MainProgram ->
--     resume (192 \<$ stopBang) \\ (Blip num) ->
--       pure (num * 3)
-- @
--
-- >>> runError (resumableFor bangOnly interpretStopper (interpretResumerPartial mainProgram))
-- Right 39
resumableOr ::
  ∀ (err :: Type) (eff :: Effect) unhandled handled r .
  Member (Error unhandled) r =>
  (err -> Either unhandled handled) ->
  InterpreterFor eff (Stop err : r) ->
  InterpreterFor (Resumable handled eff) r
resumableOr :: forall err (eff :: Effect) unhandled handled (r :: EffectRow).
Member (Error unhandled) r =>
(err -> Either unhandled handled)
-> InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable handled eff) r
resumableOr err -> Either unhandled handled
canHandle InterpreterFor eff (Stop err : r)
interpreter (Sem forall (m :: * -> *).
Monad m =>
(forall x.
 Union
   (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
 -> m x)
-> m a
m) =
  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 (m :: * -> *).
Monad m =>
(forall x.
 Union
   (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
 -> m x)
-> m a
m \ Union
  (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
u ->
    case forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp (forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall err (eff :: Effect) unhandled handled (r :: EffectRow).
Member (Error unhandled) r =>
(err -> Either unhandled handled)
-> InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable handled eff) r
resumableOr err -> Either unhandled handled
canHandle InterpreterFor eff (Stop err : r)
interpreter) Union
  (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
u) of
      Right (Weaving (Resumable Weaving eff (Sem r) a1
e) f ()
s forall x. f (Sem rInitial x) -> Sem r (f x)
wv f a -> x
ex forall x. f x -> Maybe x
ins) ->
        forall (f :: * -> *) err a res.
Functor f =>
f () -> (f (Either err a) -> res) -> Either err (f a) -> res
distribEither f ()
s f a -> x
ex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either err (f a1) -> m (Either handled (f a1))
tryHandle forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem r (Either err (f a1))
resultFromEff forall x. Union r (Sem r) x -> m x
k)
        where
          tryHandle :: Either err (f a1) -> m (Either handled (f a1))
tryHandle = \case
            Left err
err ->
              forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall x. Union r (Sem r) x -> m x
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: Effect) (r :: EffectRow) (rInitial :: EffectRow) a.
Member e r =>
e (Sem rInitial) a -> Union r (Sem rInitial) a
inj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} e (m :: k -> *) (a :: k). e -> Error e m a
Throw) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (err -> Either unhandled handled
canHandle err
err)
            Right f a1
a ->
              forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right f a1
a)
          resultFromEff :: Sem r (Either err (f a1))
resultFromEff =
            forall err (r :: EffectRow) a.
Sem (Stop err : r) a -> Sem r (Either err a)
runStop forall a b. (a -> b) -> a -> b
$ InterpreterFor eff (Stop err : r)
interpreter forall a b. (a -> b) -> a -> b
$ forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) (n :: * -> *) (m :: * -> *) (r :: EffectRow)
       a.
(Functor s, Functor n) =>
s ()
-> (forall x. s (m x) -> n (s x))
-> (forall x. s x -> Maybe x)
-> Union r m a
-> Union r n (s a)
weave f ()
s (forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem r (f x)
wv) forall x. f x -> Maybe x
ins (forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving Weaving eff (Sem r) a1
e)
      Left Union r (Sem r) x
g ->
        forall x. Union r (Sem r) x -> m x
k Union r (Sem r) x
g
{-# inline resumableOr #-}

-- | Variant of 'resumableOr' that uses 'Maybe' and rethrows the original error.
resumableFor ::
  ∀ (err :: Type) (eff :: Effect) handled r .
  Member (Error err) r =>
  (err -> Maybe handled) ->
  InterpreterFor eff (Stop err : r) ->
  InterpreterFor (Resumable handled eff) r
resumableFor :: forall err (eff :: Effect) handled (r :: EffectRow).
Member (Error err) r =>
(err -> Maybe handled)
-> InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable handled eff) r
resumableFor err -> Maybe handled
canHandle =
  forall err (eff :: Effect) unhandled handled (r :: EffectRow).
Member (Error unhandled) r =>
(err -> Either unhandled handled)
-> InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable handled eff) r
resumableOr err -> Either err handled
canHandle'
  where
    canHandle' :: err -> Either err handled
canHandle' err
err =
      forall l r. l -> Maybe r -> Either l r
maybeToRight err
err (err -> Maybe handled
canHandle err
err)
{-# inline resumableFor #-}

-- | Reinterpreting variant of 'resumableFor'.
catchResumable ::
  ∀ (err :: Type) (eff :: Effect) handled r .
  Members [eff, Error err] r =>
  (err -> Maybe handled) ->
  InterpreterFor (Resumable handled eff) r
catchResumable :: forall err (eff :: Effect) handled (r :: EffectRow).
Members '[eff, Error err] r =>
(err -> Maybe handled) -> InterpreterFor (Resumable handled eff) r
catchResumable err -> Maybe handled
canHandle (Sem forall (m :: * -> *).
Monad m =>
(forall x.
 Union
   (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
 -> m x)
-> m a
m) =
  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 (m :: * -> *).
Monad m =>
(forall x.
 Union
   (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
 -> m x)
-> m a
m \ Union
  (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
u ->
    case forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp (forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall err (eff :: Effect) handled (r :: EffectRow).
Members '[eff, Error err] r =>
(err -> Maybe handled) -> InterpreterFor (Resumable handled eff) r
catchResumable err -> Maybe handled
canHandle) Union
  (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
u) of
      Right (Weaving (Resumable Weaving eff (Sem r) a1
e) f ()
s forall x. f (Sem rInitial x) -> Sem r (f x)
wv f a -> x
ex forall x. f x -> Maybe x
ins) ->
        forall (f :: * -> *) err a res.
Functor f =>
f () -> (f (Either err a) -> res) -> Either err (f a) -> res
distribEither f ()
s f a -> x
ex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem r (Either handled (f a1))
resultFromEff forall x. Union r (Sem r) x -> m x
k
        where
          resultFromEff :: Sem r (Either handled (f a1))
resultFromEff =
            forall e (r :: EffectRow) b a.
Member (Error e) r =>
(e -> Maybe b) -> Sem r a -> (b -> Sem r a) -> Sem r a
catchJust err -> Maybe handled
canHandle (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) (n :: * -> *) (m :: * -> *) (r :: EffectRow)
       a.
(Functor s, Functor n) =>
s ()
-> (forall x. s (m x) -> n (s x))
-> (forall x. s x -> Maybe x)
-> Union r m a
-> Union r n (s a)
weave f ()
s forall x. f (Sem rInitial x) -> Sem r (f x)
wv forall x. f x -> Maybe x
ins (forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving Weaving eff (Sem r) a1
e)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
      Left Union r (Sem r) x
g ->
        forall x. Union r (Sem r) x -> m x
k Union r (Sem r) x
g
{-# inline catchResumable #-}

-- | Interpret an effect @eff@ by wrapping it in @Resumable@ and @Stop@ and leaving the rest up to the user.
runAsResumable ::
  ∀ (err :: Type) (eff :: Effect) r .
  Members [Resumable err eff, Stop err] r =>
  InterpreterFor eff r
runAsResumable :: forall err (eff :: Effect) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
runAsResumable (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union (eff : r) (Sem (eff : r)) x -> m x) -> m a
m) =
  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 (m :: * -> *).
Monad m =>
(forall x. Union (eff : r) (Sem (eff : r)) x -> m x) -> m a
m \ Union (eff : r) (Sem (eff : r)) x
u ->
    case forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp (forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist (forall err (eff :: Effect) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
runAsResumable @err @eff) Union (eff : r) (Sem (eff : r)) x
u) of
      Right Weaving eff (Sem r) x
wav ->
        forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (r :: EffectRow) a. Member (Stop e) r => e -> Sem r a
stop @err) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (e :: Effect) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send (forall err (eff :: Effect) (r :: EffectRow) a1.
Weaving eff (Sem r) a1 -> Resumable err eff (Sem r) (Either err a1)
Resumable Weaving eff (Sem r) x
wav)) forall x. Union r (Sem r) x -> m x
k
      Left Union r (Sem r) x
g ->
        forall x. Union r (Sem r) x -> m x
k Union r (Sem r) x
g
{-# inline runAsResumable #-}