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

Copyright   :  Dennis Gosnell 2017
License     :  BSD3

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

This module defines the 'Envelope' type as a wrapper around a success value, or
a set of possible errors.  The errors are an 'OpenUnion', which is an
extensible sumtype.

Other than the 'Envelope' type, the most important thing in this module is the
'ToJSON' instance for 'Envelope'.
-}

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)

-- $setup
-- >>> :set -XDataKinds
-- >>> :set -XTypeOperators
-- >>> import Data.Aeson (encode)
-- >>> import Data.ByteString.Lazy.Char8 (hPutStrLn)
-- >>> import Data.Text (Text)
-- >>> import System.IO (stdout)
-- >>> import Text.Read (readMaybe)
-- >>> import Servant.Checked.Exceptions.Internal.Prism (review)
-- >>> let putByteStrLn = hPutStrLn stdout


-- | This 'Envelope' type is a used as a wrapper around either an 'OpenUnion'
-- with an error or a successful value.  It is similar to an @'Either' e a@,
-- but where the @e@ is specialized to @'OpenUnion' es@.  The most important
-- difference from 'Either' is the the 'FromJSON' and 'ToJSON' instances.
--
-- Given an @'Envelope' \'['String', 'Double'] ()@, we know that the envelope
-- could be a 'SuccEnvelope' and contain @()@.  Or it could be a 'ErrEnvelope'
-- that contains /either/ a 'String' /or/ a 'Double'.  It might be simpler to
-- think of it as a type like @'Either' 'String' ('Either' 'Double' ())@.
--
-- An 'Envelope' can be created with the 'toErrEnvelope' and 'toSuccEnvelope'
-- functions.  The 'Prism's '_SuccEnvelope', '_ErrEnvelope', and
-- '_ErrEnvelopeErr' can be used to get values out of an 'Envelope'.
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)

-- | This 'ToJSON' instance encodes an 'Envelope' as an object with one of two
-- keys depending on whether it is a 'SuccEnvelope' or an 'ErrEnvelope'.
--
-- Here is an example of a 'SuccEnvelope':
--
-- >>> let string = "hello" :: String
-- >>> let env = toSuccEnvelope string :: Envelope '[Double] String
-- >>> putByteStrLn $ encode env
-- {"data":"hello"}
--
-- Here is an example of a 'ErrEnvelope':
--
-- >>> let double = 3.5 :: Double
-- >>> let env' = toErrEnvelope double :: Envelope '[Double] String
-- >>> putByteStrLn $ encode env'
-- {"err":3.5}
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]

-- | This is only a valid instance when the 'FromJSON' instances for the @es@
-- don't overlap.
--
-- For an explanation, see the documentation on the 'FromJSON' instance for
-- 'Servant.Checked.Exceptions.Internal.Union.Union'.
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

-- | Create an 'ErrEnvelope' from a member of the 'OpenUnion'.
--
-- For instance, here is how to create an 'ErrEnvelope' that contains a
-- 'Double':
--
-- >>> let double = 3.5 :: Double
-- >>> toErrEnvelope double :: Envelope '[String, Double, Int] ()
-- ErrEnvelope (Identity 3.5)
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

