{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Servant.Checked.Exceptions.Internal.Envelope where
import Control.Applicative ((<|>))
import Control.Monad.Fix (MonadFix(mfix))
import Data.Aeson
( FromJSON(parseJSON)
, ToJSON(toJSON)
, Value
, (.:)
, (.=)
, object
, withObject
)
import Data.Aeson.Types (Parser)
import Data.Data (Data)
import Data.Functor.Classes
( Show1
, liftShowsPrec
, showsUnaryWith
)
import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotent)
import Data.Typeable (Typeable)
import Data.WorldPeace
( Contains
, ElemRemove
, IsMember
, OpenUnion
, Remove
, ReturnX
, ToOpenProduct
, absurdUnion
, catchesOpenUnion
, openUnionHandle
, openUnionLift
, openUnionPrism
, openUnionRemove
, relaxOpenUnion
)
import GHC.Generics (Generic)
import Servant.Checked.Exceptions.Internal.Prism
(Iso, Prism, Prism', iso, preview, prism)
data Envelope es a = ErrEnvelope (OpenUnion es) | SuccEnvelope a
deriving (Envelope es a -> Bool
(a -> m) -> Envelope es a -> m
(a -> b -> b) -> b -> Envelope es a -> b
(forall m. Monoid m => Envelope es m -> m)
-> (forall m a. Monoid m => (a -> m) -> Envelope es a -> m)
-> (forall m a. Monoid m => (a -> m) -> Envelope es a -> m)
-> (forall a b. (a -> b -> b) -> b -> Envelope es a -> b)
-> (forall a b. (a -> b -> b) -> b -> Envelope es a -> b)
-> (forall b a. (b -> a -> b) -> b -> Envelope es a -> b)
-> (forall b a. (b -> a -> b) -> b -> Envelope es a -> b)
-> (forall a. (a -> a -> a) -> Envelope es a -> a)
-> (forall a. (a -> a -> a) -> Envelope es a -> a)
-> (forall a. Envelope es a -> [a])
-> (forall a. Envelope es a -> Bool)
-> (forall a. Envelope es a -> Int)
-> (forall a. Eq a => a -> Envelope es a -> Bool)
-> (forall a. Ord a => Envelope es a -> a)
-> (forall a. Ord a => Envelope es a -> a)
-> (forall a. Num a => Envelope es a -> a)
-> (forall a. Num a => Envelope es a -> a)
-> Foldable (Envelope es)
forall (es :: [*]) a. Eq a => a -> Envelope es a -> Bool
forall (es :: [*]) a. Num a => Envelope es a -> a
forall (es :: [*]) a. Ord a => Envelope es a -> a
forall (es :: [*]) m. Monoid m => Envelope es m -> m
forall (es :: [*]) a. Envelope es a -> Bool
forall (es :: [*]) a. Envelope es a -> Int
forall (es :: [*]) a. Envelope es a -> [a]
forall (es :: [*]) a. (a -> a -> a) -> Envelope es a -> a
forall (es :: [*]) m a. Monoid m => (a -> m) -> Envelope es a -> m
forall (es :: [*]) b a. (b -> a -> b) -> b -> Envelope es a -> b
forall (es :: [*]) a b. (a -> b -> b) -> b -> Envelope es a -> b
forall a. Eq a => a -> Envelope es a -> Bool
forall a. Num a => Envelope es a -> a
forall a. Ord a => Envelope es a -> a
forall m. Monoid m => Envelope es m -> m
forall a. Envelope es a -> Bool
forall a. Envelope es a -> Int
forall a. Envelope es a -> [a]
forall a. (a -> a -> a) -> Envelope es a -> a
forall m a. Monoid m => (a -> m) -> Envelope es a -> m
forall b a. (b -> a -> b) -> b -> Envelope es a -> b
forall a b. (a -> b -> b) -> b -> Envelope es a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Envelope es a -> a
$cproduct :: forall (es :: [*]) a. Num a => Envelope es a -> a
sum :: Envelope es a -> a
$csum :: forall (es :: [*]) a. Num a => Envelope es a -> a
minimum :: Envelope es a -> a
$cminimum :: forall (es :: [*]) a. Ord a => Envelope es a -> a
maximum :: Envelope es a -> a
$cmaximum :: forall (es :: [*]) a. Ord a => Envelope es a -> a
elem :: a -> Envelope es a -> Bool
$celem :: forall (es :: [*]) a. Eq a => a -> Envelope es a -> Bool
length :: Envelope es a -> Int
$clength :: forall (es :: [*]) a. Envelope es a -> Int
null :: Envelope es a -> Bool
$cnull :: forall (es :: [*]) a. Envelope es a -> Bool
toList :: Envelope es a -> [a]
$ctoList :: forall (es :: [*]) a. Envelope es a -> [a]
foldl1 :: (a -> a -> a) -> Envelope es a -> a
$cfoldl1 :: forall (es :: [*]) a. (a -> a -> a) -> Envelope es a -> a
foldr1 :: (a -> a -> a) -> Envelope es a -> a
$cfoldr1 :: forall (es :: [*]) a. (a -> a -> a) -> Envelope es a -> a
foldl' :: (b -> a -> b) -> b -> Envelope es a -> b
$cfoldl' :: forall (es :: [*]) b a. (b -> a -> b) -> b -> Envelope es a -> b
foldl :: (b -> a -> b) -> b -> Envelope es a -> b
$cfoldl :: forall (es :: [*]) b a. (b -> a -> b) -> b -> Envelope es a -> b
foldr' :: (a -> b -> b) -> b -> Envelope es a -> b
$cfoldr' :: forall (es :: [*]) a b. (a -> b -> b) -> b -> Envelope es a -> b
foldr :: (a -> b -> b) -> b -> Envelope es a -> b
$cfoldr :: forall (es :: [*]) a b. (a -> b -> b) -> b -> Envelope es a -> b
foldMap' :: (a -> m) -> Envelope es a -> m
$cfoldMap' :: forall (es :: [*]) m a. Monoid m => (a -> m) -> Envelope es a -> m
foldMap :: (a -> m) -> Envelope es a -> m
$cfoldMap :: forall (es :: [*]) m a. Monoid m => (a -> m) -> Envelope es a -> m
fold :: Envelope es m -> m
$cfold :: forall (es :: [*]) m. Monoid m => Envelope es m -> m
Foldable, a -> Envelope es b -> Envelope es a
(a -> b) -> Envelope es a -> Envelope es b
(forall a b. (a -> b) -> Envelope es a -> Envelope es b)
-> (forall a b. a -> Envelope es b -> Envelope es a)
-> Functor (Envelope es)
forall (es :: [*]) a b. a -> Envelope es b -> Envelope es a
forall (es :: [*]) a b. (a -> b) -> Envelope es a -> Envelope es b
forall a b. a -> Envelope es b -> Envelope es a
forall a b. (a -> b) -> Envelope es a -> Envelope es b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Envelope es b -> Envelope es a
$c<$ :: forall (es :: [*]) a b. a -> Envelope es b -> Envelope es a
fmap :: (a -> b) -> Envelope es a -> Envelope es b
$cfmap :: forall (es :: [*]) a b. (a -> b) -> Envelope es a -> Envelope es b
Functor, (forall x. Envelope es a -> Rep (Envelope es a) x)
-> (forall x. Rep (Envelope es a) x -> Envelope es a)
-> Generic (Envelope es a)
forall (es :: [*]) a x. Rep (Envelope es a) x -> Envelope es a
forall (es :: [*]) a x. Envelope es a -> Rep (Envelope es a) x
forall x. Rep (Envelope es a) x -> Envelope es a
forall x. Envelope es a -> Rep (Envelope es a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (es :: [*]) a x. Rep (Envelope es a) x -> Envelope es a
$cfrom :: forall (es :: [*]) a x. Envelope es a -> Rep (Envelope es a) x
Generic, Functor (Envelope es)
Foldable (Envelope es)
Functor (Envelope es)
-> Foldable (Envelope es)
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Envelope es a -> f (Envelope es b))
-> (forall (f :: * -> *) a.
Applicative f =>
Envelope es (f a) -> f (Envelope es a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Envelope es a -> m (Envelope es b))
-> (forall (m :: * -> *) a.
Monad m =>
Envelope es (m a) -> m (Envelope es a))
-> Traversable (Envelope es)
(a -> f b) -> Envelope es a -> f (Envelope es b)
forall (es :: [*]). Functor (Envelope es)
forall (es :: [*]). Foldable (Envelope es)
forall (es :: [*]) (m :: * -> *) a.
Monad m =>
Envelope es (m a) -> m (Envelope es a)
forall (es :: [*]) (f :: * -> *) a.
Applicative f =>
Envelope es (f a) -> f (Envelope es a)
forall (es :: [*]) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Envelope es a -> m (Envelope es b)
forall (es :: [*]) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Envelope es a -> f (Envelope es b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Envelope es (m a) -> m (Envelope es a)
forall (f :: * -> *) a.
Applicative f =>
Envelope es (f a) -> f (Envelope es a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Envelope es a -> m (Envelope es b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Envelope es a -> f (Envelope es b)
sequence :: Envelope es (m a) -> m (Envelope es a)
$csequence :: forall (es :: [*]) (m :: * -> *) a.
Monad m =>
Envelope es (m a) -> m (Envelope es a)
mapM :: (a -> m b) -> Envelope es a -> m (Envelope es b)
$cmapM :: forall (es :: [*]) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Envelope es a -> m (Envelope es b)
sequenceA :: Envelope es (f a) -> f (Envelope es a)
$csequenceA :: forall (es :: [*]) (f :: * -> *) a.
Applicative f =>
Envelope es (f a) -> f (Envelope es a)
traverse :: (a -> f b) -> Envelope es a -> f (Envelope es b)
$ctraverse :: forall (es :: [*]) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Envelope es a -> f (Envelope es b)
$cp2Traversable :: forall (es :: [*]). Foldable (Envelope es)
$cp1Traversable :: forall (es :: [*]). Functor (Envelope es)
Traversable)
instance (ToJSON (OpenUnion es), ToJSON a) => ToJSON (Envelope es a) where
toJSON :: Envelope es a -> Value
toJSON :: Envelope es a -> Value
toJSON (ErrEnvelope OpenUnion es
es) = [Pair] -> Value
object [Text
"err" Text -> OpenUnion es -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OpenUnion es
es]
toJSON (SuccEnvelope a
a) = [Pair] -> Value
object [Text
"data" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
a]
instance (FromJSON (OpenUnion es), FromJSON a) => FromJSON (Envelope es a) where
parseJSON :: Value -> Parser (Envelope es a)
parseJSON :: Value -> Parser (Envelope es a)
parseJSON = String
-> (Object -> Parser (Envelope es a))
-> Value
-> Parser (Envelope es a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Envelope" ((Object -> Parser (Envelope es a))
-> Value -> Parser (Envelope es a))
-> (Object -> Parser (Envelope es a))
-> Value
-> Parser (Envelope es a)
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
a -> Envelope es a
forall (es :: [*]) a. a -> Envelope es a
SuccEnvelope (a -> Envelope es a) -> Parser a -> Parser (Envelope es a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"data" Parser (Envelope es a)
-> Parser (Envelope es a) -> Parser (Envelope es a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
OpenUnion es -> Envelope es a
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope (OpenUnion es -> Envelope es a)
-> Parser (OpenUnion es) -> Parser (Envelope es a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (OpenUnion es)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"err"
deriving instance (Data (OpenUnion es), Data a, Typeable es) => Data (Envelope es a)
deriving instance (Eq (OpenUnion es), Eq a) => Eq (Envelope es a)
deriving instance (Ord (OpenUnion es), Ord a) => Ord (Envelope es a)
deriving instance (Read (OpenUnion es), Read a) => Read (Envelope es a)
deriving instance (Show (OpenUnion es), Show a) => Show (Envelope es a)
deriving instance (Typeable (OpenUnion es), Typeable a) => Typeable (Envelope es a)
instance (Show (OpenUnion es)) => Show1 (Envelope es) where
liftShowsPrec
:: (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> Envelope es a
-> ShowS
liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Envelope es a -> ShowS
liftShowsPrec Int -> a -> ShowS
showA [a] -> ShowS
_ Int
d (SuccEnvelope a
a) =
(Int -> a -> ShowS) -> String -> Int -> a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> a -> ShowS
showA String
"SuccEnvelope" Int
d a
a
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ Int
d (ErrEnvelope OpenUnion es
es) =
(Int -> OpenUnion es -> ShowS)
-> String -> Int -> OpenUnion es -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> OpenUnion es -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec String
"ErrEnvelope" Int
d OpenUnion es
es
instance Applicative (Envelope es) where
pure :: a -> Envelope es a
pure :: a -> Envelope es a
pure = a -> Envelope es a
forall (es :: [*]) a. a -> Envelope es a
SuccEnvelope
(<*>) :: Envelope es (a -> b) -> Envelope es a -> Envelope es b
ErrEnvelope OpenUnion es
es <*> :: Envelope es (a -> b) -> Envelope es a -> Envelope es b
<*> Envelope es a
_ = OpenUnion es -> Envelope es b
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope OpenUnion es
es
SuccEnvelope a -> b
f <*> Envelope es a
r = (a -> b) -> Envelope es a -> Envelope es b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Envelope es a
r
instance Monad (Envelope es) where
(>>=) :: Envelope es a -> (a -> Envelope es b) -> Envelope es b
ErrEnvelope OpenUnion es
es >>= :: Envelope es a -> (a -> Envelope es b) -> Envelope es b
>>= a -> Envelope es b
_ = OpenUnion es -> Envelope es b
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope OpenUnion es
es
SuccEnvelope a
a >>= a -> Envelope es b
k = a -> Envelope es b
k a
a
instance MonadFix (Envelope es) where
mfix :: (a -> Envelope es a) -> Envelope es a
mfix :: (a -> Envelope es a) -> Envelope es a
mfix a -> Envelope es a
f =
let a :: Envelope es a
a = a -> Envelope es a
f (Envelope es a -> a
forall (es :: [*]) a. Envelope es a -> a
unSucc Envelope es a
a)
in Envelope es a
a
where
unSucc :: Envelope es a -> a
unSucc :: Envelope es a -> a
unSucc (SuccEnvelope a
x) = a
x
unSucc (ErrEnvelope OpenUnion es
_) = String -> a
forall a. String -> a
errorWithoutStackTrace String
"mfix Envelope: ErrEnvelope"
instance Semigroup (Envelope es a) where
(<>) :: Envelope es a -> Envelope es a -> Envelope es a
ErrEnvelope OpenUnion es
_ <> :: Envelope es a -> Envelope es a -> Envelope es a
<> Envelope es a
b = Envelope es a
b
Envelope es a
a <> Envelope es a
_ = Envelope es a
a
stimes :: Integral b => b -> Envelope es a -> Envelope es a
stimes :: b -> Envelope es a -> Envelope es a
stimes = b -> Envelope es a -> Envelope es a
forall b a. Integral b => b -> a -> a
stimesIdempotent
toErrEnvelope :: IsMember e es => e -> Envelope es a
toErrEnvelope :: e -> Envelope es a
toErrEnvelope = OpenUnion es -> Envelope es a
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope (OpenUnion es -> Envelope es a)
-> (e -> OpenUnion es) -> e -> Envelope es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> OpenUnion es
forall a (as :: [*]). IsMember a as => a -> OpenUnion as
openUnionLift
toSuccEnvelope :: a -> Envelope es a
toSuccEnvelope :: a -> Envelope es a
toSuccEnvelope = a -> Envelope es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
pureErrEnvelope :: (Applicative m, IsMember e es) => e -> m (Envelope es a)
pureErrEnvelope :: e -> m (Envelope es a)
pureErrEnvelope = Envelope es a -> m (Envelope es a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Envelope es a -> m (Envelope es a))
-> (e -> Envelope es a) -> e -> m (Envelope es a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Envelope es a
forall e (es :: [*]) a. IsMember e es => e -> Envelope es a
toErrEnvelope
pureSuccEnvelope :: Applicative m => a -> m (Envelope es a)
pureSuccEnvelope :: a -> m (Envelope es a)
pureSuccEnvelope = Envelope es a -> m (Envelope es a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Envelope es a -> m (Envelope es a))
-> (a -> Envelope es a) -> a -> m (Envelope es a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Envelope es a
forall a (es :: [*]). a -> Envelope es a
toSuccEnvelope
envelope :: (OpenUnion es -> c) -> (a -> c) -> Envelope es a -> c
envelope :: (OpenUnion es -> c) -> (a -> c) -> Envelope es a -> c
envelope OpenUnion es -> c
f a -> c
_ (ErrEnvelope OpenUnion es
es) = OpenUnion es -> c
f OpenUnion es
es
envelope OpenUnion es -> c
_ a -> c
f (SuccEnvelope a
a) = a -> c
f a
a
liftA2Envelope :: (Contains es1 fullEs, Contains es2 fullEs) => (a -> b -> c) -> Envelope es1 a -> Envelope es2 b -> Envelope fullEs c
liftA2Envelope :: (a -> b -> c)
-> Envelope es1 a -> Envelope es2 b -> Envelope fullEs c
liftA2Envelope a -> b -> c
f (SuccEnvelope a
a) (SuccEnvelope b
b) = c -> Envelope fullEs c
forall (es :: [*]) a. a -> Envelope es a
SuccEnvelope (a -> b -> c
f a
a b
b)
liftA2Envelope a -> b -> c
_ (ErrEnvelope OpenUnion es1
es) Envelope es2 b
_ = OpenUnion fullEs -> Envelope fullEs c
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope (OpenUnion es1 -> OpenUnion fullEs
forall (as :: [*]) (bs :: [*]).
Contains as bs =>
OpenUnion as -> OpenUnion bs
relaxOpenUnion OpenUnion es1
es)
liftA2Envelope a -> b -> c
_ Envelope es1 a
_ (ErrEnvelope OpenUnion es2
es) = OpenUnion fullEs -> Envelope fullEs c
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope (OpenUnion es2 -> OpenUnion fullEs
forall (as :: [*]) (bs :: [*]).
Contains as bs =>
OpenUnion as -> OpenUnion bs
relaxOpenUnion OpenUnion es2
es)
bindEnvelope
:: (Contains es1 fullEs, Contains es2 fullEs)
=> Envelope es1 a
-> (a -> Envelope es2 b)
-> Envelope fullEs b
bindEnvelope :: Envelope es1 a -> (a -> Envelope es2 b) -> Envelope fullEs b
bindEnvelope (SuccEnvelope a
a) a -> Envelope es2 b
f = Envelope es2 b -> Envelope fullEs b
forall (es :: [*]) (biggerEs :: [*]) a.
Contains es biggerEs =>
Envelope es a -> Envelope biggerEs a
relaxEnvelope (Envelope es2 b -> Envelope fullEs b)
-> Envelope es2 b -> Envelope fullEs b
forall a b. (a -> b) -> a -> b
$ a -> Envelope es2 b
f a
a
bindEnvelope (ErrEnvelope OpenUnion es1
u) a -> Envelope es2 b
_ = Envelope es1 b -> Envelope fullEs b
forall (es :: [*]) (biggerEs :: [*]) a.
Contains es biggerEs =>
Envelope es a -> Envelope biggerEs a
relaxEnvelope (OpenUnion es1 -> Envelope es1 b
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope OpenUnion es1
u)
emptyEnvelope :: Envelope '[] a -> a
emptyEnvelope :: Envelope '[] a -> a
emptyEnvelope (SuccEnvelope a
a) = a
a
emptyEnvelope (ErrEnvelope OpenUnion '[]
es) = OpenUnion '[] -> a
forall u (f :: u -> *) a. Union f '[] -> a
absurdUnion OpenUnion '[]
es
fromEnvelope :: (OpenUnion es -> a) -> Envelope es a -> a
fromEnvelope :: (OpenUnion es -> a) -> Envelope es a -> a
fromEnvelope OpenUnion es -> a
f = (OpenUnion es -> a) -> (a -> a) -> Envelope es a -> a
forall (es :: [*]) c a.
(OpenUnion es -> c) -> (a -> c) -> Envelope es a -> c
envelope OpenUnion es -> a
f a -> a
forall a. a -> a
id
fromEnvelopeM
:: Applicative m
=> (OpenUnion es -> m a) -> Envelope es a -> m a
fromEnvelopeM :: (OpenUnion es -> m a) -> Envelope es a -> m a
fromEnvelopeM OpenUnion es -> m a
f = (OpenUnion es -> m a) -> (a -> m a) -> Envelope es a -> m a
forall (es :: [*]) c a.
(OpenUnion es -> c) -> (a -> c) -> Envelope es a -> c
envelope OpenUnion es -> m a
f a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
fromEnvelopeOr :: Envelope es a -> (OpenUnion es -> a) -> a
fromEnvelopeOr :: Envelope es a -> (OpenUnion es -> a) -> a
fromEnvelopeOr = ((OpenUnion es -> a) -> Envelope es a -> a)
-> Envelope es a -> (OpenUnion es -> a) -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (OpenUnion es -> a) -> Envelope es a -> a
forall (es :: [*]) a. (OpenUnion es -> a) -> Envelope es a -> a
fromEnvelope
fromEnvelopeOrM
:: Applicative m
=> Envelope es a -> (OpenUnion es -> m a) -> m a
fromEnvelopeOrM :: Envelope es a -> (OpenUnion es -> m a) -> m a
fromEnvelopeOrM = ((OpenUnion es -> m a) -> Envelope es a -> m a)
-> Envelope es a -> (OpenUnion es -> m a) -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (OpenUnion es -> m a) -> Envelope es a -> m a
forall (m :: * -> *) (es :: [*]) a.
Applicative m =>
(OpenUnion es -> m a) -> Envelope es a -> m a
fromEnvelopeM
envelopeToEither :: Envelope es a -> Either (OpenUnion es) a
envelopeToEither :: Envelope es a -> Either (OpenUnion es) a
envelopeToEither (ErrEnvelope OpenUnion es
es) = OpenUnion es -> Either (OpenUnion es) a
forall a b. a -> Either a b
Left OpenUnion es
es
envelopeToEither (SuccEnvelope a
a) = a -> Either (OpenUnion es) a
forall a b. b -> Either a b
Right a
a
eitherToEnvelope :: Either (OpenUnion es) a -> Envelope es a
eitherToEnvelope :: Either (OpenUnion es) a -> Envelope es a
eitherToEnvelope (Left OpenUnion es
es) = OpenUnion es -> Envelope es a
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope OpenUnion es
es
eitherToEnvelope (Right a
a) = a -> Envelope es a
forall (es :: [*]) a. a -> Envelope es a
SuccEnvelope a
a
isoEnvelopeEither :: Iso (Envelope es a) (Envelope fs b) (Either (OpenUnion es) a) (Either (OpenUnion fs) b)
isoEnvelopeEither :: p (Either (OpenUnion es) a) (f (Either (OpenUnion fs) b))
-> p (Envelope es a) (f (Envelope fs b))
isoEnvelopeEither = (Envelope es a -> Either (OpenUnion es) a)
-> (Either (OpenUnion fs) b -> Envelope fs b)
-> Iso
(Envelope es a)
(Envelope fs b)
(Either (OpenUnion es) a)
(Either (OpenUnion fs) b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Envelope es a -> Either (OpenUnion es) a
forall (es :: [*]) a. Envelope es a -> Either (OpenUnion es) a
envelopeToEither Either (OpenUnion fs) b -> Envelope fs b
forall (es :: [*]) a. Either (OpenUnion es) a -> Envelope es a
eitherToEnvelope
_SuccEnvelope :: Prism (Envelope es a) (Envelope es b) a b
_SuccEnvelope :: p a (f b) -> p (Envelope es a) (f (Envelope es b))
_SuccEnvelope = (b -> Envelope es b)
-> (Envelope es a -> Either (Envelope es b) a)
-> Prism (Envelope es a) (Envelope es b) a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> Envelope es b
forall (es :: [*]) a. a -> Envelope es a
SuccEnvelope ((Envelope es a -> Either (Envelope es b) a)
-> Prism (Envelope es a) (Envelope es b) a b)
-> (Envelope es a -> Either (Envelope es b) a)
-> Prism (Envelope es a) (Envelope es b) a b
forall a b. (a -> b) -> a -> b
$ (OpenUnion es -> Either (Envelope es b) a)
-> (a -> Either (Envelope es b) a)
-> Envelope es a
-> Either (Envelope es b) a
forall (es :: [*]) c a.
(OpenUnion es -> c) -> (a -> c) -> Envelope es a -> c
envelope (Envelope es b -> Either (Envelope es b) a
forall a b. a -> Either a b
Left (Envelope es b -> Either (Envelope es b) a)
-> (OpenUnion es -> Envelope es b)
-> OpenUnion es
-> Either (Envelope es b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenUnion es -> Envelope es b
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope) a -> Either (Envelope es b) a
forall a b. b -> Either a b
Right
_ErrEnvelope :: Prism (Envelope es a) (Envelope es' a) (OpenUnion es) (OpenUnion es')
_ErrEnvelope :: p (OpenUnion es) (f (OpenUnion es'))
-> p (Envelope es a) (f (Envelope es' a))
_ErrEnvelope = (OpenUnion es' -> Envelope es' a)
-> (Envelope es a -> Either (Envelope es' a) (OpenUnion es))
-> Prism
(Envelope es a) (Envelope es' a) (OpenUnion es) (OpenUnion es')
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism OpenUnion es' -> Envelope es' a
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope ((Envelope es a -> Either (Envelope es' a) (OpenUnion es))
-> Prism
(Envelope es a) (Envelope es' a) (OpenUnion es) (OpenUnion es'))
-> (Envelope es a -> Either (Envelope es' a) (OpenUnion es))
-> Prism
(Envelope es a) (Envelope es' a) (OpenUnion es) (OpenUnion es')
forall a b. (a -> b) -> a -> b
$ (OpenUnion es -> Either (Envelope es' a) (OpenUnion es))
-> (a -> Either (Envelope es' a) (OpenUnion es))
-> Envelope es a
-> Either (Envelope es' a) (OpenUnion es)
forall (es :: [*]) c a.
(OpenUnion es -> c) -> (a -> c) -> Envelope es a -> c
envelope OpenUnion es -> Either (Envelope es' a) (OpenUnion es)
forall a b. b -> Either a b
Right (Envelope es' a -> Either (Envelope es' a) (OpenUnion es)
forall a b. a -> Either a b
Left (Envelope es' a -> Either (Envelope es' a) (OpenUnion es))
-> (a -> Envelope es' a)
-> a
-> Either (Envelope es' a) (OpenUnion es)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Envelope es' a
forall (es :: [*]) a. a -> Envelope es a
SuccEnvelope)
_ErrEnvelopeErr :: forall e es a. IsMember e es => Prism' (Envelope es a) e
_ErrEnvelopeErr :: Prism' (Envelope es a) e
_ErrEnvelopeErr = p (OpenUnion es) (f (OpenUnion es))
-> p (Envelope es a) (f (Envelope es a))
forall (es :: [*]) a (es' :: [*]).
Prism
(Envelope es a) (Envelope es' a) (OpenUnion es) (OpenUnion es')
_ErrEnvelope (p (OpenUnion es) (f (OpenUnion es))
-> p (Envelope es a) (f (Envelope es a)))
-> (p e (f e) -> p (OpenUnion es) (f (OpenUnion es)))
-> p e (f e)
-> p (Envelope es a) (f (Envelope es a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p e (f e) -> p (OpenUnion es) (f (OpenUnion es))
forall a (as :: [*]). IsMember a as => Prism' (OpenUnion as) a
openUnionPrism
errEnvelopeMatch
:: forall e es a.
IsMember e es
=> Envelope es a -> Maybe e
errEnvelopeMatch :: Envelope es a -> Maybe e
errEnvelopeMatch = Prism' (Envelope es a) e -> Envelope es a -> Maybe e
forall s a. Prism' s a -> s -> Maybe a
preview forall e (es :: [*]) a. IsMember e es => Prism' (Envelope es a) e
Prism' (Envelope es a) e
_ErrEnvelopeErr
catchesEnvelope
:: forall tuple es a x.
ToOpenProduct tuple (ReturnX x es)
=> tuple -> (a -> x) -> Envelope es a -> x
catchesEnvelope :: tuple -> (a -> x) -> Envelope es a -> x
catchesEnvelope tuple
_ a -> x
a2x (SuccEnvelope a
a) = a -> x
a2x a
a
catchesEnvelope tuple
tuple a -> x
_ (ErrEnvelope OpenUnion es
u) = tuple -> OpenUnion es -> x
forall tuple x (as :: [*]).
ToOpenProduct tuple (ReturnX x as) =>
tuple -> OpenUnion as -> x
catchesOpenUnion tuple
tuple OpenUnion es
u
relaxEnvelope :: Contains es biggerEs => Envelope es a -> Envelope biggerEs a
relaxEnvelope :: Envelope es a -> Envelope biggerEs a
relaxEnvelope (SuccEnvelope a
a) = a -> Envelope biggerEs a
forall (es :: [*]) a. a -> Envelope es a
SuccEnvelope a
a
relaxEnvelope (ErrEnvelope OpenUnion es
u) = OpenUnion biggerEs -> Envelope biggerEs a
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope (OpenUnion es -> OpenUnion biggerEs
forall (as :: [*]) (bs :: [*]).
Contains as bs =>
OpenUnion as -> OpenUnion bs
relaxOpenUnion OpenUnion es
u)
envelopeRemove
:: forall e es a
. ElemRemove e es
=> Envelope es a
-> Either (Envelope (Remove e es) a) e
envelopeRemove :: Envelope es a -> Either (Envelope (Remove e es) a) e
envelopeRemove (SuccEnvelope a
a) = Envelope (Remove e es) a -> Either (Envelope (Remove e es) a) e
forall a b. a -> Either a b
Left (a -> Envelope (Remove e es) a
forall (es :: [*]) a. a -> Envelope es a
SuccEnvelope a
a)
envelopeRemove (ErrEnvelope OpenUnion es
u) =
case OpenUnion es -> Either (OpenUnion (Remove e es)) e
forall a (as :: [*]).
ElemRemove a as =>
OpenUnion as -> Either (OpenUnion (Remove a as)) a
openUnionRemove OpenUnion es
u of
Left OpenUnion (Remove e es)
u2 -> Envelope (Remove e es) a -> Either (Envelope (Remove e es) a) e
forall a b. a -> Either a b
Left (OpenUnion (Remove e es) -> Envelope (Remove e es) a
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope OpenUnion (Remove e es)
u2)
Right e
e -> e -> Either (Envelope (Remove e es) a) e
forall a b. b -> Either a b
Right e
e
envelopeHandle
:: ElemRemove e es
=> (Envelope (Remove e es) a -> x)
-> (e -> x)
-> Envelope es a
-> x
envelopeHandle :: (Envelope (Remove e es) a -> x) -> (e -> x) -> Envelope es a -> x
envelopeHandle Envelope (Remove e es) a -> x
handler e -> x
_ (SuccEnvelope a
a) = Envelope (Remove e es) a -> x
handler (a -> Envelope (Remove e es) a
forall (es :: [*]) a. a -> Envelope es a
SuccEnvelope a
a)
envelopeHandle Envelope (Remove e es) a -> x
handler e -> x
errHandler (ErrEnvelope OpenUnion es
u) =
(OpenUnion (Remove e es) -> x) -> (e -> x) -> OpenUnion es -> x
forall a (as :: [*]) b.
ElemRemove a as =>
(OpenUnion (Remove a as) -> b) -> (a -> b) -> OpenUnion as -> b
openUnionHandle (Envelope (Remove e es) a -> x
handler (Envelope (Remove e es) a -> x)
-> (OpenUnion (Remove e es) -> Envelope (Remove e es) a)
-> OpenUnion (Remove e es)
-> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenUnion (Remove e es) -> Envelope (Remove e es) a
forall (es :: [*]) a. OpenUnion es -> Envelope es a
ErrEnvelope) e -> x
errHandler OpenUnion es
u