{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}

{- |
Module      :  Servant.Checked.Exceptions.Internal.EnvelopeT

Copyright   :  Dennis Gosnell 2019
License     :  BSD3

Maintainer  :  Dennis Gosnell (cdep.illabout@gmail.com)
Stability   :  experimental
Portability :  unknown

This module defines the 'EnvelopeT' type and helper functions. 'EnvelopeT' is a
short-circuiting monad transformer.

'Envelope' is similar to 'Either' where multiple errors types are possible.
'EnvelopeT' is similar to 'ExceptT' in a similar manner.
-}

module Servant.Checked.Exceptions.Internal.EnvelopeT where

import Control.Monad.Except (ExceptT(ExceptT), MonadError(throwError, catchError))
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Reader (MonadReader, ask, local, reader)
import Control.Monad.RWS (MonadRWS)
import Control.Monad.State (MonadState, get, put, state)
import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.Monad.Writer (MonadWriter, listen, pass, tell, writer)
import Data.Functor.Classes
  ( Show1
  , liftShowList
  , liftShowsPrec
  , showsPrec1
  , showsUnaryWith
  )
import Data.Functor.Contravariant (Contravariant(contramap))
import Data.WorldPeace
  ( Contains
  , ElemRemove
  , IsMember
  , OpenUnion
  , Remove
  , ReturnX
  , ToOpenProduct
  , relaxOpenUnion
  )

import Servant.Checked.Exceptions.Internal.Envelope
  ( Envelope(ErrEnvelope, SuccEnvelope)
  , catchesEnvelope
  , liftA2Envelope
  , eitherToEnvelope
  , emptyEnvelope
  , envelope
  , envelopeRemove
  , envelopeToEither
  , errEnvelopeMatch
  , pureErrEnvelope
  , pureSuccEnvelope
  , relaxEnvelope
  )

-- $setup
-- >>> :set -XDataKinds
-- >>> :set -XTypeOperators
-- >>> import Data.Functor.Identity (Identity(Identity))

data EnvelopeT es m a = EnvelopeT
  { EnvelopeT es m a -> m (Envelope es a)
runEnvelopeT :: m (Envelope es a)
  } deriving a -> EnvelopeT es m b -> EnvelopeT es m a
(a -> b) -> EnvelopeT es m a -> EnvelopeT es m b
(forall a b. (a -> b) -> EnvelopeT es m a -> EnvelopeT es m b)
-> (forall a b. a -> EnvelopeT es m b -> EnvelopeT es m a)
-> Functor (EnvelopeT es m)
forall (es :: [*]) (m :: * -> *) a b.
Functor m =>
a -> EnvelopeT es m b -> EnvelopeT es m a
forall (es :: [*]) (m :: * -> *) a b.
Functor m =>
(a -> b) -> EnvelopeT es m a -> EnvelopeT es m b
forall a b. a -> EnvelopeT es m b -> EnvelopeT es m a
forall a b. (a -> b) -> EnvelopeT es m a -> EnvelopeT es m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> EnvelopeT es m b -> EnvelopeT es m a
$c<$ :: forall (es :: [*]) (m :: * -> *) a b.
Functor m =>
a -> EnvelopeT es m b -> EnvelopeT es m a
fmap :: (a -> b) -> EnvelopeT es m a -> EnvelopeT es m b
$cfmap :: forall (es :: [*]) (m :: * -> *) a b.
Functor m =>
(a -> b) -> EnvelopeT es m a -> EnvelopeT es m b
Functor

instance (Show (OpenUnion es), Show1 m) => Show1 (EnvelopeT es m) where
  liftShowsPrec
    :: forall a
     . (Int -> a -> ShowS)
    -> ([a] -> ShowS)
    -> Int
    -> EnvelopeT es m a -> ShowS
  liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> EnvelopeT es m a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (EnvelopeT m (Envelope es a)
m) =
    (Int -> m (Envelope es a) -> ShowS)
-> String -> Int -> m (Envelope es a) -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> m (Envelope es a) -> ShowS
showInnerM String
"EnvelopeT" Int
d m (Envelope es a)
m
    where
      showInnerM :: Int -> m (Envelope es a) -> ShowS
      showInnerM :: Int -> m (Envelope es a) -> ShowS
showInnerM = (Int -> Envelope es a -> ShowS)
-> ([Envelope es a] -> ShowS) -> Int -> m (Envelope es a) -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> Envelope es a -> ShowS
sp' [Envelope es a] -> ShowS
sl'

      sp' :: Int -> Envelope es a -> ShowS
      sp' :: Int -> Envelope es a -> ShowS
sp' = (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Envelope es a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl

      sl' :: [Envelope es a] -> ShowS
      sl' :: [Envelope es a] -> ShowS
sl' = (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Envelope es a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl

instance (Show (OpenUnion e), Show1 m, Show a) => Show (EnvelopeT e m a) where
  showsPrec :: Int -> EnvelopeT e m a -> ShowS
showsPrec = Int -> EnvelopeT e m a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1

instance Monad m => Applicative (EnvelopeT es m) where
  pure :: a -> EnvelopeT es m a
  pure :: a -> EnvelopeT es m a
pure a
a = m (Envelope es a) -> EnvelopeT es m a
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope es a) -> EnvelopeT es m a)
-> m (Envelope es a) -> EnvelopeT es m a
forall a b. (a -> b) -> a -> b
$ a -> m (Envelope es a)
forall (m :: * -> *) a (es :: [*]).
Applicative m =>
a -> m (Envelope es a)
pureSuccEnvelope a
a

  (<*>) :: EnvelopeT es m (a -> b) -> EnvelopeT es m a -> EnvelopeT es m b
  EnvelopeT m (Envelope es (a -> b))