-- | This is a function to create a 'SuccEnvelope'.
--
-- >>> toSuccEnvelope "hello" :: Envelope '[Double] String
-- SuccEnvelope "hello"
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' is 'toErrEnvelope' lifted up to an 'Applicative'.
--
-- >>> pureErrEnvelope 'c' :: Maybe (Envelope '[Char] Int)
-- Just (ErrEnvelope (Identity 'c'))
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' is 'toSuccEnvelope' lifted up to an 'Applicative'.
--
-- >>> pureSuccEnvelope 3 :: Maybe (Envelope '[Char] Int)
-- Just (SuccEnvelope 3)
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

-- | Case analysis for 'Envelope's.
--
-- ==== __Examples__
--
--  Here is an example of matching on a 'SuccEnvelope':
--
-- >>> let env = toSuccEnvelope "hello" :: Envelope '[Double, Int] String
-- >>> envelope (const "not a String") id env
-- "hello"
--
-- Here is an example of matching on a 'ErrEnvelope':
--
-- >>> let double = 3.5 :: Double
-- >>> let env' = toErrEnvelope double :: Envelope '[Double, Int] String
-- >>> envelope (const "not a String") id env'
-- "not a String"
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

-- | Similar to 'liftA2', but more general.  This allows you to operate on two
-- 'Envelope's with different sets of errors.  The resulting 'Envelope' is a
-- combination of the errors in each of the input 'Envelope's.
--
-- ==== __Examples__
--
-- >>> let env1 = toSuccEnvelope "hello" :: Envelope '[Double, Int] String
-- >>> let env2 = toSuccEnvelope " world" :: Envelope '[Char] String
-- >>> liftA2Envelope (<>) env1 env2 :: Envelope '[Double, Int, Char] String
-- SuccEnvelope "hello world"
--
-- If either of the 'Envelope's is an 'ErrEnvelope', then return the 'ErrEnvelope'.
--
-- >>> let env3 = toErrEnvelope "some err" :: Envelope '[String, Double] Int
-- >>> let env4 = toSuccEnvelope 1 :: Envelope '[Char] Int
-- >>> liftA2Envelope (+) env3 env4 :: Envelope '[String, Double, Char] Int
-- ErrEnvelope (Identity "some err")
--
-- >>> let env5 = toSuccEnvelope "hello" :: Envelope '[Char] String
-- >>> let env6 = toErrEnvelope 3.5 :: Envelope '[(), Double] String
-- >>> liftA2Envelope (<>) env5 env6 :: Envelope '[Char, (), Double] String
-- ErrEnvelope (Identity 3.5)
--
-- If both of the 'Envelope's is an 'ErrEnvelope', then short-circuit and only
-- return the first 'ErrEnvelope'.
--
-- >>> let env7 = toErrEnvelope 3.5 :: Envelope '[(), Double] String
-- >>> let env8 = toErrEnvelope 'x' :: Envelope '[Int, Char] String
-- >>> liftA2Envelope (<>) env7 env8 :: Envelope '[(), Double, Int, Char] String
-- ErrEnvelope (Identity 3.5)
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)

-- | This is like 'liftA2Envelope' but for monadic bind ('>>=').
--
-- This allows you to bind on 'Envelope's that contain different errors.
--
-- The resulting 'Envelope' must have a superset of the errors in two input
-- 'Envelope's.
--
-- ==== __Examples__
--
-- >>> let env1 = toSuccEnvelope "hello" :: Envelope '[Double, Int] String
-- >>> let f1 str = toSuccEnvelope (length str) :: Envelope '[Char] Int
-- >>> bindEnvelope env1 f1 :: Envelope '[Double, Int, Char] Int
-- SuccEnvelope 5
--
-- If either of the 'Envelope's is an 'ErrEnvelope', then return the 'ErrEnvelope'.
--
-- >>> let env2 = toErrEnvelope "some err" :: Envelope '[String, Double] Int
-- >>> let f2 i = toSuccEnvelope (i + 1) :: Envelope '[Char] Int
-- >>> bindEnvelope env2 f2 :: Envelope '[String, Double, Char] Int
-- ErrEnvelope (Identity "some err")
--
-- >>> let env3 = toSuccEnvelope "hello" :: Envelope '[Char] String
-- >>> let f3 _ = toErrEnvelope 3.5 :: Envelope '[(), Double] Int
-- >>> bindEnvelope env3 f3 :: Envelope '[Char, (), Double] Int
-- ErrEnvelope (Identity 3.5)
--
-- If both of the 'Envelope's is an 'ErrEnvelope', then short-circuit and only
-- return the first 'ErrEnvelope'.
--
-- >>> let env4 = toErrEnvelope 3.5 :: Envelope '[(), Double] String
-- >>> let f4 _ = toErrEnvelope 'x' :: Envelope '[Int, Char] String
-- >>> bindEnvelope env4 f4 :: Envelope '[Char, (), Double, Int] String
-- ErrEnvelope (Identity 3.5)
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)

-- | Unwrap an 'Envelope' that cannot contain an error.
--
-- ==== __Examples__
--
-- >>> let env = toSuccEnvelope "hello" :: Envelope '[] String
-- >>> emptyEnvelope env
-- "hello"
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

