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 (Final)
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, stopToIOFinal)
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 #-}
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 #-}
resumableIO ::
∀ (eff :: Effect) (err :: *) (r :: EffectRow) .
Typeable 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 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.
(Typeable 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 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 resumableIO #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}