a2b <*> :: EnvelopeT es m (a -> b) -> EnvelopeT es m a -> EnvelopeT es m b
<*> EnvelopeT m (Envelope es a)
a = m (Envelope es b) -> EnvelopeT es m b
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope es b) -> EnvelopeT es m b)
-> m (Envelope es b) -> EnvelopeT es m b
forall a b. (a -> b) -> a -> b
$ Envelope es (a -> b) -> Envelope es a -> Envelope es b
forall a b. Envelope es (a -> b) -> Envelope es a -> Envelope es b
go (Envelope es (a -> b) -> Envelope es a -> Envelope es b)
-> m (Envelope es (a -> b)) -> m (Envelope es a -> Envelope es b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Envelope es (a -> b))
a2b m (Envelope es a -> Envelope es b)
-> m (Envelope es a) -> m (Envelope es b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Envelope es a)
a
    where
      go :: Envelope es (a -> b) -> Envelope es a -> Envelope es b
      go :: Envelope es (a -> b) -> Envelope es a -> Envelope es b
go = Envelope es (a -> b) -> Envelope es a -> Envelope es b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

instance Monad m => Monad (EnvelopeT es m) where
  (>>=) :: EnvelopeT es m a -> (a -> EnvelopeT es m b) -> EnvelopeT es m b
  (EnvelopeT m (Envelope es a)
m) >>= :: EnvelopeT es m a -> (a -> EnvelopeT es m b) -> EnvelopeT es m b
>>= a -> EnvelopeT es m b
k = m (Envelope es b) -> EnvelopeT es m b
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope es b) -> EnvelopeT es m b)
-> m (Envelope es b) -> EnvelopeT es m b
forall a b. (a -> b) -> a -> b
$ do
    Envelope es a
env <- m (Envelope es a)
m
    case Envelope es a
env of
      SuccEnvelope a
a -> EnvelopeT es m b -> m (Envelope es b)
forall (es :: [*]) (m :: * -> *) a.
EnvelopeT es m a -> m (Envelope es a)
runEnvelopeT (EnvelopeT es m b -> m (Envelope es b))
-> EnvelopeT es m b -> m (Envelope es b)
forall a b. (a -> b) -> a -> b
$ a -> EnvelopeT es m b
k a
a
      ErrEnvelope OpenUnion es
err -> Envelope es b -> m (Envelope es b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Envelope es b -> m (Envelope es b))
-> Envelope es b -> m (Envelope es b)
forall a b. (a -> b) -> a -> b
$ OpenUnion es -> Envelope es b
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope OpenUnion es
err

instance MonadTrans (EnvelopeT es) where
  lift :: Monad m => m a -> EnvelopeT es m a
  lift :: m a -> EnvelopeT es m a
lift m a
m = m (Envelope es a) -> EnvelopeT es m a
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope es a) -> EnvelopeT es m a)
-> m (Envelope es a) -> EnvelopeT es m a
forall a b. (a -> b) -> a -> b
$ do
    a
val <- m a
m
    a -> m (Envelope es a)
forall (m :: * -> *) a (es :: [*]).
Applicative m =>
a -> m (Envelope es a)
pureSuccEnvelope a
val

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

instance Foldable m => Foldable (EnvelopeT es m) where
  foldMap :: (a -> m) -> EnvelopeT es m a -> m
