vector-heterogenous-0.2.0: A type-safe library for vectors whose elements can be of any type, or any type satisfying some constraints

Safe HaskellNone
LanguageHaskell98

Data.Vector.Heterogenous.HList

Contents

Synopsis

Heterogenous List

data HList :: [*] -> * where Source

The heterogenous list

Constructors

HNil :: HList [] 
(:::) :: t -> HList ts -> HList (t : ts) infixr 5 

Instances

(Eq x, Eq (HList xs)) => Eq (HList ((:) * x xs)) 
Eq (HList ([] *)) 
(Ord x, Ord (HList xs)) => Ord (HList ((:) * x xs)) 
Ord (HList ([] *)) 
(Show x, Show (HList xs)) => Show (HList ((:) * x xs)) 
Show (HList ([] *)) 
(Monoid x, Monoid (HList xs)) => Monoid (HList ((:) * x xs)) 
Monoid (HList ([] *)) 
HLength (HList xs) => HLength (HList ((:) * x xs)) 
HLength (HList ([] *)) 
(TypeList (HList xs), Typeable * x) => TypeList (HList ((:) * x xs)) 
TypeList (HList ([] *)) 
(ConstraintBox box x, Downcast (HList xs) box) => Downcast (HList ((:) * x xs)) box 
Downcast (HList ([] *)) a 
HList2List (HList xs) a => HList2List (HList ((:) * a xs)) a 
HList2List (HList ((:) * a ([] *))) a 
HTake1 (Nat1Box n) (HList xs1) (HList xs2) => HTake1 (Nat1Box (Succ n)) (HList ((:) * x xs1)) (HList ((:) * x xs2)) 
HTake1 (Nat1Box Zero) (HList xs1) (HList ([] *)) 
HDrop1 (Nat1Box n) (HList xs1) (HList xs2) => HDrop1 (Nat1Box (Succ n)) (HList ((:) * x xs1)) (HList xs2) 
HDrop1 (Nat1Box Zero) (HList xs1) (HList xs1) 
type UnHList * (HList xs) = xs 
type HCons x (HList xs) = HList ((:) * x xs) 
type HAppend (HList xs) (HList ys) = HList ((++) * xs ys) 

class HLength xs where Source

Used only for the HList class to determine its length

Methods

hlength :: xs -> Int Source

Instances

HLength (HList xs) => HLength (HList ((:) * x xs)) 
HLength (HList ([] *)) 

class List2HList x xs where Source

For construction from lists

Methods

list2hlist :: [x] -> HList (x : xs) Source

Instances

List2HList x ([] *) 
List2HList x xs => List2HList x ((:) * x xs) 

class HList2List xs a | xs -> a where Source

For converting into a list

Methods

hlist2list :: xs -> [a] Source

Instances

HList2List (HList xs) a => HList2List (HList ((:) * a xs)) a 
HList2List (HList ((:) * a ([] *))) a 

class HTake1 n xs1 xs2 | n xs1 -> xs2 where Source

Equivalent to prelude's "take"

Methods

htake1 :: n -> xs1 -> xs2 Source

Instances

HTake1 (Nat1Box n) (HList xs1) (HList xs2) => HTake1 (Nat1Box (Succ n)) (HList ((:) * x xs1)) (HList ((:) * x xs2)) 
HTake1 (Nat1Box Zero) (HList xs1) (HList ([] *)) 

class HDrop1 n xs1 xs2 | n xs1 -> xs2 where Source

Equivalent to prelude's "drop"

Methods

hdrop1 :: n -> xs1 -> xs2 Source

Instances

HDrop1 (Nat1Box n) (HList xs1) (HList xs2) => HDrop1 (Nat1Box (Succ n)) (HList ((:) * x xs1)) (HList xs2) 
HDrop1 (Nat1Box Zero) (HList xs1) (HList xs1) 

Typeable

class TypeList t where Source

Methods

typeList :: t -> [TypeRep] Source

Instances

(TypeList (HList xs), Typeable * x) => TypeList (HList ((:) * x xs)) 
TypeList (HList ([] *)) 

Downcasting

class ConstraintBox box a where Source

Methods

box :: a -> box Source

unsafeUnbox :: box -> a Source

Instances

class Downcast h box where Source

Minimal complete definition

downcast

Methods

downcast :: h -> [box] Source

downcastAs :: (a -> box) -> h -> [box] Source

Instances

(ConstraintBox box x, Downcast (HList xs) box) => Downcast (HList ((:) * x xs)) box 
Downcast (HList ([] *)) a 

Boxes

data ShowBox Source

Use this box unless you know for certain that your types won't have a show instance.

Constructors

forall a . Show a => ShowBox !a 

