    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE CPP #-}
    module Foundation.Monad.Except
        ( ExceptT(..)
        ) where

    import Basement.Imports
    import Foundation.Monad.Base
    import Foundation.Monad.Reader
    #if MIN_VERSION_base(4,13,0)
    import Control.Monad.Fail
    #endif

    newtype ExceptT e m a = ExceptT { forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT :: m (Either e a) }

    instance Functor m => Functor (ExceptT e m) where
        fmap :: forall a b. (a -> b) -> ExceptT e m a -> ExceptT e m b
    fmap a -> b
    f = m (Either e b) -> ExceptT e m b
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (m (Either e b) -> ExceptT e m b)
    -> (ExceptT e m a -> m (Either e b))
    -> ExceptT e m a
    -> ExceptT e m b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (Either e a -> Either e b) -> m (Either e a) -> m (Either e 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) -> Either e a -> Either e b
    forall a b. (a -> b) -> Either e a -> Either e b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f) (m (Either e a) -> m (Either e b))
    -> (ExceptT e m a -> m (Either e a))
    -> ExceptT e m a
    -> m (Either e b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . ExceptT e m a -> m (Either e a)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT

    instance Monad m => Applicative (ExceptT e m) where
        pure :: forall a. a -> ExceptT e m a
    pure a
    a = m (Either e a) -> ExceptT e m a
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (m (Either e a) -> ExceptT e m a)
    -> m (Either e a) -> ExceptT e m a
    forall a b. (a -> b) -> a -> b
    $ Either e a -> m (Either e a)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a -> Either e a
    forall a b. b -> Either a b
    Right a
    a)
        ExceptT m (Either e (a -> b))
    f <*> :: forall a b. ExceptT e m (a -> b) -> ExceptT e m a -> ExceptT e m b
    <*> ExceptT m (Either e a)
    v = m (Either e b) -> ExceptT e m b
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (m (Either e b) -> ExceptT e m b)
    -> m (Either e b) -> ExceptT e m b
    forall a b. (a -> b) -> a -> b
    $ do
            mf <- m (Either e (a -> b))
    f
            case mf of
                Left e
    e -> Either e b -> m (Either e b)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (e -> Either e b
    forall a b. a -> Either a b
    Left e
    e)
                Right a -> b
    k -> do
                    mv <- m (Either e a)
    v
                    case mv of
                        Left e
    e -> Either e b -> m (Either e b)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (e -> Either e b
    forall a b. a -> Either a b
    Left e
    e)
                        Right a
    x -> Either e b -> m (Either e b)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (b -> Either e b
    forall a b. b -> Either a b
    Right (a -> b
    k a
    x))

    instance Monad m => MonadFailure (ExceptT e m) where
        type Failure (ExceptT e m) = e
        mFail :: Failure (ExceptT e m) -> ExceptT e m ()
    mFail = m (Either e ()) -> ExceptT e m ()
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (m (Either e ()) -> ExceptT e m ())
    -> (e -> m (Either e ())) -> e -> ExceptT e m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Either e () -> m (Either e ())
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either e () -> m (Either e ()))
    -> (e -> Either e ()) -> e -> m (Either e ())
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . e -> Either e ()
    forall a b. a -> Either a b
    Left

    instance Monad m => Monad (ExceptT e m) where
        return :: forall a. a -> ExceptT e m a
    return = a -> ExceptT e m a
    forall a. a -> ExceptT e m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        ExceptT e m a
    m >>= :: forall a b. ExceptT e m a -> (a -> ExceptT e m b) -> ExceptT e m b
    >>= a -> ExceptT e m b
    k = m (Either e b) -> ExceptT e m b
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (m (Either e b) -> ExceptT e m b)
    -> m (Either e b) -> ExceptT e m b
    forall a b. (a -> b) -> a -> b
    $ do
            a <- 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
            case a of
                Left e
    e -> Either e b -> m (Either e b)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (e -> Either e b
    forall a b. a -> Either a b
    Left e
    e)
                Right a
    x -> ExceptT e m b -> m (Either e b)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (a -> ExceptT e m b
    k a
    x)
    #if !MIN_VERSION_base(4,13,0)
        fail = ExceptT . fail
    #else
    instance MonadFail m => MonadFail (ExceptT e m) where
        fail :: forall a. String -> ExceptT e m a
    fail = m (Either e a) -> ExceptT e m a
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (m (Either e a) -> ExceptT e m a)
    -> (String -> m (Either e a)) -> String -> ExceptT e m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . String -> m (Either e a)
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail
    #endif

    instance (Monad m, MonadFix m) => MonadFix (ExceptT e m) where
        mfix :: forall a. (a -> ExceptT e m a) -> ExceptT e m a
    mfix a -> ExceptT e m a
    f = m (Either e a) -> ExceptT e m a
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT ((Either e a -> m (Either e a)) -> m (Either e a)
    forall a. (a -> m a) -> m a
    forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
    mfix (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))
    -> (Either e a -> ExceptT e m a) -> Either e a -> m (Either e a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . a -> ExceptT e m a
    f (a -> ExceptT e m a)
    -> (Either e a -> a) -> Either e a -> ExceptT e m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Either e a -> a
    forall {a} {b}. Either a b -> b
    fromEither))
          where
            fromEither :: Either a b -> b
    fromEither (Right b
    x) = b
    x
            fromEither (Left  a
    _) = String -> b
    forall a. HasCallStack => String -> a
    error String
    "mfix (ExceptT): inner computation returned Left value"
        {-# INLINE mfix #-}

    instance MonadReader m => MonadReader (ExceptT e m) where
        type ReaderContext (ExceptT e m) = ReaderContext m
        ask :: ExceptT e m (ReaderContext (ExceptT e m))
    ask = m (Either e (ReaderContext m)) -> ExceptT e m (ReaderContext m)
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (ReaderContext m -> Either e (ReaderContext m)
    forall a b. b -> Either a b
    Right (ReaderContext m -> Either e (ReaderContext m))
    -> m (ReaderContext m) -> m (Either e (ReaderContext m))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m (ReaderContext m)
    forall (m :: * -> *). MonadReader m => m (ReaderContext m)
    ask)

    instance MonadTrans (ExceptT e) where
        lift :: forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
    lift m a
    f = m (Either e a) -> ExceptT e m a
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (a -> Either e a
    forall a b. b -> Either a b
    Right (a -> Either e a) -> m a -> m (Either e a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> m a
    f)

    instance MonadIO m => MonadIO (ExceptT e m) where
        liftIO :: forall a. IO a -> ExceptT e m a
    liftIO IO a
    f = m (Either e a) -> ExceptT e m a
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (a -> Either e a
    forall a b. b -> Either a b
    Right (a -> Either e a) -> m a -> m (Either e a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO a
    f)