{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}

module Label
  ( -- * Labels
    Label,
    label,
    label',
    getLabel,
    mapLabel,
    traverseLabel,

    -- * Named Tuples
    T2 (..),
    focusOnField,
    monoMapT2,
    tupleToT2,
    T3 (..),
    monoMapT3,
    tupleToT3,

    -- * Named Sums/Enums
    E2 (..),
    mapE2,
    monoMapE2,
    monoFoldE2,
    monoTraverseE2,
    partitionE2,
    isE21,
    isE22,
    getE21,
    getE22,
    E3 (..),
    mapE3,
  )
where

import Data.Data (Proxy (..))
import Data.Either (partitionEithers)
import Data.Function ((&))
import Data.Functor ((<&>))
import Data.Typeable (Typeable)
import GHC.Records (HasField (..))
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)

-- | A labelled value.
--
-- Use 'label'/'label'' to construct,
-- then use dot-syntax to get the inner value.
newtype Label (label :: Symbol) value = Label value
  deriving stock (Label label value -> Label label value -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (label :: Symbol) value.
Eq value =>
Label label value -> Label label value -> Bool
/= :: Label label value -> Label label value -> Bool
$c/= :: forall (label :: Symbol) value.
Eq value =>
Label label value -> Label label value -> Bool
== :: Label label value -> Label label value -> Bool
$c== :: forall (label :: Symbol) value.
Eq value =>
Label label value -> Label label value -> Bool
Eq, Label label value -> Label label value -> Bool
Label label value -> Label label value -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {label :: Symbol} {value}.
Ord value =>
Eq (Label label value)
forall (label :: Symbol) value.
Ord value =>
Label label value -> Label label value -> Bool
forall (label :: Symbol) value.
Ord value =>
Label label value -> Label label value -> Ordering
forall (label :: Symbol) value.
Ord value =>
Label label value -> Label label value -> Label label value
min :: Label label value -> Label label value -> Label label value
$cmin :: forall (label :: Symbol) value.
Ord value =>
Label label value -> Label label value -> Label label value
max :: Label label value -> Label label value -> Label label value
$cmax :: forall (label :: Symbol) value.
Ord value =>
Label label value -> Label label value -> Label label value
>= :: Label label value -> Label label value -> Bool
$c>= :: forall (label :: Symbol) value.
Ord value =>
Label label value -> Label label value -> Bool
> :: Label label value -> Label label value -> Bool
$c> :: forall (label :: Symbol) value.
Ord value =>
Label label value -> Label label value -> Bool
<= :: Label label value -> Label label value -> Bool
$c<= :: forall (label :: Symbol) value.
Ord value =>
Label label value -> Label label value -> Bool
< :: Label label value -> Label label value -> Bool
$c< :: forall (label :: Symbol) value.
Ord value =>
Label label value -> Label label value -> Bool
compare :: Label label value -> Label label value -> Ordering
$ccompare :: forall (label :: Symbol) value.
Ord value =>
Label label value -> Label label value -> Ordering
Ord)
  deriving newtype (Typeable, NonEmpty (Label label value) -> Label label value
Label label value -> Label label value -> Label label value
forall b. Integral b => b -> Label label value -> Label label value
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (label :: Symbol) value.
Semigroup value =>
NonEmpty (Label label value) -> Label label value
forall (label :: Symbol) value.
Semigroup value =>
Label label value -> Label label value -> Label label value
forall (label :: Symbol) value b.
(Semigroup value, Integral b) =>
b -> Label label value -> Label label value
stimes :: forall b. Integral b => b -> Label label value -> Label label value
$cstimes :: forall (label :: Symbol) value b.
(Semigroup value, Integral b) =>
b -> Label label value -> Label label value
sconcat :: NonEmpty (Label label value) -> Label label value
$csconcat :: forall (label :: Symbol) value.
Semigroup value =>
NonEmpty (Label label value) -> Label label value
<> :: Label label value -> Label label value -> Label label value
$c<> :: forall (label :: Symbol) value.
Semigroup value =>
Label label value -> Label label value -> Label label value
Semigroup, Label label value
[Label label value] -> Label label value
Label label value -> Label label value -> Label label value
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {label :: Symbol} {value}.
Monoid value =>
Semigroup (Label label value)
forall (label :: Symbol) value. Monoid value => Label label value
forall (label :: Symbol) value.
Monoid value =>
[Label label value] -> Label label value
forall (label :: Symbol) value.
Monoid value =>
Label label value -> Label label value -> Label label value
mconcat :: [Label label value] -> Label label value
$cmconcat :: forall (label :: Symbol) value.
Monoid value =>
[Label label value] -> Label label value
mappend :: Label label value -> Label label value -> Label label value
$cmappend :: forall (label :: Symbol) value.
Monoid value =>
Label label value -> Label label value -> Label label value
mempty :: Label label value
$cmempty :: forall (label :: Symbol) value. Monoid value => Label label value
Monoid)

instance (KnownSymbol label, Show value) => Show (Label label value) where
  showsPrec :: Int -> Label label value -> ShowS
showsPrec Int
d (Label value
val) =
    Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"label @"
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @label))
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 value
val