foldMap a -> m
f (EnvelopeT m (Envelope es a)
m) = (Envelope es a -> m) -> m (Envelope es a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((OpenUnion es -> m) -> (a -> m) -> Envelope es a -> m
forall (es :: [*]) c a.
(OpenUnion es -> c) -> (a -> c) -> Envelope es a -> c
envelope (m -> OpenUnion es -> m
forall a b. a -> b -> a
const m
forall a. Monoid a => a
mempty) a -> m
f) m (Envelope es a)
m

instance (Traversable m) => Traversable (EnvelopeT es m) where
  traverse
    :: Applicative f => (a -> f b) -> EnvelopeT es m a -> f (EnvelopeT es m b)
  traverse :: (a -> f b) -> EnvelopeT es m a -> f (EnvelopeT es m b)
traverse a -> f b
f (EnvelopeT m (Envelope es a)
m) =
    (m (Envelope es b) -> EnvelopeT es m b)
-> f (m (Envelope es b)) -> f (EnvelopeT es m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m (Envelope es b) -> EnvelopeT es m b
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (f (m (Envelope es b)) -> f (EnvelopeT es m b))
-> f (m (Envelope es b)) -> f (EnvelopeT es m b)
forall a b. (a -> b) -> a -> b
$
      (Envelope es a -> f (Envelope es b))
-> m (Envelope es a) -> f (m (Envelope es b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((OpenUnion es -> f (Envelope es b))
-> (a -> f (Envelope es b)) -> Envelope es a -> f (Envelope es b)
forall (es :: [*]) c a.
(OpenUnion es -> c) -> (a -> c) -> Envelope es a -> c
envelope (Envelope es b -> f (Envelope es b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Envelope es b -> f (Envelope es b))
-> (OpenUnion es -> Envelope es b)
-> OpenUnion es
-> f (Envelope es b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenUnion es -> Envelope es b
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope) ((b -> Envelope es b) -> f b -> f (Envelope es b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Envelope es b
forall (es :: [*]) a. a -> Envelope es a
SuccEnvelope (f b -> f (Envelope es b)) -> (a -> f b) -> a -> f (Envelope es b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f)) m (Envelope es a)
m

instance Contravariant m => Contravariant (EnvelopeT es m) where
  contramap :: (b -> a) -> EnvelopeT es m a -> EnvelopeT es m b
  contramap :: (b -> a) -> EnvelopeT es m a -> EnvelopeT es m b
contramap b -> a
f (EnvelopeT m (Envelope es a)
m) = m (Envelope es b) -> EnvelopeT es m b
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope es b) -> EnvelopeT es m b)
-> m (Envelope es b) -> EnvelopeT es m b
forall a b. (a -> b) -> a -> b
$ (Envelope es b -> Envelope es a)
-> m (Envelope es a) -> m (Envelope es b)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ((b -> a) -> Envelope es b -> Envelope es a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f) m (Envelope es a)
m

instance MonadRWS r w s m => MonadRWS r w s (EnvelopeT es m)

instance MonadError error m => MonadError error (EnvelopeT es m) where
  throwError :: error -> EnvelopeT es m a
throwError = m (Envelope es a) -> EnvelopeT es m a
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope es a) -> EnvelopeT es m a)
-> (error -> m (Envelope es a)) -> error -> EnvelopeT es m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. error -> m (Envelope es a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

  catchError
    :: forall a
     . EnvelopeT es m a
    -> (error -> EnvelopeT es m a)
    -> EnvelopeT es m a
  catchError :: EnvelopeT es m a -> (error -> EnvelopeT es m a) -> EnvelopeT es m a
catchError (EnvelopeT m (Envelope es a)
m) error -> EnvelopeT es m a
handler = m (Envelope es a) -> EnvelopeT es m a
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope es a) -> EnvelopeT es m a)
-> m (Envelope es a) -> EnvelopeT es m a
forall a b. (a -> b) -> a -> b
$ m (Envelope es a)
-> (error -> m (Envelope es a)) -> m (Envelope es a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m (Envelope es a)
m error -> m (Envelope es a)
innerRunner
    where
      innerRunner :: error -> m (Envelope es a)
      innerRunner :: error -> m (Envelope es a)
innerRunner = EnvelopeT es m a -> m (Envelope es a)
forall (es :: [*]) (m :: * -> *) a.
EnvelopeT es m a -> m (Envelope es a)
runEnvelopeT (EnvelopeT es m a -> m (Envelope es a))
-> (error -> EnvelopeT es m a) -> error -> m (Envelope es a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. error -> EnvelopeT es m a
handler

instance MonadReader r m => MonadReader r (EnvelopeT es m) where
  ask :: EnvelopeT es m r
ask = m r -> EnvelopeT es m r
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 :: (r -> r) -> EnvelopeT es m a -> EnvelopeT es m a
local r -> r
f (EnvelopeT m (Envelope es a)
m) = m (Envelope es a) -> EnvelopeT es m a
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT ((r -> r) -> m (Envelope es a) -> m (Envelope es a)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f m (Envelope es a)
m)
  reader :: (r -> a) -> EnvelopeT es m a
reader = m a -> EnvelopeT es m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> EnvelopeT es m a)
-> ((r -> a) -> m a) -> (r -> a) -> EnvelopeT es m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader

instance MonadState s m => MonadState s (EnvelopeT es m) where
  get :: EnvelopeT es m s
get = m s -> EnvelopeT es m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> EnvelopeT es m ()
put = m () -> EnvelopeT es m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> EnvelopeT es m ())
-> (s -> m ()) -> s -> EnvelopeT es m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
  state :: (s -> (a, s)) -> EnvelopeT es m a
state = m a -> EnvelopeT es m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> EnvelopeT es m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> EnvelopeT es m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state

instance MonadWriter w m => MonadWriter w (EnvelopeT es m) where
  writer :: (a, w) -> EnvelopeT es m a
writer = m a -> EnvelopeT es m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> EnvelopeT es m a)
-> ((a, w) -> m a) -> (a, w) -> EnvelopeT es m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
  tell :: w -> EnvelopeT es m ()
tell = m () -> EnvelopeT es m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> EnvelopeT es m ())
-> (w -> m ()) -> w -> EnvelopeT es m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: EnvelopeT es m a -> EnvelopeT es m (a, w)
listen (EnvelopeT m (Envelope es a)
m) =
    m (Envelope es (a, w)) -> EnvelopeT es m (a, w)
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope es (a, w)) -> EnvelopeT es m (a, w))
-> m (Envelope es (a, w)) -> EnvelopeT es m (a, w)
forall a b. (a -> b) -> a -> b
$ do
      (Envelope es a
envelopeA, w
w) <- m (Envelope es a) -> m (Envelope es a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m (Envelope es a)
m
      Envelope es (a, w) -> m (Envelope es (a, w))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Envelope es (a, w) -> m (Envelope es (a, w)))
-> Envelope es (a, w) -> m (Envelope es (a, w))
forall a b. (a -> b) -> a -> b
$ (a -> (a, w)) -> Envelope es a -> Envelope es (a, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,w
w) Envelope es a
envelopeA
  pass :: EnvelopeT es m (a, w -> w) -> EnvelopeT es m a
pass (EnvelopeT m (Envelope es (a, w -> w))
m) =
    m (Envelope es a) -> EnvelopeT es m a
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope es a) -> EnvelopeT es m a)
-> m (Envelope es a) -> EnvelopeT es m a
forall a b. (a -> b) -> a -> b
$ do
      Envelope es (a, w -> w)
