module Polysemy.Resume.Resumable where

import Polysemy (Final, Tactical)
import Polysemy.Error (Error (Throw), catchJust)
import Polysemy.Internal (Sem (Sem, runSem), liftSem, raise, raiseUnder, send, usingSem)
import Polysemy.Internal.CustomErrors (FirstOrder)
import Polysemy.Internal.Tactics (liftT, runTactics)
import Polysemy.Internal.Union (Weaving (Weaving), decomp, hoist, inj, injWeaving, weave)

import Polysemy.Resume.Data.Resumable (Resumable (..))
import Polysemy.Resume.Data.Stop (Stop, stop)
import Polysemy.Resume.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 :: 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 (f (Either err a) -> res)
-> (Either err (f a) -> f (Either err a))
-> Either err (f a)
-> res
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Right f a
fa -> a -> Either err a
forall a b. b -> Either a b
Right (a -> Either err a) -> f a -> f (Either err a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa
    Left err
err -> err -> Either err a
forall a b. a -> Either a b
Left err
err Either err a -> f () -> f (Either err a)
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:
--
--   @
--   interpretEffResumable :: 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 :: 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 (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 (Resumable err eff : r) (Sem (Resumable err eff : r)) x
 -> m x)
-> m a
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 Union (Resumable err eff : r) (Sem r) x
-> Either
     (Union r (Sem r) x) (Weaving (Resumable err eff) (Sem r) x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp (InterpreterFor (Resumable err eff) r
-> Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
-> Union (Resumable err eff : 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 (InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable err eff) r
forall err (eff :: (* -> *) -> * -> *) (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) a
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) ->
        f () -> (f (Either err a) -> x) -> Either err (f a) -> x
forall (f :: * -> *) err a res.
Functor f =>
f () -> (f (Either err a) -> res) -> Either err (f a) -> res
distribEither f ()
s f a -> x
f (Either err a) -> x
ex (Either err (f a) -> x) -> m (Either err (f a)) -> m x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r (Either err (f a))
-> (forall x. Union r (Sem r) x -> m x) -> m (Either err (f 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 r (Either err (f a))
resultFromEff forall x. Union r (Sem r) x -> m x
k
        where
          resultFromEff :: Sem r (Either err (f a))
resultFromEff =
            Sem (Stop err : r) (f a) -> Sem r (Either err (f a))
forall e (r :: EffectRow) a.
Sem (Stop e : r) a -> Sem r (Either e a)
runStop (Sem (Stop err : r) (f a) -> Sem r (Either err (f a)))
-> Sem (Stop err : r) (f a) -> Sem r (Either err (f a))
forall a b. (a -> b) -> a -> b
$ Sem (eff : Stop err : r) (f a) -> Sem (Stop err : r) (f a)
InterpreterFor eff (Stop err : r)
interpreter (Sem (eff : Stop err : r) (f a) -> Sem (Stop err : r) (f a))
-> Sem (eff : Stop err : r) (f a) -> Sem (Stop err : r) (f a)
forall a b. (a -> b) -> a -> b
$ Union (eff : Stop err : r) (Sem (eff : Stop err : r)) (f a)
-> Sem (eff : Stop err : r) (f a)
forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem (Union (eff : Stop err : r) (Sem (eff : Stop err : r)) (f a)
 -> Sem (eff : Stop err : r) (f a))
-> Union (eff : Stop err : r) (Sem (eff : Stop err : r)) (f a)
-> Sem (eff : Stop err : r) (f a)
forall a b. (a -> b) -> a -> b
$ f ()
-> (forall x. f (Sem r x) -> Sem (eff : Stop err : r) (f x))
-> (forall x. f x -> Maybe x)
-> Union (eff : Stop err : r) (Sem r) a
-> Union (eff : Stop err : r) (Sem (eff : Stop err : r)) (f a)
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 (Sem (Stop err : r) (f x) -> Sem (eff : Stop err : r) (f x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem (Stop err : r) (f x) -> Sem (eff : Stop err : r) (f x))
-> (f (Sem rInitial x) -> Sem (Stop err : r) (f x))
-> f (Sem rInitial x)
-> Sem (eff : Stop err : r) (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r (f x) -> Sem (Stop err : r) (f x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem r (f x) -> Sem (Stop err : r) (f x))
-> (f (Sem rInitial x) -> Sem r (f x))
-> f (Sem rInitial x)
-> Sem (Stop err : r) (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Sem rInitial x) -> Sem r (f x)
forall x. f (Sem rInitial x) -> Sem r (f x)
wv) forall x. f x -> Maybe x
ins (Weaving eff (Sem r) a -> Union (eff : Stop err : r) (Sem r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving Weaving eff (Sem r) a
e)
      Left Union r (Sem 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
g
  -- where
  --   int =
  --     runSem . interpreter
{-# 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 :: (Sem (eff : r) a -> Sem r b)
-> Sem (Resumable err eff : r) a -> Sem r b
raiseResumable Sem (eff : r) a -> Sem r b
interpreter =
  Sem (eff : r) a -> Sem r b
interpreter (Sem (eff : r) a -> Sem r b)
-> (Sem (Resumable err eff : r) a -> Sem (eff : r) a)
-> Sem (Resumable err eff : r) a
-> Sem r b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Resumable err eff : eff : r) a -> Sem (eff : r) a
InterpreterFor (Resumable err eff) (eff : r)
normalize (Sem (Resumable err eff : eff : r) a -> Sem (eff : r) a)
-> (Sem (Resumable err eff : r) a
    -> Sem (Resumable err eff : eff : r) a)
-> Sem (Resumable err eff : r) a
-> Sem (eff : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Resumable err eff : r) a
-> Sem (Resumable err eff : eff : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder
  where
    normalize :: InterpreterFor (Resumable err eff) (eff : r)
    normalize :: Sem (Resumable err eff : eff : r) a -> Sem (eff : r) a
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 (m :: * -> *).
 Monad m =>
 (forall x. Union (eff : r) (Sem (eff : r)) x -> m x) -> m a)
-> Sem (eff : 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 (eff : r) (Sem (eff : r)) x -> m x
k -> (forall x.
 Union
   (Resumable err eff : eff : r) (Sem (Resumable err eff : eff : r)) x
 -> m x)
-> m a
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 Union (Resumable err eff : eff : r) (Sem (eff : r)) x
-> Either
     (Union (eff : r) (Sem (eff : r)) x)
     (Weaving (Resumable err eff) (Sem (eff : r)) x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp (InterpreterFor (Resumable err eff) (eff : r)
-> Union
     (Resumable err eff : eff : r) (Sem (Resumable err eff : eff : r)) x
-> Union (Resumable err eff : eff : r) (Sem (eff : r)) x
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) a
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 (f a -> x) -> (f a -> f a) -> f a -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either err a) -> f a -> f (Either err a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either err a
forall a b. b -> Either a b
Right (f a -> x) -> m (f a) -> m x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((forall x. Union (eff : r) (Sem (eff : r)) x -> m x)
-> Sem (eff : r) (f a) -> m (f a)
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 (Sem (eff : r) (f a) -> m (f a)) -> Sem (eff : r) (f a) -> m (f a)
forall a b. (a -> b) -> a -> b
$ Union (eff : r) (Sem (eff : r)) (f a) -> Sem (eff : r) (f a)
forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem (Union (eff : r) (Sem (eff : r)) (f a) -> Sem (eff : r) (f a))
-> Union (eff : r) (Sem (eff : r)) (f a) -> Sem (eff : r) (f a)
forall a b. (a -> b) -> a -> b
$ f ()
-> (forall x. f (Sem r x) -> Sem (eff : r) (f x))
-> (forall x. f x -> Maybe x)
-> Union (eff : r) (Sem r) a
-> Union (eff : r) (Sem (eff : r)) (f a)
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)
forall x. f (Sem r x) -> Sem (eff : r) (f x)
wv forall x. f x -> Maybe x
ins (Weaving eff (Sem r) a -> Union (eff : r) (Sem r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving Weaving eff (Sem r) a
e))
          Left Union (eff : r) (Sem (eff : r)) x
g ->
            Union (eff : r) (Sem (eff : r)) x -> m x
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 '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 :: 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 (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 (Resumable err eff : r) (Sem (Resumable err eff : r)) x
 -> m x)
-> m a
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 Union (Resumable err eff : r) (Sem r) x
-> Either
     (Union r (Sem r) x) (Weaving (Resumable err eff) (Sem r) x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp (InterpreterFor (Resumable err eff) r
-> Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
-> Union (Resumable err eff : 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 (InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable err eff) r
forall err (eff :: (* -> *) -> * -> *) (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) a
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) ->
        f () -> (f (Either err a) -> x) -> Either err (f a) -> x
forall (f :: * -> *) err a res.
Functor f =>
f () -> (f (Either err a) -> res) -> Either err (f a) -> res
distribEither f ()
s f a -> x
f (Either err a) -> x
ex (Either err (f a) -> x) -> m (Either err (f a)) -> m x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r (Either err (f a))
-> (forall x. Union r (Sem r) x -> m x) -> m (Either err (f 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 r (Either err (f a))
resultFromEff forall x. Union r (Sem r) x -> m x
k
        where
          resultFromEff :: Sem r (Either err (f a))
resultFromEff =
            Sem (Stop err : r) (f a) -> Sem r (Either err (f a))
forall e (r :: EffectRow) a.
(Exception (StopExc e), Member (Final IO) r) =>
Sem (Stop e : r) a -> Sem r (Either e a)
stopToIOFinal (Sem (Stop err : r) (f a) -> Sem r (Either err (f a)))
-> Sem (Stop err : r) (f a) -> Sem r (Either err (f a))
forall a b. (a -> b) -> a -> b
$ Sem (eff : Stop err : r) (f a) -> Sem (Stop err : r) (f a)
InterpreterFor eff (Stop err : r)
interpreter (Sem (eff : Stop err : r) (f a) -> Sem (Stop err : r) (f a))
-> Sem (eff : Stop err : r) (f a) -> Sem (Stop err : r) (f a)
forall a b. (a -> b) -> a -> b
$ Union (eff : Stop err : r) (Sem (eff : Stop err : r)) (f a)
-> Sem (eff : Stop err : r) (f a)
forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem (Union (eff : Stop err : r) (Sem (eff : Stop err : r)) (f a)
 -> Sem (eff : Stop err : r) (f a))
-> Union (eff : Stop err : r) (Sem (eff : Stop err : r)) (f a)
-> Sem (eff : Stop err : r) (f a)
forall a b. (a -> b) -> a -> b
$ f ()
-> (forall x. f (Sem r x) -> Sem (eff : Stop err : r) (f x))
-> (forall x. f x -> Maybe x)
-> Union (eff : Stop err : r) (Sem r) a
-> Union (eff : Stop err : r) (Sem (eff : Stop err : r)) (f a)
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 (Sem (Stop err : r) (f x) -> Sem (eff : Stop err : r) (f x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem (Stop err : r) (f x) -> Sem (eff : Stop err : r) (f x))
-> (f (Sem rInitial x) -> Sem (Stop err : r) (f x))
-> f (Sem rInitial x)
-> Sem (eff : Stop err : r) (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r (f x) -> Sem (Stop err : r) (f x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem r (f x) -> Sem (Stop err : r) (f x))
-> (f (Sem rInitial x) -> Sem r (f x))
-> f (Sem rInitial x)
-> Sem (Stop err : r) (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Sem rInitial x) -> Sem r (f x)
forall x. f (Sem rInitial x) -> Sem r (f x)
wv) forall x. f x -> Maybe x
ins (Weaving eff (Sem r) a -> Union (eff : Stop err : r) (Sem r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving Weaving eff (Sem r) a
e)
      Left Union r (Sem 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
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 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 (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 (Resumable err eff : r) (Sem (Resumable err eff : r)) x
 -> m x)
-> m a
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 Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
-> Either
     (Union r (Sem (Resumable err eff : r)) x)
     (Weaving (Resumable err eff) (Sem (Resumable err eff : r)) x)
forall (e :: (* -> *) -> * -> *) (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 ->
        Union r (Sem r) x -> m x
forall x. Union r (Sem r) x -> m x
k (InterpreterFor (Resumable err eff) r
-> Union r (Sem (Resumable err eff : 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 (r0 :: EffectRow).
 eff (Sem r0) x
 -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
forall err (eff :: (* -> *) -> * -> *) (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 -> a
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 x. Union r (Sem r) x -> m x) -> Sem r x -> m x
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 (Either err (Compose f f a) -> x)
-> Sem r (Either err (Compose f f a)) -> Sem r x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem (Stop err : r) (Compose f f a)
-> Sem r (Either err (Compose f f a))
forall e (r :: EffectRow) a.
Sem (Stop e : r) a -> Sem r (Either e a)
runStop Sem (Stop err : r) (Compose f f a)
tac)
        where
          tac :: Sem (Stop err : r) (Compose f f a)
tac =
            Compose f f ()
-> (forall x.
    Compose f f (Sem rInitial x)
    -> Sem (Resumable err eff : Stop err : r) (Compose f f x))
-> (forall x. Compose f f x -> Maybe x)
-> (forall x.
    Compose f f (Sem rInitial x) -> Sem (Stop err : r) (Compose f f x))
-> 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)
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 (f ()) -> Compose f f ()
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f ()
s f () -> f () -> f (f ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
sOuter))
            (Sem (Resumable err eff : r) (Compose f f x)
-> Sem (Resumable err eff : Stop err : r) (Compose f f x)
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder (Sem (Resumable err eff : r) (Compose f f x)
 -> Sem (Resumable err eff : Stop err : r) (Compose f f x))
-> (Compose f f (Sem rInitial x)
    -> Sem (Resumable err eff : r) (Compose f f x))
-> Compose f f (Sem rInitial x)
-> Sem (Resumable err eff : Stop err : r) (Compose f f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (f x) -> Compose f f x)
-> Sem (Resumable err eff : r) (f (f x))
-> Sem (Resumable err eff : r) (Compose f f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (f x) -> Compose f f x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Sem (Resumable err eff : r) (f (f x))
 -> Sem (Resumable err eff : r) (Compose f f x))
-> (Compose f f (Sem rInitial x)
    -> Sem (Resumable err eff : r) (f (f x)))
-> Compose f f (Sem rInitial x)
-> Sem (Resumable err eff : r) (Compose f f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Sem rInitial (f x)) -> Sem (Resumable err eff : r) (f (f x))
forall x. f (Sem rInitial x) -> Sem (Resumable err eff : r) (f x)
distOuter (f (Sem rInitial (f x)) -> Sem (Resumable err eff : r) (f (f x)))
-> (Compose f f (Sem rInitial x) -> f (Sem rInitial (f x)))
-> Compose f f (Sem rInitial x)
-> Sem (Resumable err eff : r) (f (f x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (Sem rInitial x) -> Sem r (f x))
-> f (f (Sem rInitial x)) -> f (Sem r (f x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (Sem rInitial x) -> Sem r (f x)
forall x. f (Sem rInitial x) -> Sem r (f x)
dist (f (f (Sem rInitial x)) -> f (Sem r (f x)))
-> (Compose f f (Sem rInitial x) -> f (f (Sem rInitial x)))
-> Compose f f (Sem rInitial x)
-> f (Sem r (f x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f f (Sem rInitial x) -> f (f (Sem rInitial x))
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)
            (Maybe (Maybe x) -> Maybe x
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe x) -> Maybe x)
-> (Compose f f x -> Maybe (Maybe x)) -> Compose f f x -> Maybe x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f x -> Maybe x) -> Maybe (f x) -> Maybe (Maybe x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f x -> Maybe x
forall x. f x -> Maybe x
ins (Maybe (f x) -> Maybe (Maybe x))
-> (Compose f f x -> Maybe (f x))
-> Compose f f x
-> Maybe (Maybe x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (f x) -> Maybe (f x)
forall x. f x -> Maybe x
insOuter (f (f x) -> Maybe (f x))
-> (Compose f f x -> f (f x)) -> Compose f f x -> Maybe (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f f x -> f (f x)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)
            (Sem r (Compose f f x) -> Sem (Stop err : r) (Compose f f x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem r (Compose f f x) -> Sem (Stop err : r) (Compose f f x))
-> (Compose f f (Sem rInitial x) -> Sem r (Compose f f x))
-> Compose f f (Sem rInitial x)
-> Sem (Stop err : r) (Compose f f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x (r0 :: EffectRow).
 eff (Sem r0) x
 -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
forall err (eff :: (* -> *) -> * -> *) (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 (Resumable err eff : r) (Compose f f x)
 -> Sem r (Compose f f x))
-> (Compose f f (Sem rInitial x)
    -> Sem (Resumable err eff : r) (Compose f f x))
-> Compose f f (Sem rInitial x)
-> Sem r (Compose f f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (f x) -> Compose f f x)
-> Sem (Resumable err eff : r) (f (f x))
-> Sem (Resumable err eff : r) (Compose f f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (f x) -> Compose f f x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Sem (Resumable err eff : r) (f (f x))
 -> Sem (Resumable err eff : r) (Compose f f x))
-> (Compose f f (Sem rInitial x)
    -> Sem (Resumable err eff : r) (f (f x)))
-> Compose f f (Sem rInitial x)
-> Sem (Resumable err eff : r) (Compose f f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Sem rInitial (f x)) -> Sem (Resumable err eff : r) (f (f x))
forall x. f (Sem rInitial x) -> Sem (Resumable err eff : r) (f x)
distOuter (f (Sem rInitial (f x)) -> Sem (Resumable err eff : r) (f (f x)))
-> (Compose f f (Sem rInitial x) -> f (Sem rInitial (f x)))
-> Compose f f (Sem rInitial x)
-> Sem (Resumable err eff : r) (f (f x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (Sem rInitial x) -> Sem r (f x))
-> f (f (Sem rInitial x)) -> f (Sem r (f x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (Sem rInitial x) -> Sem r (f x)
forall x. f (Sem rInitial x) -> Sem r (f x)
dist (f (f (Sem rInitial x)) -> f (Sem r (f x)))
-> (Compose f f (Sem rInitial x) -> f (f (Sem rInitial x)))
-> Compose f f (Sem rInitial x)
-> f (Sem r (f x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f f (Sem rInitial x) -> f (f (Sem rInitial x))
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)
            (eff (Sem rInitial) a
-> Tactical (Resumable err eff) (Sem rInitial) (Stop err : r) a
forall x (r0 :: EffectRow).
eff (Sem r0) x
-> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x
handler eff (Sem rInitial) a
e)
          exFinal :: Either err (Compose f f a) -> x
exFinal = f a -> x
exOuter (f a -> x)
-> (Either err (Compose f f a) -> f a)
-> Either err (Compose f f a)
-> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            Right (Compose f f a -> f (f a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose -> f (f a)
a) -> a -> Either err a
forall a b. b -> Either a b
Right (a -> Either err a) -> (f a -> a) -> f a -> Either err a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> a
ex (f a -> Either err a) -> f (f a) -> f (Either err a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f a)
a
            Left err
err -> err -> Either err a
forall a b. a -> Either a b
Left err
err Either err a -> f () -> f (Either err a)
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 ::
--   Member (Stop Boom) r =>
--   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 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 x (r0 :: EffectRow).
 eff (Sem r0) x
 -> Tactical (Resumable err eff) (Sem r0) (Stop err : r) x)
-> InterpreterFor (Resumable err eff) r
forall err (eff :: (* -> *) -> * -> *) (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 -> Sem (Stop err : r) x
-> Sem
     (WithTactics (Resumable err eff) f (Sem r0) (Stop err : r)) (f x)
forall (m :: * -> *) (f :: * -> *) (r :: EffectRow)
       (e :: (* -> *) -> * -> *) a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT (eff (Sem r0) x -> Sem (Stop err : r) x
forall x (r0 :: EffectRow). eff (Sem r0) x -> Sem (Stop err : r) x
handler eff (Sem r0) x
e)
{-# inline interpretResumable #-}

-- |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 :: InterpreterFor eff (Error err : Stop err : r)
-> InterpreterFor (Resumable err eff) r
resumableError InterpreterFor eff (Error err : Stop err : r)
interpreter =
  InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable err eff) r
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable err eff) r
resumable (Sem (Error err : Stop err : r) a -> Sem (Stop err : r) a
forall err (r :: EffectRow) a.
Member (Stop err) r =>
Sem (Error err : r) a -> Sem r a
stopOnError (Sem (Error err : Stop err : r) a -> Sem (Stop err : r) a)
-> (Sem (eff : Stop err : r) a -> Sem (Error err : Stop err : r) a)
-> Sem (eff : Stop err : r) a
-> Sem (Stop err : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (eff : Error err : Stop err : r) a
-> Sem (Error err : Stop err : r) a
InterpreterFor eff (Error err : Stop err : r)
interpreter (Sem (eff : Error err : Stop err : r) a
 -> Sem (Error err : Stop err : r) a)
-> (Sem (eff : Stop err : r) a
    -> Sem (eff : Error err : Stop err : r) a)
-> Sem (eff : Stop err : r) a
-> Sem (Error err : Stop err : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (eff : Stop err : r) a
-> Sem (eff : Error err : Stop err : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (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 :: (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 (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
   (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
 -> m x)
-> m a
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 Union (Resumable handled eff : r) (Sem r) x
-> Either
     (Union r (Sem r) x) (Weaving (Resumable handled eff) (Sem r) x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp (InterpreterFor (Resumable handled eff) r
-> Union
     (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
-> Union (Resumable handled eff : 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 ((err -> Either unhandled handled)
-> InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable handled eff) r
forall err (eff :: (* -> *) -> * -> *) 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) a
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) ->
        f () -> (f (Either handled a) -> x) -> Either handled (f a) -> x
forall (f :: * -> *) err a res.
Functor f =>
f () -> (f (Either err a) -> res) -> Either err (f a) -> res
distribEither f ()
s f a -> x
f (Either handled a) -> x
ex (Either handled (f a) -> x) -> m (Either handled (f a)) -> m x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Either err (f a) -> m (Either handled (f a))
tryHandle (Either err (f a) -> m (Either handled (f a)))
-> m (Either err (f a)) -> m (Either handled (f a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem r (Either err (f a))
-> (forall x. Union r (Sem r) x -> m x) -> m (Either err (f 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 r (Either err (f a))
resultFromEff forall x. Union r (Sem r) x -> m x
k)
        where
          tryHandle :: Either err (f a) -> m (Either handled (f a))
tryHandle = \case
            Left err
err ->
              (unhandled -> m (Either handled (f a)))
-> (handled -> m (Either handled (f a)))
-> Either unhandled handled
-> m (Either handled (f a))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Union r (Sem r) (Either handled (f a)) -> m (Either handled (f a))
forall x. Union r (Sem r) x -> m x
k (Union r (Sem r) (Either handled (f a))
 -> m (Either handled (f a)))
-> (unhandled -> Union r (Sem r) (Either handled (f a)))
-> unhandled
-> m (Either handled (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error unhandled (Sem r) (Either handled (f a))
-> Union r (Sem r) (Either handled (f a))
forall (e :: (* -> *) -> * -> *) (r :: EffectRow)
       (rInitial :: EffectRow) a.
Member e r =>
e (Sem rInitial) a -> Union r (Sem rInitial) a
inj (Error unhandled (Sem r) (Either handled (f a))
 -> Union r (Sem r) (Either handled (f a)))
-> (unhandled -> Error unhandled (Sem r) (Either handled (f a)))
-> unhandled
-> Union r (Sem r) (Either handled (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. unhandled -> Error unhandled (Sem r) (Either handled (f a))
forall k e (m :: k -> *) (a :: k). e -> Error e m a
Throw) (Either handled (f a) -> m (Either handled (f a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either handled (f a) -> m (Either handled (f a)))
-> (handled -> Either handled (f a))
-> handled
-> m (Either handled (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. handled -> Either handled (f a)
forall a b. a -> Either a b
Left) (err -> Either unhandled handled
canHandle err
err)
            Right f a
a ->
              Either handled (f a) -> m (Either handled (f a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a -> Either handled (f a)
forall a b. b -> Either a b
Right f a
a)
          resultFromEff :: Sem r (Either err (f a))
resultFromEff =
            Sem (Stop err : r) (f a) -> Sem r (Either err (f a))
forall e (r :: EffectRow) a.
Sem (Stop e : r) a -> Sem r (Either e a)
runStop (Sem (Stop err : r) (f a) -> Sem r (Either err (f a)))
-> Sem (Stop err : r) (f a) -> Sem r (Either err (f a))
forall a b. (a -> b) -> a -> b
$ Sem (eff : Stop err : r) (f a) -> Sem (Stop err : r) (f a)
InterpreterFor eff (Stop err : r)
interpreter (Sem (eff : Stop err : r) (f a) -> Sem (Stop err : r) (f a))
-> Sem (eff : Stop err : r) (f a) -> Sem (Stop err : r) (f a)
forall a b. (a -> b) -> a -> b
$ Union (eff : Stop err : r) (Sem (eff : Stop err : r)) (f a)
-> Sem (eff : Stop err : r) (f a)
forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem (Union (eff : Stop err : r) (Sem (eff : Stop err : r)) (f a)
 -> Sem (eff : Stop err : r) (f a))
-> Union (eff : Stop err : r) (Sem (eff : Stop err : r)) (f a)
-> Sem (eff : Stop err : r) (f a)
forall a b. (a -> b) -> a -> b
$ f ()
-> (forall x. f (Sem r x) -> Sem (eff : Stop err : r) (f x))
-> (forall x. f x -> Maybe x)
-> Union (eff : Stop err : r) (Sem r) a
-> Union (eff : Stop err : r) (Sem (eff : Stop err : r)) (f a)
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 (Sem (Stop err : r) (f x) -> Sem (eff : Stop err : r) (f x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem (Stop err : r) (f x) -> Sem (eff : Stop err : r) (f x))
-> (f (Sem rInitial x) -> Sem (Stop err : r) (f x))
-> f (Sem rInitial x)
-> Sem (eff : Stop err : r) (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem r (f x) -> Sem (Stop err : r) (f x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
raise (Sem r (f x) -> Sem (Stop err : r) (f x))
-> (f (Sem rInitial x) -> Sem r (f x))
-> f (Sem rInitial x)
-> Sem (Stop err : r) (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Sem rInitial x) -> Sem r (f x)
forall x. f (Sem rInitial x) -> Sem r (f x)
wv) forall x. f x -> Maybe x
ins (Weaving eff (Sem r) a -> Union (eff : Stop err : r) (Sem r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving Weaving eff (Sem r) a
e)
      Left Union r (Sem 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
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 :: (err -> Maybe handled)
-> InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable handled eff) r
resumableFor err -> Maybe handled
canHandle =
  (err -> Either err handled)
-> InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable handled eff) r
forall err (eff :: (* -> *) -> * -> *) 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 =
      err -> Maybe handled -> Either err handled
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 :: (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 (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
   (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
 -> m x)
-> m a
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 Union (Resumable handled eff : r) (Sem r) x
-> Either
     (Union r (Sem r) x) (Weaving (Resumable handled eff) (Sem r) x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp (InterpreterFor (Resumable handled eff) r
-> Union
     (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
-> Union (Resumable handled eff : 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 ((err -> Maybe handled) -> InterpreterFor (Resumable handled eff) r
forall err (eff :: (* -> *) -> * -> *) 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) a
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) ->
        f () -> (f (Either handled a) -> x) -> Either handled (f a) -> x
forall (f :: * -> *) err a res.
Functor f =>
f () -> (f (Either err a) -> res) -> Either err (f a) -> res
distribEither f ()
s f a -> x
f (Either handled a) -> x
ex (Either handled (f a) -> x) -> m (Either handled (f a)) -> m x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r (Either handled (f a))
-> (forall x. Union r (Sem r) x -> m x) -> m (Either handled (f 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 r (Either handled (f a))
resultFromEff forall x. Union r (Sem r) x -> m x
k
        where
          resultFromEff :: Sem r (Either handled (f a))
resultFromEff =
            (err -> Maybe handled)
-> Sem r (Either handled (f a))
-> (handled -> Sem r (Either handled (f a)))
-> Sem r (Either handled (f a))
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 ((f a -> Either handled (f a))
-> Sem r (f a) -> Sem r (Either handled (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> Either handled (f a)
forall a b. b -> Either a b
Right (Sem r (f a) -> Sem r (Either handled (f a)))
-> Sem r (f a) -> Sem r (Either handled (f a))
forall a b. (a -> b) -> a -> b
$ Union r (Sem r) (f a) -> Sem r (f a)
forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem (Union r (Sem r) (f a) -> Sem r (f a))
-> Union r (Sem r) (f a) -> Sem r (f a)
forall a b. (a -> b) -> a -> b
$ f ()
-> (forall x. f (Sem r x) -> Sem r (f x))
-> (forall x. f x -> Maybe x)
-> Union r (Sem r) a
-> Union r (Sem r) (f a)
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)
forall x. f (Sem r x) -> Sem r (f x)
wv forall x. f x -> Maybe x
ins (Weaving eff (Sem r) a -> Union r (Sem r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving Weaving eff (Sem r) a
e)) (Either handled (f a) -> Sem r (Either handled (f a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either handled (f a) -> Sem r (Either handled (f a)))
-> (handled -> Either handled (f a))
-> handled
-> Sem r (Either handled (f a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. handled -> Either handled (f a)
forall a b. a -> Either a b
Left)
      Left Union r (Sem 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
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 :: InterpreterFor eff r
runAsResumable (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union (eff : r) (Sem (eff : 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 (eff : r) (Sem (eff : r)) x -> m x) -> m a
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 Union (eff : r) (Sem r) x
-> Either (Union r (Sem r) x) (Weaving eff (Sem r) x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp (InterpreterFor eff r
-> Union (eff : r) (Sem (eff : r)) x -> Union (eff : 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 (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
forall err (eff :: (* -> *) -> * -> *) (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 ->
        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 ((err -> Sem r x) -> (x -> Sem r x) -> Either err x -> Sem r x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (r :: EffectRow) a.
MemberWithError (Stop err) r =>
err -> Sem r a
forall e (r :: EffectRow) a.
MemberWithError (Stop e) r =>
e -> Sem r a
stop @err) x -> Sem r x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either err x -> Sem r x) -> Sem r (Either err x) -> Sem r x
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Resumable err eff (Sem r) (Either err x) -> Sem r (Either err x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send (Weaving eff (Sem r) x -> Resumable err eff (Sem r) (Either err x)
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Weaving eff (Sem r) a -> Resumable err eff (Sem r) (Either err a)
Resumable Weaving eff (Sem r) x
wav)) forall x. Union r (Sem r) x -> m x
k
      Left Union r (Sem 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
g
{-# inline runAsResumable #-}