module Polysemy.Resume.Stop where
import Control.Monad.Trans.Except (throwE)
import Data.Typeable (typeRep)
import Polysemy (Final)
import Polysemy.Error (runError, throw)
import Polysemy.Final (getInitialStateS, interpretFinal, runS, withStrategicToFinal)
import Polysemy.Internal (Sem(Sem))
import Polysemy.Internal.Union (Weaving(Weaving), decomp, weave)
import qualified Text.Show
import Control.Exception (throwIO, try)
import Polysemy.Resume.Data.Stop (Stop(Stop), stop)
hush :: Either e a -> Maybe a
hush :: Either e a -> Maybe a
hush (Right a :: a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
hush (Left _) = Maybe a
forall a. Maybe a
Nothing
runStop ::
Sem (Stop e : r) a ->
Sem r (Either e a)
runStop :: Sem (Stop e : r) a -> Sem r (Either e a)
runStop (Sem m :: forall (m :: * -> *).
Monad m =>
(forall x. Union (Stop e : r) (Sem (Stop e : r)) x -> m x) -> m a
m) =
(forall (m :: * -> *).
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> m (Either e a))
-> Sem r (Either e 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 ->
ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e m a -> m (Either e a))
-> ExceptT e m a -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ (forall x.
Union (Stop e : r) (Sem (Stop e : r)) x -> ExceptT e m x)
-> ExceptT e m a
forall (m :: * -> *).
Monad m =>
(forall x. Union (Stop e : r) (Sem (Stop e : r)) x -> m x) -> m a
m \ u :: Union (Stop e : r) (Sem (Stop e : r)) x
u ->
case Union (Stop e : r) (Sem (Stop e : r)) x
-> Either
(Union r (Sem (Stop e : r)) x)
(Weaving (Stop e) (Sem (Stop e : r)) x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (Stop e : r) (Sem (Stop e : r)) x
u of
Left x :: Union r (Sem (Stop e : r)) x
x ->
m (Either e x) -> ExceptT e m x
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e x) -> ExceptT e m x)
-> m (Either e x) -> ExceptT e m x
forall a b. (a -> b) -> a -> b
$ Union r (Sem r) (Either e x) -> m (Either e x)
forall x. Union r (Sem r) x -> m x
k (Union r (Sem r) (Either e x) -> m (Either e x))
-> Union r (Sem r) (Either e x) -> m (Either e x)
forall a b. (a -> b) -> a -> b
$ Either e ()
-> (forall x. Either e (Sem (Stop e : r) x) -> Sem r (Either e x))
-> (forall x. Either e x -> Maybe x)
-> Union r (Sem (Stop e : r)) x
-> Union r (Sem r) (Either e x)
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 (() -> Either e ()
forall a b. b -> Either a b
Right ()) ((e -> Sem r (Either e x))
-> (Sem (Stop e : r) x -> Sem r (Either e x))
-> Either e (Sem (Stop e : r) x)
-> Sem r (Either e x)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either e x -> Sem r (Either e x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e x -> Sem r (Either e x))
-> (e -> Either e x) -> e -> Sem r (Either e x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e x
forall a b. a -> Either a b
Left) Sem (Stop e : r) x -> Sem r (Either e x)
forall e (r :: EffectRow) a.
Sem (Stop e : r) a -> Sem r (Either e a)
runStop) forall x. Either e x -> Maybe x
forall e a. Either e a -> Maybe a
hush Union r (Sem (Stop e : r)) x
x
Right (Weaving (Stop e :: e
e) _ _ _ _) ->
e -> ExceptT e m x
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
e
{-# INLINE runStop #-}
newtype WrappedExc e =
WrappedExc { WrappedExc e -> e
unwrapExc :: e }
deriving (Typeable)
instance Typeable e => Show (WrappedExc e) where
show :: WrappedExc e -> String
show =
String -> ShowS
forall a. Monoid a => a -> a -> a
mappend "WrappedExc: " ShowS -> (WrappedExc e -> String) -> WrappedExc e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> String
forall b a. (Show a, IsString b) => a -> b
show (TypeRep -> String)
-> (WrappedExc e -> TypeRep) -> WrappedExc e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedExc e -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep
instance Typeable e => Exception (WrappedExc e)
runStopAsExcFinal ::
Typeable e =>
Member (Final IO) r =>
Sem (Stop e : r) a ->
Sem r a
runStopAsExcFinal :: Sem (Stop e : r) a -> Sem r a
runStopAsExcFinal =
(forall x (rInitial :: EffectRow).
Stop e (Sem rInitial) x -> Strategic IO (Sem rInitial) x)
-> Sem (Stop e : r) a -> Sem r a
forall (m :: * -> *) (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Final m) r =>
(forall x (rInitial :: EffectRow).
e (Sem rInitial) x -> Strategic m (Sem rInitial) x)
-> Sem (e : r) a -> Sem r a
interpretFinal \case
Stop e ->
IO (f x) -> Sem (WithStrategy IO f (Sem rInitial)) (IO (f x))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WrappedExc e -> IO (f x)
forall e a. Exception e => e -> IO a
throwIO (e -> WrappedExc e
forall e. e -> WrappedExc e
WrappedExc e
e))
{-# INLINE runStopAsExcFinal #-}
stopToIOFinal ::
Typeable e =>
Member (Final IO) r =>
Sem (Stop e : r) a ->
Sem r (Either e a)
stopToIOFinal :: Sem (Stop e : r) a -> Sem r (Either e a)
stopToIOFinal sem :: Sem (Stop e : r) a
sem =
Strategic IO (Sem r) (Either e a) -> Sem r (Either e a)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Final m) r =>
Strategic m (Sem r) a -> Sem r a
withStrategicToFinal @IO do
IO (f a)
m' <- Sem r a -> Sem (WithStrategy IO f (Sem r)) (IO (f a))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS (Sem (Stop e : r) a -> Sem r a
forall e (r :: EffectRow) a.
(Typeable e, Member (Final IO) r) =>
Sem (Stop e : r) a -> Sem r a
runStopAsExcFinal Sem (Stop e : r) a
sem)
f ()
s <- Sem (WithStrategy IO f (Sem r)) (f ())
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS
pure $ (WrappedExc e -> f (Either e a))
-> (f a -> f (Either e a))
-> Either (WrappedExc e) (f a)
-> f (Either e a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((Either e a -> f () -> f (Either e a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s) (Either e a -> f (Either e a))
-> (WrappedExc e -> Either e a) -> WrappedExc e -> f (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left (e -> Either e a)
-> (WrappedExc e -> e) -> WrappedExc e -> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrappedExc e -> e
forall e. WrappedExc e -> e
unwrapExc) ((a -> Either e a) -> f a -> f (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either e a
forall a b. b -> Either a b
Right) (Either (WrappedExc e) (f a) -> f (Either e a))
-> IO (Either (WrappedExc e) (f a)) -> IO (f (Either e a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (f a) -> IO (Either (WrappedExc e) (f a))
forall e a. Exception e => IO a -> IO (Either e a)
try IO (f a)
m'
{-# INLINE stopToIOFinal #-}
stopEither ::
Member (Stop err) r =>
Either err a ->
Sem r a
stopEither :: Either err a -> Sem r a
stopEither =
(err -> Sem r a) -> (a -> Sem r a) -> Either err a -> Sem r a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either err -> Sem r a
forall e (r :: EffectRow) a.
MemberWithError (Stop e) r =>
e -> Sem r a
stop a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
stopOnError ::
Member (Stop err) r =>
Sem (Error err : r) a ->
Sem r a
stopOnError :: Sem (Error err : r) a -> Sem r a
stopOnError =
Either err a -> Sem r a
forall err (r :: EffectRow) a.
Member (Stop err) r =>
Either err a -> Sem r a
stopEither (Either err a -> Sem r a)
-> (Sem (Error err : r) a -> Sem r (Either err a))
-> Sem (Error err : r) a
-> Sem r a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Sem (Error err : r) a -> Sem r (Either err a)
forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError
{-# INLINE stopOnError #-}
stopToError ::
Member (Error err) r =>
Sem (Stop err : r) a ->
Sem r a
stopToError :: Sem (Stop err : r) a -> Sem r a
stopToError =
(err -> Sem r a) -> (a -> Sem r a) -> Either err a -> Sem r a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either err -> Sem r a
forall e (r :: EffectRow) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either err a -> Sem r a)
-> (Sem (Stop err : r) a -> Sem r (Either err a))
-> Sem (Stop err : r) a
-> Sem r a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Sem (Stop err : r) a -> Sem r (Either err a)
forall e (r :: EffectRow) a.
Sem (Stop e : r) a -> Sem r (Either e a)
runStop
{-# INLINE stopToError #-}
stopToErrorIO ::
Typeable err =>
Members [Error err, Final IO] r =>
Sem (Stop err : r) a ->
Sem r a
stopToErrorIO :: Sem (Stop err : r) a -> Sem r a
stopToErrorIO =
(err -> Sem r a) -> (a -> Sem r a) -> Either err a -> Sem r a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either err -> Sem r a
forall e (r :: EffectRow) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either err a -> Sem r a)
-> (Sem (Stop err : r) a -> Sem r (Either err a))
-> Sem (Stop err : r) a
-> Sem r a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Sem (Stop err : r) a -> Sem r (Either err a)
forall e (r :: EffectRow) a.
(Typeable e, Member (Final IO) r) =>
Sem (Stop e : r) a -> Sem r (Either e a)
stopToIOFinal
{-# INLINE stopToErrorIO #-}