envel <- m (Envelope es (a, w -> w))
m
      m (Envelope es a, w -> w) -> m (Envelope es a)
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m (Envelope es a, w -> w) -> m (Envelope es a))
-> ((Envelope es a, w -> w) -> m (Envelope es a, w -> w))
-> (Envelope es a, w -> w)
-> m (Envelope es a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Envelope es a, w -> w) -> m (Envelope es a, w -> w)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Envelope es a, w -> w) -> m (Envelope es a))
-> (Envelope es a, w -> w) -> m (Envelope es a)
forall a b. (a -> b) -> a -> b
$
        case Envelope es (a, w -> w)
envel of
          SuccEnvelope (a
a, w -> w
f) -> (a -> Envelope es a
forall (es :: [*]) a. a -> Envelope es a
SuccEnvelope a
a, w -> w
f)
          ErrEnvelope OpenUnion es
es -> (OpenUnion es -> Envelope es a
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope OpenUnion es
es, w -> w
forall a. a -> a
id)

-- | This is 'pure' for 'EnvelopeT'.
--
-- >>> pureSuccEnvT "hello" :: EnvelopeT '[] Identity String
-- EnvelopeT (Identity (SuccEnvelope "hello"))
pureSuccEnvT :: Applicative m => a -> EnvelopeT es m a
pureSuccEnvT :: a -> EnvelopeT es m a
pureSuccEnvT = m (Envelope es a) -> EnvelopeT es m a
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope es a) -> EnvelopeT es m a)
-> (a -> m (Envelope es a)) -> a -> EnvelopeT es m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Envelope es a)
forall (m :: * -> *) a (es :: [*]).
Applicative m =>
a -> m (Envelope es a)
pureSuccEnvelope

-- | Throw an error in an 'ErrEnvelope'.
--
-- >>> let double = 3.5 :: Double
-- >>> throwErrEnvT double :: EnvelopeT '[String, Double, Int] Identity ()
-- EnvelopeT (Identity (ErrEnvelope (Identity 3.5)))
--
-- This is similar to 'throwError', but is specialized so you can throw just
-- one of the error types.
throwErrEnvT :: (Applicative m, IsMember e es) => e -> EnvelopeT es m a
throwErrEnvT :: e -> EnvelopeT es m a
throwErrEnvT = m (Envelope es a) -> EnvelopeT es m a
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope es a) -> EnvelopeT es m a)
-> (e -> m (Envelope es a)) -> e -> EnvelopeT es m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m (Envelope es a)
forall (m :: * -> *) e (es :: [*]) a.
(Applicative m, IsMember e es) =>
e -> m (Envelope es a)
pureErrEnvelope

-- | Case analysis for 'EnvelopeT'.
--
-- ==== __Examples__
--
--  Here is an example of matching on a 'SuccEnvelope':
--
-- >>> let env = pure "hello" :: EnvelopeT '[Double, Int] Identity String
-- >>> envelopeT (\_ -> Identity "not a String") Identity env
-- Identity "hello"
--
-- Here is an example of matching on a 'ErrEnvelope':
--
-- >>> let double = 3.5 :: Double
-- >>> let env' = throwErrEnvT double :: EnvelopeT '[Double, Int] Identity String
-- >>> envelopeT (\_ -> Identity "not a String") Identity env'
-- Identity "not a String"
envelopeT :: Monad m => (OpenUnion es -> m c) -> (a -> m c) -> EnvelopeT es m a -> m c
envelopeT :: (OpenUnion es -> m c) -> (a -> m c) -> EnvelopeT es m a -> m c
envelopeT OpenUnion es -> m c
errHandler a -> m c
succHandler (EnvelopeT m (Envelope es a)
m) = do
  Envelope es a
envel <- m (Envelope es a)
m
  (OpenUnion es -> m c) -> (a -> m c) -> Envelope es a -> m c
forall (es :: [*]) c a.
(OpenUnion es -> c) -> (a -> c) -> Envelope es a -> c
envelope OpenUnion es -> m c
errHandler a -> m c
succHandler Envelope es a
envel

-- | Slight simplification of 'envelopeT'.
--
-- ==== __Examples__
--
--  Here is an example of successfully matching:
--
-- >>> let env = pure "hello" :: EnvelopeT '[Double, Int] Identity String
-- >>> fromEnvT (\_ -> Identity "not a String") env
-- Identity "hello"
--
-- Here is an example of unsuccessfully matching:
--
-- >>> let double = 3.5 :: Double
-- >>> let env' = throwErrEnvT double :: EnvelopeT '[Double, Int] Identity String
-- >>> fromEnvT (\_ -> Identity "not a String") env'
-- Identity "not a String"
fromEnvT :: Monad m => (OpenUnion es -> m a) -> EnvelopeT es m a -> m a
fromEnvT :: (OpenUnion es -> m a) -> EnvelopeT es m a -> m a
fromEnvT OpenUnion es -> m a
f = (OpenUnion es -> m a) -> (a -> m a) -> EnvelopeT es m a -> m a
forall (m :: * -> *) (es :: [*]) c a.
Monad m =>
(OpenUnion es -> m c) -> (a -> m c) -> EnvelopeT es m a -> m c
envelopeT OpenUnion es -> m a
f a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Flipped version of 'fromEnvT'.
fromEnvTOr :: Monad m => EnvelopeT es m a -> (OpenUnion es -> m a) -> m a
fromEnvTOr :: EnvelopeT es m a -> (OpenUnion es -> m a) -> m a
fromEnvTOr = ((OpenUnion es -> m a) -> EnvelopeT es m a -> m a)
-> EnvelopeT es m a -> (OpenUnion es -> m a) -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (OpenUnion es -> m a) -> EnvelopeT es m a -> m a
forall (m :: * -> *) (es :: [*]) a.
Monad m =>
(OpenUnion es -> m a) -> EnvelopeT es m a -> m a
fromEnvT

