{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Data.Variant.Excepts
   ( Excepts (..)
   , runE
   , runE_
   , liftE
   , appendE
   , prependE
   , failureE
   , successE
   , throwE
   , throwSomeE
   , catchE
   , catchEvalE
   , evalE
   , onE_
   , onE
   , finallyE
   , injectExcepts
   , withExcepts
   , withExcepts_
   , mapExcepts
   , variantToExcepts
   , veitherToExcepts
   , catchLiftBoth
   , catchLiftLeft
   , catchLiftRight
   , catchAllE
   , catchDieE
   , catchRemove
   , sequenceE
   , runBothE
   -- * Reexport
   , module Data.Variant.VEither
   )
where

import GHC.TypeLits
import Data.Variant.Types
import Data.Variant.VEither

import Control.Monad
import Control.Monad.Catch
import Control.Monad.Reader.Class
import Control.Monad.Trans.Class

#if MIN_VERSION_base(4,12,0) && !MIN_VERSION_base(4,13,0)
import qualified Control.Monad.Fail
import           Control.Monad.Fail ( MonadFail )
#endif

#if defined(ENABLE_UNLIFTIO)
import Control.Monad.IO.Unlift
import qualified Control.Exception as E
#endif

newtype Excepts es m a = Excepts (m (VEither es a))

deriving instance Show (m (VEither es a)) => Show (Excepts es m a)

-- | Run an Excepts
runE :: forall es a m.
   Excepts es m a -> m (VEither es a)
{-# INLINABLE runE #-}
runE :: forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (Excepts m (VEither es a)
m) = m (VEither es a)
m

-- | Run an Excepts, discard the result value
runE_ :: forall es a m.
   Functor m => Excepts es m a -> m ()
{-# INLINABLE runE_ #-}
runE_ :: forall (es :: [*]) a (m :: * -> *).
Functor m =>
Excepts es m a -> m ()
runE_ Excepts es m a
m = m (VEither es a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts es m a
m)

injectExcepts :: forall es a m.
   Monad m => Excepts es m a -> Excepts es m (VEither es a)
{-# INLINABLE injectExcepts #-}
injectExcepts :: forall (es :: [*]) a (m :: * -> *).
Monad m =>
Excepts es m a -> Excepts es m (VEither es a)
injectExcepts (Excepts m (VEither es a)
m) = m (VEither es a) -> Excepts es m (VEither es a)
forall (m :: * -> *) a. Monad m => m a -> Excepts es m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (VEither es a)
m

withExcepts_ :: Monad m => (VEither es a -> m ()) -> Excepts es m a -> Excepts es m a
{-# INLINABLE withExcepts_ #-}
withExcepts_ :: forall (m :: * -> *) (es :: [*]) a.
Monad m =>
(VEither es a -> m ()) -> Excepts es m a -> Excepts es m a
withExcepts_ VEither es a -> m ()
f (Excepts m (VEither es a)
m) = m (VEither es a) -> Excepts es m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es a) -> Excepts es m a)
-> m (VEither es a) -> Excepts es m a
forall a b. (a -> b) -> a -> b
$ do
   VEither es a
v <- m (VEither es a)
m
   VEither es a -> m ()
f VEither es a
v
   VEither es a -> m (VEither es a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VEither es a
v

withExcepts :: Monad m => (VEither es a -> m b) -> Excepts es m a -> Excepts es m b
{-# INLINABLE withExcepts #-}
withExcepts :: forall (m :: * -> *) (es :: [*]) a b.
Monad m =>
(VEither es a -> m b) -> Excepts es m a -> Excepts es m b
withExcepts VEither es a -> m b
f (Excepts m (VEither es a)
m) = m (VEither es b) -> Excepts es m b
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es b) -> Excepts es m b)
-> m (VEither es b) -> Excepts es m b
forall a b. (a -> b) -> a -> b
$ do
   VEither es a
v <- m (VEither es a)
m
   b -> VEither es b
forall x (xs :: [*]). x -> VEither xs x
VRight (b -> VEither es b) -> m b -> m (VEither es b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VEither es a -> m b
f VEither es a
v

-- | Convert a flow without error into a value
evalE :: Monad m => Excepts '[] m a -> m a
{-# INLINABLE evalE #-}
evalE :: forall (m :: * -> *) a. Monad m => Excepts '[] m a -> m a
evalE Excepts '[] m a
v = VEither '[] a -> a
forall a. VEither '[] a -> a
veitherToValue (VEither '[] a -> a) -> m (VEither '[] a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Excepts '[] m a -> m (VEither '[] a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts '[] m a
v

mapExcepts :: (m (VEither es a) -> n (VEither es' b)) -> Excepts es m a -> Excepts es' n b
{-# INLINABLE mapExcepts #-}
mapExcepts :: forall (m :: * -> *) (es :: [*]) a (n :: * -> *) (es' :: [*]) b.
(m (VEither es a) -> n (VEither es' b))
-> Excepts es m a -> Excepts es' n b
mapExcepts m (VEither es a) -> n (VEither es' b)
f = n (VEither es' b) -> Excepts es' n b
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (n (VEither es' b) -> Excepts es' n b)
-> (Excepts es m a -> n (VEither es' b))
-> Excepts es m a
-> Excepts es' n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (VEither es a) -> n (VEither es' b)
f (m (VEither es a) -> n (VEither es' b))
-> (Excepts es m a -> m (VEither es a))
-> Excepts es m a
-> n (VEither es' b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE

-- | Lift a Excepts into another
liftE :: forall es' es a m.
   ( Monad m
   , VEitherLift es es'
   ) => Excepts es m a -> Excepts es' m a
{-# INLINABLE liftE #-}
liftE :: forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE = (m (VEither es a) -> m (VEither es' a))
-> Excepts es m a -> Excepts es' m a
forall (m :: * -> *) (es :: [*]) a (n :: * -> *) (es' :: [*]) b.
(m (VEither es a) -> n (VEither es' b))
-> Excepts es m a -> Excepts es' n b
mapExcepts ((VEither es a -> VEither es' a)
-> m (VEither es a) -> m (VEither es' a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM VEither es a -> VEither es' a
forall (es' :: [*]) (es :: [*]) a.
VEitherLift es es' =>
VEither es a -> VEither es' a
veitherLift)

-- | Append errors to an Excepts
appendE :: forall ns es a m.
   ( Monad m
   ) => Excepts es m a -> Excepts (Concat es ns) m a
{-# INLINABLE appendE #-}
appendE :: forall (ns :: [*]) (es :: [*]) a (m :: * -> *).
Monad m =>
Excepts es m a -> Excepts (Concat es ns) m a
appendE = (m (VEither es a) -> m (VEither (Concat es ns) a))
-> Excepts es m a -> Excepts (Concat es ns) m a
forall (m :: * -> *) (es :: [*]) a (n :: * -> *) (es' :: [*]) b.
(m (VEither es a) -> n (VEither es' b))
-> Excepts es m a -> Excepts es' n b
mapExcepts ((VEither es a -> VEither (Concat es ns) a)
-> m (VEither es a) -> m (VEither (Concat es ns) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (ns :: [*]) (es :: [*]) a.
VEither es a -> VEither (Concat es ns) a
veitherAppend @ns))

-- | Prepend errors to an Excepts
prependE :: forall ns es a m.
   ( Monad m
   , KnownNat (Length ns)
   ) => Excepts es m a -> Excepts (Concat ns es) m a
{-# INLINABLE prependE #-}
prependE :: forall (ns :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, KnownNat (Length ns)) =>
Excepts es m a -> Excepts (Concat ns es) m a
prependE = (m (VEither es a) -> m (VEither (Concat ns es) a))
-> Excepts es m a -> Excepts (Concat ns es) m a
forall (m :: * -> *) (es :: [*]) a (n :: * -> *) (es' :: [*]) b.
(m (VEither es a) -> n (VEither es' b))
-> Excepts es m a -> Excepts es' n b
mapExcepts ((VEither es a -> VEither (Concat ns es) a)
-> m (VEither es a) -> m (VEither (Concat ns es) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (ns :: [*]) (es :: [*]) a.
KnownNat (Length ns) =>
VEither es a -> VEither (Concat ns es) a
veitherPrepend @ns))

instance Functor m => Functor (Excepts es m) where
   {-# INLINABLE fmap #-}
   fmap :: forall a b. (a -> b) -> Excepts es m a -> Excepts es m b
fmap a -> b
f = (m (VEither es a) -> m (VEither es b))
-> Excepts es m a -> Excepts es m b
forall (m :: * -> *) (es :: [*]) a (n :: * -> *) (es' :: [*]) b.
(m (VEither es a) -> n (VEither es' b))
-> Excepts es m a -> Excepts es' n b
mapExcepts ((VEither es a -> VEither es b)
-> m (VEither es a) -> m (VEither es b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> VEither es a -> VEither es b
forall a b. (a -> b) -> VEither es a -> VEither es b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f))

instance Foldable m => Foldable (Excepts es m) where
   {-# INLINABLE foldMap #-}
   foldMap :: forall m a. Monoid m => (a -> m) -> Excepts es m a -> m
foldMap a -> m
f (Excepts m (VEither es a)
m) = (VEither es a -> m) -> m (VEither es a) -> m
forall m a. Monoid m => (a -> m) -> m a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((V es -> m) -> (a -> m) -> VEither es a -> m
forall (es :: [*]) u a.
(V es -> u) -> (a -> u) -> VEither es a -> u
veitherCont (m -> V es -> m
forall a b. a -> b -> a
const m
forall a. Monoid a => a
mempty) a -> m
f) m (VEither es a)
m

instance Traversable m => Traversable (Excepts es m) where
   {-# INLINABLE traverse #-}
   traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Excepts es m a -> f (Excepts es m b)
traverse a -> f b
f (Excepts m (VEither es a)
m) =
      m (VEither es b) -> Excepts es m b
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es b) -> Excepts es m b)
-> f (m (VEither es b)) -> f (Excepts es m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VEither es a -> f (VEither es b))
-> m (VEither es a) -> f (m (VEither es b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> m a -> f (m b)
traverse ((V es -> f (VEither es b))
-> (a -> f (VEither es b)) -> VEither es a -> f (VEither es b)
forall (es :: [*]) u a.
(V es -> u) -> (a -> u) -> VEither es a -> u
veitherCont (VEither es b -> f (VEither es b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VEither es b -> f (VEither es b))
-> (V es -> VEither es b) -> V es -> f (VEither es b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V es -> VEither es b
forall x (xs :: [*]). V xs -> VEither xs x
VLeft) ((b -> VEither es b) -> f b -> f (VEither es b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> VEither es b
forall x (xs :: [*]). x -> VEither xs x
VRight (f b -> f (VEither es b)) -> (a -> f b) -> a -> f (VEither es b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f)) m (VEither es a)
m

instance (Functor m, Monad m) => Applicative (Excepts es m) where
    {-# INLINABLE pure #-}
    pure :: forall a. a -> Excepts es m a
pure a
a = m (VEither es a) -> Excepts es m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es a) -> Excepts es m a)
-> m (VEither es a) -> Excepts es m a
forall a b. (a -> b) -> a -> b
$ VEither es a -> m (VEither es a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> VEither es a
forall x (xs :: [*]). x -> VEither xs x
VRight a
a)

    {-# INLINABLE (<*>) #-}
    Excepts m (VEither es (a -> b))
mf <*> :: forall a b.
Excepts es m (a -> b) -> Excepts es m a -> Excepts es m b
<*> Excepts m (VEither es a)
ma = m (VEither es b) -> Excepts es m b
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es b) -> Excepts es m b)
-> m (VEither es b) -> Excepts es m b
forall a b. (a -> b) -> a -> b
$ do
      VEither es (a -> b)
f <- m (VEither es (a -> b))
mf
      case VEither es (a -> b)
f of
        VLeft V es
e -> VEither es b -> m (VEither es b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (V es -> VEither es b
forall x (xs :: [*]). V xs -> VEither xs x
VLeft V es
e)
        VRight a -> b
k -> do
          VEither es a
a <- m (VEither es a)
ma
          case VEither es a
a of
            VLeft V es
e -> VEither es b -> m (VEither es b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (V es -> VEither es b
forall x (xs :: [*]). V xs -> VEither xs x
VLeft V es
e)
            VRight a
x -> VEither es b -> m (VEither es b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> VEither es b
forall x (xs :: [*]). x -> VEither xs x
VRight (a -> b
k a
x))

    {-# INLINABLE (*>) #-}
    Excepts es m a
m *> :: forall a b. Excepts es m a -> Excepts es m b -> Excepts es m b
*> Excepts es m b
k = Excepts es m a
m Excepts es m a -> (a -> Excepts es m b) -> Excepts es m b
forall a b.
Excepts es m a -> (a -> Excepts es m b) -> Excepts es m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
_ -> Excepts es m b
k

instance (Monad m) => Monad (Excepts es m) where
    {-# INLINABLE (>>=) #-}
    Excepts es m a
m >>= :: forall a b.
Excepts es m a -> (a -> Excepts es m b) -> Excepts es m b
>>= a -> Excepts es m b
k = m (VEither es b) -> Excepts es m b
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es b) -> Excepts es m b)
-> m (VEither es b) -> Excepts es m b
forall a b. (a -> b) -> a -> b
$ do
        VEither es a
a <- Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts es m a
m
        case VEither es a
a of
            VLeft V es
es -> VEither es b -> m (VEither es b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (V es -> VEither es b
forall x (xs :: [*]). V xs -> VEither xs x
VLeft V es
es)
            VRight a
x -> Excepts es m b -> m (VEither es b)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (a -> Excepts es m b
k a
x)

#if MIN_VERSION_base(4,12,0)
instance (MonadFail m) => MonadFail (Excepts es m) where
#endif
   {-# INLINABLE fail #-}
   fail :: forall a. String -> Excepts es m a
fail = m (VEither es a) -> Excepts es m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es a) -> Excepts es m a)
-> (String -> m (VEither es a)) -> String -> Excepts es m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m (VEither es a)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

instance MonadTrans (Excepts e) where
    {-# INLINABLE lift #-}
    lift :: forall (m :: * -> *) a. Monad m => m a -> Excepts e m a
lift = m (VEither e a) -> Excepts e m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither e a) -> Excepts e m a)
-> (m a -> m (VEither e a)) -> m a -> Excepts e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> VEither e a) -> m a -> m (VEither e a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> VEither e a
forall x (xs :: [*]). x -> VEither xs x
VRight

instance (MonadIO m) => MonadIO (Excepts es m) where
    {-# INLINABLE liftIO #-}
    liftIO :: forall a. IO a -> Excepts es m a
liftIO = m a -> Excepts es m a
forall (m :: * -> *) a. Monad m => m a -> Excepts es m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Excepts es m a) -> (IO a -> m a) -> IO a -> Excepts es m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO


-- | Throws exceptions into the base monad.
instance MonadThrow m => MonadThrow (Excepts e m) where
   {-# INLINABLE throwM #-}
   throwM :: forall e a. (HasCallStack, Exception e) => e -> Excepts e m a
throwM = m a -> Excepts e m a
forall (m :: * -> *) a. Monad m => m a -> Excepts e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Excepts e m a) -> (e -> m a) -> e -> Excepts e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM

-- | Catches exceptions from the base monad.
instance MonadCatch m => MonadCatch (Excepts e m) where
   catch :: forall e a.
(HasCallStack, Exception e) =>
Excepts e m a -> (e -> Excepts e m a) -> Excepts e m a
catch (Excepts m (VEither e a)
m) e -> Excepts e m a
f = m (VEither e a) -> Excepts e m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither e a) -> Excepts e m a)
-> m (VEither e a) -> Excepts e m a
forall a b. (a -> b) -> a -> b
$ m (VEither e a) -> (e -> m (VEither e a)) -> m (VEither e a)
forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch m (VEither e a)
m (Excepts e m a -> m (VEither e a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (Excepts e m a -> m (VEither e a))
-> (e -> Excepts e m a) -> e -> m (VEither e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Excepts e m a
f)

instance MonadMask m => MonadMask (Excepts e m) where
   mask :: forall b.
HasCallStack =>
((forall a. Excepts e m a -> Excepts e m a) -> Excepts e m b)
-> Excepts e m b
mask (forall a. Excepts e m a -> Excepts e m a) -> Excepts e m b
f = m (VEither e b) -> Excepts e m b
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither e b) -> Excepts e m b)
-> m (VEither e b) -> Excepts e m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m (VEither e b)) -> m (VEither e b)
forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (VEither e b)) -> m (VEither e b))
-> ((forall a. m a -> m a) -> m (VEither e b)) -> m (VEither e b)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> Excepts e m b -> m (VEither e b)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (Excepts e m b -> m (VEither e b))
-> Excepts e m b -> m (VEither e b)
forall a b. (a -> b) -> a -> b
$ (forall a. Excepts e m a -> Excepts e m a) -> Excepts e m b
f ((m (VEither e a) -> m (VEither e a))
-> Excepts e m a -> Excepts e m a
forall a.
(m (VEither e a) -> m (VEither e a))
-> Excepts e m a -> Excepts e m a
q m (VEither e a) -> m (VEither e a)
forall a. m a -> m a
u)
      where
         q :: (m (VEither e a) -> m (VEither e a)) -> Excepts e m a -> Excepts e m a
         q :: forall a.
(m (VEither e a) -> m (VEither e a))
-> Excepts e m a -> Excepts e m a
q m (VEither e a) -> m (VEither e a)
u (Excepts m (VEither e a)
b) = m (VEither e a) -> Excepts e m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither e a) -> m (VEither e a)
u m (VEither e a)
b)

   uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Excepts e m a -> Excepts e m a) -> Excepts e m b)
-> Excepts e m b
uninterruptibleMask (forall a. Excepts e m a -> Excepts e m a) -> Excepts e m b
f = m (VEither e b) -> Excepts e m b
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither e b) -> Excepts e m b)
-> m (VEither e b) -> Excepts e m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m (VEither e b)) -> m (VEither e b)
forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall a. m a -> m a) -> m (VEither e b)) -> m (VEither e b))
-> ((forall a. m a -> m a) -> m (VEither e b)) -> m (VEither e b)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> Excepts e m b -> m (VEither e b)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (Excepts e m b -> m (VEither e b))
-> Excepts e m b -> m (VEither e b)
forall a b. (a -> b) -> a -> b
$ (forall a. Excepts e m a -> Excepts e m a) -> Excepts e m b
f ((m (VEither e a) -> m (VEither e a))
-> Excepts e m a -> Excepts e m a
forall a.
(m (VEither e a) -> m (VEither e a))
-> Excepts e m a -> Excepts e m a
q m (VEither e a) -> m (VEither e a)
forall a. m a -> m a
u)
      where
         q :: (m (VEither e a) -> m (VEither e a)) -> Excepts e m a -> Excepts e m a
         q :: forall a.
(m (VEither e a) -> m (VEither e a))
-> Excepts e m a -> Excepts e m a
q m (VEither e a) -> m (VEither e a)
u (Excepts m (VEither e a)
b) = m (VEither e a) -> Excepts e m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither e a) -> m (VEither e a)
u m (VEither e a)
b)

   generalBracket :: forall a b c.
HasCallStack =>
Excepts e m a
-> (a -> ExitCase b -> Excepts e m c)
-> (a -> Excepts e m b)
-> Excepts e m (b, c)
generalBracket Excepts e m a
acquire a -> ExitCase b -> Excepts e m c
release a -> Excepts e m b
use = m (VEither e (b, c)) -> Excepts e m (b, c)
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither e (b, c)) -> Excepts e m (b, c))
-> m (VEither e (b, c)) -> Excepts e m (b, c)
forall a b. (a -> b) -> a -> b
$ do
      (VEither e b
eb, VEither e c
ec) <- m (VEither e a)
-> (VEither e a -> ExitCase (VEither e b) -> m (VEither e c))
-> (VEither e a -> m (VEither e b))
-> m (VEither e b, VEither e c)
forall a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
         (Excepts e m a -> m (VEither e a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts e m a
acquire)
         (\VEither e a
eresource ExitCase (VEither e b)
exitCase -> case VEither e a
eresource of
            VLeft V e
e -> VEither e c -> m (VEither e c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (V e -> VEither e c
forall x (xs :: [*]). V xs -> VEither xs x
VLeft V e
e) -- nothing to release, acquire didn't succeed
            VRight a
resource -> case ExitCase (VEither e b)
exitCase of
               ExitCaseSuccess (VRight b
b) -> Excepts e m c -> m (VEither e c)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (a -> ExitCase b -> Excepts e m c
release a
resource (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b))
               ExitCaseException SomeException
e        -> Excepts e m c -> m (VEither e c)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (a -> ExitCase b -> Excepts e m c
release a
resource (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e))
               ExitCase (VEither e b)
_                          -> Excepts e m c -> m (VEither e c)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (a -> ExitCase b -> Excepts e m c
release a
resource ExitCase b
forall a. ExitCase a
ExitCaseAbort))
         ((V e -> m (VEither e b))
-> (a -> m (VEither e b)) -> VEither e a -> m (VEither e b)
forall (es :: [*]) u a.
(V es -> u) -> (a -> u) -> VEither es a -> u
veitherCont (VEither e b -> m (VEither e b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (VEither e b -> m (VEither e b))
-> (V e -> VEither e b) -> V e -> m (VEither e b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V e -> VEither e b
forall x (xs :: [*]). V xs -> VEither xs x
VLeft) (Excepts e m b -> m (VEither e b)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (Excepts e m b -> m (VEither e b))
-> (a -> Excepts e m b) -> a -> m (VEither e b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Excepts e m b
use))
      Excepts e m (b, c) -> m (VEither e (b, c))
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (Excepts e m (b, c) -> m (VEither e (b, c)))
-> Excepts e m (b, c) -> m (VEither e (b, c))
forall a b. (a -> b) -> a -> b
$ do
         -- The order in which we perform those two 'Excepts' effects determines
         -- which error will win if they are both erroring. We want the error from
         -- 'release' to win.
         c
c <- m (VEither e c) -> Excepts e m c
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (VEither e c -> m (VEither e c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VEither e c
ec)
         b
b <- m (VEither e b) -> Excepts e m b
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (VEither e b -> m (VEither e b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VEither e b
eb)
         (b, c) -> Excepts e m (b, c)
forall a. a -> Excepts e m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, c
c)

instance MonadReader r m => MonadReader r (Excepts e m) where
  ask :: Excepts e m r
ask    = m r -> Excepts e m r
forall (m :: * -> *) a. Monad m => m a -> Excepts e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> Excepts e m a -> Excepts e m a
local  = (m (VEither e a) -> m (VEither e a))
-> Excepts e m a -> Excepts e m a
forall (m :: * -> *) (es :: [*]) a (n :: * -> *) (es' :: [*]) b.
(m (VEither es a) -> n (VEither es' b))
-> Excepts es m a -> Excepts es' n b
mapExcepts ((m (VEither e a) -> m (VEither e a))
 -> Excepts e m a -> Excepts e m a)
-> ((r -> r) -> m (VEither e a) -> m (VEither e a))
-> (r -> r)
-> Excepts e m a
-> Excepts e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> m (VEither e a) -> m (VEither e a)
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
  reader :: forall a. (r -> a) -> Excepts e m a
reader = m a -> Excepts e m a
forall (m :: * -> *) a. Monad m => m a -> Excepts e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Excepts e m a)
-> ((r -> a) -> m a) -> (r -> a) -> Excepts e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a) -> m a
forall a. (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader


-- | Signal an exception value @e@.
throwE :: forall e es a m. (Monad m, e :< es) => e -> Excepts es m a
{-# INLINABLE throwE #-}
throwE :: forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE = m (VEither es a) -> Excepts es m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es a) -> Excepts es m a)
-> (e -> m (VEither es a)) -> e -> Excepts es m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VEither es a -> m (VEither es a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VEither es a -> m (VEither es a))
-> (e -> VEither es a) -> e -> m (VEither es a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V es -> VEither es a
forall x (xs :: [*]). V xs -> VEither xs x
VLeft (V es -> VEither es a) -> (e -> V es) -> e -> VEither es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> V es
forall c (cs :: [*]). (c :< cs) => c -> V cs
V

-- | Throw some exception
throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excepts es m a
{-# INLINABLE throwSomeE #-}
throwSomeE :: forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, LiftVariant es' es) =>
V es' -> Excepts es m a
throwSomeE = m (VEither es a) -> Excepts es m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es a) -> Excepts es m a)
-> (V es' -> m (VEither es a)) -> V es' -> Excepts es m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VEither es a -> m (VEither es a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VEither es a -> m (VEither es a))
-> (V es' -> VEither es a) -> V es' -> m (VEither es a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V es -> VEither es a
forall x (xs :: [*]). V xs -> VEither xs x
VLeft (V es -> VEither es a) -> (V es' -> V es) -> V es' -> VEither es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V es' -> V es
forall (ys :: [*]) (xs :: [*]). LiftVariant xs ys => V xs -> V ys
liftVariant

-- | Signal an exception value @e@.
failureE :: forall e a m. Monad m => e -> Excepts '[e] m a
{-# INLINABLE failureE #-}
failureE :: forall e a (m :: * -> *). Monad m => e -> Excepts '[e] m a
failureE = e -> Excepts '[e] m a
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE

-- | Signal a success
successE :: forall a m. Monad m => a -> Excepts '[] m a
{-# INLINABLE successE #-}
successE :: forall a (m :: * -> *). Monad m => a -> Excepts '[] m a
successE = a -> Excepts '[] m a
forall a. a -> Excepts '[] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Handle an exception. Lift both normal and exceptional flows into the result
-- flow
catchE :: forall e es' es'' es a m.
   ( Monad m
   , e :< es
   , LiftVariant (Remove e es) es'
   , LiftVariant es'' es'
   ) => (e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
{-# INLINABLE catchE #-}
catchE :: forall e (es' :: [*]) (es'' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, e :< es, LiftVariant (Remove e es) es',
 LiftVariant es'' es') =>
(e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
catchE = (e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
forall e (es' :: [*]) (es'' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, e :< es, LiftVariant (Remove e es) es',
 LiftVariant es'' es') =>
(e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
catchLiftBoth

-- | Handle an exception. Lift both normal and exceptional flows into the result
-- flow
catchLiftBoth :: forall e es' es'' es a m.
   ( Monad m
   , e :< es
   , LiftVariant (Remove e es) es'
   , LiftVariant es'' es'
   ) => (e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
{-# INLINABLE catchLiftBoth #-}
catchLiftBoth :: forall e (es' :: [*]) (es'' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, e :< es, LiftVariant (Remove e es) es',
 LiftVariant es'' es') =>
(e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
catchLiftBoth e -> Excepts es'' m a
h Excepts es m a
m = m (VEither es' a) -> Excepts es' m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es' a) -> Excepts es' m a)
-> m (VEither es' a) -> Excepts es' m a
forall a b. (a -> b) -> a -> b
$ do
   VEither es a
a <- Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts es m a
m
   case VEither es a
a of
      VRight a
r -> VEither es' a -> m (VEither es' a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> VEither es' a
forall x (xs :: [*]). x -> VEither xs x
VRight a
r)
      VLeft  V es
ls -> case V es -> Either (V (Remove e es)) e
forall a (xs :: [*]).
(a :< xs) =>
V xs -> Either (V (Remove a xs)) a
popVariant V es
ls of
         Right e
l -> Excepts es' m a -> m (VEither es' a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (Excepts es'' m a -> Excepts es' m a
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (e -> Excepts es'' m a
h e
l))
         Left V (Remove e es)
rs -> VEither es' a -> m (VEither es' a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (V es' -> VEither es' a
forall x (xs :: [*]). V xs -> VEither xs x
VLeft (V (Remove e es) -> V es'
forall (ys :: [*]) (xs :: [*]). LiftVariant xs ys => V xs -> V ys
liftVariant V (Remove e es)
rs))

-- | Handle an exception. Assume it is in the first position
catchRemove :: forall e es a m.
   ( Monad m
   ) => (e -> Excepts es m a) -> Excepts (e ': es) m a -> Excepts es m a
{-# INLINABLE catchRemove #-}
catchRemove :: forall e (es :: [*]) a (m :: * -> *).
Monad m =>
(e -> Excepts es m a) -> Excepts (e : es) m a -> Excepts es m a
catchRemove e -> Excepts es m a
h Excepts (e : es) m a
m = m (VEither es a) -> Excepts es m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es a) -> Excepts es m a)
-> m (VEither es a) -> Excepts es m a
forall a b. (a -> b) -> a -> b
$ do
   VEither (e : es) a
a <- Excepts (e : es) m a -> m (VEither (e : es) a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts (e : es) m a
m
   case VEither (e : es) a
a of
      VRight a
r -> VEither es a -> m (VEither es a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> VEither es a
forall x (xs :: [*]). x -> VEither xs x
VRight a
r)
      VLeft  V (e : es)
ls -> case V (e : es) -> Either (V es) e
forall x (xs :: [*]). V (x : xs) -> Either (V xs) x
popVariantHead V (e : es)
ls of
         Right e
l -> Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (e -> Excepts es m a
h e
l)
         Left V es
rs -> VEither es a -> m (VEither es a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (V es -> VEither es a
forall x (xs :: [*]). V xs -> VEither xs x
VLeft V es
rs)

-- | Handle an exception. Lift the remaining errors into the resulting flow
catchLiftLeft :: forall e es es' a m.
   ( Monad m
   , e :< es
   , LiftVariant (Remove e es) es'
   ) => (e -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
{-# INLINABLE catchLiftLeft #-}
catchLiftLeft :: forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es, LiftVariant (Remove e es) es') =>
(e -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
catchLiftLeft e -> Excepts es' m a
h Excepts es m a
m = m (VEither es' a) -> Excepts es' m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es' a) -> Excepts es' m a)
-> m (VEither es' a) -> Excepts es' m a
forall a b. (a -> b) -> a -> b
$ do
   VEither es a
a <- Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts es m a
m
   case VEither es a
a of
      VRight a
r -> VEither es' a -> m (VEither es' a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> VEither es' a
forall x (xs :: [*]). x -> VEither xs x
VRight a
r)
      VLeft  V es
ls -> case V es -> Either (V (Remove e es)) e
forall a (xs :: [*]).
(a :< xs) =>
V xs -> Either (V (Remove a xs)) a
popVariant V es
ls of
         Right e
l -> Excepts es' m a -> m (VEither es' a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (e -> Excepts es' m a
h e
l)
         Left V (Remove e es)
rs -> VEither es' a -> m (VEither es' a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (V es' -> VEither es' a
forall x (xs :: [*]). V xs -> VEither xs x
VLeft (V (Remove e es) -> V es'
forall (ys :: [*]) (xs :: [*]). LiftVariant xs ys => V xs -> V ys
liftVariant V (Remove e es)
rs))

-- | Handle an exception. Lift the handler into the resulting flow
catchLiftRight :: forall e es es' a m.
   ( Monad m
   , e :< es
   , LiftVariant es' (Remove e es)
   ) => (e -> Excepts es' m a) -> Excepts es m a -> Excepts (Remove e es) m a
{-# INLINABLE catchLiftRight #-}
catchLiftRight :: forall e (es :: [*]) (es' :: [*]) a (m :: * -> *).
(Monad m, e :< es, LiftVariant es' (Remove e es)) =>
(e -> Excepts es' m a)
-> Excepts es m a -> Excepts (Remove e es) m a
catchLiftRight e -> Excepts es' m a
h Excepts es m a
m = m (VEither (Remove e es) a) -> Excepts (Remove e es) m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither (Remove e es) a) -> Excepts (Remove e es) m a)
-> m (VEither (Remove e es) a) -> Excepts (Remove e es) m a
forall a b. (a -> b) -> a -> b
$ do
   VEither es a
a <- Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts es m a
m
   case VEither es a
a of
      VRight a
r -> VEither (Remove e es) a -> m (VEither (Remove e es) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> VEither (Remove e es) a
forall x (xs :: [*]). x -> VEither xs x
VRight a
r)
      VLeft  V es
ls -> case V es -> Either (V (Remove e es)) e
forall a (xs :: [*]).
(a :< xs) =>
V xs -> Either (V (Remove a xs)) a
popVariant V es
ls of
         Right e
l -> Excepts (Remove e es) m a -> m (VEither (Remove e es) a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (Excepts es' m a -> Excepts (Remove e es) m a
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (e -> Excepts es' m a
h e
l))
         Left V (Remove e es)
rs -> VEither (Remove e es) a -> m (VEither (Remove e es) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (V (Remove e es) -> VEither (Remove e es) a
forall x (xs :: [*]). V xs -> VEither xs x
VLeft V (Remove e es)
rs)

-- | Do something in case of error
catchAllE :: Monad m => (V es -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
{-# INLINABLE catchAllE #-}
catchAllE :: forall (m :: * -> *) (es :: [*]) (es' :: [*]) a.
Monad m =>
(V es -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
catchAllE V es -> Excepts es' m a
h Excepts es m a
m = m (VEither es' a) -> Excepts es' m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es' a) -> Excepts es' m a)
-> m (VEither es' a) -> Excepts es' m a
forall a b. (a -> b) -> a -> b
$ do
   VEither es a
a <- Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts es m a
m
   case VEither es a
a of
      VRight a
x  -> VEither es' a -> m (VEither es' a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> VEither es' a
forall x (xs :: [*]). x -> VEither xs x
VRight a
x)
      VLeft V es
xs  -> Excepts es' m a -> m (VEither es' a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (V es -> Excepts es' m a
h V es
xs)

-- | Evaluate a Excepts. Use the provided function to handle error cases.
catchEvalE :: Monad m => (V es -> m a) -> Excepts es m a -> m a
{-# INLINABLE catchEvalE #-}
catchEvalE :: forall (m :: * -> *) (es :: [*]) a.
Monad m =>
(V es -> m a) -> Excepts es m a -> m a
catchEvalE V es -> m a
h Excepts es m a
m = do
   VEither es a
a <- Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts es m a
m
   case VEither es a
a of
      VRight a
x  -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
      VLeft V es
xs  -> V es -> m a
h V es
xs

-- | Catch and die in case of error
catchDieE :: (e :< es, Monad m) => (e -> m ()) -> Excepts es m a -> Excepts (Remove e es) m a
{-# INLINABLE catchDieE #-}
catchDieE :: forall e (es :: [*]) (m :: * -> *) a.
(e :< es, Monad m) =>
(e -> m ()) -> Excepts es m a -> Excepts (Remove e es) m a
catchDieE e -> m ()
h Excepts es m a
m = m (VEither (Remove e es) a) -> Excepts (Remove e es) m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither (Remove e es) a) -> Excepts (Remove e es) m a)
-> m (VEither (Remove e es) a) -> Excepts (Remove e es) m a
forall a b. (a -> b) -> a -> b
$ do
   VEither es a
a <- Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts es m a
m
   case VEither es a
a of
      VRight a
r -> VEither (Remove e es) a -> m (VEither (Remove e es) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> VEither (Remove e es) a
forall x (xs :: [*]). x -> VEither xs x
VRight a
r)
      VLeft  V es
ls -> case V es -> Either (V (Remove e es)) e
forall a (xs :: [*]).
(a :< xs) =>
V xs -> Either (V (Remove a xs)) a
popVariant V es
ls of
         Right e
l -> e -> m ()
h e
l m () -> m (VEither (Remove e es) a) -> m (VEither (Remove e es) a)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> m (VEither (Remove e es) a)
forall a. HasCallStack => String -> a
error String
"catchDieE"
         Left V (Remove e es)
rs -> VEither (Remove e es) a -> m (VEither (Remove e es) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (V (Remove e es) -> VEither (Remove e es) a
forall x (xs :: [*]). V xs -> VEither xs x
VLeft V (Remove e es)
rs)

-- | Do something in case of error
onE_ :: Monad m => m () -> Excepts es m a -> Excepts es m a
{-# INLINABLE onE_ #-}
onE_ :: forall (m :: * -> *) (es :: [*]) a.
Monad m =>
m () -> Excepts es m a -> Excepts es m a
onE_ m ()
h Excepts es m a
m = m (VEither es a) -> Excepts es m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es a) -> Excepts es m a)
-> m (VEither es a) -> Excepts es m a
forall a b. (a -> b) -> a -> b
$ do
   VEither es a
a <- Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts es m a
m
   case VEither es a
a of
      VRight a
_ -> VEither es a -> m (VEither es a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VEither es a
a
      VLeft V es
_  -> m ()
h m () -> m (VEither es a) -> m (VEither es a)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VEither es a -> m (VEither es a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VEither es a
a

-- | Do something in case of error
onE :: Monad m => (V es -> m ()) -> Excepts es m a -> Excepts es m a
{-# INLINABLE onE #-}
onE :: forall (m :: * -> *) (es :: [*]) a.
Monad m =>
(V es -> m ()) -> Excepts es m a -> Excepts es m a
onE V es -> m ()
h Excepts es m a
m = m (VEither es a) -> Excepts es m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es a) -> Excepts es m a)
-> m (VEither es a) -> Excepts es m a
forall a b. (a -> b) -> a -> b
$ do
   VEither es a
a <- Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts es m a
m
   case VEither es a
a of
      VRight a
_  -> VEither es a -> m (VEither es a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VEither es a
a
      VLeft V es
es  -> V es -> m ()
h V es
es m () -> m (VEither es a) -> m (VEither es a)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VEither es a -> m (VEither es a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VEither es a
a

-- | Finally for Excepts
finallyE :: Monad m => m () -> Excepts es m a -> Excepts es m a
{-# INLINABLE finallyE #-}
finallyE :: forall (m :: * -> *) (es :: [*]) a.
Monad m =>
m () -> Excepts es m a -> Excepts es m a
finallyE m ()
h Excepts es m a
m = m (VEither es a) -> Excepts es m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es a) -> Excepts es m a)
-> m (VEither es a) -> Excepts es m a
forall a b. (a -> b) -> a -> b
$ do
   VEither es a
a <- Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts es m a
m
   m ()
h
   VEither es a -> m (VEither es a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VEither es a
a

-- | Convert a Variant into a Excepts
variantToExcepts :: Monad m => V (a ': es) -> Excepts es m a
{-# INLINABLE variantToExcepts #-}
variantToExcepts :: forall (m :: * -> *) a (es :: [*]).
Monad m =>
V (a : es) -> Excepts es m a
variantToExcepts V (a : es)
v = m (VEither es a) -> Excepts es m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (VEither es a -> m (VEither es a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (V (a : es) -> VEither es a
forall a (es :: [*]). V (a : es) -> VEither es a
veitherFromVariant V (a : es)
v))

-- | Convert a VEither into a Excepts
veitherToExcepts :: Monad m => VEither es a -> Excepts es m a
{-# INLINABLE veitherToExcepts #-}
veitherToExcepts :: forall (m :: * -> *) (es :: [*]) a.
Monad m =>
VEither es a -> Excepts es m a
veitherToExcepts VEither es a
v = m (VEither es a) -> Excepts es m a
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (VEither es a -> m (VEither es a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VEither es a
v)

-- | Product of the execution of two Excepts
--
-- You can use a generic monad combinator such as
-- `Control.Concurrent.Async.concurrently` (in "async" package) to get
-- concurrent execution.
--
-- >> concurrentE = runBothE concurrently
runBothE ::
   ( KnownNat (Length (b:e2))
   , Monad m
   ) => (forall x y. m x -> m y -> m (x,y)) -> Excepts e1 m a -> Excepts e2 m b -> Excepts (Tail (Product (a:e1) (b:e2))) m (a,b)
runBothE :: forall b (e2 :: [*]) (m :: * -> *) (e1 :: [*]) a.
(KnownNat (Length (b : e2)), Monad m) =>
(forall x y. m x -> m y -> m (x, y))
-> Excepts e1 m a
-> Excepts e2 m b
-> Excepts (Tail (Product (a : e1) (b : e2))) m (a, b)
runBothE forall x y. m x -> m y -> m (x, y)
exec Excepts e1 m a
f Excepts e2 m b
g = m (VEither (Concat (Product' a e2) (Product e1 (b : e2))) (a, b))
-> Excepts (Concat (Product' a e2) (Product e1 (b : e2))) m (a, b)
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts do
   (VEither e1 a
v1,VEither e2 b
v2) <- m (VEither e1 a)
-> m (VEither e2 b) -> m (VEither e1 a, VEither e2 b)
forall x y. m x -> m y -> m (x, y)
exec (Excepts e1 m a -> m (VEither e1 a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts e1 m a
f) (Excepts e2 m b -> m (VEither e2 b)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts e2 m b
g)
   VEither (Concat (Product' a e2) (Product e1 (b : e2))) (a, b)
-> m (VEither
        (Concat (Product' a e2) (Product e1 (b : e2))) (a, b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VEither e1 a
-> VEither e2 b
-> VEither (Tail (Product (a : e1) (b : e2))) (a, b)
forall b (e2 :: [*]) (e1 :: [*]) a.
KnownNat (Length (b : e2)) =>
VEither e1 a
-> VEither e2 b
-> VEither (Tail (Product (a : e1) (b : e2))) (a, b)
veitherProduct VEither e1 a
v1 VEither e2 b
v2)

-- | Product of the sequential execution of two Excepts
--
-- The second one is run even if the first one failed!
sequenceE ::
   ( KnownNat (Length (b:e2))
   , Monad m
   ) => Excepts e1 m a -> Excepts e2 m b -> Excepts (Tail (Product (a:e1) (b:e2))) m (a,b)
sequenceE :: forall b (e2 :: [*]) (m :: * -> *) (e1 :: [*]) a.
(KnownNat (Length (b : e2)), Monad m) =>
Excepts e1 m a
-> Excepts e2 m b
-> Excepts (Tail (Product (a : e1) (b : e2))) m (a, b)
sequenceE = (forall x y. m x -> m y -> m (x, y))
-> Excepts e1 m a
-> Excepts e2 m b
-> Excepts (Tail (Product (a : e1) (b : e2))) m (a, b)
forall b (e2 :: [*]) (m :: * -> *) (e1 :: [*]) a.
(KnownNat (Length (b : e2)), Monad m) =>
(forall x y. m x -> m y -> m (x, y))
-> Excepts e1 m a
-> Excepts e2 m b
-> Excepts (Tail (Product (a : e1) (b : e2))) m (a, b)
runBothE m x -> m y -> m (x, y)
forall x y. m x -> m y -> m (x, y)
forall {m :: * -> *} {a} {b}. Monad m => m a -> m b -> m (a, b)
exec
   where
      exec :: m a -> m b -> m (a, b)
exec m a
f m b
g = do
         a
v1 <- m a
f
         b
v2 <- m b
g
         (a, b) -> m (a, b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
v1,b
v2)

#if defined(ENABLE_UNLIFTIO)
instance forall es m . (MonadCatch m, MonadUnliftIO m, Exception (V es)) => MonadUnliftIO (Excepts es m) where
    withRunInIO :: forall b.
((forall a. Excepts es m a -> IO a) -> IO b) -> Excepts es m b
withRunInIO (forall a. Excepts es m a -> IO a) -> IO b
exceptSToIO = m (VEither es b) -> Excepts es m b
forall (es :: [*]) (m :: * -> *) a.
m (VEither es a) -> Excepts es m a
Excepts (m (VEither es b) -> Excepts es m b)
-> m (VEither es b) -> Excepts es m b
forall a b. (a -> b) -> a -> b
$ (Either (V es) b -> VEither es b)
-> m (Either (V es) b) -> m (VEither es b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((V es -> VEither es b)
-> (b -> VEither es b) -> Either (V es) b -> VEither es b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either V es -> VEither es b
forall x (xs :: [*]). V xs -> VEither xs x
VLeft b -> VEither es b
forall x (xs :: [*]). x -> VEither xs x
VRight) (m (Either (V es) b) -> m (VEither es b))
-> m (Either (V es) b) -> m (VEither es b)
forall a b. (a -> b) -> a -> b
$ m b -> m (Either (V es) b)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m b -> m (Either (V es) b)) -> m b -> m (Either (V es) b)
forall a b. (a -> b) -> a -> b
$ do
        ((forall a. m a -> IO a) -> IO b) -> m b
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO ->
            (forall a. Excepts es m a -> IO a) -> IO b
exceptSToIO (m a -> IO a
forall a. m a -> IO a
runInIO (m a -> IO a) -> (Excepts es m a -> m a) -> Excepts es m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((\case
                                     VLeft V es
v -> IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ SomeException -> IO a
forall e a. Exception e => e -> IO a
E.throwIO (SomeException -> IO a) -> SomeException -> IO a
forall a b. (a -> b) -> a -> b
$ V es -> SomeException
forall e. Exception e => e -> SomeException
toException V es
v
                                     VRight a
a -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (VEither es a -> m a)
-> (Excepts es m a -> m (VEither es a)) -> Excepts es m a -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Excepts es m a -> m (VEither es a)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE))
#endif