-- | Just like 'Data.Either.fromEither' but for 'Envelope'.
--
-- ==== __Examples__
--
--  Here is an example of successfully matching:
--
-- >>> let env = toSuccEnvelope "hello" :: Envelope '[Double, Int] String
-- >>> fromEnvelope (const "not a String") env
-- "hello"
--
-- Here is an example of unsuccessfully matching:
--
-- >>> let double = 3.5 :: Double
-- >>> let env' = toErrEnvelope double :: Envelope '[Double, Int] String
-- >>> fromEnvelope (const "not a String") env'
-- "not a String"
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

-- | Lifted version of 'fromEnvelope'.
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

-- | Flipped version of 'fromEnvelope'.
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

-- | Flipped version of 'fromEnvelopeM'.
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

-- | Convert an 'Envelope' to an 'Either'.
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

-- | Convert an 'Either' to an 'Envelope'.
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

-- | Lens-compatible 'Iso' from 'Envelope' to 'Either'.
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

-- | Lens-compatible 'Prism' to pull out an @a@ from a 'SuccEnvelope'.
--
-- ==== __Examples__
--
-- Use '_SuccEnvelope' to construct an 'Envelope':
--
-- >>> review _SuccEnvelope "hello" :: Envelope '[Double] String
-- SuccEnvelope "hello"
--
-- Use '_SuccEnvelope' to try to destruct an 'Envelope' into an @a@:
--
-- >>> let env = toSuccEnvelope "hello" :: Envelope '[Double] String
-- >>> preview _SuccEnvelope env :: Maybe String
-- Just "hello"
--
-- Use '_SuccEnvelope' to try to destruct a 'Envelope into an @a@
-- (unsuccessfully):
--
-- >>> let double = 3.5 :: Double
-- >>> let env' = toErrEnvelope double :: Envelope '[Double] String
-- >>> preview _SuccEnvelope env' :: Maybe String
-- Nothing
_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

-- | Lens-compatible 'Prism' to pull out an @'OpenUnion' es@ from a
-- 'ErrEnvelope'.
--
-- Most users will not use '_ErrEnvelope', but instead '_ErrEnvelopeErr'.
--
-- ==== __Examples__
--
-- Use '_ErrEnvelope' to construct an 'Envelope':
--
-- >>> let string = "hello" :: String
-- >>> review _ErrEnvelope (openUnionLift string) :: Envelope '[String] Double
-- ErrEnvelope (Identity "hello")
--
-- Use '_ErrEnvelope' to try to destruct an 'Envelope' into an
-- @'OpenUnion' es@:
--
-- >>> let double = 3.5 :: Double
-- >>> let env = toErrEnvelope double :: Envelope '[Double] ()
-- >>> preview _ErrEnvelope env :: Maybe (OpenUnion '[Double])
-- Just (Identity 3.5)
--
-- Use '_ErrEnvelope' to try to destruct a 'Envelope into an
-- @'OpenUnion' es@ (unsuccessfully):
--
-- >>> let env' = toSuccEnvelope () :: Envelope '[Double] ()
-- >>> preview _ErrEnvelope env' :: Maybe (OpenUnion '[Double])
-- Nothing
_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)

-- | Lens-compatible 'Prism' to pull out a specific @e@ from an 'ErrEnvelope'.
--
-- Most users will use '_ErrEnvelopeErr' instead of '_ErrEnvelope'.
--
-- ==== __Examples__
--
-- Use '_ErrEnvelopeErr' to construct an 'Envelope':
--
-- >>> let string = "hello" :: String
-- >>> review _ErrEnvelopeErr string :: Envelope '[String] Double
-- ErrEnvelope (Identity "hello")
--
-- Use '_ErrEnvelopeErr' to try to destruct an 'Envelope' into an @e@:
--
-- >>> let double = 3.5 :: Double
-- >>> let env = toErrEnvelope double :: Envelope '[Double] ()
-- >>> preview _ErrEnvelopeErr env :: Maybe Double
-- Just 3.5
--
-- Use '_ErrEnvelopeErr' to try to destruct a 'Envelope into an
-- @e@ (unsuccessfully):
--
-- >>> let env' = toSuccEnvelope () :: Envelope '[Double] ()
-- >>> preview _ErrEnvelopeErr env' :: Maybe Double
-- Nothing
-- >>> let env'' = toErrEnvelope 'c' :: Envelope '[Double, Char] ()
-- >>> preview _ErrEnvelopeErr env'' :: Maybe Double
-- Nothing
_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