-- | Try to pull out a specific @e@ from an 'ErrEnvelope'.
--
-- ==== __Examples__
--
-- Successfully pull out an @e@:
--
-- >>> let double = 3.5 :: Double
-- >>> let env = throwErrEnvT double :: EnvelopeT '[Double, Char] Identity ()
-- >>> errEnvTMatch env :: Identity (Maybe Double)
-- Identity (Just 3.5)
--
-- Unsuccessfully pull out an @e@:
--
-- >>> let env' = pure () :: EnvelopeT '[String, Double] Identity ()
-- >>> errEnvTMatch env' :: Identity (Maybe Double)
-- Identity Nothing
errEnvTMatch
  :: forall e es m a.
     (Functor m, IsMember e es)
  => EnvelopeT es m a
  -> m (Maybe e)
errEnvTMatch :: EnvelopeT es m a -> m (Maybe e)
errEnvTMatch (EnvelopeT m (Envelope es a)
m) = (Envelope es a -> Maybe e) -> m (Envelope es a) -> m (Maybe e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Envelope es a -> Maybe e
forall e (es :: [*]) a. IsMember e es => Envelope es a -> Maybe e
errEnvelopeMatch m (Envelope es a)
m

-- | An alternate case anaylsis for an 'EnvelopeT'.  This method uses a tuple
-- containing handlers for each potential value of the underlying 'Envelope'.
-- This is somewhat similar to the 'Control.Exception.catches' function.
--
-- When working with an 'Envelope' with a large number of possible error types,
-- it can be easier to use 'catchesEnvT' than 'envelopeT'.
--
-- ==== __Examples__
--
-- Here is an example of handling an 'SuccEnvelope' with two possible error values.
-- Notice that a normal tuple is used:
--
-- >>> let env = pure 2.0 :: EnvelopeT '[Int, String] IO Double
-- >>> let intHandler = (\int -> pure $ show int) :: Int -> IO String
-- >>> let strHandler = (\str -> pure str) :: String -> IO String
-- >>> let succHandler = (\dbl -> pure "got a double") :: Double -> IO String
-- >>> catchesEnvT (intHandler, strHandler) succHandler env :: IO String
-- "got a double"
--
-- Here is an example of handling an 'ErrEnvelope' with two possible error values.
-- Notice that a normal tuple is used to hold the handlers:
--
-- >>> let env = throwErrEnvT (3 :: Int) :: EnvelopeT '[Int, String] Identity Double
-- >>> let intHandler = (\int -> Identity $ show int) :: Int -> Identity String
-- >>> let strHandler = (\str -> Identity str) :: String -> Identity String
-- >>> let succHandler = (\dbl -> Identity "got a double") :: Double -> Identity String
-- >>> catchesEnvT (intHandler, strHandler) succHandler env :: Identity String
-- Identity "3"
--
-- Given an 'EnvelopeT' like @'EnvelopeT' \'['Int', 'String'] 'IO' 'Double'@,
-- the type of 'catchesEnvT' becomes the following:
--
-- @
--   'catchesEnvT'
--     :: ('Int' -> 'IO' x, 'String' -> 'IO' x)
--     -> ('Double' -> 'IO' x)
--     -> 'EnvelopeT' \'['Int', 'String'] 'IO' 'Double'
--     -> 'IO' x
-- @
--
-- Here is an example of handling an 'ErrEnvelope' with three possible values.
-- Notice how a 3-tuple is used to hold the handlers:
--
-- >>> let env = throwErrEnvT ("hi" :: String) :: EnvelopeT '[Int, String, Char] IO Double
-- >>> let intHandler = (\int -> pure $ show int) :: Int -> IO String
-- >>> let strHandler = (\str -> pure str) :: String -> IO String
-- >>> let chrHandler = (\chr -> pure [chr]) :: Char -> IO String
-- >>> let succHandler = (\dbl -> pure "got a double") :: Double -> IO String
-- >>> catchesEnvT (intHandler, strHandler, chrHandler) succHandler env :: IO String
-- "hi"
--
-- Given an 'Envelope' like @'EnvelopeT' \'['Int', 'String', 'Char'] 'IO' 'Double'@,
-- the type of 'catchesEnvT' becomes the following:
--
-- @
--   'catchesEnvT'
--     :: ('Int' -> 'IO' x, 'String' -> 'IO' x, 'Char' -> 'IO' x)
--     -> ('Double' -> 'IO' x)
--     -> 'EnvelopeT' \'['Int', 'String', 'Char'] 'IO' 'Double'
--     -> x
-- @
catchesEnvT
  :: forall tuple es m a x
   .  (Monad m, ToOpenProduct tuple (ReturnX (m x) es))
  => tuple -> (a -> m x) -> EnvelopeT es m a -> m x
catchesEnvT :: tuple -> (a -> m x) -> EnvelopeT es m a -> m x
catchesEnvT tuple
tuple a -> m x
a2mx (EnvelopeT m (Envelope es a)
m) = do
  Envelope es a
envel <- m (Envelope es a)
m
  tuple -> (a -> m x) -> Envelope es a -> m x
forall tuple (es :: [*]) a x.
ToOpenProduct tuple (ReturnX x es) =>
tuple -> (a -> x) -> Envelope es a -> x
catchesEnvelope tuple
tuple a -> m x
a2mx Envelope es a
envel

-- | Convert an 'EnvelopeT' to an 'ExceptT'.
envTToExceptT :: Functor m => EnvelopeT es m a -> ExceptT (OpenUnion es) m a
envTToExceptT :: EnvelopeT es m a -> ExceptT (OpenUnion es) m a
envTToExceptT (EnvelopeT m (Envelope es a)
m) = m (Either (OpenUnion es) a) -> ExceptT (OpenUnion es) m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either (OpenUnion es) a) -> ExceptT (OpenUnion es) m a)
-> m (Either (OpenUnion es) a) -> ExceptT (OpenUnion es) m a
forall a b. (a -> b) -> a -> b
$ (Envelope es a -> Either (OpenUnion es) a)
-> m (Envelope es a) -> m (Either (OpenUnion es) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Envelope es a -> Either (OpenUnion es) a
forall (es :: [*]) a. Envelope es a -> Either (OpenUnion es) a
envelopeToEither m (Envelope es a)
m

-- | Convert an 'ExceptT' to an 'EnvelopeT'.
exceptTToEnvT :: Functor m => ExceptT (OpenUnion es) m a -> EnvelopeT es m a
exceptTToEnvT :: ExceptT (OpenUnion es) m a -> EnvelopeT es m a
exceptTToEnvT (ExceptT m (Either (OpenUnion es) a)
m) = m (Envelope es a) -> EnvelopeT es m a
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope es a) -> EnvelopeT es m a)
-> m (Envelope es a) -> EnvelopeT es m a
forall a b. (a -> b) -> a -> b
$ (Either (OpenUnion es) a -> Envelope es a)
-> m (Either (OpenUnion es) a) -> m (Envelope es a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (OpenUnion es) a -> Envelope es a
forall (es :: [*]) a. Either (OpenUnion es) a -> Envelope es a
eitherToEnvelope m (Either (OpenUnion es) a)
m

-- | Safely unwrap an 'EnvelopeT'.
--
-- >>> let myenvT = pure "hello" :: EnvelopeT '[] IO String
-- >>> emptyEnvT myenvT :: IO String
-- "hello"
emptyEnvT :: Functor m => EnvelopeT '[] m a -> m a
emptyEnvT :: EnvelopeT '[] m a -> m a
emptyEnvT (EnvelopeT m (Envelope '[] a)
m) = (Envelope '[] a -> a) -> m (Envelope '[] a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Envelope '[] a -> a
forall a. Envelope '[] a -> a
emptyEnvelope m (Envelope '[] a)
m

-- | Change the errors type in an 'EnvelopeT' to a larger set.
--
-- ==== __Examples__
--
-- >>> let double = 3.5 :: Double
-- >>> let envT1 = throwErrEnvT double :: EnvelopeT '[Int, Double] Identity Float
-- >>> relaxEnvT envT1 :: EnvelopeT '[Char, Int, String, Double] Identity Float
-- EnvelopeT (Identity (ErrEnvelope (Identity 3.5)))
--
-- >>> let envT2 = pure double :: EnvelopeT '[Char, Int] Identity Double
-- >>> relaxEnvT envT2 :: EnvelopeT '[(), Char, String, Int] Identity Double
-- EnvelopeT (Identity (SuccEnvelope 3.5))
relaxEnvT :: (Functor m, Contains es1 es2) => EnvelopeT es1 m a -> EnvelopeT es2 m a
relaxEnvT :: EnvelopeT es1 m a -> EnvelopeT es2 m a
relaxEnvT (EnvelopeT m (Envelope es1 a)
m) = m (Envelope es2 a) -> EnvelopeT es2 m a
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope es2 a) -> EnvelopeT es2 m a)
-> m (Envelope es2 a) -> EnvelopeT es2 m a
forall a b. (a -> b) -> a -> b
$ (Envelope es1 a -> Envelope es2 a)
-> m (Envelope es1 a) -> m (Envelope es2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Envelope es1 a -> Envelope es2 a
forall (es :: [*]) (biggerEs :: [*]) a.
Contains es biggerEs =>
Envelope es a -> Envelope biggerEs a
relaxEnvelope m (Envelope es1 a)
m

-- | Combine two 'EnvelopeT's.  Generalize the set of errors to include the errors
-- from both 'EnvelopeT's. Similar to 'liftA2' but more general.
--
-- ==== __Examples__
--
-- >>> let env1 = pure "hello" :: EnvelopeT '[Double, Int] Identity String
-- >>> let env2 = pure " world" :: EnvelopeT '[Char]  Identity String
-- >>> liftA2EnvT (<>) env1 env2 :: EnvelopeT '[Double, Int, Char] Identity String
-- EnvelopeT (Identity (SuccEnvelope "hello world"))
--
-- If either of the 'Envelope's is an 'ErrEnvelope', then return the 'ErrEnvelope'.
--
-- >>> let env3 = throwErrEnvT "some err" :: EnvelopeT '[String, Double] Identity Int
-- >>> let env4 = pure 1 :: EnvelopeT '[Char]  Identity Int
-- >>> liftA2EnvT (+) env3 env4 :: EnvelopeT '[String, Double, Char] Identity Int
-- EnvelopeT (Identity (ErrEnvelope (Identity "some err")))
--
-- >>> let env5 = pure "hello" :: EnvelopeT '[Char] Identity String
-- >>> let env6 = throwErrEnvT 3.5 :: EnvelopeT '[(), Double] Identity String
-- >>> liftA2EnvT (<>) env5 env6 :: EnvelopeT '[Char, (), Double] Identity String
-- EnvelopeT (Identity (ErrEnvelope (Identity 3.5)))
--
-- If both of the 'EnvelopeT's is an 'ErrEnvelope', then short-circuit and only
-- return the first 'ErrEnvelope'.
--
-- >>> let env7 = throwErrEnvT 4.5 :: EnvelopeT '[(), Double] Identity String
-- >>> let env8 = throwErrEnvT 'x' :: EnvelopeT '[Int, Char] Identity String
-- >>> liftA2EnvT (<>) env7 env8 :: EnvelopeT '[(), Double, Int, Char] Identity String
-- EnvelopeT (Identity (ErrEnvelope (Identity 4.5)))
liftA2EnvT
  :: (Contains es1 fullEs, Contains es2 fullEs, Applicative m)
  => (a -> b -> c)
  -> EnvelopeT es1 m a
  -> EnvelopeT es2 m b
  -> EnvelopeT fullEs m c
liftA2EnvT :: (a -> b -> c)
-> EnvelopeT es1 m a -> EnvelopeT es2 m b -> EnvelopeT fullEs m c
liftA2EnvT a -> b -> c
f (EnvelopeT m (Envelope es1 a)
m) (EnvelopeT m (Envelope es2 b)
n) =
  m (Envelope fullEs c) -> EnvelopeT fullEs m c
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope fullEs c) -> EnvelopeT fullEs m c)
-> m (Envelope fullEs c) -> EnvelopeT fullEs m c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c)
-> Envelope es1 a -> Envelope es2 b -> Envelope fullEs c
forall (es1 :: [*]) (fullEs :: [*]) (es2 :: [*]) a b c.
(Contains es1 fullEs, Contains es2 fullEs) =>
(a -> b -> c)
-> Envelope es1 a -> Envelope es2 b -> Envelope fullEs c
liftA2Envelope a -> b -> c
f (Envelope es1 a -> Envelope es2 b -> Envelope fullEs c)
-> m (Envelope es1 a) -> m (Envelope es2 b -> Envelope fullEs c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Envelope es1 a)
m m (Envelope es2 b -> Envelope fullEs c)
-> m (Envelope es2 b) -> m (Envelope fullEs c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Envelope es2 b)
n