data AnyBox Source

Most generic box, can be used on any type.

Constructors

forall a . AnyBox !a 

Type functions

HList

type family HCons x xs :: * Source

Instances

type HCons x (HList xs) = HList ((:) * x xs) 

type family UnHList xs :: [a] Source

Instances

type UnHList * (HList xs) = xs 

type family HAppend xs ys :: * Source

Instances

type HAppend (HList xs) (HList ys) = HList ((++) * xs ys) 

Type Lists

type family Distribute xs t :: [b] Source

Instances

type Distribute k k1 ([] (k1 -> k)) a = [] k 
type Distribute k k1 ((:) (k1 -> k) x xs) a = (:) k (x a) (Distribute k k1 xs a) 

type family Replicate n x :: [a] Source

Instances

type Replicate k n x 

type family Map f xs :: [a] Source

Instances

type Map k f ([] k) = [] k 
type Map k f ((:) k x xs) = (:) k (f x) (Map k f xs) 

type family Reverse xs :: [a] Source

Instances

type Reverse k ([] k) = [] k 
type Reverse k ((:) k x xs) = (++) k (Reverse k xs) ((:) k x ([] k)) 

type family xs :! i :: a Source

Instances

type (:!) k xs n = Index k xs (ToNat1 n) 

type family Index xs i :: a Source

Instances

type Index k ((:) k x xs) Zero = x 
type Index k ((:) k x xs) (Succ i) = Index k xs i 

type family xs ++ ys :: [a] Source

Instances

type (++) k ([] k) ys = ys 
type (++) k ((:) k x xs) ys = (:) k x ((++) k xs ys) 

type family Concat xs :: [a] Source

Instances

type Concat k ([] [k]) = [] k 
type Concat k ((:) [k] x xs) = (++) k x (Concat k xs) 

type family Length xs :: Nat Source

Instances

type Length k xs = FromNat1 (Length1 k xs) 

type family Length1 xs :: Nat1 Source

Instances

type Length1 k ([] k) = Zero 
type Length1 k ((:) k x xs) = Succ (Length1 k xs) 

Type Nats

data Nat1 Source

Constructors

Zero 
Succ Nat1 

data Nat1Box n Source

Constructors

Nat1Box 

Instances

HTake1 (Nat1Box n) (HList xs1) (HList xs2) => HTake1 (Nat1Box (Succ n)) (HList ((:) * x xs1)) (HList ((:) * x xs2)) 
HTake1 (Nat1Box Zero) (HList xs1) (HList ([] *)) 
HDrop1 (Nat1Box n) (HList xs1) (HList xs2) => HDrop1 (Nat1Box (Succ n)) (HList ((:) * x xs1)) (HList xs2) 
HDrop1 (Nat1Box Zero) (HList xs1) (HList xs1) 

type family ToNat1 n :: Nat1 Source

Instances

type ToNat1 0 = Zero 
type ToNat1 1 = Succ (ToNat1 0) 
type ToNat1 2 = Succ (ToNat1 1) 
type ToNat1 3 = Succ (ToNat1 2) 
type ToNat1 4 = Succ (ToNat1 3) 
type ToNat1 5 = Succ (ToNat1 4) 
type ToNat1 6 = Succ (ToNat1 5) 
type ToNat1 7 = Succ (ToNat1 6) 
type ToNat1 8 = Succ (ToNat1 7) 
type ToNat1 9 = Succ (ToNat1 8) 
type ToNat1 10 = Succ (ToNat1 9) 
type ToNat1 11 = Succ (ToNat1 10) 
type ToNat1 12 = Succ (ToNat1 11) 
type ToNat1 13 = Succ (ToNat1 12) 
type ToNat1 14 = Succ (ToNat1 13) 
type ToNat1 15 = Succ (ToNat1 14) 
type ToNat1 16 = Succ (ToNat1 15) 
type ToNat1 17 = Succ (ToNat1 16) 
type ToNat1 18 = Succ (ToNat1 17) 
type ToNat1 19 = Succ (ToNat1 18) 
type ToNat1 20 = Succ (ToNat1 19) 

type family FromNat1 n :: Nat Source

Instances

type FromNat1 Zero = 0 
type FromNat1 (Succ (Succ (Succ (Succ (Succ (Succ Zero)))))) = 6 
type FromNat1 (Succ (Succ (Succ (Succ (Succ Zero))))) = 5 
type FromNat1 (Succ (Succ (Succ (Succ Zero)))) = 4 
type FromNat1 (Succ (Succ (Succ Zero))) = 3 
type FromNat1 (Succ (Succ Zero)) = 2 
type FromNat1 (Succ Zero) = 1