-- | Pull out a specific @e@ from an 'ErrEnvelope'.
--
-- ==== __Examples__
--
-- Successfully pull out an @e@:
--
-- >>> let double = 3.5 :: Double
-- >>> let env = toErrEnvelope double :: Envelope '[Double] ()
-- >>> errEnvelopeMatch env :: Maybe Double
-- Just 3.5
--
-- Unsuccessfully pull out an @e@:
--
-- >>> let env' = toSuccEnvelope () :: Envelope '[Double] ()
-- >>> errEnvelopeMatch env' :: Maybe Double
-- Nothing
-- >>> let env'' = toErrEnvelope 'c' :: Envelope '[Double, Char] ()
-- >>> errEnvelopeMatch env'' :: Maybe Double
-- Nothing
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

-- | An alternate case anaylsis for an 'Envelope'.  This method uses a tuple
-- containing handlers for each potential value of the '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 'catchesEnvelope' than 'envelope'.
--
-- ==== __Examples__
--
-- Here is an example of handling an 'SuccEnvelope' with two possible error values.
-- Notice that a normal tuple is used:
--
-- >>> let env = toSuccEnvelope 2.0 :: Envelope '[Int, String] Double
-- >>> let intHandler = (\int -> show int) :: Int -> String
-- >>> let strHandler = (\str -> str) :: String -> String
-- >>> let succHandler = (\dbl -> "got a double") :: Double -> String
-- >>> catchesEnvelope (intHandler, strHandler) succHandler env :: 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 = toErrEnvelope (3 :: Int) :: Envelope '[Int, String] Double
-- >>> let intHandler = (\int -> show int) :: Int -> String
-- >>> let strHandler = (\str -> str) :: String -> String
-- >>> let succHandler = (\dbl -> "got a double") :: Double -> String
-- >>> catchesEnvelope (intHandler, strHandler) succHandler env :: String
-- "3"
--
-- Given an 'Envelope' like @'Envelope' \'['Int', 'String'] 'Double'@, the type of
-- 'catchesEnvelope' becomes the following:
--
-- @
--   'catchesEnvelope'
--     :: ('Int' -> x, 'String' -> x)
--     -> ('Double' -> x)
--     -> 'Envelope' \'['Int', 'String'] 'Double'
--     -> 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 = toErrEnvelope ("hi" :: String) :: Envelope '[Int, String, Char] Double
-- >>> let intHandler = (\int -> show int) :: Int -> String
-- >>> let strHandler = (\str -> str) :: String -> String
-- >>> let chrHandler = (\chr -> [chr]) :: Char -> String
-- >>> let succHandler = (\dbl -> "got a double") :: Double -> String
-- >>> catchesEnvelope (intHandler, strHandler, chrHandler) succHandler env :: String
-- "hi"
--
-- Given an 'Envelope' like @'Envelope' \'['Int', 'String', 'Char'] 'Double'@,
-- the type of 'catchesEnvelope' becomes the following:
--
-- @
--   'catchesEnvelope'
--     :: ('Int' -> x, 'String' -> x, 'Char' -> x)
--     -> ('Double' -> x)
--     -> 'Envelope' \'['Int', 'String', 'Char'] 'Double'
--     -> x
-- @
--
-- Here is an example of handling an 'ErrEnvelope' with only one possible error value.
-- Notice that a normal handler is used (not a tuple):
--
-- >>> let env = toErrEnvelope (3 :: Int) :: Envelope '[Int] Double
-- >>> let intHandler = (\int -> show int) :: Int -> String
-- >>> let succHandler = (\dbl -> "got a double") :: Double -> String
-- >>> catchesEnvelope intHandler succHandler env :: String
-- "3"
--
-- Given an 'Envelope' like @'Envelope' \'['Int'] 'Double'@, the type of
-- 'catchesEnvelope' becomes the following:
--
-- @
--   'catchesEnvelope'
--     :: ('Int' -> x)
--     -> ('Double' -> x)
--     -> 'Envelope' \'['Int'] 'Double'
--     -> x
-- @
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