-- | This is like 'liftA2EnvT' but for monadic bind ('>>=').
--
-- This allows you to bind on 'EnvelopeT's that contain different errors.
--
-- The resulting 'EnvelopeT' must have a superset of the errors in two input
-- 'EnvelopeT's.
--
-- ==== __Examples__
--
-- >>> let env1 = pure "hello" :: EnvelopeT '[Double, Int] Identity String
-- >>> let f1 str = pure (length str) :: EnvelopeT '[Char] Identity Int
-- >>> bindEnvT env1 f1 :: EnvelopeT '[Double, Int, Char] Identity Int
-- EnvelopeT (Identity (SuccEnvelope 5))
--
-- If either of the 'EnvelopeT's holds an 'ErrEnvelope', then return the 'ErrEnvelope'.
--
-- >>> let env2 = throwErrEnvT "some err" :: EnvelopeT '[String, Double] Identity Int
-- >>> let f2 i = pureSuccEnvT (i + 1) :: EnvelopeT '[Char] Identity Int
-- >>> bindEnvT env2 f2 :: EnvelopeT '[String, Double, Char] Identity Int
-- EnvelopeT (Identity (ErrEnvelope (Identity "some err")))
--
-- >>> let env3 = pureSuccEnvT "hello" :: EnvelopeT '[Char] Identity String
-- >>> let f3 _ = throwErrEnvT 3.5 :: EnvelopeT '[(), Double] Identity Int
-- >>> bindEnvT env3 f3 :: EnvelopeT '[Char, (), Double] Identity Int
-- EnvelopeT (Identity (ErrEnvelope (Identity 3.5)))
--
-- If both of the 'Envelope's is an 'ErrEnvelope', then short-circuit and only
-- return the first 'ErrEnvelope'.
--
-- >>> let env4 = throwErrEnvT 3.5 :: EnvelopeT '[(), Double] Maybe String
-- >>> let f4 _ = throwErrEnvT 'x' :: EnvelopeT '[Int, Char] Maybe String
-- >>> bindEnvT env4 f4 :: EnvelopeT '[Char, (), Double, Int] Maybe String
-- EnvelopeT (Just (ErrEnvelope (Identity 3.5)))
bindEnvT
  :: (Contains es1 fullEs, Contains es2 fullEs, Monad m)
  => EnvelopeT es1 m a
  -> (a -> EnvelopeT es2 m b)
  -> EnvelopeT fullEs m b