-- | Attach a label to a value; should be used with a type application to name the label.
--
-- @
-- let f = label @"foo" 'f' :: Label "foo" Char
-- in f.foo :: Char
-- @
--
-- Use dot-syntax to get the labelled value.
label :: forall label value. value -> Label label value
label :: forall (label :: Symbol) value. value -> Label label value
label value
value = forall (label :: Symbol) value. value -> Label label value
Label value
value

-- | Attach a label to a value; Pass it a proxy with the label name in the argument type.
-- This is intended for passing through the label value;
-- you can also use 'label'.
--
--
-- @
-- let f = label' (Proxy @"foo") 'f' :: Label "foo" Char
-- in f.foo :: Char
-- @
--
-- Use dot-syntax to get the labelled value.
label' :: forall label value. (Proxy label) -> value -> Label label value
label' :: forall (label :: Symbol) value.
Proxy label -> value -> Label label value
label' Proxy label
Proxy value
value = forall (label :: Symbol) value. value -> Label label value
Label value
value

-- | Fetches the labelled value.
instance HasField label (Label label value) value where
  getField :: (Label label value) -> value
  getField :: Label label value -> value
getField (Label value
value) = value
value

-- | Fetch a value from a record, like 'getField', but also keep it wrapped by its label.
getLabel :: forall label record a. HasField label record a => record -> Label label a
getLabel :: forall (label :: Symbol) record a.
HasField label record a =>
record -> Label label a
getLabel record
rec = record
rec forall a b. a -> (a -> b) -> b
& forall {k} (x :: k) r a. HasField x r a => r -> a
getField @label forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) value. value -> Label label value
label @label

-- | 'fmap' over the contents of the labbelled value. Helper.
mapLabel :: forall label a b. (a -> b) -> Label label a -> Label label b
mapLabel :: forall (label :: Symbol) a b.
(a -> b) -> Label label a -> Label label b
mapLabel a -> b
f (Label a
a) = forall (label :: Symbol) value. value -> Label label value
Label @label forall a b. (a -> b) -> a -> b
$ a -> b
f a
a

-- | 'traverse' over the contents of the labbelled value. Helper.
traverseLabel :: forall label f a b. Functor f => (a -> f b) -> Label label a -> f (Label label b)
traverseLabel :: forall (label :: Symbol) (f :: * -> *) a b.
Functor f =>
(a -> f b) -> Label label a -> f (Label label b)
traverseLabel a -> f b
fab (Label a
a) = forall (label :: Symbol) value. value -> Label label value
Label @label forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
fab a
a

-- | A named 2-element tuple. Since the elements are named, you can access them with `.`.
--
-- @
-- let t2 = T2 (label @"myfield" 'c') (label @"otherfield" True) :: T2 "myfield" Char "otherfield" Bool
-- in (
--   t2.myfield :: Char,
--   t2.otherfield :: Bool
-- )
-- @
data T2 (l1 :: Symbol) t1 (l2 :: Symbol) t2 = T2 (Label l1 t1) (Label l2 t2)
  deriving stock (Int -> T2 l1 t1 l2 t2 -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(KnownSymbol l1, KnownSymbol l2, Show t1, Show t2) =>
Int -> T2 l1 t1 l2 t2 -> ShowS
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(KnownSymbol l1, KnownSymbol l2, Show t1, Show t2) =>
[T2 l1 t1 l2 t2] -> ShowS
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(KnownSymbol l1, KnownSymbol l2, Show t1, Show t2) =>
T2 l1 t1 l2 t2 -> String
showList :: [T2 l1 t1 l2 t2] -> ShowS
$cshowList :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(KnownSymbol l1, KnownSymbol l2, Show t1, Show t2) =>
[T2 l1 t1 l2 t2] -> ShowS
show :: T2 l1 t1 l2 t2 -> String
$cshow :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(KnownSymbol l1, KnownSymbol l2, Show t1, Show t2) =>
T2 l1 t1 l2 t2 -> String
showsPrec :: Int -> T2 l1 t1 l2 t2 -> ShowS
$cshowsPrec :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(KnownSymbol l1, KnownSymbol l2, Show t1, Show t2) =>
Int -> T2 l1 t1 l2 t2 -> ShowS
Show, T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Eq t1, Eq t2) =>
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
/= :: T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
$c/= :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Eq t1, Eq t2) =>
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
== :: T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
$c== :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Eq t1, Eq t2) =>
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
Eq, T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {l1 :: Symbol} {t1} {l2 :: Symbol} {t2}.
(Ord t1, Ord t2) =>
Eq (T2 l1 t1 l2 t2)
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Ord t1, Ord t2) =>
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Ord t1, Ord t2) =>
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Ordering
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Ord t1, Ord t2) =>
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2
min :: T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2
$cmin :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Ord t1, Ord t2) =>
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2
max :: T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2
$cmax :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Ord t1, Ord t2) =>
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2
>= :: T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
$c>= :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Ord t1, Ord t2) =>
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
> :: T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
$c> :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Ord t1, Ord t2) =>
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
<= :: T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
$c<= :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Ord t1, Ord t2) =>
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
< :: T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
$c< :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Ord t1, Ord t2) =>
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Bool
compare :: T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Ordering
$ccompare :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Ord t1, Ord t2) =>
T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> Ordering
Ord)

