{-# 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 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
)
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)
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
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
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
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
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
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
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
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
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
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
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
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
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
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