bindEnvT :: EnvelopeT es1 m a
-> (a -> EnvelopeT es2 m b) -> EnvelopeT fullEs m b
bindEnvT (EnvelopeT m (Envelope es1 a)
m) a -> EnvelopeT es2 m b
f =
  m (Envelope fullEs b) -> EnvelopeT fullEs m b
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope fullEs b) -> EnvelopeT fullEs m b)
-> m (Envelope fullEs b) -> EnvelopeT fullEs m b
forall a b. (a -> b) -> a -> b
$ do
    Envelope es1 a
envel1 <- m (Envelope es1 a)
m
    case Envelope es1 a
envel1 of
      SuccEnvelope a
a ->
        let x :: EnvelopeT es2 m b
x = a -> EnvelopeT es2 m b
f a
a
        in EnvelopeT fullEs m b -> m (Envelope fullEs b)
forall (es :: [*]) (m :: * -> *) a.
EnvelopeT es m a -> m (Envelope es a)
runEnvelopeT (EnvelopeT fullEs m b -> m (Envelope fullEs b))
-> EnvelopeT fullEs m b -> m (Envelope fullEs b)
forall a b. (a -> b) -> a -> b
$ EnvelopeT es2 m b -> EnvelopeT fullEs m b
forall (m :: * -> *) (es1 :: [*]) (es2 :: [*]) a.
(Functor m, Contains es1 es2) =>
EnvelopeT es1 m a -> EnvelopeT es2 m a
relaxEnvT EnvelopeT es2 m b
x
      ErrEnvelope OpenUnion es1