-- | Access the first field by label
instance HasField l1 (T2 l1 t1 l2 t2) t1 where
  getField :: T2 l1 t1 l2 t2 -> t1
getField (T2 Label l1 t1
t1 Label l2 t2
_) = forall {k} (x :: k) r a. HasField x r a => r -> a
getField @l1 Label l1 t1
t1

-- | Access the second field by label
instance HasField l2 (T2 l1 t1 l2 t2) t2 where
  getField :: T2 l1 t1 l2 t2 -> t2
getField (T2 Label l1 t1
_ Label l2 t2
t2) = forall {k} (x :: k) r a. HasField x r a => r -> a
getField @l2 Label l2 t2
t2

instance (Semigroup t1, Semigroup t2) => Semigroup (T2 l1 t1 l2 t2) where
  T2 Label l1 t1
t1 Label l2 t2
t2 <> :: T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2 -> T2 l1 t1 l2 t2
<> T2 Label l1 t1
t1' Label l2 t2
t2' = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l1 t1 -> Label l2 t2 -> T2 l1 t1 l2 t2
T2 (Label l1 t1
t1 forall a. Semigroup a => a -> a -> a
<> Label l1 t1
t1') (Label l2 t2
t2 forall a. Semigroup a => a -> a -> a
<> Label l2 t2
t2')

instance (Monoid t1, Monoid t2) => Monoid (T2 l1 t1 l2 t2) where
  mempty :: T2 l1 t1 l2 t2
mempty = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l1 t1 -> Label l2 t2 -> T2 l1 t1 l2 t2
T2 forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

-- | Given a record with some field, “focus” on that field by pulling it into the first part of the T2,
-- and put the original record into the second part of the T2.
--
-- This can be useful when you have a function that requires something with a field,
-- but the field itself is nested somewhere in the record.
--
-- Example:
--
-- @
-- data Foo = Foo
--   { nested :: Label "myId" Text
--   }
--
-- foo = Foo {nested = "hi"}
--
-- fn :: HasField "myId" rec Text => rec -> Text
-- fn rec = rec.myId <> "!"
--
-- x = fn (focusOnField @"myId" (.nested) foo) == "hi!"
-- @
--
-- Note that you will have to give `focusOnField` a type annotation of which label to use,
-- otherwise it cannot infer it.
focusOnField ::
  forall field rec subrec t.
  HasField field subrec t =>
  (rec -> subrec) ->
  rec ->
  T2 field t "dat" rec
focusOnField :: forall (field :: Symbol) rec subrec t.
HasField field subrec t =>
(rec -> subrec) -> rec -> T2 field t "dat" rec
focusOnField rec -> subrec
zoom rec
rec = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l1 t1 -> Label l2 t2 -> T2 l1 t1 l2 t2
T2 (forall (label :: Symbol) record a.
HasField label record a =>
record -> Label label a
getLabel @field (rec
rec forall a b. a -> (a -> b) -> b
& rec -> subrec
zoom)) (forall (label :: Symbol) value. value -> Label label value
label @"dat" rec
rec)

-- | Map a function over all fields in the tuple. All fields have to have the same type.
monoMapT2 :: (t -> t') -> T2 l1 t l2 t -> T2 l1 t' l2 t'
monoMapT2 :: forall t t' (l1 :: Symbol) (l2 :: Symbol).
(t -> t') -> T2 l1 t l2 t -> T2 l1 t' l2 t'
monoMapT2 t -> t'
f (T2 Label l1 t
a Label l2 t
b) = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l1 t1 -> Label l2 t2 -> T2 l1 t1 l2 t2
T2 (forall (label :: Symbol) a b.
(a -> b) -> Label label a -> Label label b
mapLabel t -> t'
f Label l1 t
a) (forall (label :: Symbol) a b.
(a -> b) -> Label label a -> Label label b
mapLabel t -> t'
f Label l2 t
b)

-- | Convert a tuple to a T2 by giving its elements names.
--
-- @tupleToT2 @"left" @"right" ('c', True) :: T2 "left" Char "right" Bool@
tupleToT2 :: forall l1 l2 t1 t2. (t1, t2) -> T2 l1 t1 l2 t2
tupleToT2 :: forall (l1 :: Symbol) (l2 :: Symbol) t1 t2.
(t1, t2) -> T2 l1 t1 l2 t2
tupleToT2 (t1
t1, t2
t2) = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l1 t1 -> Label l2 t2 -> T2 l1 t1 l2 t2
T2 (forall (label :: Symbol) value. value -> Label label value
label @l1 t1
t1) (forall (label :: Symbol) value. value -> Label label value
label @l2 t2
t2)

-- | A named 3-element tuple. Since the elements are named, you can access them with `.`. See 'T2' for an example.
data T3 (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3 = T3 (Label l1 t1) (Label l2 t2) (Label l3 t3)
  deriving stock (Int -> T3 l1 t1 l2 t2 l3 t3 -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(KnownSymbol l1, KnownSymbol l2, KnownSymbol l3, Show t1, Show t2,
 Show t3) =>
Int -> T3 l1 t1 l2 t2 l3 t3 -> ShowS
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(KnownSymbol l1, KnownSymbol l2, KnownSymbol l3, Show t1, Show t2,
 Show t3) =>
[T3 l1 t1 l2 t2 l3 t3] -> ShowS
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(KnownSymbol l1, KnownSymbol l2, KnownSymbol l3, Show t1, Show t2,
 Show t3) =>
T3 l1 t1 l2 t2 l3 t3 -> String
showList :: [T3 l1 t1 l2 t2 l3 t3] -> ShowS
$cshowList :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(KnownSymbol l1, KnownSymbol l2, KnownSymbol l3, Show t1, Show t2,
 Show t3) =>
[T3 l1 t1 l2 t2 l3 t3] -> ShowS
show :: T3 l1 t1 l2 t2 l3 t3 -> String
$cshow :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(KnownSymbol l1, KnownSymbol l2, KnownSymbol l3, Show t1, Show t2,
 Show t3) =>
T3 l1 t1 l2 t2 l3 t3 -> String
showsPrec :: Int -> T3 l1 t1 l2 t2 l3 t3 -> ShowS
$cshowsPrec :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(KnownSymbol l1, KnownSymbol l2, KnownSymbol l3, Show t1, Show t2,
 Show t3) =>
Int -> T3 l1 t1 l2 t2 l3 t3 -> ShowS
Show, T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Eq t1, Eq t2, Eq t3) =>
T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
/= :: T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
$c/= :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Eq t1, Eq t2, Eq t3) =>
T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
== :: T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
$c== :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Eq t1, Eq t2, Eq t3) =>
T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
Eq, T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {l1 :: Symbol} {t1} {l2 :: Symbol} {t2} {l3 :: Symbol} {t3}.
(Ord t1, Ord t2, Ord t3) =>
Eq (T3 l1 t1 l2 t2 l3 t3)
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Ord t1, Ord t2, Ord t3) =>
T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Ord t1, Ord t2, Ord t3) =>
T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Ordering
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Ord t1, Ord t2, Ord t3) =>
T3 l1 t1 l2 t2 l3 t3
-> T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3
min :: T3 l1 t1 l2 t2 l3 t3
-> T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3
$cmin :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Ord t1, Ord t2, Ord t3) =>
T3 l1 t1 l2 t2 l3 t3
-> T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3
max :: T3 l1 t1 l2 t2 l3 t3
-> T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3
$cmax :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Ord t1, Ord t2, Ord t3) =>
T3 l1 t1 l2 t2 l3 t3
-> T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3
>= :: T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
$c>= :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Ord t1, Ord t2, Ord t3) =>
T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
> :: T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
$c> :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Ord t1, Ord t2, Ord t3) =>
T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
<= :: T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
$c<= :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Ord t1, Ord t2, Ord t3) =>
T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
< :: T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
$c< :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Ord t1, Ord t2, Ord t3) =>
T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Bool
compare :: T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Ordering
$ccompare :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Ord t1, Ord t2, Ord t3) =>
T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3 -> Ordering
Ord)

