vary-0.1.0.1: Vary: Friendly and fast polymorphic variants (open unions/coproducts/extensible sums)
Safe HaskellSafe-Inferred
LanguageGHC2021

Vary.Utils

Synopsis

Useful in generic code

type (:|) e es = Member e es Source #

Constrain es to be any type list containing e.

Useful to talk about variants generically without having to specify the exact type list right away.

For instance, the type of from is

Vary.from :: (a :| l) => a -> Vary l

because we can use it to construct any Vary as long as there is an a somewhere in its list of types.

class KnownPrefix (es :: [Type]) where Source #

Calculate length of a statically known prefix of es.

Instances

Instances details
KnownPrefix es Source # 
Instance details

Defined in Vary.Utils

KnownPrefix es => KnownPrefix (e ': es) Source # 
Instance details

Defined in Vary.Utils

type family Length (xs :: [k]) :: Nat where ... Source #

Get list length

Equations

Length xs = Length' 0 xs 

class KnownPrefix es => Subset (xs :: [Type]) (es :: [Type]) where Source #

Provide evidence that xs is a subset of es.

Minimal complete definition

Nothing

Instances

Instances details
(KnownPrefix es, IsUnknownSuffixOf xs es) => Subset xs es Source # 
Instance details

Defined in Vary.Utils

Methods

subsetFullyKnown :: Bool Source #

morph' :: forall (ys :: [Type]). Vary xs -> Vary ys Source #

KnownPrefix es => Subset ('[] :: [Type]) es Source # 
Instance details

Defined in Vary.Utils

Methods

subsetFullyKnown :: Bool Source #

morph' :: forall (ys :: [Type]). Vary '[] -> Vary ys Source #

(e :| es, Subset xs es) => Subset (e ': xs) es Source # 
Instance details

Defined in Vary.Utils

Methods

subsetFullyKnown :: Bool Source #

morph' :: forall (ys :: [Type]). Vary (e ': xs) -> Vary ys Source #

type Index (n :: Nat) (l :: [k]) = Type_List_Too_Vague___Please_Specify_Prefix_Of_List_Including_The_Desired_Type's_Location n l l Source #

Indexed access into the list

type IndexOf (x :: k) (xs :: [k]) = IndexOf' (MaybeIndexOf x xs) x xs Source #

Get the first index of a type

type Mappable a b xs ys = (a :| xs, b :| ys, ys ~ Mapped a b xs) Source #

Constraint to link the input and output lists together, without specifying any particular element order.

This allows us to defer type signatures until the final place the variant is used.

pop :: Vary (a : as) -> Either (Vary as) a Source #

Attempts to extract a value of the first type from the Vary.

If this failed, we know it has to be one of the other possibilities.

This function can also be seen as turning one layer of Vary into its isomorphic Either representation.

This function is not often useful in normal code, but super useful in generic code where you want to recurse on the variant's types.

For instance when implementing a typeclass for any Vary whose elements implement the typeclass:

instance Show (Vary '[]) where
   show = Vary.exhaustiveCase

instance (Show a, Show (Vary as)) => Show (Vary (a : as)) where
   show vary = case Vary.pop vary of
       Right val -> "Vary.from " <> show val
       Left other -> show other

To go the other way:

  • Use Vary.morph to turn Vary as back into Vary (a : as)
  • Use Vary.from to turn a back into Vary (a : as)

Informational

size :: forall xs. KnownNat (Length xs) => Vary xs -> Word Source #

Returns the number of elements contained in this variant.

Does not actually use the runtime representation of the variant in any way.

activeIndex :: Vary a -> Word Source #

Returns the currently active 'tag index' of the variant.

Not useful in normal code, but maybe nice in certaing debugging scenarios.

Note that this index changes whenever a variant is morphed.

Helper

natValue :: forall (n :: Nat) a. (KnownNat n, Num a) => a Source #