u ->
        let fullEs :: OpenUnion fullEs
fullEs = OpenUnion es1 -> OpenUnion fullEs
forall (as :: [*]) (bs :: [*]).
Contains as bs =>
OpenUnion as -> OpenUnion bs
relaxOpenUnion OpenUnion es1
u
        in Envelope fullEs b -> m (Envelope fullEs b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Envelope fullEs b -> m (Envelope fullEs b))
-> Envelope fullEs b -> m (Envelope fullEs b)
forall a b. (a -> b) -> a -> b
$ OpenUnion fullEs -> Envelope fullEs b
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope OpenUnion fullEs
fullEs

-- | This function allows you to try to remove individual error types from an
-- 'EnvelopeT'.
--
-- This can be used to handle only certain error types in an 'Envelope',
-- instead of having to handle all of them at the same time.  This can be more
-- convenient than a function like 'catchesEnvT'.
--
-- ==== __Examples__
--
-- Pulling out an error in an 'EnvelopeT':
--
-- >>> let env1 = throwErrEnvT "hello" :: EnvelopeT '[String, Double] Identity Float
-- >>> envTRemove env1 :: EnvelopeT '[Double] Identity (Either Float String)
-- EnvelopeT (Identity (SuccEnvelope (Right "hello")))
--
-- Failing to pull out an error in an 'EnvelopeT':
--
-- >>> let env2 = throwErrEnvT (3.5 :: Double) :: EnvelopeT '[String, Double] Identity Float
-- >>> envTRemove env2 :: EnvelopeT '[Double] Identity (Either Float String)
-- EnvelopeT (Identity (ErrEnvelope (Identity 3.5)))
--
-- Note that if you have an 'EnvelopeT' with multiple errors of the same type,
-- they will all be handled at the same time:
--
-- >>> let env3 = throwErrEnvT (3.5 :: Double) :: EnvelopeT '[String, Double, Char, Double] Identity Float
-- >>> envTRemove env3 :: EnvelopeT '[String, Char] Identity (Either Float Double)
-- EnvelopeT (Identity (SuccEnvelope (Right 3.5)))
--
-- 'SuccEnvelope' gets passed through as expected:
--
-- >>> let env4 = pureSuccEnvT 3.5 :: EnvelopeT '[String, Double] Identity Float
-- >>> envTRemove env4 :: EnvelopeT '[Double] Identity (Either Float String)
-- EnvelopeT (Identity (SuccEnvelope (Left 3.5)))
envTRemove
  :: forall e es m a
   . (ElemRemove e es, Functor m)
  => EnvelopeT es m a
  -> EnvelopeT (Remove e es) m (Either a e)
envTRemove :: EnvelopeT es m a -> EnvelopeT (Remove e es) m (Either a e)
envTRemove (EnvelopeT m (Envelope es a)
m) = m (Envelope (Remove e es) (Either a e))
-> EnvelopeT (Remove e es) m (Either a e)
forall (es :: [*]) (m :: * -> *) a.
m (Envelope es a) -> EnvelopeT es m a
EnvelopeT (m (Envelope (Remove e es) (Either a e))
 -> EnvelopeT (Remove e es) m (Either a e))
-> m (Envelope (Remove e es) (Either a e))
-> EnvelopeT (Remove e es) m (Either a e)
forall a b. (a -> b) -> a -> b
$ (Envelope es a -> Envelope (Remove e es) (Either a e))
-> m (Envelope es a) -> m (Envelope (Remove e es) (Either a e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Envelope es a -> Envelope (Remove e es) (Either a e)
go m (Envelope es a)
m
  where
  go :: Envelope es a -> Envelope (Remove e es) (Either a e)
  go :: Envelope es a -> Envelope (Remove e es) (Either a e)
go Envelope es a
envel =
    case Envelope es a -> Either (Envelope (Remove e es) a) e
forall e (es :: [*]) a.
ElemRemove e es =>
Envelope es a -> Either (Envelope (Remove e es) a) e
envelopeRemove Envelope es a
envel of
      Right e
e -> Either a e -> Envelope (Remove e es) (Either a e)
forall (es :: [*]) a. a -> Envelope es a
SuccEnvelope (e -> Either a e
forall a b. b -> Either a b
Right e
e)
      Left Envelope (Remove e es) a
envel -> (a -> Either a e)
-> Envelope (Remove e es) a -> Envelope (Remove e es) (Either a e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a e
forall a b. a -> Either a b
Left Envelope (Remove e es) a
envel