Data.WorldPeace.Union

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

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

Union

data Union (f :: u -> *) (as :: [u]) 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 :: *.

What does this mean in practice? It means that a type like Union Identity '[String, Int] can be _either_ an Identity String or an Identity Int.

You need to pattern match on the This and That constructors to figure out whether you are holding a String or Int:

>>> let u = That (This (Identity 1)) :: Union Identity '[String, Int]
>>> :{
  case u of
    This (Identity str) -> "we got a string: " ++ str
    That (This (Identity int)) -> "we got an int: " ++ show int
:}
"we got an int: 1"

There are multiple functions that let you perform this pattern matching easier: union, catchesUnion, unionMatch

There is also a type synonym OpenUnion for the common case of Union Indentity, as well as helper functions for working with it.

Constructors

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

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

Instances

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

Methods

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

(/=) :: Union a1 f ((a1 ': a2) as) -> Union a1 f ((a1 ': a2) 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 a2), Ord (Union a1 f as)) => Ord (Union a1 f ((:) a1 a2 as))

Methods

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

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

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

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

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

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

min :: Union a1 f ((a1 ': a2) as) -> Union a1 f ((a1 ': a2) as) -> Union a1 f ((a1 ': a2) 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 a2), Read (Union a1 f as)) => Read (Union a1 f ((:) a1 a2 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 a1 f ((a1 ': a2) as))

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

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

readListPrec :: ReadPrec [Union a1 f ((a1 ': a2) 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 a2), Show (Union a1 f as)) => Show (Union a1 f ((:) a1 a2 as))

Methods

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

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

showList :: [Union a1 f ((a1 ': a2) 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 a2), ToJSON (Union a1 f as)) => ToJSON (Union a1 f ((:) a1 a2 as))

Methods

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

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

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

toEncodingList :: [Union a1 f ((a1 ': a2) 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 a2), FromJSON (Union a1 f as)) => FromJSON (Union a1 f ((:) a1 a2 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 a1 f ((a1 ': a2) as))

parseJSONList :: Value -> Parser [Union a1 f ((a1 ': a2) 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 a2), NFData (Union a1 f as)) => NFData (Union a1 f ((:) a1 a2 as))

Methods

rnf :: Union a1 f ((a1 ': a2) 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.

Examples

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.

Examples

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.

Examples

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.

Examples

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.

Examples

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.

Examples

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)

type family ReturnX x as where ...

Change a list of types into a list of functions that take the given type and return x.

>>> import Data.Type.Equality ((:~:)(Refl))
>>> Refl :: ReturnX Double '[String, Int] :~: '[String -> Double, Int -> Double]
Refl

Don't do anything with an empty list:

>>> Refl :: ReturnX Double '[] :~: '[]
Refl

Equations

ReturnX x (a ': as) = (a -> x) ': ReturnX x as

ReturnX x '[] = '[]

class i ~ RIndex a as => UElem (a :: u) (as :: [u]) (i :: Nat) 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 a1 a2 ((:) a1 a2 as) Z

Methods

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

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

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

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

Methods

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

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

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

type IsMember (a :: u) (as :: [u]) = UElem a as (RIndex a as)

This is a helpful Constraint synonym to assert that a is a member of as. You can see how it is used in functions like openUnionLift.

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.

Examples

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.

Examples

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.

Examples

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

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

When working with large OpenUnions, it can be easier to use catchesOpenUnion than openUnion.

Examples

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

>>> let u = openUnionLift (3 :: Int) :: OpenUnion '[Int, String]
>>> let intHandler = (\int -> show int) :: Int -> String
>>> let strHandler = (\str -> str) :: String -> String
>>> catchesOpenUnion (intHandler, strHandler) u :: String
"3"

Given an OpenUnion like OpenUnion '[Int, String], the type of catchesOpenUnion becomes the following:

  catchesOpenUnion
    :: (Int -> x, String -> x)
    -> OpenUnion '[Int, String]
    -> x

Here is an example of handling an OpenUnion with three possible values:

>>> let u = openUnionLift ("hello" :: String) :: OpenUnion '[Int, String, Double]
>>> let intHandler = (\int -> show int) :: Int -> String
>>> let strHandler = (\str -> str) :: String -> String
>>> let dblHandler = (\dbl -> "got a double") :: Double -> String
>>> catchesOpenUnion (intHandler, strHandler, dblHandler) u :: String
"hello"

Here is an example of handling an OpenUnion with only one possible value. Notice how a tuple is not used, just a single value:

>>> let u = openUnionLift (2.2 :: Double) :: OpenUnion '[Double]
>>> let dblHandler = (\dbl -> "got a double") :: Double -> String
>>> catchesOpenUnion dblHandler u :: String
"got a double"

Setup code for doctests

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