-- | Access the first field by label
instance HasField l1 (T3 l1 t1 l2 t2 l3 t3) t1 where
  getField :: T3 l1 t1 l2 t2 l3 t3 -> t1
getField (T3 Label l1 t1
t1 Label l2 t2
_ Label l3 t3
_) = forall {k} (x :: k) r a. HasField x r a => r -> a
getField @l1 Label l1 t1
t1

-- | Access the second field by label
instance HasField l2 (T3 l1 t1 l2 t2 l3 t3) t2 where
  getField :: T3 l1 t1 l2 t2 l3 t3 -> t2
getField (T3 Label l1 t1
_ Label l2 t2
t2 Label l3 t3
_) = forall {k} (x :: k) r a. HasField x r a => r -> a
getField @l2 Label l2 t2
t2

-- | Access the third field by label
instance HasField l3 (T3 l1 t1 l2 t2 l3 t3) t3 where
  getField :: T3 l1 t1 l2 t2 l3 t3 -> t3
getField (T3 Label l1 t1
_ Label l2 t2
_ Label l3 t3
t3) = forall {k} (x :: k) r a. HasField x r a => r -> a
getField @l3 Label l3 t3
t3

instance (Semigroup t1, Semigroup t2, Semigroup t3) => Semigroup (T3 l1 t1 l2 t2 l3 t3) where
  T3 Label l1 t1
