module Polysemy.Resume.Resumable where

import Polysemy.Internal (Sem(Sem), liftSem, raise, raiseUnder, runSem, send)
import Polysemy.Internal.Union (Weaving(Weaving), decomp, hoist, inj, injWeaving, weave)

import Polysemy.Error (Error(Throw), catchJust)
import Polysemy.Resume.Data.Resumable (Resumable(..))
import Polysemy.Resume.Data.Stop (Stop, stop)
import Polysemy.Resume.Stop (runStop, stopOnError)

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 initialState :: f ()
initialState result :: 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 fa :: 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 -> 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'.
--
-- >>> run $ resumable interpretStopper (interpretResumer mainProgram)
-- 237
resumable ::
  ∀ (eff :: Effect) (err :: *) (r :: EffectRow) .
  InterpreterFor eff (Stop err : r) ->
  InterpreterFor (Resumable err eff) r
resumable :: InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable err eff) r
resumable interpreter :: InterpreterFor eff (Stop err : r)
interpreter sem :: Sem (Resumable err eff : r) a
sem =
  (forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem \ k :: forall x. Union r (Sem r) x -> m x
k -> Sem (Resumable err eff : r) a
-> (forall x.
    Union (Resumable err eff : r) (Sem (Resumable err eff : r)) x
    -> m x)
-> m a
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem (Resumable err eff : r) a
sem \ u :: 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 (eff :: (* -> *) -> * -> *) err (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 e :: Weaving eff (Sem r) a
e) s :: f ()
s wv :: forall x. f (Sem rInitial x) -> Sem r (f x)
wv ex :: f a -> x
ex ins :: 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 g :: 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 resumable #-}

-- |Convert an interpreter for @eff@ that uses 'Error' into one using 'Stop' and wrap it using 'resumable'.
resumableError ::
  ∀ eff err 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 interpreter :: InterpreterFor eff (Error err : Stop err : r)
interpreter =
  InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable err eff) r
forall (eff :: (* -> *) -> * -> *) err (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 ::
  ∀ eff err 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 canHandle :: err -> Either unhandled handled
canHandle interpreter :: InterpreterFor eff (Stop err : r)
interpreter sem :: Sem (Resumable handled eff : r) a
sem =
  (forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem \ k :: forall x. Union r (Sem r) x -> m x
k -> Sem (Resumable handled eff : r) a
-> (forall x.
    Union
      (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
    -> m x)
-> m a
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem (Resumable handled eff : r) a
sem \ u :: 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 (eff :: (* -> *) -> * -> *) err 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 e :: Weaving eff (Sem r) a
e) s :: f ()
s wv :: forall x. f (Sem rInitial x) -> Sem r (f x)
wv ex :: f a -> x
ex ins :: 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
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 a :: 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 g :: 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 ::
  ∀ eff err 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 canHandle :: err -> Maybe handled
canHandle =
  (err -> Either err handled)
-> InterpreterFor eff (Stop err : r)
-> InterpreterFor (Resumable handled eff) r
forall (eff :: (* -> *) -> * -> *) err 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 =
      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 ::
  ∀ eff handled err r .
  Members [eff, Error err] r =>
  (err -> Maybe handled) ->
  InterpreterFor (Resumable handled eff) r
catchResumable :: (err -> Maybe handled) -> InterpreterFor (Resumable handled eff) r
catchResumable canHandle :: err -> Maybe handled
canHandle sem :: Sem (Resumable handled eff : r) a
sem =
  (forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem \ k :: forall x. Union r (Sem r) x -> m x
k -> Sem (Resumable handled eff : r) a
-> (forall x.
    Union
      (Resumable handled eff : r) (Sem (Resumable handled eff : r)) x
    -> m x)
-> m a
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem (Resumable handled eff : r) a
sem \ u :: 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 (eff :: (* -> *) -> * -> *) handled err (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 e :: Weaving eff (Sem r) a
e) s :: f ()
s wv :: forall x. f (Sem rInitial x) -> Sem r (f x)
wv ex :: f a -> x
ex ins :: 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 g :: 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 eff r .
  Members [Resumable err eff, Stop err] r =>
  InterpreterFor eff r
runAsResumable :: InterpreterFor eff r
runAsResumable sem :: Sem (eff : r) a
sem =
  (forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem \ k :: forall x. Union r (Sem r) x -> m x
k -> Sem (eff : r) a
-> (forall x. Union (eff : r) (Sem (eff : r)) x -> m x) -> m a
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem (eff : r) a
sem \ u :: 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 InterpreterFor eff r
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow).
Members '[Resumable err eff, Stop err] r =>
InterpreterFor eff r
runAsResumable Union (eff : r) (Sem (eff : r)) x
u) of
      Right wav :: 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 err -> Sem r x
forall e (r :: EffectRow) a.
MemberWithError (Stop e) r =>
e -> Sem r a
stop 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 g :: 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 #-}