Servant.Checked.Exceptions.Internal.Union

This module defines extensible sum-types. This is similar to how vinyl defines extensible records.

This is used extensively in the definition of the Envelope type in Servant.Checked.Exceptions.Internal.Envelope.

A large portion of the code from this module was taken from the union package.

Union

data Union f as where

A Union is parameterized by a universe u, an interpretation f and a list of labels as. The labels of the union are given by inhabitants of the kind u; the type of values at any label a :: u is given by its interpretation f a :: *.

Constructors

This :: !(f a) -> Union f (a ': as)

That :: !(Union f as) -> Union f (a ': as)

Instances

(Eq (f a1), Eq (Union a f as)) => Eq (Union a f ((:) a a1 as))

Methods

(==) :: Union a f ((a ': a1) as) -> Union a f ((a ': a1) as) -> Bool

(/=) :: Union a f ((a ': a1) as) -> Union a f ((a ': a1) as) -> Bool

Eq (Union u f ([] u))

Methods

(==) :: Union u f [u] -> Union u f [u] -> Bool

(/=) :: Union u f [u] -> Union u f [u] -> Bool

(Ord (f a1), Ord (Union a f as)) => Ord (Union a f ((:) a a1 as))

Methods

compare :: Union a f ((a ': a1) as) -> Union a f ((a ': a1) as) -> Ordering

(<) :: Union a f ((a ': a1) as) -> Union a f ((a ': a1) as) -> Bool

(<=) :: Union a f ((a ': a1) as) -> Union a f ((a ': a1) as) -> Bool

(>) :: Union a f ((a ': a1) as) -> Union a f ((a ': a1) as) -> Bool

(>=) :: Union a f ((a ': a1) as) -> Union a f ((a ': a1) as) -> Bool

max :: Union a f ((a ': a1) as) -> Union a f ((a ': a1) as) -> Union a f ((a ': a1) as)

min :: Union a f ((a ': a1) as) -> Union a f ((a ': a1) as) -> Union a f ((a ': a1) as)

Ord (Union u f ([] u))

Methods

compare :: Union u f [u] -> Union u f [u] -> Ordering

(<) :: Union u f [u] -> Union u f [u] -> Bool

(<=) :: Union u f [u] -> Union u f [u] -> Bool

(>) :: Union u f [u] -> Union u f [u] -> Bool

(>=) :: Union u f [u] -> Union u f [u] -> Bool

max :: Union u f [u] -> Union u f [u] -> Union u f [u]

min :: Union u f [u] -> Union u f [u] -> Union u f [u]

(Read (f a1), Read (Union a f as)) => Read (Union a f ((:) a a1 as))

This is only a valid instance when the Read instances for the types don't overlap.

For instance, imagine we are working with a Union of a String and a Double. 3.5 can only be read as a Double, not as a String. Oppositely, "hello" can only be read as a String, not as a Double.

>>> let o = readMaybe "Identity 3.5" :: Maybe (Union Identity '[Double, String])
>>> o
Just (Identity 3.5)
>>> o >>= openUnionMatch :: Maybe Double
Just 3.5
>>> o >>= openUnionMatch :: Maybe String
Nothing

>>> let p = readMaybe "Identity \"hello\"" :: Maybe (Union Identity '[Double, String])
>>> p
Just (Identity "hello")
>>> p >>= openUnionMatch :: Maybe Double
Nothing
>>> p >>= openUnionMatch :: Maybe String
Just "hello"

However, imagine are we working with a Union of a String and Text. "hello" can be read as both a String and Text. However, in the following example, it can only be read as a String:

>>> let q = readMaybe "Identity \"hello\"" :: Maybe (Union Identity '[String, Text])
>>> q
Just (Identity "hello")
>>> q >>= openUnionMatch :: Maybe String
Just "hello"
>>> q >>= openUnionMatch :: Maybe Text
Nothing

If the order of the types is flipped around, we are are able to read "hello" as a Text but not as a String.

>>> let r = readMaybe "Identity \"hello\"" :: Maybe (Union Identity '[Text, String])
>>> r
Just (Identity "hello")
>>> r >>= openUnionMatch :: Maybe String
Nothing
>>> r >>= openUnionMatch :: Maybe Text
Just "hello"

Methods

readsPrec :: Int -> ReadS (Union a f ((a ': a1) as))

readList :: ReadS [Union a f ((a ': a1) as)]

readPrec :: ReadPrec (Union a f ((a ': a1) as))

readListPrec :: ReadPrec [Union a f ((a ': a1) as)]

Read (Union u f ([] u))

This will always fail, since Union f '[] is effectively Void.

Methods

readsPrec :: Int -> ReadS (Union u f [u])

readList :: ReadS [Union u f [u]]

readPrec :: ReadPrec (Union u f [u])

readListPrec :: ReadPrec [Union u f [u]]

(Show (f a1), Show (Union a f as)) => Show (Union a f ((:) a a1 as))

Methods

showsPrec :: Int -> Union a f ((a ': a1) as) -> ShowS

show :: Union a f ((a ': a1) as) -> String

showList :: [Union a f ((a ': a1) as)] -> ShowS

Show (Union u f ([] u))

Methods

showsPrec :: Int -> Union u f [u] -> ShowS

show :: Union u f [u] -> String

showList :: [Union u f [u]] -> ShowS

(ToJSON (f a1), ToJSON (Union a f as)) => ToJSON (Union a f ((:) a a1 as))

Methods

toJSON :: Union a f ((a ': a1) as) -> Value

toEncoding :: Union a f ((a ': a1) as) -> Encoding

toJSONList :: [Union a f ((a ': a1) as)] -> Value

toEncodingList :: [Union a f ((a ': a1) as)] -> Encoding

ToJSON (Union u f ([] u))

Methods

toJSON :: Union u f [u] -> Value

toEncoding :: Union u f [u] -> Encoding

toJSONList :: [Union u f [u]] -> Value

toEncodingList :: [Union u f [u]] -> Encoding

(FromJSON (f a1), FromJSON (Union a f as)) => FromJSON (Union a f ((:) a a1 as))

This is only a valid instance when the FromJSON instances for the types don't overlap.

This is similar to the Read instance.

Methods

parseJSON :: Value -> Parser (Union a f ((a ': a1) as))

parseJSONList :: Value -> Parser [Union a f ((a ': a1) as)]

FromJSON (Union u f ([] u))

This will always fail, since Union f '[] is effectively Void.

Methods

parseJSON :: Value -> Parser (Union u f [u])

parseJSONList :: Value -> Parser [Union u f [u]]

(NFData (f a1), NFData (Union a f as)) => NFData (Union a f ((:) a a1 as))

Methods

rnf :: Union a f ((a ': a1) as) -> ()

NFData (Union u f ([] u))

Methods

rnf :: Union u f [u] -> ()

union :: (Union f as -> c) -> (f a -> c) -> Union f (a ': as) -> c

Case analysis for Union.

Here is an example of matching on a This:

>>> let u = This (Identity "hello") :: Union Identity '[String, Int]
>>> let runIdent = runIdentity :: Identity String -> String
>>> union (const "not a String") runIdent u
"hello"

Here is an example of matching on a That:

>>> let v = That (This (Identity 3.3)) :: Union Identity '[String, Double, Int]
>>> union (const "not a String") runIdent v
"not a String"

catchesUnion :: (Applicative f, ToProduct tuple f (ReturnX x as)) => tuple -> Union f as -> f x

An alternate case anaylsis for a Union. This method uses a tuple containing handlers for each potential value of the Union. This is somewhat similar to the catches function.

Here is an example of handling a Union with two possible values. Notice that a normal tuple is used:

>>> let u = This $ Identity 3 :: Union Identity '[Int, String]
>>> let intHandler = (Identity $ \int -> show int) :: Identity (Int -> String)
>>> let strHandler = (Identity $ \str -> str) :: Identity (String -> String)
>>> catchesUnion (intHandler, strHandler) u :: Identity String
Identity "3"

Given a Union like Union Identity '[Int, String], the type of catchesUnion becomes the following:

  catchesUnion
    :: (Identity (Int -> String), Identity (String -> String))
    -> Union Identity '[Int, String]
    -> Identity String

Checkout catchesOpenUnion for more examples.

absurdUnion :: Union f '[] -> a

Since a union with an empty list of labels is uninhabited, we can recover any type from it.

umap :: (forall a. f a -> g a) -> Union f as -> Union g as

Map over the interpretation f in the Union.

Here is an example of changing a Union Identity '[String, Int] to Union Maybe '[String, Int]:

>>> let u = This (Identity "hello") :: Union Identity '[String, Int]
>>> umap (Just . runIdentity) u :: Union Maybe '[String, Int]
Just "hello"

Optics

_This :: Prism (Union f (a ': as)) (Union f (b ': as)) (f a) (f b)

Lens-compatible Prism for This.

Use _This to construct a Union:

>>> review _This (Just "hello") :: Union Maybe '[String]
Just "hello"

Use _This to try to destruct a Union into a f a:

>>> let u = This (Identity "hello") :: Union Identity '[String, Int]
>>> preview _This u :: Maybe (Identity String)
Just (Identity "hello")

Use _This to try to destruct a Union into a f a (unsuccessfully):

>>> let v = That (This (Identity 3.3)) :: Union Identity '[String, Double, Int]
>>> preview _This v :: Maybe (Identity String)
Nothing

_That :: Prism (Union f (a ': as)) (Union f (a ': bs)) (Union f as) (Union f bs)

Lens-compatible Prism for That.

Use _That to construct a Union:

>>> let u = This (Just "hello") :: Union Maybe '[String]
>>> review _That u :: Union Maybe '[Double, String]
Just "hello"

Use _That to try to peel off a That from a Union:

>>> let v = That (This (Identity "hello")) :: Union Identity '[Int, String]
>>> preview _That v :: Maybe (Union Identity '[String])
Just (Identity "hello")

Use _That to try to peel off a That from a Union (unsuccessfully):

>>> let w = This (Identity 3.5) :: Union Identity '[Double, String]
>>> preview _That w :: Maybe (Union Identity '[String])
Nothing

Typeclasses

data Nat

A mere approximation of the natural numbers. And their image as lifted by -XDataKinds corresponds to the actual natural numbers.

Constructors

Z

S !Nat

type family RIndex (r :: k) (rs :: [k]) :: Nat where ...

A partial relation that gives the index of a value in a list.

Find the first item:

>>> import Data.Type.Equality ((:~:)(Refl))
>>> Refl :: RIndex String '[String, Int] :~: 'Z
Refl

Find the third item:

>>> Refl :: RIndex Char '[String, Int, Char] :~: 'S ('S 'Z)
Refl

Equations

RIndex r (r ': rs) = Z

RIndex r (s ': rs) = S (RIndex r rs)

class i ~ RIndex a as => UElem a as i where

UElem a as i provides a way to potentially get an f a out of a Union f as (unionMatch). It also provides a way to create a Union f as from an f a (unionLift).

This is safe because of the RIndex contraint. This RIndex constraint tells us that there actually is an a in as at index i.

As an end-user, you should never need to implement an additional instance of this typeclass.

Minimal complete definition

unionPrism | unionLift, unionMatch

Methods

unionPrism :: Prism' (Union f as) (f a)

This is implemented as prism' unionLift unionMatch.

unionLift :: f a -> Union f as

This is implemented as review unionPrism.

unionMatch :: Union f as -> Maybe (f a)

This is implemented as preview unionPrism.

Instances

UElem a a1 ((:) a a1 as) Z

Methods

unionPrism :: (Choice p, Applicative f) => p (f ((a ': a1) as)) (f (f ((a ': a1) as))) -> p (Union a1 f Z) (f (Union a1 f Z))

unionLift :: f ((a ': a1) as) -> Union a1 f Z

unionMatch :: Union a1 f Z -> Maybe (f ((a ': a1) as))

((~) Nat (RIndex a a1 ((:) a b as)) (S i), UElem a a1 as i) => UElem a a1 ((:) a b as) (S i)

Methods

unionPrism :: (Choice p, Applicative f) => p (f ((a ': b) as)) (f (f ((a ': b) as))) -> p (Union a1 f (S i)) (f (Union a1 f (S i)))

unionLift :: f ((a ': b) as) -> Union a1 f (S i)

unionMatch :: Union a1 f (S i) -> Maybe (f ((a ': b) as))

type IsMember a as = UElem a as (RIndex a as)

This is a helpful Constraint synonym to assert that a is a member of as.

OpenUnion

type OpenUnion = Union Identity

We can use Union Identity as a standard open sum type.

openUnion :: (OpenUnion as -> c) -> (a -> c) -> OpenUnion (a ': as) -> c

Case analysis for OpenUnion.

Here is an example of successfully matching:

>>> let string = "hello" :: String
>>> let o = openUnionLift string :: OpenUnion '[String, Int]
>>> openUnion (const "not a String") id o
"hello"

Here is an example of unsuccessfully matching:

>>> let double = 3.3 :: Double
>>> let p = openUnionLift double :: OpenUnion '[String, Double, Int]
>>> openUnion (const "not a String") id p
"not a String"

fromOpenUnion :: (OpenUnion as -> a) -> OpenUnion (a ': as) -> a

This is similar to fromMaybe for an OpenUnion.

Here is an example of successfully matching:

>>> let string = "hello" :: String
>>> let o = openUnionLift string :: OpenUnion '[String, Int]
>>> fromOpenUnion (const "not a String") o
"hello"

Here is an example of unsuccessfully matching:

>>> let double = 3.3 :: Double
>>> let p = openUnionLift double :: OpenUnion '[String, Double, Int]
>>> fromOpenUnion (const "not a String") p
"not a String"

fromOpenUnionOr :: OpenUnion (a ': as) -> (OpenUnion as -> a) -> a

Flipped version of fromOpenUnion.

openUnionPrism :: forall a as. IsMember a as => Prism' (OpenUnion as) a

Just like unionPrism but for OpenUnion.

openUnionLift :: forall a as. IsMember a as => a -> OpenUnion as

Just like unionLift but for OpenUnion.

Creating an OpenUnion:

>>> let string = "hello" :: String
>>> openUnionLift string :: OpenUnion '[Double, String, Int]
Identity "hello"

openUnionMatch :: forall a as. IsMember a as => OpenUnion as -> Maybe a

Just like unionMatch but for OpenUnion.

Successful matching:

>>> let string = "hello" :: String
>>> let o = openUnionLift string :: OpenUnion '[Double, String, Int]
>>> openUnionMatch o :: Maybe String
Just "hello"

Failure matching:

>>> let double = 3.3 :: Double
>>> let p = openUnionLift double :: OpenUnion '[Double, String]
>>> openUnionMatch p :: Maybe String
Nothing

catchesOpenUnion :: ToOpenProduct tuple (ReturnX x as) => tuple -> OpenUnion as -> x

Setup code for doctests

>>> :set -XDataKinds
>>> :set -XTypeOperators
>>> import Data.Text (Text)
>>> import Text.Read (readMaybe)