t1 Label l2 t2
t2 Label l3 t3
t3 <> :: T3 l1 t1 l2 t2 l3 t3
-> T3 l1 t1 l2 t2 l3 t3 -> T3 l1 t1 l2 t2 l3 t3
<> T3 Label l1 t1
t1' Label l2 t2
t2' Label l3 t3
t3' = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
Label l1 t1 -> Label l2 t2 -> Label l3 t3 -> T3 l1 t1 l2 t2 l3 t3
T3 (Label l1 t1
t1 forall a. Semigroup a => a -> a -> a
<> Label l1 t1
t1') (Label l2 t2
t2 forall a. Semigroup a => a -> a -> a
<> Label l2 t2
t2') (Label l3 t3
t3 forall a. Semigroup a => a -> a -> a
<> Label l3 t3
t3')

instance (Monoid t1, Monoid t2, Monoid t3) => Monoid (T3 l1 t1 l2 t2 l3 t3) where
  mempty :: T3 l1 t1 l2 t2 l3 t3
mempty = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
Label l1 t1 -> Label l2 t2 -> Label l3 t3 -> T3 l1 t1 l2 t2 l3 t3
T3 forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

-- | Map a function over all fields in the tuple. All fields have to have the same type.
monoMapT3 :: (t -> t') -> T3 l1 t l2 t l3 t -> T3 l1 t' l2 t' l3 t'
monoMapT3 :: forall t t' (l1 :: Symbol) (l2 :: Symbol) (l3 :: Symbol).
(t -> t') -> T3 l1 t l2 t l3 t -> T3 l1 t' l2 t' l3 t'
monoMapT3 t -> t'
f (T3 Label l1 t
a Label l2 t
b Label l3 t
c) = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
Label l1 t1 -> Label l2 t2 -> Label l3 t3 -> T3 l1 t1 l2 t2 l3 t3
T3 (forall (label :: Symbol) a b.
(a -> b) -> Label label a -> Label label b
mapLabel t -> t'
f Label l1 t
a) (forall (label :: Symbol) a b.
(a -> b) -> Label label a -> Label label b
mapLabel t -> t'
f Label l2 t
b) (forall (label :: Symbol) a b.
(a -> b) -> Label label a -> Label label b
mapLabel t -> t'
f Label l3 t
c)

-- | Convert a tuple to a T3 by giving its elements names.
--
-- @tupleToT3 @"left" @"right" @"grip" ('c', True, Maybe 'x') :: T3 "left" Char "right" Bool "grip" (Maybe Char)@
tupleToT3 :: forall l1 l2 l3 t1 t2 t3. (t1, t2, t3) -> T3 l1 t1 l2 t2 l3 t3
tupleToT3 :: forall (l1 :: Symbol) (l2 :: Symbol) (l3 :: Symbol) t1 t2 t3.
(t1, t2, t3) -> T3 l1 t1 l2 t2 l3 t3
tupleToT3 (t1
t1, t2
t2, t3
t3) = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
Label l1 t1 -> Label l2 t2 -> Label l3 t3 -> T3 l1 t1 l2 t2 l3 t3
T3 (forall (label :: Symbol) value. value -> Label label value
label @l1 t1
t1) (forall (label :: Symbol) value. value -> Label label value
label @l2 t2
t2) (forall (label :: Symbol) value. value -> Label label value
label @l3 t3
t3)

-- | A named 2-alternative sum (“'Either' with labels”).
data E2 (l1 :: Symbol) t1 (l2 :: Symbol) t2
  = E21 (Label l1 t1)
  | E22 (Label l2 t2)
  deriving stock (E2 l1 t1 l2 t2 -> E2 l1 t1 l2 t2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Eq t1, Eq t2) =>
E2 l1 t1 l2 t2 -> E2 l1 t1 l2 t2 -> Bool
/= :: E2 l1 t1 l2 t2 -> E2 l1 t1 l2 t2 -> Bool
$c/= :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Eq t1, Eq t2) =>
E2 l1 t1 l2 t2 -> E2 l1 t1 l2 t2 -> Bool
== :: E2 l1 t1 l2 t2 -> E2 l1 t1 l2 t2 -> Bool
$c== :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(Eq t1, Eq t2) =>
E2 l1 t1 l2 t2 -> E2 l1 t1 l2 t2 -> Bool
Eq, Int -> E2 l1 t1 l2 t2 -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(KnownSymbol l1, KnownSymbol l2, Show t1, Show t2) =>
Int -> E2 l1 t1 l2 t2 -> ShowS
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(KnownSymbol l1, KnownSymbol l2, Show t1, Show t2) =>
[E2 l1 t1 l2 t2] -> ShowS
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(KnownSymbol l1, KnownSymbol l2, Show t1, Show t2) =>
E2 l1 t1 l2 t2 -> String
showList :: [E2 l1 t1 l2 t2] -> ShowS
$cshowList :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(KnownSymbol l1, KnownSymbol l2, Show t1, Show t2) =>
[E2 l1 t1 l2 t2] -> ShowS
show :: E2 l1 t1 l2 t2 -> String
$cshow :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(KnownSymbol l1, KnownSymbol l2, Show t1, Show t2) =>
E2 l1 t1 l2 t2 -> String
showsPrec :: Int -> E2 l1 t1 l2 t2 -> ShowS
$cshowsPrec :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
(KnownSymbol l1, KnownSymbol l2, Show t1, Show t2) =>
Int -> E2 l1 t1 l2 t2 -> ShowS
Show)

instance (Bounded t1, Bounded t2) => Bounded (E2 l1 t1 l2 t2) where
  minBound :: E2 l1 t1 l2 t2
minBound = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l1 t1 -> E2 l1 t1 l2 t2
E21 (forall (label :: Symbol) value. value -> Label label value
label @l1 forall a. Bounded a => a
minBound)
  maxBound :: E2 l1 t1 l2 t2
maxBound = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l2 t2 -> E2 l1 t1 l2 t2
E22 (forall (label :: Symbol) value. value -> Label label value
label @l2 forall a. Bounded a => a
maxBound)

-- TODO: instance for arbitrary Enum types?
instance Enum (E2 l1 () l2 ()) where
  toEnum :: Int -> E2 l1 () l2 ()
toEnum Int
0 = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l1 t1 -> E2 l1 t1 l2 t2
E21 (forall (label :: Symbol) value. value -> Label label value
label @l1 ())
  toEnum Int
1 = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l2 t2 -> E2 l1 t1 l2 t2
E22 (forall (label :: Symbol) value. value -> Label label value
label @l2 ())
  toEnum Int
_ = forall a. HasCallStack => String -> a
error String
"E2: toEnum"

  fromEnum :: E2 l1 () l2 () -> Int
fromEnum (E21 Label l1 ()
_) = Int
0
  fromEnum (E22 Label l2 ()
_) = Int
1

-- | Map a separate function over every possibility in this enum. The label names stay the same.
--
-- Each function has access to its label, this is intentional so that you have to mention the label once (e.g. by using dot-notation), to prevent confusing the cases.
mapE2 ::
  forall l1 t1 t1' l2 t2 t2'.
  (Label l1 t1 -> t1') ->
  (Label l2 t2 -> t2') ->
  E2 l1 t1 l2 t2 ->
  E2 l1 t1' l2 t2'
mapE2 :: forall (l1 :: Symbol) t1 t1' (l2 :: Symbol) t2 t2'.
(Label l1 t1 -> t1')
-> (Label l2 t2 -> t2') -> E2 l1 t1 l2 t2 -> E2 l1 t1' l2 t2'
mapE2 Label l1 t1 -> t1'
f1 Label l2 t2 -> t2'
f2 = \case
  E21 Label l1 t1
lbl -> Label l1 t1
lbl forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) record a.
HasField label record a =>
record -> Label label a
getLabel @l1 forall a b. a -> (a -> b) -> b
& Label l1 t1 -> t1'
f1 forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) value. value -> Label label value
label @l1 forall a b. a -> (a -> b) -> b
& forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l1 t1 -> E2 l1 t1 l2 t2
E21
  E22 Label l2 t2
lbl -> Label l2 t2
lbl forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) record a.
HasField label record a =>
record -> Label label a
getLabel @l2 forall a b. a -> (a -> b) -> b
& Label l2 t2 -> t2'
f2 forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) value. value -> Label label value
label @l2 forall a b. a -> (a -> b) -> b
& forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l2 t2 -> E2 l1 t1 l2 t2
E22

-- | Map a single function over every possiblity in this enum. All fields have to have the same type.
monoMapE2 :: (t -> t') -> E2 l1 t l2 t -> E2 l1 t' l2 t'
monoMapE2 :: forall t t' (l1 :: Symbol) (l2 :: Symbol).
(t -> t') -> E2 l1 t l2 t -> E2 l1 t' l2 t'
monoMapE2 t -> t'
f = \case
  E21 Label l1 t
lbl -> Label l1 t
lbl forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) a b.
(a -> b) -> Label label a -> Label label b
mapLabel t -> t'
f forall a b. a -> (a -> b) -> b
& forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l1 t1 -> E2 l1 t1 l2 t2
E21
  E22 Label l2 t
lbl -> Label l2 t
lbl forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) a b.
(a -> b) -> Label label a -> Label label b
mapLabel t -> t'
f forall a b. a -> (a -> b) -> b
& forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l2 t2 -> E2 l1 t1 l2 t2
E22

-- | If ever branch of this enum has the same type, fold the enum into its contents.
-- This loses the distinction between cases.
monoFoldE2 :: E2 l1 t l2 t -> t
monoFoldE2 :: forall (l1 :: Symbol) t (l2 :: Symbol). E2 l1 t l2 t -> t
monoFoldE2 = \case
  E21 (Label t
t) -> t
t
  E22 (Label t
t) -> t
t

-- | Partition a list of E2 into two lists that each keep their respective label.
-- Like 'partitionEithers', but with labels.
partitionE2 :: forall l1 t1 l2 t2. [E2 l1 t1 l2 t2] -> T2 l1 [t1] l2 [t2]
partitionE2 :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
[E2 l1 t1 l2 t2] -> T2 l1 [t1] l2 [t2]
partitionE2 [E2 l1 t1 l2 t2]
es =
  [E2 l1 t1 l2 t2]
es
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ( \case
            E21 (Label t1
t1) -> forall a b. a -> Either a b
Left t1
t1
            E22 (Label t2
t2) -> forall a b. b -> Either a b
Right t2
t2
        )
    forall a b. a -> (a -> b) -> b
& forall a b. [Either a b] -> ([a], [b])
partitionEithers
    forall a b. a -> (a -> b) -> b
& (\([t1]
t1s, [t2]
t2s) -> forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l1 t1 -> Label l2 t2 -> T2 l1 t1 l2 t2
T2 (forall (label :: Symbol) value. value -> Label label value
label @l1 [t1]
t1s) (forall (label :: Symbol) value. value -> Label label value
label @l2 [t2]
t2s))

-- | Map a monadic (actually just a functor-ic) function over each possibility in this enum. All fields have to have the same type.
monoTraverseE2 :: Functor f => (t -> f t') -> E2 l1 t l2 t -> f (E2 l1 t' l2 t')
monoTraverseE2 :: forall (f :: * -> *) t t' (l1 :: Symbol) (l2 :: Symbol).
Functor f =>
(t -> f t') -> E2 l1 t l2 t -> f (E2 l1 t' l2 t')
monoTraverseE2 t -> f t'
f = \case
  E21 Label l1 t
lbl -> Label l1 t
lbl forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) (f :: * -> *) a b.
Functor f =>
(a -> f b) -> Label label a -> f (Label label b)
traverseLabel t -> f t'
f forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l1 t1 -> E2 l1 t1 l2 t2
E21
  E22 Label l2 t
lbl -> Label l2 t
lbl forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) (f :: * -> *) a b.
Functor f =>
(a -> f b) -> Label label a -> f (Label label b)
traverseLabel t -> f t'
f forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
Label l2 t2 -> E2 l1 t1 l2 t2
E22

-- | Check the E21 case. Use TypeApplications to make sure you are checking the right case.
--
-- >>> isE21 @"foo" (E21 (label @"foo" 'c') :: E2 "foo" Char "bar" Int)
-- True
isE21 :: forall l1 t1 l2 t2. E2 l1 t1 l2 t2 -> Bool
isE21 :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2. E2 l1 t1 l2 t2 -> Bool
isE21 = \case
  E21 Label l1 t1
_ -> Bool
True
  E22 Label l2 t2
_ -> Bool
False

-- | Check the E22 case. Use TypeApplications to make sure you are checking the right case.
--
-- >>> isE22 @"bar" (E21 (label @"foo" 'c') :: E2 "foo" Char "bar" Int)
-- False
isE22 :: forall l2 t2 l1 t1. E2 l1 t1 l2 t2 -> Bool
isE22 :: forall (l2 :: Symbol) t2 (l1 :: Symbol) t1. E2 l1 t1 l2 t2 -> Bool
isE22 = \case
  E21 Label l1 t1
_ -> Bool
False
  E22 Label l2 t2
_ -> Bool
True

getE21 :: forall l1 t1 l2 t2. E2 l1 t1 l2 t2 -> Maybe t1
getE21 :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2.
E2 l1 t1 l2 t2 -> Maybe t1
getE21 = \case
  E21 Label l1 t1
lbl -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {k} (x :: k) r a. HasField x r a => r -> a
getField @l1 Label l1 t1
lbl
  E22 Label l2 t2
_ -> forall a. Maybe a
Nothing

getE22 :: forall l2 t2 l1 t1. E2 l1 t1 l2 t2 -> Maybe t2
getE22 :: forall (l2 :: Symbol) t2 (l1 :: Symbol) t1.
E2 l1 t1 l2 t2 -> Maybe t2
getE22 = \case
  E21 Label l1 t1
_ -> forall a. Maybe a
Nothing
  E22 Label l2 t2
lbl -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {k} (x :: k) r a. HasField x r a => r -> a
getField @l2 Label l2 t2
lbl

-- | A named 3-alternative sum (“'Either' with labels”).
data E3 (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3
  = E31 (Label l1 t1)
  | E32 (Label l2 t2)
  | E33 (Label l3 t3)
  deriving stock (E3 l1 t1 l2 t2 l3 t3 -> E3 l1 t1 l2 t2 l3 t3 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Eq t1, Eq t2, Eq t3) =>
E3 l1 t1 l2 t2 l3 t3 -> E3 l1 t1 l2 t2 l3 t3 -> Bool
/= :: E3 l1 t1 l2 t2 l3 t3 -> E3 l1 t1 l2 t2 l3 t3 -> Bool
$c/= :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Eq t1, Eq t2, Eq t3) =>
E3 l1 t1 l2 t2 l3 t3 -> E3 l1 t1 l2 t2 l3 t3 -> Bool
== :: E3 l1 t1 l2 t2 l3 t3 -> E3 l1 t1 l2 t2 l3 t3 -> Bool
$c== :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(Eq t1, Eq t2, Eq t3) =>
E3 l1 t1 l2 t2 l3 t3 -> E3 l1 t1 l2 t2 l3 t3 -> Bool
Eq, Int -> E3 l1 t1 l2 t2 l3 t3 -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(KnownSymbol l1, KnownSymbol l2, KnownSymbol l3, Show t1, Show t2,
 Show t3) =>
Int -> E3 l1 t1 l2 t2 l3 t3 -> ShowS
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(KnownSymbol l1, KnownSymbol l2, KnownSymbol l3, Show t1, Show t2,
 Show t3) =>
[E3 l1 t1 l2 t2 l3 t3] -> ShowS
forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(KnownSymbol l1, KnownSymbol l2, KnownSymbol l3, Show t1, Show t2,
 Show t3) =>
E3 l1 t1 l2 t2 l3 t3 -> String
showList :: [E3 l1 t1 l2 t2 l3 t3] -> ShowS
$cshowList :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(KnownSymbol l1, KnownSymbol l2, KnownSymbol l3, Show t1, Show t2,
 Show t3) =>
[E3 l1 t1 l2 t2 l3 t3] -> ShowS
show :: E3 l1 t1 l2 t2 l3 t3 -> String
$cshow :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(KnownSymbol l1, KnownSymbol l2, KnownSymbol l3, Show t1, Show t2,
 Show t3) =>
E3 l1 t1 l2 t2 l3 t3 -> String
showsPrec :: Int -> E3 l1 t1 l2 t2 l3 t3 -> ShowS
$cshowsPrec :: forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
(KnownSymbol l1, KnownSymbol l2, KnownSymbol l3, Show t1, Show t2,
 Show t3) =>
Int -> E3 l1 t1 l2 t2 l3 t3 -> ShowS
Show)

