module Polysemy.Resume.Stop where

import Control.Monad.Trans.Except (throwE)
import Polysemy.Error (runError, throw)
import Polysemy.Internal (Sem(Sem))
import Polysemy.Internal.Union (Weaving(Weaving), decomp, weave)

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

-- |Equivalent of 'runError'.
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 #-}

-- |Convert a program using regular 'Error's to one using 'Stop'.
stopOnError ::
  Member (Stop err) r =>
  Sem (Error err : r) a ->
  Sem r a
stopOnError :: Sem (Error err : r) a -> Sem r a
stopOnError sem :: Sem (Error err : r) a
sem =
  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 Sem (Error err : r) a
sem Sem r (Either err a) -> (Either err a -> Sem r a) -> Sem r a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right a :: a
a -> a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Left err :: err
err -> err -> Sem r a
forall e (r :: EffectRow) a.
MemberWithError (Stop e) r =>
e -> Sem r a
stop err
err
{-# INLINE stopOnError #-}

-- |Convert a program using 'Stop' to one using 'Error'.
stopToError ::
  Member (Error err) r =>
  Sem (Stop err : r) a ->
  Sem r a
stopToError :: Sem (Stop err : r) a -> Sem r a
stopToError sem :: Sem (Stop err : r) a
sem =
  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 Sem (Stop err : r) a
sem Sem r (Either err a) -> (Either err a -> Sem r a) -> Sem r a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right a :: a
a -> a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Left err :: err
err -> err -> Sem r a
forall e (r :: EffectRow) a.
MemberWithError (Error e) r =>
e -> Sem r a
throw err
err
{-# INLINE stopToError #-}