-- | Change the errors type in an 'Envelope' to a larger set.
--
-- >>> let double = 3.5 :: Double
-- >>> let env = toErrEnvelope double :: Envelope '[Double, Int] Char
-- >>> relaxEnvelope env :: Envelope '[(), Int, Double, String] Char
-- ErrEnvelope (Identity 3.5)
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)

-- | This function allows you to try to remove individual error types from an
-- 'Envelope'.
--
-- 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 'catchesEnvelope'.
--
-- ==== __Examples__
--
-- Pulling out an error in an 'Envelope':
--
-- >>> let env1 = toErrEnvelope "hello" :: Envelope '[String, Double] Float
-- >>> envelopeRemove env1 :: Either (Envelope '[Double] Float) String
-- Right "hello"
--
-- Failing to pull out an error in an 'Envelope':
--
-- >>> let env2 = toErrEnvelope (3.5 :: Double) :: Envelope '[String, Double] Float
-- >>> envelopeRemove env2 :: Either (Envelope '[Double] Float) String
-- Left (ErrEnvelope (Identity 3.5))
--
-- Note that if you have an 'Envelope' with multiple errors of the same type,
-- they will all be handled at the same time:
--
-- >>> let env3 = toErrEnvelope (3.5 :: Double) :: Envelope '[String, Double, Char, Double] Float
-- >>> envelopeRemove env3 :: Either (Envelope '[String, Char] Float) Double
-- Right 3.5
--
-- 'SuccEnvelope' gets passed through as expected:
--
-- >>> let env4 = toSuccEnvelope 3.5 :: Envelope '[String, Double] Float
-- >>> envelopeRemove env4 :: Either (Envelope '[Double] Float) String
-- Left (SuccEnvelope 3.5)
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

-- | Handle a single case in an 'Envelope'.  This is similar to 'envelope'
-- but lets you handle any case within the 'Envelope', not just the first one.
--
-- ==== __Examples__
--
-- Handling the first item in an 'Envelope':
--
-- >>> let env1 = toErrEnvelope 3.5 :: Envelope '[Double, Int] Char
-- >>> let printDouble = print :: Double -> IO ()
-- >>> let printEnv = print :: Envelope '[Int] Char -> IO ()
-- >>> envelopeHandle printEnv printDouble env1
-- 3.5
--
-- Handling a middle item in an 'Envelope':
--
-- >>> let env2 = toErrEnvelope (3.5 :: Double) :: Envelope '[Char, Double, Int] Float
-- >>> let printEnv = print :: Envelope '[Char, Int] Float -> IO ()
-- >>> envelopeHandle printEnv printDouble env2
-- 3.5
--
-- Failing to handle an item in an 'Envelope'.  In the following example, the
-- @printEnv@ function is called:
--
-- >>> let env3 = toErrEnvelope 'c' :: Envelope '[Char, Double, Int] Float
-- >>> let printEnv = print :: Envelope '[Char, Int] Float -> IO ()
-- >>> envelopeHandle printEnv printDouble env3
-- ErrEnvelope (Identity 'c')
--
-- If you have duplicates in your 'Envelope', they will both get handled with
-- a single call to 'unionHandle'.
--
-- >>> let env4 = toErrEnvelope 3.5 :: Envelope '[Double, Double, Int] Char
-- >>> let printEnv = print :: Envelope '[Int] Char -> IO ()
-- >>> envelopeHandle printEnv printDouble env4
-- 3.5
--
-- 'SuccEnvelope' gets passed through as expected:
--
-- >>> let env5 = toSuccEnvelope 3.5 :: Envelope '[String, Double] Float
-- >>> let printEnv = print :: Envelope '[String] Float -> IO ()
-- >>> envelopeHandle printEnv printDouble env5
-- SuccEnvelope 3.5
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