instance (Bounded t1, Bounded t3) => Bounded (E3 l1 t1 l2 t2 l3 t3) where
  minBound :: E3 l1 t1 l2 t2 l3 t3
minBound = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
Label l1 t1 -> E3 l1 t1 l2 t2 l3 t3
E31 (forall (label :: Symbol) value. value -> Label label value
label @l1 forall a. Bounded a => a
minBound)
  maxBound :: E3 l1 t1 l2 t2 l3 t3
maxBound = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
Label l3 t3 -> E3 l1 t1 l2 t2 l3 t3
E33 (forall (label :: Symbol) value. value -> Label label value
label @l3 forall a. Bounded a => a
maxBound)

-- TODO: instance for arbitrary Enum types?
instance Enum (E3 l1 () l2 () l3 ()) where
  toEnum :: Int -> E3 l1 () l2 () l3 ()
toEnum Int
0 = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
Label l1 t1 -> E3 l1 t1 l2 t2 l3 t3
E31 (forall (label :: Symbol) value. value -> Label label value
label @l1 ())
  toEnum Int
1 = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
Label l2 t2 -> E3 l1 t1 l2 t2 l3 t3
E32 (forall (label :: Symbol) value. value -> Label label value
label @l2 ())
  toEnum Int
2 = forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
Label l3 t3 -> E3 l1 t1 l2 t2 l3 t3
E33 (forall (label :: Symbol) value. value -> Label label value
label @l3 ())
  toEnum Int
_ = forall a. HasCallStack => String -> a
error String
"E3: toEnum"

  fromEnum :: E3 l1 () l2 () l3 () -> Int
fromEnum (E31 Label l1 ()
_) = Int
0
  fromEnum (E32 Label l2 ()
_) = Int
1
  fromEnum (E33 Label l3 ()
_) = Int
2

-- | Map a function over every element in this enum. The label names stay the same.
mapE3 ::
  forall l1 t1 t1' l2 t2 t2' l3 t3 t3'.
  (Label l1 t1 -> t1') ->
  (Label l2 t2 -> t2') ->
  (Label l3 t3 -> t3') ->
  E3 l1 t1 l2 t2 l3 t3 ->
  E3 l1 t1' l2 t2' l3 t3'
mapE3 :: forall (l1 :: Symbol) t1 t1' (l2 :: Symbol) t2 t2' (l3 :: Symbol)
       t3 t3'.
(Label l1 t1 -> t1')
-> (Label l2 t2 -> t2')
-> (Label l3 t3 -> t3')
-> E3 l1 t1 l2 t2 l3 t3
-> E3 l1 t1' l2 t2' l3 t3'
mapE3 Label l1 t1 -> t1'
f1 Label l2 t2 -> t2'
f2 Label l3 t3 -> t3'
f3 = \case
  E31 Label l1 t1
lbl -> Label l1 t1
lbl forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) record a.
HasField label record a =>
record -> Label label a
getLabel @l1 forall a b. a -> (a -> b) -> b
& Label l1 t1 -> t1'
f1 forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) value. value -> Label label value
label @l1 forall a b. a -> (a -> b) -> b
& forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
Label l1 t1 -> E3 l1 t1 l2 t2 l3 t3
E31
  E32 Label l2 t2
lbl -> Label l2 t2
lbl forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) record a.
HasField label record a =>
record -> Label label a
getLabel @l2 forall a b. a -> (a -> b) -> b
& Label l2 t2 -> t2'
f2 forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) value. value -> Label label value
label @l2 forall a b. a -> (a -> b) -> b
& forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
Label l2 t2 -> E3 l1 t1 l2 t2 l3 t3
E32
  E33 Label l3 t3
lbl -> Label l3 t3
lbl forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) record a.
HasField label record a =>
record -> Label label a
getLabel @l3 forall a b. a -> (a -> b) -> b
& Label l3 t3 -> t3'
f3 forall a b. a -> (a -> b) -> b
& forall (label :: Symbol) value. value -> Label label value
label @l3 forall a b. a -> (a -> b) -> b
& forall (l1 :: Symbol) t1 (l2 :: Symbol) t2 (l3 :: Symbol) t3.
Label l3 t3 -> E3 l1 t1 l2 t2 l3 t3
E33