HList-0.5.1.0: Heterogeneous lists
Copyright(C) 2004 Oleg Kiselyov Ralf Laemmel Keean Schupke
Safe HaskellNone
LanguageHaskell2010

Data.HList.CommonMain

Description

The HList library

This module re-exports everything needed to use HList.

Synopsis

Faking dependent types in Haskell

Functions for all collections

Array-like access to HLists

Result-type-driven operations

Type-indexed operations

Record

quasiquoter pun helps to avoid needing a proxy value with type Label in the first place: when you take values out of or into records with pattern matching, the variable name determines the label name.

Unpacked / Unboxed Records

data RecordU l Source #

A type which behaves similarly to Record, except all elements must fit in the same UArray. A consequence of this is that RecordU has the following properties:

  • it is strict in the element types
  • it cannot do type-changing updates of RecordU, except if the function applies to all elements
  • it probably is slower to update the very first elements of the RecordU

The benefit is that lookups should be faster and records should take up less space. However benchmarks done with a slow HNat2Integral do not suggest that RecordU is faster than Record.

Instances

Instances details
(ApplyAB f (GetElemTy x) (GetElemTy y), IArray UArray (GetElemTy y), IArray UArray (GetElemTy x)) => HMapAux RecordU f x y Source # 
Instance details

Defined in Data.HList.RecordU

Methods

hMapAux :: f -> RecordU x -> RecordU y Source #

(r ~ r', v ~ GetElemTy r, HFindLabel l r n, HNat2Integral n, IArray UArray v, HasField l (Record r') v) => HUpdateAtLabel RecordU (l :: k) v r r' Source # 
Instance details

Defined in Data.HList.RecordU

Methods

hUpdateAtLabel :: Label l -> v -> RecordU r -> RecordU r' Source #

(s ~ t, a ~ b, IArray UArray a, a ~ GetElemTy s, HLensCxt x RecordU s t a b) => Labelable (x :: k) RecordU s t a b Source #

make a Lens' (RecordU s) a

Instance details

Defined in Data.HList.RecordU

Associated Types

type LabelableTy RecordU :: LabeledOpticType Source #

Methods

hLens' :: Label x -> LabeledOptic x RecordU s t a b Source #

(IArray UArray v, v ~ GetElemTy ls, HFindLabel l ls n, HNat2Integral n) => HasField (l :: k) (RecordU ls) v Source # 
Instance details

Defined in Data.HList.RecordU

Methods

hLookupByLabel :: Label l -> RecordU ls -> v Source #

(RecordValues lv, HList2List (RecordValuesR lv) v, HFindMany (LabelsOf lv) (LabelsOf r) ixs, IArray UArray v, v ~ GetElemTy r, HNats2Integrals ixs) => HUpdateMany lv (RecordU r) Source # 
Instance details

Defined in Data.HList.RecordU

Methods

hUpdateMany :: Record lv -> RecordU r -> RecordU r Source #

Eq (UArray Int (GetElemTy l)) => Eq (RecordU l) Source # 
Instance details

Defined in Data.HList.RecordU

Methods

(==) :: RecordU l -> RecordU l -> Bool #

(/=) :: RecordU l -> RecordU l -> Bool #

Ord (UArray Int (GetElemTy l)) => Ord (RecordU l) Source # 
Instance details

Defined in Data.HList.RecordU

Methods

compare :: RecordU l -> RecordU l -> Ordering #

(<) :: RecordU l -> RecordU l -> Bool #

(<=) :: RecordU l -> RecordU l -> Bool #

(>) :: RecordU l -> RecordU l -> Bool #

(>=) :: RecordU l -> RecordU l -> Bool #

max :: RecordU l -> RecordU l -> RecordU l #

min :: RecordU l -> RecordU l -> RecordU l #

Read (UArray Int (GetElemTy l)) => Read (RecordU l) Source # 
Instance details

Defined in Data.HList.RecordU

Show (UArray Int (GetElemTy l)) => Show (RecordU l) Source # 
Instance details

Defined in Data.HList.RecordU

Methods

showsPrec :: Int -> RecordU l -> ShowS #

show :: RecordU l -> String #

showList :: [RecordU l] -> ShowS #

HMapUnboxF xs us => HMapUnboxF (HList x ': xs) (RecordU x ': us) Source # 
Instance details

Defined in Data.HList.RecordU

type LabelableTy RecordU Source # 
Instance details

Defined in Data.HList.RecordU

data RecordUS (x :: [*]) Source #

RecordUS is stored as a HList of RecordU to allow the RecordUS to contain elements of different types, so long all of the types can be put into an unboxed array (UArray).

It is advantageous (at least space-wise) to sort the record to keep elements with the same types elements adjacent. See SortForRecordUS for more details.

Instances

Instances details
(HFindLabel l r n, HLookupByHNatUS n u (Tagged l v), HasField l (Record r) v, RecordUSCxt r u) => HasField (l :: k) (RecordUS r) v Source #

works expected. See examples attached to bad.

Instance details

Defined in Data.HList.RecordU

Methods

hLookupByLabel :: Label l -> RecordUS r -> v Source #

(RecordUSCxt x u, Show (HList u)) => Show (RecordUS x) Source # 
Instance details

Defined in Data.HList.RecordU

Methods

showsPrec :: Int -> RecordUS x -> ShowS #

show :: RecordUS x -> String #

showList :: [RecordUS x] -> ShowS #

class SortForRecordUS x x' | x -> x' where Source #

Reorders a Record such that the RecordUS made from it takes up less space

Bad has alternating Double and Int fields

>>> bad
Record{x=1.0,i=2,y=3.0,j=4}

4 arrays containing one element each are needed when this Record is stored as a RecordUS

>>> recordToRecordUS bad
RecordUS H[RecordU (array (0,0) [(0,1.0)]),RecordU (array (0,0) [(0,2)]),RecordU (array (0,0) [(0,3.0)]),RecordU (array (0,0) [(0,4)])]

It is possible to sort the record

>>> sortForRecordUS bad
Record{x=1.0,y=3.0,i=2,j=4}

This allows the same content to be stored in two unboxed arrays

>>> recordToRecordUS (sortForRecordUS bad)
RecordUS H[RecordU (array (0,1) [(0,1.0),(1,3.0)]),RecordU (array (0,1) [(0,2),(1,4)])]

Instances

Instances details
SortForRecordUS ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.RecordU

Methods

sortForRecordUS :: Record '[] -> Record '[] Source #

(HPartitionEq EqTagValue x (x ': xs) xi xo, SortForRecordUS xo xo', sorted ~ HAppendListR xi xo', HAppendList xi xo') => SortForRecordUS (x ': xs) sorted Source # 
Instance details

Defined in Data.HList.RecordU

Methods

sortForRecordUS :: Record (x ': xs) -> Record sorted Source #

class HUpdateMany lv rx where Source #

analogous flip //. Similar to .<++., except it is restricted to cases where the left argument holds a subset of elements.

Methods

hUpdateMany :: Record lv -> rx -> rx Source #

Instances

Instances details
(HLeftUnion lv x lvx, HRLabelSet x, HLabelSet (LabelsOf x), HRearrange (LabelsOf x) lvx x) => HUpdateMany lv (Record x) Source #

implementation in terms of .<++.

Instance details

Defined in Data.HList.RecordU

Methods

hUpdateMany :: Record lv -> Record x -> Record x Source #

(RecordValues lv, HList2List (RecordValuesR lv) v, HFindMany (LabelsOf lv) (LabelsOf r) ixs, IArray UArray v, v ~ GetElemTy r, HNats2Integrals ixs) => HUpdateMany lv (RecordU r) Source # 
Instance details

Defined in Data.HList.RecordU

Methods

hUpdateMany :: Record lv -> RecordU r -> RecordU r Source #

hMapRU :: HMapCxt RecordU f x y => f -> RecordU x -> RecordU y Source #

hMap specialized to RecordU

internals for types

class HFindMany (ls :: [k]) (r :: [k]) (ns :: [HNat]) | ls r -> ns Source #

behaves like map HFind

Instances

Instances details
HFindMany ('[] :: [k]) (r :: [k]) ('[] :: [HNat]) Source # 
Instance details

Defined in Data.HList.RecordU

(HFind l r n, HFindMany ls r ns) => HFindMany (l ': ls :: [k]) (r :: [k]) (n ': ns) Source # 
Instance details

Defined in Data.HList.RecordU

class HNats2Integrals (ns :: [HNat]) where Source #

Methods

hNats2Integrals :: Integral i => Proxy ns -> [i] Source #

Instances

Instances details
HNats2Integrals ('[] :: [HNat]) Source # 
Instance details

Defined in Data.HList.FakePrelude

Methods

hNats2Integrals :: Integral i => Proxy '[] -> [i] Source #

(HNats2Integrals ns, HNat2Integral n) => HNats2Integrals (n ': ns) Source # 
Instance details

Defined in Data.HList.FakePrelude

Methods

hNats2Integrals :: Integral i => Proxy (n ': ns) -> [i] Source #

class RecordUSCxt (x :: [*]) (u :: [*]) | x -> u, u -> x Source #

connect the unpacked x representation with the corresponding list of RecordU u representation.

Instances

Instances details
(HGroupBy EqTagValue x g, HMapUnboxF g u) => RecordUSCxt x u Source #

the only instance

Instance details

Defined in Data.HList.RecordU

class HLookupByHNatUS (n :: HNat) (us :: [*]) (e :: *) | n us -> e Source #

Minimal complete definition

hLookupByHNatUS

Instances

Instances details
(r ~ HSubtract (HLength u) n, RecordU u ~ ru, HLookupByHNatUS1 r n u us e) => HLookupByHNatUS n (ru ': us) e Source # 
Instance details

Defined in Data.HList.RecordU

Methods

hLookupByHNatUS :: Proxy n -> HList (ru ': us) -> e Source #

class HLookupByHNatUS1 (r :: Either HNat HNat) (n :: HNat) (u :: [*]) (us :: [*]) (e :: *) | r n u us -> e Source #

Minimal complete definition

hLookupByHNatUS1

Instances

Instances details
(HNat2Integral n, HLookupByHNatR n u ~ le, le ~ Tagged l e, IArray UArray e, e ~ GetElemTy u) => HLookupByHNatUS1 ('Left t :: Either HNat HNat) n u us le Source # 
Instance details

Defined in Data.HList.RecordU

Methods

hLookupByHNatUS1 :: Proxy ('Left t) -> Proxy n -> RecordU u -> HList us -> le Source #

HLookupByHNatUS t us e => HLookupByHNatUS1 ('Right t :: Either HNat HNat) n u us e Source # 
Instance details

Defined in Data.HList.RecordU

Methods

hLookupByHNatUS1 :: Proxy ('Right t) -> Proxy n -> RecordU u -> HList us -> e Source #

type family HSubtract (n1 :: HNat) (n2 :: HNat) :: Either HNat HNat Source #

HSubtract a b is Left (a-b), Right (b-a) or Right HZero

Instances

Instances details
type HSubtract 'HZero 'HZero Source # 
Instance details

Defined in Data.HList.RecordU

type HSubtract 'HZero ('HSucc y) Source # 
Instance details

Defined in Data.HList.RecordU

type HSubtract 'HZero ('HSucc y) = 'Right ('HSucc y) :: Either HNat HNat
type HSubtract ('HSucc y) 'HZero Source # 
Instance details

Defined in Data.HList.RecordU

type HSubtract ('HSucc y) 'HZero = 'Left ('HSucc y) :: Either HNat HNat
type HSubtract ('HSucc x) ('HSucc y) Source # 
Instance details

Defined in Data.HList.RecordU

type HSubtract ('HSucc x) ('HSucc y) = HSubtract x y

class HMapUnboxF (xs :: [*]) (us :: [*]) | xs -> us, us -> xs Source #

proof that hMap UnboxF :: r xs -> r us can determine xs from us and us from xs

Instances

Instances details
HMapUnboxF ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.RecordU

HMapUnboxF xs us => HMapUnboxF (HList x ': xs) (RecordU x ': us) Source # 
Instance details

Defined in Data.HList.RecordU

data UnboxF Source #

Instances

Instances details
(hx ~ HList x, ux ~ RecordU x, RecordToRecordU x) => ApplyAB UnboxF hx ux Source # 
Instance details

Defined in Data.HList.RecordU

Methods

applyAB :: UnboxF -> hx -> ux Source #

data BoxF Source #

Instances

Instances details
(ux ~ RecordU x, hx ~ HList x, RecordUToRecord x) => ApplyAB BoxF ux hx Source # 
Instance details

Defined in Data.HList.RecordU

Methods

applyAB :: BoxF -> ux -> hx Source #

data EqTagValue Source #

Instances

Instances details
HEqByFn EqTagValue Source # 
Instance details

Defined in Data.HList.RecordU

(txv ~ Tagged x v, tyw ~ Tagged y w, HEq v w b) => HEqBy EqTagValue (txv :: Type) (tyw :: Type) b Source # 
Instance details

Defined in Data.HList.RecordU

type family GetElemTy (x :: [*]) :: * Source #

Instances

Instances details
type GetElemTy (Tagged label v ': rest) Source # 
Instance details

Defined in Data.HList.RecordU

type GetElemTy (Tagged label v ': rest) = v

class ElemTyEq (xs :: [*]) Source #

all elements of the list have the same type

Instances

Instances details
ElemTyEq ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.RecordU

t1v ~ Tagged t v => ElemTyEq (t1v ': rest) Source # 
Instance details

Defined in Data.HList.RecordU

(t1v ~ Tagged t1 v, t2v ~ Tagged t2 v, ElemTyEq (tv2 ': rest)) => ElemTyEq (tv1 ': (tv2 ': rest)) Source # 
Instance details

Defined in Data.HList.RecordU

class RecordToRecordU x Source #

Minimal complete definition

recordToRecordU

Instances

Instances details
(RecordValues x, HList2List (RecordValuesR x) (GetElemTy x), HNat2Integral n, HLengthEq x n, IArray UArray (GetElemTy x)) => RecordToRecordU x Source # 
Instance details

Defined in Data.HList.RecordU

class RecordUToRecord x Source #

Minimal complete definition

recordUToRecord

Instances

Instances details
(HMapCxt HList TaggedFn (RecordValuesR x) x, IArray UArray (GetElemTy x), HList2List (RecordValuesR x) (GetElemTy x)) => RecordUToRecord x Source # 
Instance details

Defined in Data.HList.RecordU

HList

A subset of Data.HList.HList is re-exported.

data UncurrySappend Source #

Constructors

UncurrySappend 

Instances

Instances details
(aa ~ (a, a), Semigroup a) => ApplyAB UncurrySappend aa a Source # 
Instance details

Defined in Data.HList.HList

Methods

applyAB :: UncurrySappend -> aa -> a Source #

data UncurryMappend Source #

Constructors

UncurryMappend 

Instances

Instances details
(aa ~ (a, a), Monoid a) => ApplyAB UncurryMappend aa a Source # 
Instance details

Defined in Data.HList.HList

Methods

applyAB :: UncurryMappend -> aa -> a Source #

data ConstMempty Source #

Constructors

ConstMempty 

Instances

Instances details
(x ~ Proxy y, Monoid y) => ApplyAB ConstMempty x y Source # 
Instance details

Defined in Data.HList.HList

Methods

applyAB :: ConstMempty -> x -> y Source #

class HZipList x y l | x y -> l, l -> x y where Source #

Methods

hZipList :: HList x -> HList y -> HList l Source #

hUnzipList :: HList l -> (HList x, HList y) Source #

Instances

Instances details
HZipList ('[] :: [Type]) ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hZipList :: HList '[] -> HList '[] -> HList '[] Source #

hUnzipList :: HList '[] -> (HList '[], HList '[]) Source #

((x, y) ~ z, HZipList xs ys zs) => HZipList (x ': xs) (y ': ys) (z ': zs) Source # 
Instance details

Defined in Data.HList.HList

Methods

hZipList :: HList (x ': xs) -> HList (y ': ys) -> HList (z ': zs) Source #

hUnzipList :: HList (z ': zs) -> (HList (x ': xs), HList (y ': ys)) Source #

class HSpanEqBy2 (b :: Bool) (f :: t) (x :: *) (y :: *) (ys :: [*]) (i :: [*]) (o :: [*]) | b f x y ys -> i o where Source #

Methods

hSpanEqBy2 :: Proxy b -> Proxy f -> x -> y -> HList ys -> (HList i, HList o) Source #

Instances

Instances details
HSpanEqBy2 'False (f :: t) x y ys ('[] :: [Type]) (y ': ys) Source # 
Instance details

Defined in Data.HList.HList

Methods

hSpanEqBy2 :: Proxy 'False -> Proxy f -> x -> y -> HList ys -> (HList '[], HList (y ': ys)) Source #

HSpanEqBy1 f x zs i o => HSpanEqBy2 'True (f :: t) x y zs (y ': i) o Source # 
Instance details

Defined in Data.HList.HList

Methods

hSpanEqBy2 :: Proxy 'True -> Proxy f -> x -> y -> HList zs -> (HList (y ': i), HList o) Source #

class HSpanEqBy1 (f :: t) (x :: *) (y :: [*]) (i :: [*]) (o :: [*]) | f x y -> i o where Source #

Methods

hSpanEqBy1 :: Proxy f -> x -> HList y -> (HList i, HList o) Source #

Instances

Instances details
HSpanEqBy1 (f :: t) x ('[] :: [Type]) ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hSpanEqBy1 :: Proxy f -> x -> HList '[] -> (HList '[], HList '[]) Source #

(HEqBy f x y b, HSpanEqBy2 b f x y ys i o) => HSpanEqBy1 (f :: t) x (y ': ys) i o Source # 
Instance details

Defined in Data.HList.HList

Methods

hSpanEqBy1 :: Proxy f -> x -> HList (y ': ys) -> (HList i, HList o) Source #

class HSpanEqBy (f :: t) (x :: *) (y :: [*]) (fst :: [*]) (snd :: [*]) | f x y -> fst snd, fst snd -> y where Source #

HSpanEq x y fst snd is analogous to (fst,snd) = span (== x) y

Methods

hSpanEqBy :: Proxy f -> x -> HList y -> (HList fst, HList snd) Source #

Instances

Instances details
(HSpanEqBy1 f x y fst snd, HAppendListR fst snd ~ y) => HSpanEqBy (f :: t) x y fst snd Source # 
Instance details

Defined in Data.HList.HList

Methods

hSpanEqBy :: Proxy f -> x -> HList y -> (HList fst, HList snd) Source #

class HGroupBy (f :: t) (as :: [*]) (gs :: [*]) | f as -> gs, gs -> as where Source #

HGroupBy f x y is analogous to y = groupBy f x

given that f is used by HEqBy

Methods

hGroupBy :: Proxy f -> HList as -> HList gs Source #

Instances

Instances details
HGroupBy (f :: t) ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hGroupBy :: Proxy f -> HList '[] -> HList '[] Source #

(HSpanEqBy f a as fst snd, HGroupBy f snd gs) => HGroupBy (f :: t) (a ': as) (HList (a ': fst) ': gs) Source # 
Instance details

Defined in Data.HList.HList

Methods

hGroupBy :: Proxy f -> HList (a ': as) -> HList (HList (a ': fst) ': gs) Source #

class HPartitionEq1 (b :: Bool) f x1 x xs xi xo | b f x1 x xs -> xi xo where Source #

Methods

hPartitionEq1 :: Proxy b -> Proxy f -> Proxy x1 -> x -> HList xs -> (HList xi, HList xo) Source #

Instances

Instances details
HPartitionEq f x1 xs xi xo => HPartitionEq1 'False (f :: k1) (x1 :: k2) x xs xi (x ': xo) Source # 
Instance details

Defined in Data.HList.HList

Methods

hPartitionEq1 :: Proxy 'False -> Proxy f -> Proxy x1 -> x -> HList xs -> (HList xi, HList (x ': xo)) Source #

HPartitionEq f x1 xs xi xo => HPartitionEq1 'True (f :: k1) (x1 :: k2) x xs (x ': xi) xo Source # 
Instance details

Defined in Data.HList.HList

Methods

hPartitionEq1 :: Proxy 'True -> Proxy f -> Proxy x1 -> x -> HList xs -> (HList (x ': xi), HList xo) Source #

class HPartitionEq f x1 xs xi xo | f x1 xs -> xi xo where Source #

HPartitionEq f x1 xs xi xo is analogous to

(xi,xo) = partition (f x1) xs

where f is a "function" passed in using it's instance of HEqBy

Methods

hPartitionEq :: Proxy f -> Proxy x1 -> HList xs -> (HList xi, HList xo) Source #

Instances

Instances details
HPartitionEq (f :: k1) (x1 :: k2) ('[] :: [Type]) ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hPartitionEq :: Proxy f -> Proxy x1 -> HList '[] -> (HList '[], HList '[]) Source #

(HEqBy f x1 x b, HPartitionEq1 b f x1 x xs xi xo) => HPartitionEq (f :: k) (x1 :: Type) (x ': xs) xi xo Source # 
Instance details

Defined in Data.HList.HList

Methods

hPartitionEq :: Proxy f -> Proxy x1 -> HList (x ': xs) -> (HList xi, HList xo) Source #

type family HMapTail (xxs :: [*]) :: [*] Source #

evidence to satisfy the fundeps in HInits

Instances

Instances details
type HMapTail ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

type HMapTail ('[] :: [Type]) = '[] :: [Type]
type HMapTail (HList (a ': as) ': bs) Source # 
Instance details

Defined in Data.HList.HList

type HMapTail (HList (a ': as) ': bs) = HList as ': HMapTail bs

type family HMapCons (x :: *) (xxs :: [*]) :: [*] Source #

evidence to satisfy the fundeps in HInits

Instances

Instances details
type HMapCons x ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

type HMapCons x ('[] :: [Type]) = '[] :: [Type]
type HMapCons x (HList a ': b) Source # 
Instance details

Defined in Data.HList.HList

type HMapCons x (HList a ': b) = HList (x ': a) ': HMapCons x b

data FHCons2 x Source #

similar to FHCons

Constructors

FHCons2 x 

Instances

Instances details
(hxs ~ HList xs, hxxs ~ HList (x ': xs)) => ApplyAB (FHCons2 x) hxs hxxs Source # 
Instance details

Defined in Data.HList.HList

Methods

applyAB :: FHCons2 x -> hxs -> hxxs Source #

class HInits1 a b | a -> b, b -> a where Source #

behaves like tail . inits

Methods

hInits1 :: HList a -> HList b Source #

Instances

Instances details
HInits1 ('[] :: [Type]) '[HList ('[] :: [Type])] Source # 
Instance details

Defined in Data.HList.HList

Methods

hInits1 :: HList '[] -> HList '[HList '[]] Source #

(HInits1 xs ys, HMapCxt HList (FHCons2 x) ys ys', HMapCons x ys ~ ys', HMapTail ys' ~ ys) => HInits1 (x ': xs) (HList '[x] ': ys') Source # 
Instance details

Defined in Data.HList.HList

Methods

hInits1 :: HList (x ': xs) -> HList (HList '[x] ': ys') Source #

class HInits a b | a -> b, b -> a where Source #

Methods

hInits :: HList a -> HList b Source #

Instances

Instances details
HInits1 a b => HInits a (HList ('[] :: [Type]) ': b) Source # 
Instance details

Defined in Data.HList.HList

Methods

hInits :: HList a -> HList (HList '[] ': b) Source #

class HTails a b | a -> b, b -> a where Source #

Methods

hTails :: HList a -> HList b Source #

Instances

Instances details
HTails ('[] :: [Type]) '[HList ('[] :: [Type])] Source # 
Instance details

Defined in Data.HList.HList

Methods

hTails :: HList '[] -> HList '[HList '[]] Source #

HTails xs ys => HTails (x ': xs) (HList (x ': xs) ': ys) Source # 
Instance details

Defined in Data.HList.HList

Methods

hTails :: HList (x ': xs) -> HList (HList (x ': xs) ': ys) Source #

class HTuple v t | v -> t, t -> v where Source #

Methods

hToTuple :: HList v -> t Source #

alternatively: hUncurry (,,,)

hFromTuple :: t -> HList v Source #

Instances

Instances details
HTuple ('[] :: [Type]) () Source # 
Instance details

Defined in Data.HList.HList

Methods

hToTuple :: HList '[] -> () Source #

hFromTuple :: () -> HList '[] Source #

HTuple '[a, b] (a, b) Source # 
Instance details

Defined in Data.HList.HList

Methods

hToTuple :: HList '[a, b] -> (a, b) Source #

hFromTuple :: (a, b) -> HList '[a, b] Source #

HTuple '[a, b, c] (a, b, c) Source # 
Instance details

Defined in Data.HList.HList

Methods

hToTuple :: HList '[a, b, c] -> (a, b, c) Source #

hFromTuple :: (a, b, c) -> HList '[a, b, c] Source #

HTuple '[a, b, c, d] (a, b, c, d) Source # 
Instance details

Defined in Data.HList.HList

Methods

hToTuple :: HList '[a, b, c, d] -> (a, b, c, d) Source #

hFromTuple :: (a, b, c, d) -> HList '[a, b, c, d] Source #

HTuple '[a, b, c, d, e] (a, b, c, d, e) Source # 
Instance details

Defined in Data.HList.HList

Methods

hToTuple :: HList '[a, b, c, d, e] -> (a, b, c, d, e) Source #

hFromTuple :: (a, b, c, d, e) -> HList '[a, b, c, d, e] Source #

HTuple '[a, b, c, d, e, f] (a, b, c, d, e, f) Source # 
Instance details

Defined in Data.HList.HList

Methods

hToTuple :: HList '[a, b, c, d, e, f] -> (a, b, c, d, e, f) Source #

hFromTuple :: (a, b, c, d, e, f) -> HList '[a, b, c, d, e, f] Source #

class HDrop (n :: HNat) xs ys | n xs -> ys where Source #

Methods

hDrop :: HLengthGe xs n => Proxy n -> HList xs -> HList ys Source #

Instances

Instances details
HDrop 'HZero xs xs Source # 
Instance details

Defined in Data.HList.HList

Methods

hDrop :: Proxy 'HZero -> HList xs -> HList xs Source #

(HLengthGe xs n, HDrop n xs ys) => HDrop ('HSucc n) (x ': xs) ys Source # 
Instance details

Defined in Data.HList.HList

Methods

hDrop :: Proxy ('HSucc n) -> HList (x ': xs) -> HList ys Source #

class HTake (n :: HNat) xs ys | n xs -> ys where Source #

Methods

hTake :: (HLengthEq ys n, HLengthGe xs n) => Proxy n -> HList xs -> HList ys Source #

Instances

Instances details
HTake 'HZero xs ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hTake :: Proxy 'HZero -> HList xs -> HList '[] Source #

(HLengthEq ys n, HLengthGe xs n, HTake n xs ys) => HTake ('HSucc n) (x ': xs) (x ': ys) Source # 
Instance details

Defined in Data.HList.HList

Methods

hTake :: Proxy ('HSucc n) -> HList (x ': xs) -> HList (x ': ys) Source #

class HStripPrefix xs xsys ys | xs xsys -> ys Source #

analog of stripPrefix

Instances

Instances details
HStripPrefix ('[] :: [k2]) (ys :: k1) (ys :: k1) Source # 
Instance details

Defined in Data.HList.HList

(x' ~ x, HStripPrefix xs xsys ys) => HStripPrefix (x' ': xs :: [a]) (x ': xsys :: [a]) (ys :: k) Source # 
Instance details

Defined in Data.HList.HList

class HStripPrefix xs xsys ys => HAppendList1 (xs :: [k]) (ys :: [k]) (xsys :: [k]) | xs ys -> xsys, xs xsys -> ys Source #

HAppendList1 xs ys xsys is the type-level way of saying xs ++ ys == xsys

used by HSplitAt

Instances

Instances details
HAppendList1 ('[] :: [k]) (ys :: [k]) (ys :: [k]) Source # 
Instance details

Defined in Data.HList.HList

HAppendList1 xs ys zs => HAppendList1 (x ': xs :: [a]) (ys :: [a]) (x ': zs :: [a]) Source # 
Instance details

Defined in Data.HList.HList

class HLengthGe (xs :: [*]) (n :: HNat) Source #

HLengthGe xs n says that HLength xs >= n.

unlike the expression with a type family HLength, ghc assumes xs ~ (aFresh ': bFresh) when given a constraint HLengthGe xs (HSucc HZero)

Instances

Instances details
HLengthGe xxs 'HZero Source # 
Instance details

Defined in Data.HList.HList

(HLengthGe xs n, xxs ~ (x ': xs)) => HLengthGe xxs ('HSucc n) Source # 
Instance details

Defined in Data.HList.HList

class HLengthEq2 (xs :: [*]) n | xs -> n Source #

Instances

Instances details
zero ~ 'HZero => HLengthEq2 ('[] :: [Type]) (zero :: HNat) Source # 
Instance details

Defined in Data.HList.HList

(HLengthEq xs n, sn ~ 'HSucc n) => HLengthEq2 (x ': xs) (sn :: HNat) Source # 
Instance details

Defined in Data.HList.HList

class HLengthEq1 (xs :: [*]) n Source #

Instances

Instances details
xxs ~ ('[] :: [Type]) => HLengthEq1 xxs 'HZero Source # 
Instance details

Defined in Data.HList.HList

(HLengthEq xs n, xxs ~ (x ': xs)) => HLengthEq1 xxs ('HSucc n :: HNat) Source # 
Instance details

Defined in Data.HList.HList

class (SameLength' (HReplicateR n ()) xs, HLengthEq1 xs n, HLengthEq2 xs n) => HLengthEq (xs :: [*]) (n :: HNat) | xs -> n Source #

a better way to write HLength xs ~ n because:

  1. it works properly with ghc-7.10 (probably another example of ghc bug #10009)
  2. it works backwards a bit in that if n is known, then xs can be refined:
>>> undefined :: HLengthEq xs HZero => HList xs
H[]

Instances

Instances details
(SameLength' (HReplicateR n ()) xs, HLengthEq1 xs n, HLengthEq2 xs n) => HLengthEq xs n Source # 
Instance details

Defined in Data.HList.HList

class HSplitAt1 accum (n :: HNat) xsys xs ys | accum n xsys -> xs ys where Source #

helper for HSplitAt

Methods

hSplitAt1 :: HList accum -> Proxy n -> HList xsys -> (HList xs, HList ys) Source #

Instances

Instances details
HRevApp accum ('[] :: [Type]) xs => HSplitAt1 accum 'HZero ys xs ys Source # 
Instance details

Defined in Data.HList.HList

Methods

hSplitAt1 :: HList accum -> Proxy 'HZero -> HList ys -> (HList xs, HList ys) Source #

HSplitAt1 (b ': accum) n bs xs ys => HSplitAt1 accum ('HSucc n) (b ': bs) xs ys Source # 
Instance details

Defined in Data.HList.HList

Methods

hSplitAt1 :: HList accum -> Proxy ('HSucc n) -> HList (b ': bs) -> (HList xs, HList ys) Source #

class (HLengthEq xs n, HAppendList1 xs ys xsys) => HSplitAt (n :: HNat) xsys xs ys | n xsys -> xs ys, xs ys -> xsys, xs -> n where Source #

splitAt

setup

>>> let two = hSucc (hSucc hZero)
>>> let xsys = hEnd $ hBuild 1 2 3 4

If a length is explicitly provided, the resulting lists are inferred

>>> hSplitAt two xsys
(H[1,2],H[3,4])
>>> let sameLength_ :: SameLength a b => r a -> r b -> r a; sameLength_ = const
>>> let len2 x = x `sameLength_` HCons () (HCons () HNil)

If the first chunk of the list (a) has to be a certain length, the type of the Proxy argument can be inferred.

>>> case hSplitAt Proxy xsys of (a,b) -> (len2 a, b)
(H[1,2],H[3,4])

Methods

hSplitAt :: Proxy n -> HList xsys -> (HList xs, HList ys) Source #

Instances

Instances details
(HSplitAt1 ('[] :: [Type]) n xsys xs ys, HAppendList1 xs ys xsys, HLengthEq xs n) => HSplitAt n xsys xs ys Source # 
Instance details

Defined in Data.HList.HList

Methods

hSplitAt :: Proxy n -> HList xsys -> (HList xs, HList ys) Source #

class HSplit l where Source #

Analogus to Data.List.partition snd. See also HPartition

>>> let (.=.) :: p x -> y -> Tagged x y; _ .=. y = Tagged y
>>> hSplit $ hTrue .=. 2 .*. hTrue .=. 3 .*. hFalse .=. 1 .*. HNil
(H[2,3],H[1])

it might make more sense to instead have LVPair Bool e instead of (e, Proxy Bool) since the former has the same runtime representation as e

Associated Types

type HSplitT l :: [*] Source #

type HSplitF l :: [*] Source #

Methods

hSplit :: HList l -> (HList (HSplitT l), HList (HSplitF l)) Source #

Instances

Instances details
HSplit ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Associated Types

type HSplitT '[] :: [Type] Source #

type HSplitF '[] :: [Type] Source #

Methods

hSplit :: HList '[] -> (HList (HSplitT '[]), HList (HSplitF '[])) Source #

HSplit l => HSplit ((e, Proxy 'False) ': l) Source # 
Instance details

Defined in Data.HList.HList

Associated Types

type HSplitT ((e, Proxy 'False) ': l) :: [Type] Source #

type HSplitF ((e, Proxy 'False) ': l) :: [Type] Source #

Methods

hSplit :: HList ((e, Proxy 'False) ': l) -> (HList (HSplitT ((e, Proxy 'False) ': l)), HList (HSplitF ((e, Proxy 'False) ': l))) Source #

HSplit l => HSplit ((e, Proxy 'True) ': l) Source # 
Instance details

Defined in Data.HList.HList

Associated Types

type HSplitT ((e, Proxy 'True) ': l) :: [Type] Source #

type HSplitF ((e, Proxy 'True) ': l) :: [Type] Source #

Methods

hSplit :: HList ((e, Proxy 'True) ': l) -> (HList (HSplitT ((e, Proxy 'True) ': l)), HList (HSplitF ((e, Proxy 'True) ': l))) Source #

HSplit l => HSplit (Tagged 'False e ': l) Source # 
Instance details

Defined in Data.HList.HList

Associated Types

type HSplitT (Tagged 'False e ': l) :: [Type] Source #

type HSplitF (Tagged 'False e ': l) :: [Type] Source #

Methods

hSplit :: HList (Tagged 'False e ': l) -> (HList (HSplitT (Tagged 'False e ': l)), HList (HSplitF (Tagged 'False e ': l))) Source #

HSplit l => HSplit (Tagged 'True e ': l) Source # 
Instance details

Defined in Data.HList.HList

Associated Types

type HSplitT (Tagged 'True e ': l) :: [Type] Source #

type HSplitF (Tagged 'True e ': l) :: [Type] Source #

Methods

hSplit :: HList (Tagged 'True e ': l) -> (HList (HSplitT (Tagged 'True e ': l)), HList (HSplitF (Tagged 'True e ': l))) Source #

data HRmTag Source #

Constructors

HRmTag 

Instances

Instances details
e' ~ e => ApplyAB HRmTag (e, t) e' Source # 
Instance details

Defined in Data.HList.HList

Methods

applyAB :: HRmTag -> (e, t) -> e' Source #

data HAddTag t Source #

Constructors

HAddTag t 

Instances

Instances details
et ~ (e, t) => ApplyAB (HAddTag t) e et Source # 
Instance details

Defined in Data.HList.HList

Methods

applyAB :: HAddTag t -> e -> et Source #

data HFromJust Source #

Constructors

HFromJust 

Instances

Instances details
hJustA ~ HJust a => ApplyAB HFromJust hJustA a Source # 
Instance details

Defined in Data.HList.HList

Methods

applyAB :: HFromJust -> hJustA -> a Source #

class FromHJustR (ToHJustR l) ~ l => FromHJust l where Source #

Associated Types

type FromHJustR l :: [*] Source #

Methods

fromHJust :: HList l -> HList (FromHJustR l) Source #

Instances

Instances details
FromHJust ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Associated Types

type FromHJustR '[] :: [Type] Source #

Methods

fromHJust :: HList '[] -> HList (FromHJustR '[]) Source #

FromHJust l => FromHJust (HJust e ': l) Source # 
Instance details

Defined in Data.HList.HList

Associated Types

type FromHJustR (HJust e ': l) :: [Type] Source #

Methods

fromHJust :: HList (HJust e ': l) -> HList (FromHJustR (HJust e ': l)) Source #

FromHJust l => FromHJust (HNothing ': l) Source # 
Instance details

Defined in Data.HList.HList

Associated Types

type FromHJustR (HNothing ': l) :: [Type] Source #

Methods

fromHJust :: HList (HNothing ': l) -> HList (FromHJustR (HNothing ': l)) Source #

class FromHJustR (ToHJustR l) ~ l => ToHJust l where Source #

the same as map Just

>>> toHJust (2 .*. 'a' .*. HNil)
H[HJust 2,HJust 'a']
>>> toHJust2 (2 .*. 'a' .*. HNil)
H[HJust 2,HJust 'a']

Associated Types

type ToHJustR l :: [*] Source #

Methods

toHJust :: HList l -> HList (ToHJustR l) Source #

Instances

Instances details
ToHJust ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Associated Types

type ToHJustR '[] :: [Type] Source #

Methods

toHJust :: HList '[] -> HList (ToHJustR '[]) Source #

ToHJust l => ToHJust (e ': l) Source # 
Instance details

Defined in Data.HList.HList

Associated Types

type ToHJustR (e ': l) :: [Type] Source #

Methods

toHJust :: HList (e ': l) -> HList (ToHJustR (e ': l)) Source #

class HList2List l e | l -> e where Source #

hMapOut id is similar, except this function is restricted to HLists that actually contain a value (so the list produced will be nonempty). This restriction allows adding a functional dependency, which means that less type annotations can be necessary.

Methods

hList2List :: HList l -> [e] Source #

list2HListSuffix :: [e] -> Maybe (HList l, [e]) Source #

Instances

Instances details
HList2List (e' ': l) e => HList2List (e ': (e' ': l)) e Source # 
Instance details

Defined in Data.HList.HList

Methods

hList2List :: HList (e ': (e' ': l)) -> [e] Source #

list2HListSuffix :: [e] -> Maybe (HList (e ': (e' ': l)), [e]) Source #

HList2List '[e] e Source # 
Instance details

Defined in Data.HList.HList

Methods

hList2List :: HList '[e] -> [e] Source #

list2HListSuffix :: [e] -> Maybe (HList '[e], [e]) Source #

class HTIntersectBool (b :: Bool) h t l1 l2 | b h t l1 -> l2 where Source #

Methods

hTIntersectBool :: Proxy b -> h -> HList t -> HList l1 -> HList l2 Source #

Instances

Instances details
HTIntersect t l1 l2 => HTIntersectBool 'False h t l1 l2 Source # 
Instance details

Defined in Data.HList.HList

Methods

hTIntersectBool :: Proxy 'False -> h -> HList t -> HList l1 -> HList l2 Source #

HTIntersect t l1 l2 => HTIntersectBool 'True h t l1 (h ': l2) Source # 
Instance details

Defined in Data.HList.HList

Methods

hTIntersectBool :: Proxy 'True -> h -> HList t -> HList l1 -> HList (h ': l2) Source #

class HTIntersect l1 l2 l3 | l1 l2 -> l3 where Source #

Methods

hTIntersect :: HList l1 -> HList l2 -> HList l3 Source #

Instances

Instances details
HTIntersect ('[] :: [Type]) l ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hTIntersect :: HList '[] -> HList l -> HList '[] Source #

(HTMember h l1 b, HTIntersectBool b h t l1 l2) => HTIntersect (h ': t) l1 l2 Source # 
Instance details

Defined in Data.HList.HList

Methods

hTIntersect :: HList (h ': t) -> HList l1 -> HList l2 Source #

class HTMember e (l :: [*]) (b :: Bool) | e l -> b Source #

could be an associated type if HEq had one

Instances

Instances details
HTMember (e :: k) ('[] :: [Type]) 'False Source # 
Instance details

Defined in Data.HList.HList

(HEq e e' b, HTMember e l b', HOr b b' ~ b'') => HTMember (e :: Type) (e' ': l) b'' Source # 
Instance details

Defined in Data.HList.HList

class HFind2 (b :: Bool) (e :: k) (l :: [k]) (l0 :: [k]) (n :: HNat) | b e l -> n Source #

Instances

Instances details
HFind2 'True (e :: k) (l :: [k]) (l0 :: [k]) 'HZero Source # 
Instance details

Defined in Data.HList.HList

HFind1 e l l0 n => HFind2 'False (e :: k) (l :: [k]) (l0 :: [k]) ('HSucc n) Source # 
Instance details

Defined in Data.HList.HList

class HFind1 (e :: k) (l :: [k]) (l0 :: [k]) (n :: HNat) | e l -> n Source #

Instances

Instances details
Fail (FieldNotFound e1 l0) => HFind1 (e1 :: k) ('[] :: [k]) (l0 :: [k]) 'HZero Source # 
Instance details

Defined in Data.HList.HList

(HEq e1 e2 b, HFind2 b e1 l l0 n) => HFind1 (e1 :: a) (e2 ': l :: [a]) (l0 :: [a]) n Source # 
Instance details

Defined in Data.HList.HList

class HFind1 e l l n => HFind (e :: k) (l :: [k]) (n :: HNat) | e l -> n Source #

It is a pure type-level operation

Instances

Instances details
HFind1 e l l n => HFind (e :: k) (l :: [k]) n Source # 
Instance details

Defined in Data.HList.HList

class HMemberM2 (b :: Maybe [k]) (e1 :: k) (l :: [k]) (r :: Maybe [k]) | b e1 l -> r Source #

Instances

Instances details
HMemberM2 ('Nothing :: Maybe [k]) (e1 :: k) (l :: [k]) ('Nothing :: Maybe [k]) Source # 
Instance details

Defined in Data.HList.HList

HMemberM2 ('Just l1 :: Maybe [a]) (e1 :: a) (e ': l :: [a]) ('Just (e ': l1) :: Maybe [a]) Source # 
Instance details

Defined in Data.HList.HList

class HMemberM1 (b :: Bool) (e1 :: k) (l :: [k]) (r :: Maybe [k]) | b e1 l -> r Source #

Instances

Instances details
(HMemberM e1 l r, HMemberM2 r e1 (e ': l) res) => HMemberM1 'False (e1 :: a) (e ': l :: [a]) (res :: Maybe [a]) Source # 
Instance details

Defined in Data.HList.HList

HMemberM1 'True (e1 :: k) (e ': l :: [k]) ('Just l :: Maybe [k]) Source # 
Instance details

Defined in Data.HList.HList

class HMemberM (e1 :: k) (l :: [k]) (r :: Maybe [k]) | e1 l -> r Source #

Check to see if an element e occurs in a list l If not, return 'Nothing If the element does occur, return 'Just l1 where l1 is a type-level list without e

Instances

Instances details
HMemberM (e1 :: k) ('[] :: [k]) ('Nothing :: Maybe [k]) Source # 
Instance details

Defined in Data.HList.HList

(HEq e1 e b, HMemberM1 b e1 (e ': l) res) => HMemberM (e1 :: a) (e ': l :: [a]) (res :: Maybe [a]) Source # 
Instance details

Defined in Data.HList.HList

type family HMemberP' pred e1 (l :: [*]) pb :: Bool Source #

Instances

Instances details
type HMemberP' pred e1 l (Proxy 'False) Source # 
Instance details

Defined in Data.HList.HList

type HMemberP' pred e1 l (Proxy 'False) = HMemberP pred e1 l
type HMemberP' pred e1 l (Proxy 'True) Source # 
Instance details

Defined in Data.HList.HList

type HMemberP' pred e1 l (Proxy 'True) = 'True

type family HMemberP pred e1 (l :: [*]) :: Bool Source #

The following is a similar type-only membership test It uses the user-supplied curried type equality predicate pred

Instances

Instances details
type HMemberP pred e1 ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

type HMemberP pred e1 ('[] :: [Type]) = 'False
type HMemberP pred e1 (e ': l) Source # 
Instance details

Defined in Data.HList.HList

type HMemberP pred e1 (e ': l) = HMemberP' pred e1 l (ApplyR pred (e1, e))

class HMember' (b0 :: Bool) (e1 :: k) (l :: [k]) (b :: Bool) | b0 e1 l -> b Source #

Instances

Instances details
HMember e1 l br => HMember' 'False (e1 :: k) (l :: [k]) br Source # 
Instance details

Defined in Data.HList.HList

HMember' 'True (e1 :: k) (l :: [k]) 'True Source # 
Instance details

Defined in Data.HList.HList

class HMember (e1 :: k) (l :: [k]) (b :: Bool) | e1 l -> b Source #

Check to see if an HList contains an element with a given type This is a type-level only test

Instances

Instances details
HMember (e1 :: k) ('[] :: [k]) 'False Source # 
Instance details

Defined in Data.HList.HList

(HEq e1 e b, HMember' b e1 l br) => HMember (e1 :: a) (e ': l :: [a]) br Source # 
Instance details

Defined in Data.HList.HList

type family HNats (l :: [*]) :: [HNat] Source #

We do so constructively, converting the HList whose elements are Proxy HNat to [HNat]. The latter kind is unpopulated and is present only at the type level.

Instances

Instances details
type HNats ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

type HNats ('[] :: [Type]) = '[] :: [HNat]
type HNats (Proxy n ': l) Source # 
Instance details

Defined in Data.HList.HList

type HNats (Proxy n ': l) = n ': HNats l

type HMapOut f l e = HFoldr (Mapcar f) [e] l [e] Source #

newtype Mapcar f Source #

Constructors

Mapcar f 

Instances

Instances details
(l ~ [e'], ApplyAB f e e', el ~ (e, l)) => ApplyAB (Mapcar f) el l Source # 
Instance details

Defined in Data.HList.HList

Methods

applyAB :: Mapcar f -> el -> l Source #

class (Applicative m, SameLength a b) => HSequence m a b | a -> b, m b -> a where Source #

A heterogeneous version of

sequenceA :: (Applicative m) => [m a] -> m [a]

Only now we operate on heterogeneous lists, where different elements may have different types a. In the argument list of monadic values (m a_i), although a_i may differ, the monad m must be the same for all elements. That's why we needed Data.HList.TypeCastGeneric2 (currently (~)). The typechecker will complain if we attempt to use hSequence on a HList of monadic values with different monads.

The hSequence problem was posed by Matthias Fischmann in his message on the Haskell-Cafe list on Oct 8, 2006

http://www.haskell.org/pipermail/haskell-cafe/2006-October/018708.html

http://www.haskell.org/pipermail/haskell-cafe/2006-October/018784.html

Maybe
>>> hSequence $ Just (1 :: Integer) `HCons` (Just 'c') `HCons` HNil
Just H[1,'c']
>>> hSequence $  return 1 `HCons` Just  'c' `HCons` HNil
Just H[1,'c']
List
>>> hSequence $ [1] `HCons` ['c'] `HCons` HNil
[H[1,'c']]

Methods

hSequence :: HList a -> m (HList b) Source #

Instances

Instances details
Applicative m => HSequence m ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hSequence :: HList '[] -> m (HList '[]) Source #

(m1 ~ m, Applicative m, HSequence m as bs) => HSequence m (m1 a ': as) (a ': bs) Source # 
Instance details

Defined in Data.HList.HList

Methods

hSequence :: HList (m1 a ': as) -> m (HList (a ': bs)) Source #

class HMapAux (r :: [*] -> *) f (x :: [*]) (y :: [*]) Source #

Minimal complete definition

hMapAux

Instances

Instances details
HMapAux HList (HFmap f) x y => HMapAux Record f x y Source # 
Instance details

Defined in Data.HList.Record

Methods

hMapAux :: f -> Record x -> Record y Source #

HMapAux Variant f xs ys => HMapAux TIC f xs ys Source # 
Instance details

Defined in Data.HList.TIC

Methods

hMapAux :: f -> TIC xs -> TIC ys Source #

(ApplyAB f (GetElemTy x) (GetElemTy y), IArray UArray (GetElemTy y), IArray UArray (GetElemTy x)) => HMapAux RecordU f x y Source # 
Instance details

Defined in Data.HList.RecordU

Methods

hMapAux :: f -> RecordU x -> RecordU y Source #

HMapAux HList f ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hMapAux :: f -> HList '[] -> HList '[] Source #

(ApplyAB f e e', HMapAux HList f l l', SameLength l l') => HMapAux HList f (e ': l) (e' ': l') Source # 
Instance details

Defined in Data.HList.HList

Methods

hMapAux :: f -> HList (e ': l) -> HList (e' ': l') Source #

(ApplyAB f te te', HMapCxt Variant f (l ': ls) (l' ': ls')) => HMapAux Variant f (te ': (l ': ls)) (te' ': (l' ': ls')) Source # 
Instance details

Defined in Data.HList.Variant

Methods

hMapAux :: f -> Variant (te ': (l ': ls)) -> Variant (te' ': (l' ': ls')) Source #

ApplyAB f te te' => HMapAux Variant f '[te] '[te'] Source # 
Instance details

Defined in Data.HList.Variant

Methods

hMapAux :: f -> Variant '[te] -> Variant '[te'] Source #

class (SameLength a b, HMapAux r f a b) => HMapCxt r f a b Source #

Instances

Instances details
(SameLength a b, HMapAux r f a b) => HMapCxt r f a b Source # 
Instance details

Defined in Data.HList.HList

newtype HMapL f Source #

Constructors

HMapL f 

Instances

Instances details
(HMapCxt HList f a b, as ~ HList a, bs ~ HList b) => ApplyAB (HMapL f) as bs Source # 
Instance details

Defined in Data.HList.HList

Methods

applyAB :: HMapL f -> as -> bs Source #

newtype HMap f Source #

hMap is written such that the length of the result list can be determined from the length of the argument list (and the other way around). Similarly, the type of the elements of the list is propagated in both directions too.

>>> :set -XNoMonomorphismRestriction
>>> let xs = 1 .*. 'c' .*. HNil
>>> :t hMap (HJust ()) xs
hMap (HJust ()) xs :: Num y => HList '[HJust y, HJust Char]

These 4 examples show that the constraint on the length (2 in this case) can be applied before or after the hMap. That inference is independent of the direction that type information is propagated for the individual elements.

>>> let asLen2 xs = xs `asTypeOf` (undefined :: HList '[a,b])
>>> let lr xs = asLen2 (applyAB (HMap HRead) xs)
>>> let ls xs = asLen2 (applyAB (HMap HShow) xs)
>>> let rl xs = applyAB (HMap HRead) (asLen2 xs)
>>> let sl xs = applyAB (HMap HShow) (asLen2 xs)
>>> :t lr
lr
  :: (Read ..., Read ...) => HList '[String, String] -> HList '[..., ...]
>>> :t rl
rl
  :: (Read ..., Read ...) => HList '[String, String] -> HList '[..., ...]
>>> :t ls
ls
  :: (Show ..., Show ...) => HList '[..., ...] -> HList '[String, String]
>>> :t sl
sl
  :: (Show ..., Show ...) => HList '[..., ...] -> HList '[String, String]

Constructors

HMap f 

Instances

Instances details
(HMapCxt r f a b, as ~ r a, bs ~ r b) => ApplyAB (HMap f) as bs Source # 
Instance details

Defined in Data.HList.HList

Methods

applyAB :: HMap f -> as -> bs Source #

class HAppendFD a b ab | a b -> ab where Source #

Methods

hAppendFD :: HList a -> HList b -> HList ab Source #

Instances

Instances details
HAppendFD ('[] :: [Type]) b b Source # 
Instance details

Defined in Data.HList.HList

Methods

hAppendFD :: HList '[] -> HList b -> HList b Source #

HAppendFD as bs cs => HAppendFD (a ': as) bs (a ': cs) Source # 
Instance details

Defined in Data.HList.HList

Methods

hAppendFD :: HList (a ': as) -> HList bs -> HList (a ': cs) Source #

class HConcatFD xxs xs | xxs -> xs where Source #

Methods

hConcatFD :: HList xxs -> HList xs Source #

Instances

Instances details
HConcatFD ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hConcatFD :: HList '[] -> HList '[] Source #

(HConcatFD as bs, HAppendFD a bs cs) => HConcatFD (HList a ': as) cs Source # 
Instance details

Defined in Data.HList.HList

Methods

hConcatFD :: HList (HList a ': as) -> HList cs Source #

type family UnHList a :: [*] Source #

Instances

Instances details
type UnHList (HList a) Source # 
Instance details

Defined in Data.HList.HList

type UnHList (HList a) = a

type family HConcatR (a :: [*]) :: [*] Source #

Instances

Instances details
type HConcatR ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

type HConcatR ('[] :: [Type]) = '[] :: [Type]
type HConcatR (x ': xs) Source # 
Instance details

Defined in Data.HList.HList

type HConcatR (x ': xs) = HAppendListR (UnHList x) (HConcatR xs)

type HConcat xs = HConcatFD xs (HConcatR xs) Source #

Like concat but for HLists of HLists.

Works in ghci... puzzling as what is different in doctest (it isn't -XExtendedDefaultRules)

>>> let a = hEnd $ hBuild 1 2 3
>>> let b = hEnd $ hBuild 'a' "abc"
>>> hConcat $ hBuild a b
H[1,2,3,'a',"abc"]

class HLengthEq r n => HIterate n f z r where Source #

This function behaves like iterate, with an extra argument to help figure out the result length

>>> let three = hSucc (hSucc (hSucc hZero))
>>> let f = Fun Just :: Fun '() Maybe
>>> :t applyAB f
applyAB f :: a -> Maybe a

f is applied to different types:

>>> hIterate three f ()
H[(),Just (),Just (Just ())]

It is also possible to specify the length later on, as done with Prelude.iterate

>>> let take3 x | _ <- hLength x `asTypeOf` three = x
>>> take3 $ hIterate Proxy f ()
H[(),Just (),Just (Just ())]

Methods

hIterate :: HLengthEq r n => Proxy n -> f -> z -> HList r Source #

Instances

Instances details
HIterate 'HZero f z ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hIterate :: Proxy 'HZero -> f -> z -> HList '[] Source #

(ApplyAB f z z', HIterate n f z' r', z ~ z_) => HIterate ('HSucc n) f z (z_ ': r') Source # 
Instance details

Defined in Data.HList.HList

Methods

hIterate :: Proxy ('HSucc n) -> f -> z -> HList (z_ ': r') Source #

class HLengthEq r n => HReplicateF (n :: HNat) f z r | r -> n where Source #

HReplicate produces lists that can be converted to ordinary lists

>>> let two = hSucc (hSucc hZero)
>>> let f = Fun' fromInteger :: Fun' Num Integer
>>> :t applyAB f
applyAB f :: Num b => Integer -> b
>>> hReplicateF two f 3
H[3,3]
>>> hReplicateF Proxy f 3 :: HList [Int, Double, Integer]
H[3,3.0,3]

Methods

hReplicateF :: HLengthEq r n => Proxy n -> f -> z -> HList r Source #

Instances

Instances details
HReplicateF 'HZero f z ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hReplicateF :: Proxy 'HZero -> f -> z -> HList '[] Source #

(ApplyAB f z fz, HReplicateF n f z r') => HReplicateF ('HSucc n) f z (fz ': r') Source # 
Instance details

Defined in Data.HList.HList

Methods

hReplicateF :: Proxy ('HSucc n) -> f -> z -> HList (fz ': r') Source #

type family HReplicateR (n :: HNat) (e :: k) :: [k] Source #

would be associated with HReplicate except we want it to work with e of any kind, not just * that you can put into a HList. An "inverse" of HLength

Instances

Instances details
type HReplicateR 'HZero (e :: k) Source # 
Instance details

Defined in Data.HList.HList

type HReplicateR 'HZero (e :: k) = '[] :: [k]
type HReplicateR ('HSucc n) (e :: k) Source # 
Instance details

Defined in Data.HList.HList

type HReplicateR ('HSucc n) (e :: k) = e ': HReplicateR n e

class HLengthEq es n => HReplicateFD (n :: HNat) e es | n e -> es, es -> n where Source #

Sometimes the result type can fix the type of the first argument:

>>> hReplicate Proxy () :: HList '[ (), (), () ]
H[(),(),()]

However, with HReplicate all elements must have the same type, so it may be easier to use HList2List:

>>> list2HList (repeat 3) :: Maybe (HList [Int, Int, Int])
Just H[3,3,3]

Methods

hReplicate :: Proxy n -> e -> HList es Source #

Instances

Instances details
HReplicateFD 'HZero e ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hReplicate :: Proxy 'HZero -> e -> HList '[] Source #

(HReplicateFD n e es, e ~ e') => HReplicateFD ('HSucc n) e (e' ': es) Source # 
Instance details

Defined in Data.HList.HList

Methods

hReplicate :: Proxy ('HSucc n) -> e -> HList (e' ': es) Source #

class HUnfoldFD p res z | p res -> z where Source #

Methods

hUnfold' :: p -> res -> HList z Source #

Instances

Instances details
HUnfoldFD p HNothing ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hUnfold' :: p -> HNothing -> HList '[] Source #

(Apply p s, HUnfoldFD p (ApplyR p s) z) => HUnfoldFD p (HJust (e, s)) (e ': z) Source # 
Instance details

Defined in Data.HList.HList

Methods

hUnfold' :: p -> HJust (e, s) -> HList (e ': z) Source #

type HUnfold' p res = HUnfoldFD p (ApplyR p res) (HUnfold p res) Source #

type family HUnfoldR p res :: [*] Source #

Instances

Instances details
type HUnfoldR p HNothing Source # 
Instance details

Defined in Data.HList.HList

type HUnfoldR p HNothing = '[] :: [Type]
type HUnfoldR p (HJust (e, s)) Source # 
Instance details

Defined in Data.HList.HList

type HUnfoldR p (HJust (e, s)) = e ': HUnfoldR p (ApplyR p s)

type HUnfold p s = HUnfoldR p (ApplyR p s) Source #

class HFoldl f (z :: *) xs (r :: *) where Source #

like foldl

>>> hFoldl (uncurry $ flip (:)) [] (1 `HCons` 2 `HCons` HNil)
[2,1]

Methods

hFoldl :: f -> z -> HList xs -> r Source #

Instances

Instances details
z ~ z' => HFoldl f z ('[] :: [Type]) z' Source # 
Instance details

Defined in Data.HList.HList

Methods

hFoldl :: f -> z -> HList '[] -> z' Source #

(zx ~ (z, x), ApplyAB f zx z', HFoldl f z' xs r) => HFoldl f z (x ': xs) r Source # 
Instance details

Defined in Data.HList.HList

Methods

hFoldl :: f -> z -> HList (x ': xs) -> r Source #

class HFoldr1 f (l :: [*]) r where Source #

Methods

hFoldr1 :: f -> HList l -> r Source #

Instances

Instances details
(ApplyAB f (e, r) r', HFoldr1 f (e' ': l) r) => HFoldr1 f (e ': (e' ': l)) r' Source #

uses ApplyAB not Apply

Instance details

Defined in Data.HList.HList

Methods

hFoldr1 :: f -> HList (e ': (e' ': l)) -> r' Source #

v ~ v' => HFoldr1 f '[v] v' Source # 
Instance details

Defined in Data.HList.HList

Methods

hFoldr1 :: f -> HList '[v] -> v' Source #

class HScanr f z ls rs where Source #

Methods

hScanr :: f -> z -> HList ls -> HList rs Source #

Instances

Instances details
lz ~ '[z] => HScanr f z ('[] :: [Type]) lz Source # 
Instance details

Defined in Data.HList.HList

Methods

hScanr :: f -> z -> HList '[] -> HList lz Source #

(ApplyAB f (x, r) s, HScanr f z xs (r ': rs), srrs ~ (s ': (r ': rs))) => HScanr f z (x ': xs) srrs Source # 
Instance details

Defined in Data.HList.HList

Methods

hScanr :: f -> z -> HList (x ': xs) -> HList srrs Source #

class HFoldr f v (l :: [*]) r where Source #

Methods

hFoldr :: f -> v -> HList l -> r Source #

Instances

Instances details
v ~ v' => HFoldr f v ('[] :: [Type]) v' Source # 
Instance details

Defined in Data.HList.HList

Methods

hFoldr :: f -> v -> HList '[] -> v' Source #

(ApplyAB f (e, r) r', HFoldr f v l r) => HFoldr f v (e ': l) r' Source #

uses ApplyAB not Apply

Instance details

Defined in Data.HList.HList

Methods

hFoldr :: f -> v -> HList (e ': l) -> r' Source #

class HBuild' l r where Source #

Methods

hBuild' :: HList l -> r Source #

Instances

Instances details
HReverse l l' => HBuild' l (HList l') Source # 
Instance details

Defined in Data.HList.HList

Methods

hBuild' :: HList l -> HList l' Source #

(HReverse l lRev, HMapTaggedFn lRev l') => HBuild' l (Record l') Source #

This instance allows creating a Record with

hBuild 3 a :: Record '[Tagged "x" Int, Tagged "y" Char]
Instance details

Defined in Data.HList.Record

Methods

hBuild' :: HList l -> Record l' Source #

HBuild' (a ': l) r => HBuild' l (a -> r) Source # 
Instance details

Defined in Data.HList.HList

Methods

hBuild' :: HList l -> a -> r Source #

(HRevAppR l ('[] :: [Type]) ~ lRev, HExtendRs lRev (Proxy ('[] :: [Type])) ~ Proxy l1, l' ~ l1) => HBuild' l (Proxy l') Source #

see hEndP

Instance details

Defined in Data.HList.Record

Methods

hBuild' :: HList l -> Proxy l' Source #

class HReverse xs sx | xs -> sx, sx -> xs where Source #

Methods

hReverse :: HList xs -> HList sx Source #

Instances

Instances details
(HRevApp xs ('[] :: [Type]) sx, HRevApp sx ('[] :: [Type]) xs) => HReverse xs sx Source # 
Instance details

Defined in Data.HList.HList

Methods

hReverse :: HList xs -> HList sx Source #

class HRevApp l1 l2 l3 | l1 l2 -> l3 where Source #

Methods

hRevApp :: HList l1 -> HList l2 -> HList l3 Source #

Instances

Instances details
HRevApp ('[] :: [Type]) l2 l2 Source # 
Instance details

Defined in Data.HList.HList

Methods

hRevApp :: HList '[] -> HList l2 -> HList l2 Source #

HRevApp l (x ': l') z => HRevApp (x ': l) l' z Source # 
Instance details

Defined in Data.HList.HList

Methods

hRevApp :: HList (x ': l) -> HList l' -> HList z Source #

type family HRevAppR (l1 :: [k]) (l2 :: [k]) :: [k] Source #

Instances

Instances details
type HRevAppR ('[] :: [k]) (l :: [k]) Source # 
Instance details

Defined in Data.HList.HList

type HRevAppR ('[] :: [k]) (l :: [k]) = l
type HRevAppR (e ': l :: [a]) (l' :: [a]) Source # 
Instance details

Defined in Data.HList.HList

type HRevAppR (e ': l :: [a]) (l' :: [a]) = HRevAppR l (e ': l')

class HAppendList l1 l2 where Source #

Methods

hAppendList :: HList l1 -> HList l2 -> HList (HAppendListR l1 l2) Source #

the same as hAppend

Instances

Instances details
HAppendList ('[] :: [Type]) l2 Source # 
Instance details

Defined in Data.HList.HList

Methods

hAppendList :: HList '[] -> HList l2 -> HList (HAppendListR '[] l2) Source #

HAppendList l l' => HAppendList (x ': l) l' Source # 
Instance details

Defined in Data.HList.HList

Methods

hAppendList :: HList (x ': l) -> HList l' -> HList (HAppendListR (x ': l) l') Source #

type family HAppendListR (l1 :: [k]) (l2 :: [k]) :: [k] Source #

Instances

Instances details
type HAppendListR ('[] :: [k]) (l :: [k]) Source # 
Instance details

Defined in Data.HList.HList

type HAppendListR ('[] :: [k]) (l :: [k]) = l
type HAppendListR (e ': l :: [k]) (l' :: [k]) Source # 
Instance details

Defined in Data.HList.HList

type HAppendListR (e ': l :: [k]) (l' :: [k]) = e ': HAppendListR l l'

type family HLength (x :: [k]) :: HNat Source #

Length, but see HLengthEq instead

Instances

Instances details
type HLength ('[] :: [k]) Source # 
Instance details

Defined in Data.HList.HList

type HLength ('[] :: [k]) = 'HZero
type HLength (x ': xs :: [k]) Source # 
Instance details

Defined in Data.HList.HList

type HLength (x ': xs :: [k]) = 'HSucc (HLength xs)

class HInit xs where Source #

Associated Types

type HInitR xs :: [*] Source #

Methods

hInit :: HList xs -> HList (HInitR xs) Source #

Instances

Instances details
HInit (b ': c) => HInit (a ': (b ': c)) Source # 
Instance details

Defined in Data.HList.HList

Associated Types

type HInitR (a ': (b ': c)) :: [Type] Source #

Methods

hInit :: HList (a ': (b ': c)) -> HList (HInitR (a ': (b ': c))) Source #

HInit '[x] Source # 
Instance details

Defined in Data.HList.HList

Associated Types

type HInitR '[x] :: [Type] Source #

Methods

hInit :: HList '[x] -> HList (HInitR '[x]) Source #

data ReadElement Source #

Constructors

ReadElement 

Instances

Instances details
(y ~ ReadP x, Read x) => ApplyAB ReadElement (Proxy x) y Source # 
Instance details

Defined in Data.HList.HList

Methods

applyAB :: ReadElement -> Proxy x -> y Source #

type family DropProxy (xs :: k) :: k Source #

inverse of AddProxy

Instances

Instances details
type DropProxy ('[] :: [k]) Source # 
Instance details

Defined in Data.HList.HList

type DropProxy ('[] :: [k]) = '[] :: [k]
type DropProxy (Proxy x :: Type) Source # 
Instance details

Defined in Data.HList.HList

type DropProxy (Proxy x :: Type) = x
type DropProxy (x ': xs :: [a]) Source # 
Instance details

Defined in Data.HList.HList

type DropProxy (x ': xs :: [a]) = DropProxy x ': DropProxy xs

type family AddProxy (xs :: k) :: k Source #

Add Proxy to a type

>>> let x = undefined :: HList (AddProxy [Char,Int])
>>> :t x
x :: HList '[Proxy Char, Proxy Int]

Instances

Instances details
type AddProxy (x :: Type) Source # 
Instance details

Defined in Data.HList.HList

type AddProxy (x :: Type) = Proxy x
type AddProxy ('[] :: [k]) Source # 
Instance details

Defined in Data.HList.HList

type AddProxy ('[] :: [k]) = '[] :: [k]
type AddProxy (x ': xs :: [a]) Source # 
Instance details

Defined in Data.HList.HList

type AddProxy (x ': xs :: [a]) = AddProxy x ': AddProxy xs

type HProxies xs = HProxiesFD xs (AddProxy xs) Source #

class HProxiesFD (xs :: [*]) pxs | pxs -> xs, xs -> pxs where Source #

creates a HList of Proxies

Methods

hProxies :: HList pxs Source #

Instances

Instances details
HProxiesFD ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hProxies :: HList '[] Source #

HProxiesFD xs pxs => HProxiesFD (x ': xs) (Proxy x ': pxs) Source # 
Instance details

Defined in Data.HList.HList

Methods

hProxies :: HList (Proxy x ': pxs) Source #

data family HList (l :: [*]) infixr 2 Source #

Instances

Instances details
(SameLengths '[x, y, xy], HZipList x y xy) => HZip HList x y xy Source # 
Instance details

Defined in Data.HList.HList

Methods

hZip :: HList x -> HList y -> HList xy Source #

(SameLengths '[x, y, xy], HZipList x y xy) => HUnzip HList x y xy Source # 
Instance details

Defined in Data.HList.HList

Methods

hUnzip :: HList xy -> (HList x, HList y) Source #

HDeleteMany (e :: k) (HList ('[] :: [Type])) (HList ('[] :: [Type])) Source # 
Instance details

Defined in Data.HList.HTypeIndexed

Methods

hDeleteMany :: Proxy e -> HList '[] -> HList '[] Source #

HMapAux HList f ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

Methods

hMapAux :: f -> HList '[] -> HList '[] Source #

(HSpanEqBy f a as fst snd, HGroupBy f snd gs) => HGroupBy (f :: t) (a ': as) (HList (a ': fst) ': gs) Source # 
Instance details

Defined in Data.HList.HList

Methods

hGroupBy :: Proxy f -> HList (a ': as) -> HList (HList (a ': fst) ': gs) Source #

(ApplyAB f e e', HMapAux HList f l l', SameLength l l') => HMapAux HList f (e ': l) (e' ': l') Source # 
Instance details

Defined in Data.HList.HList

Methods

hMapAux :: f -> HList (e ': l) -> HList (e' ': l') Source #

(HOccurs e l, HProject l (HList l')) => HProject l (HList (e ': l')) Source # 
Instance details

Defined in Data.HList.HOccurs

Methods

hProject :: l -> HList (e ': l') Source #

(HOccurrence e (x ': y) l', HOccurs' e l' (x ': y)) => HOccurs e (HList (x ': y)) Source # 
Instance details

Defined in Data.HList.HOccurs

Methods

hOccurs :: HList (x ': y) -> e Source #

HExtend e (HList l) Source # 
Instance details

Defined in Data.HList.HList

Associated Types

type HExtendR e (HList l) Source #

Methods

(.*.) :: e -> HList l -> HExtendR e (HList l) Source #

HReverse l l' => HBuild' l (HList l') Source # 
Instance details

Defined in Data.HList.HList

Methods

hBuild' :: HList l -> HList l' Source #

HInits1 a b => HInits a (HList ('[] :: [Type]) ': b) Source # 
Instance details

Defined in Data.HList.HList

Methods

hInits :: HList a -> HList (HList '[] ': b) Source #

(Bounded x, Bounded (HList xs)) => Bounded (HList (x ': xs)) Source # 
Instance details

Defined in Data.HList.HList

Methods

minBound :: HList (x ': xs) #

maxBound :: HList (x ': xs) #

Bounded (HList ('[] :: [Type])) Source # 
Instance details

Defined in Data.HList.HList

Methods

minBound :: HList '[] #

maxBound :: HList '[] #

(Eq x, Eq (HList xs)) => Eq (HList (x ': xs)) Source # 
Instance details

Defined in Data.HList.HList

Methods

(==) :: HList (x ': xs) -> HList (x ': xs) -> Bool #

(/=) :: HList (x ': xs) -> HList (x ': xs) -> Bool #

Eq (HList ('[] :: [Type])) Source # 
Instance details

Defined in Data.HList.HList

Methods

(==) :: HList '[] -> HList '[] -> Bool #

(/=) :: HList '[] -> HList '[] -> Bool #

(Data x, Data (HList xs), TypeablePolyK (x ': xs), Typeable (HList (x ': xs))) => Data (HList (x ': xs)) Source # 
Instance details

Defined in Data.HList.Data

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> HList (x ': xs) -> c (HList (x ': xs)) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (HList (x ': xs)) #

toConstr :: HList (x ': xs) -> Constr #

dataTypeOf :: HList (x ': xs) -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (HList (x ': xs))) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (HList (x ': xs))) #

gmapT :: (forall b. Data b => b -> b) -> HList (x ': xs) -> HList (x ': xs) #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> HList (x ': xs) -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> HList (x ': xs) -> r #

gmapQ :: (forall d. Data d => d -> u) -> HList (x ': xs) -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> HList (x ': xs) -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> HList (x ': xs) -> m (HList (x ': xs)) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> HList (x ': xs) -> m (HList (x ': xs)) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> HList (x ': xs) -> m (HList (x ': xs)) #

Typeable (HList ('[] :: [Type])) => Data (HList ('[] :: [Type])) Source # 
Instance details

Defined in Data.HList.Data

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> HList '[] -> c (HList '[]) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (HList '[]) #

toConstr :: HList '[] -> Constr #

dataTypeOf :: HList '[] -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (HList '[])) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (HList '[])) #

gmapT :: (forall b. Data b => b -> b) -> HList '[] -> HList '[] #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> HList '[] -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> HList '[] -> r #

gmapQ :: (forall d. Data d => d -> u) -> HList '[] -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> HList '[] -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> HList '[] -> m (HList '[]) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> HList '[] -> m (HList '[]) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> HList '[] -> m (HList '[]) #

(Ord x, Ord (HList xs)) => Ord (HList (x ': xs)) Source # 
Instance details

Defined in Data.HList.HList

Methods

compare :: HList (x ': xs) -> HList (x ': xs) -> Ordering #

(<) :: HList (x ': xs) -> HList (x ': xs) -> Bool #

(<=) :: HList (x ': xs) -> HList (x ': xs) -> Bool #

(>) :: HList (x ': xs) -> HList (x ': xs) -> Bool #

(>=) :: HList (x ': xs) -> HList (x ': xs) -> Bool #

max :: HList (x ': xs) -> HList (x ': xs) -> HList (x ': xs) #

min :: HList (x ': xs) -> HList (x ': xs) -> HList (x ': xs) #

Ord (HList ('[] :: [Type])) Source # 
Instance details

Defined in Data.HList.HList

Methods

compare :: HList '[] -> HList '[] -> Ordering #

(<) :: HList '[] -> HList '[] -> Bool #

(<=) :: HList '[] -> HList '[] -> Bool #

(>) :: HList '[] -> HList '[] -> Bool #

(>=) :: HList '[] -> HList '[] -> Bool #

max :: HList '[] -> HList '[] -> HList '[] #

min :: HList '[] -> HList '[] -> HList '[] #

(HProxies l, Read e, HSequence ReadP (ReadP e ': readP_l) (e ': l), HMapCxt HList ReadElement (AddProxy l) readP_l) => Read (HList (e ': l)) Source # 
Instance details

Defined in Data.HList.HList

Methods

readsPrec :: Int -> ReadS (HList (e ': l)) #

readList :: ReadS [HList (e ': l)] #

readPrec :: ReadPrec (HList (e ': l)) #

readListPrec :: ReadPrec [HList (e ': l)] #

Read (HList ('[] :: [Type])) Source # 
Instance details

Defined in Data.HList.HList

(Show e, Show (HList l)) => Show (HList (e ': l)) Source # 
Instance details

Defined in Data.HList.HList

Methods

showsPrec :: Int -> HList (e ': l) -> ShowS #

show :: HList (e ': l) -> String #

showList :: [HList (e ': l)] -> ShowS #

Show (HList ('[] :: [Type])) Source # 
Instance details

Defined in Data.HList.HList

Methods

showsPrec :: Int -> HList '[] -> ShowS #

show :: HList '[] -> String #

showList :: [HList '[]] -> ShowS #

(Ix x, Ix (HList xs)) => Ix (HList (x ': xs)) Source # 
Instance details

Defined in Data.HList.HList

Methods

range :: (HList (x ': xs), HList (x ': xs)) -> [HList (x ': xs)] #

index :: (HList (x ': xs), HList (x ': xs)) -> HList (x ': xs) -> Int #

unsafeIndex :: (HList (x ': xs), HList (x ': xs)) -> HList (x ': xs) -> Int #

inRange :: (HList (x ': xs), HList (x ': xs)) -> HList (x ': xs) -> Bool #

rangeSize :: (HList (x ': xs), HList (x ': xs)) -> Int #

unsafeRangeSize :: (HList (x ': xs), HList (x ': xs)) -> Int #

Ix (HList ('[] :: [Type])) Source # 
Instance details

Defined in Data.HList.HList

Methods

range :: (HList '[], HList '[]) -> [HList '[]] #

index :: (HList '[], HList '[]) -> HList '[] -> Int #

unsafeIndex :: (HList '[], HList '[]) -> HList '[] -> Int #

inRange :: (HList '[], HList '[]) -> HList '[] -> Bool #

rangeSize :: (HList '[], HList '[]) -> Int #

unsafeRangeSize :: (HList '[], HList '[]) -> Int #

(HZip HList a a aa, HMapCxt HList UncurryMappend aa a) => Semigroup (HList a) Source # 
Instance details

Defined in Data.HList.HList

Methods

(<>) :: HList a -> HList a -> HList a #

sconcat :: NonEmpty (HList a) -> HList a #

stimes :: Integral b => b -> HList a -> HList a #

(HProxies a, HMapCxt HList ConstMempty (AddProxy a) a, HZip HList a a aa, HMapCxt HList UncurryMappend aa a) => Monoid (HList a) Source #

Analogous to the Monoid instance for tuples

>>> import Data.Monoid
>>> mempty :: HList '[(), All, [Int]]
H[(),All {getAll = True},[]]
>>> mappend (hBuild "a") (hBuild "b") :: HList '[String]
H["ab"]
Instance details

Defined in Data.HList.HList

Methods

mempty :: HList a #

mappend :: HList a -> HList a -> HList a #

mconcat :: [HList a] -> HList a #

(TypeRepsList (HList xs), Typeable x) => TypeRepsList (HList (x ': xs)) Source # 
Instance details

Defined in Data.HList.Data

Methods

typeRepsList :: HList (x ': xs) -> [TypeRep] Source #

TypeRepsList (HList ('[] :: [Type])) Source # 
Instance details

Defined in Data.HList.Data

Methods

typeRepsList :: HList '[] -> [TypeRep] Source #

(HDeleteAtHNat n l, HType2HNat e l n, l' ~ HDeleteAtHNatR n l) => HDeleteAtLabel HList (e :: Type) l l' Source #

should this instead delete the first element of that type?

Instance details

Defined in Data.HList.HTypeIndexed

Methods

hDeleteAtLabel :: Label e -> HList l -> HList l' Source #

(HEq e1 e b, HDeleteManyCase b e1 e l l1) => HDeleteMany (e1 :: Type) (HList (e ': l)) (HList l1) Source # 
Instance details

Defined in Data.HList.HTypeIndexed

Methods

hDeleteMany :: Proxy e1 -> HList (e ': l) -> HList l1 Source #

HProject (HList l) (HList ('[] :: [Type])) Source # 
Instance details

Defined in Data.HList.HOccurs

Methods

hProject :: HList l -> HList '[] Source #

HAppendList l1 l2 => HAppend (HList l1) (HList l2) Source # 
Instance details

Defined in Data.HList.HList

Methods

hAppend :: HList l1 -> HList l2 -> HAppendR (HList l1) (HList l2) Source #

ApplyAB f e e' => ApplyAB (MapCar f) (e, HList l) (HList (e' ': l)) Source # 
Instance details

Defined in Data.HList.HList

Methods

applyAB :: MapCar f -> (e, HList l) -> HList (e' ': l) Source #

HInits1 ('[] :: [Type]) '[HList ('[] :: [Type])] Source # 
Instance details

Defined in Data.HList.HList

Methods

hInits1 :: HList '[] -> HList '[HList '[]] Source #

HTails ('[] :: [Type]) '[HList ('[] :: [Type])] Source # 
Instance details

Defined in Data.HList.HList

Methods

hTails :: HList '[] -> HList '[HList '[]] Source #

Apply (FHUProj sel ns) (HList l, Proxy ('HSucc n)) => Apply (Proxy 'False, FHUProj sel ns) (HList (e ': l), Proxy n) Source # 
Instance details

Defined in Data.HList.HArray

Associated Types

type ApplyR (Proxy 'False, FHUProj sel ns) (HList (e ': l), Proxy n) Source #

Methods

apply :: (Proxy 'False, FHUProj sel ns) -> (HList (e ': l), Proxy n) -> ApplyR (Proxy 'False, FHUProj sel ns) (HList (e ': l), Proxy n) Source #

Apply (Proxy 'True, FHUProj sel ns) (HList (e ': l), Proxy n) Source # 
Instance details

Defined in Data.HList.HArray

Associated Types

type ApplyR (Proxy 'True, FHUProj sel ns) (HList (e ': l), Proxy n) Source #

Methods

apply :: (Proxy 'True, FHUProj sel ns) -> (HList (e ': l), Proxy n) -> ApplyR (Proxy 'True, FHUProj sel ns) (HList (e ': l), Proxy n) Source #

(ch ~ Proxy (HBoolEQ sel (KMember n ns)), Apply (ch, FHUProj sel ns) (HList (e ': l), Proxy n)) => Apply (FHUProj sel ns) (HList (e ': l), Proxy n) Source # 
Instance details

Defined in Data.HList.HArray

Associated Types

type ApplyR (FHUProj sel ns) (HList (e ': l), Proxy n) Source #

Methods

apply :: FHUProj sel ns -> (HList (e ': l), Proxy n) -> ApplyR (FHUProj sel ns) (HList (e ': l), Proxy n) Source #

Apply (FHUProj sel ns) (HList ('[] :: [Type]), n) Source # 
Instance details

Defined in Data.HList.HArray

Associated Types

type ApplyR (FHUProj sel ns) (HList '[], n) Source #

Methods

apply :: FHUProj sel ns -> (HList '[], n) -> ApplyR (FHUProj sel ns) (HList '[], n) Source #

(HConcatFD as bs, HAppendFD a bs cs) => HConcatFD (HList a ': as) cs Source # 
Instance details

Defined in Data.HList.HList

Methods

hConcatFD :: HList (HList a ': as) -> HList cs Source #

(HInits1 xs ys, HMapCxt HList (FHCons2 x) ys ys', HMapCons x ys ~ ys', HMapTail ys' ~ ys) => HInits1 (x ': xs) (HList '[x] ': ys') Source # 
Instance details

Defined in Data.HList.HList

Methods

hInits1 :: HList (x ': xs) -> HList (HList '[x] ': ys') Source #

HTails xs ys => HTails (x ': xs) (HList (x ': xs) ': ys) Source # 
Instance details

Defined in Data.HList.HList

Methods

hTails :: HList (x ': xs) -> HList (HList (x ': xs) ': ys) Source #

HMapUnboxF xs us => HMapUnboxF (HList x ': xs) (RecordU x ': us) Source # 
Instance details

Defined in Data.HList.RecordU

(HList (x ': y) ~ z, HZip3 xs ys zs) => HZip3 (x ': xs) (HList y ': ys) (z ': zs) Source # 
Instance details

Defined in Data.HList.HZip

Methods

hZip3 :: HList (x ': xs) -> HList (HList y ': ys) -> HList (z ': zs) Source #

type HExtendR e (HList l) Source # 
Instance details

Defined in Data.HList.HList

type HExtendR e (HList l) = HList (e ': l)
type HMapCons x (HList a ': b) Source # 
Instance details

Defined in Data.HList.HList

type HMapCons x (HList a ': b) = HList (x ': a) ': HMapCons x b
type UnHList (HList a) Source # 
Instance details

Defined in Data.HList.HList

type UnHList (HList a) = a
data HList ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.HList

data HList ('[] :: [Type]) = HNil
type HAppendR (HList l1 :: Type) (HList l2 :: Type) Source # 
Instance details

Defined in Data.HList.HList

type HAppendR (HList l1 :: Type) (HList l2 :: Type) = HList (HAppendListR l1 l2)
type ApplyR (Proxy 'False, FHUProj sel ns) (HList (e ': l), Proxy n) Source # 
Instance details

Defined in Data.HList.HArray

type ApplyR (Proxy 'False, FHUProj sel ns) (HList (e ': l), Proxy n) = ApplyR (FHUProj sel ns) (HList l, Proxy ('HSucc n))
type ApplyR (Proxy 'True, FHUProj sel ns) (HList (e ': l), Proxy n) Source # 
Instance details

Defined in Data.HList.HArray

type ApplyR (Proxy 'True, FHUProj sel ns) (HList (e ': l), Proxy n) = HJust (e, (HList l, Proxy ('HSucc n)))
type ApplyR (FHUProj sel ns) (HList ('[] :: [Type]), n) Source # 
Instance details

Defined in Data.HList.HArray

type ApplyR (FHUProj sel ns) (HList ('[] :: [Type]), n) = HNothing
type ApplyR (FHUProj sel ns) (HList (e ': l), Proxy n) Source # 
Instance details

Defined in Data.HList.HArray

type ApplyR (FHUProj sel ns) (HList (e ': l), Proxy n) = ApplyR (Proxy (HBoolEQ sel (KMember n ns)), FHUProj sel ns) (HList (e ': l), Proxy n)
type HMapTail (HList (a ': as) ': bs) Source # 
Instance details

Defined in Data.HList.HList

type HMapTail (HList (a ': as) ': bs) = HList as ': HMapTail bs
data HList (x ': xs) Source # 
Instance details

Defined in Data.HList.HList

data HList (x ': xs) = x `HCons` (HList xs)

hHead :: HList (e ': l) -> e Source #

hTail :: HList (e ': l) -> HList l Source #

hLast :: forall (l1 :: [Type]) e (l :: [Type]). HRevApp l1 ('[] :: [Type]) (e ': l) => HList l1 -> e Source #

hLength :: HLengthEq l n => HList l -> Proxy n Source #

hReverse_ :: forall (l1 :: [Type]) (l3 :: [Type]). HRevApp l1 ('[] :: [Type]) l3 => HList l1 -> HList l3 Source #

a version of hReverse that does not allow the type information to flow backwards

hEnd :: HList l -> HList l Source #

Note:

x :: HList a
means: forall a. x :: HList a
hEnd x
means: exists a. x :: HList a

List termination

hBuild :: HBuild' '[] r => r Source #

Building lists

hUnfold :: forall f a (z :: [Type]). (HUnfoldFD f (ApplyR f a) z, Apply f a) => f -> a -> HList z Source #

hConcat :: HConcat xs => HList xs -> HList (HConcatR xs) Source #

hMap :: forall (a :: [Type]) (b :: [Type]) r f. (SameLength' a b, SameLength' b a, HMapAux r f a b) => f -> r a -> r b Source #

hMapL :: forall (a :: [Type]) (b :: [Type]) f. (SameLength' a b, SameLength' b a, HMapAux HList f a b) => f -> HList a -> HList b Source #

hMap constrained to HList

hComposeList :: HFoldr Comp (a -> a) l (t -> a) => HList l -> t -> a Source #

>>> let xs = length .*. (+1) .*. (*2) .*. HNil
>>> hComposeList xs "abc"
8

hMapOut :: forall f e l. HMapOut f l e => f -> HList l -> [e] Source #

compare hMapOut f with hList2List . hMap f

hMapM :: (Monad m, HMapOut f l (m e)) => f -> HList l -> [m e] Source #

mapM :: forall b m a. (Monad m) => (a -> m b) -> [a] -> m [b]

Likewise for mapM_.

See hSequence if the result list should also be heterogenous.

hMapM_ :: (Monad m, HMapOut f l (m ())) => f -> HList l -> m () Source #

GHC doesn't like its own type.

hMapM_ :: forall m a f e. (Monad m, HMapOut f a (m e)) => f -> a -> m ()

Without explicit type signature, it's Ok. Sigh. Anyway, Hugs does insist on a better type. So we restrict as follows:

hMember :: HMember e l b => Proxy e -> Proxy l -> Proxy b Source #

hTMember :: HTMember e l b => e -> HList l -> Proxy b Source #

list2HList :: HList2List l e => [e] -> Maybe (HList l) Source #

listAsHList :: forall (l1 :: [Type]) e1 (l2 :: [Type]) e2 p f. (HList2List l1 e1, HList2List l2 e2, Choice p, Applicative f) => p (HList l2) (f (HList l1)) -> p [e2] (f [e1]) Source #

Prism [s] [t] (HList s) (HList t)

listAsHList' :: forall (l :: [Type]) e p f. (HList2List l e, Choice p, Applicative f) => p (HList l) (f (HList l)) -> p [e] (f [e]) Source #

Prism' [a] (HList s)

where s ~ HReplicateR n a

toHJust2 :: (HMapCxt r (HJust ()) a b, ToHJust a, b ~ ToHJustR a) => r a -> r b Source #

alternative implementation. The Apply instance is in Data.HList.FakePrelude. A longer type could be inferred.

fromHJust2 :: HMapCxt r HFromJust a b => r a -> r b Source #

This implementation is shorter.

hAddTag :: forall (a :: [Type]) (b :: [Type]) r t. (SameLength' a b, SameLength' b a, HMapAux r (HAddTag t) a b) => t -> r a -> r b Source #

hRmTag :: forall (a :: [Type]) (b :: [Type]) r. (SameLength' a b, SameLength' b a, HMapAux r HRmTag a b) => r a -> r b Source #

hFlag :: forall (a :: [Type]) (b :: [Type]) r. (SameLength' a b, SameLength' b a, HMapAux r (HAddTag (Proxy 'True)) a b) => r a -> r b Source #

Annotate list with a type-level Boolean

hFlag :: HMapCxt (HAddTag (Proxy True)) l r => HList l -> HList r

hTuple :: forall p f (v1 :: [Type]) a (v2 :: [Type]) t. (Profunctor p, Functor f, HTuple v1 a, HTuple v2 t) => p a (f t) -> p (HList v1) (f (HList v2)) Source #

Iso (HList v) (HList v') a b

hTuple' :: forall p f (v :: [Type]) a. (Profunctor p, Functor f, HTuple v a) => p a (f a) -> p (HList v) (f (HList v)) Source #

Iso' (HList v) a

A subset of Data.HList.HSort

hSort :: HSort x y => HList x -> HList y Source #

type HSort x y = HSortBy HLeFn x y Source #

class (SameLength a b, HEqByFn le) => HSortBy le (a :: [*]) (b :: [*]) | le a -> b where Source #

quick sort with a special case for sorted lists

Methods

hSortBy :: Proxy le -> HList a -> HList b Source #

Instances

Instances details
(SameLength a b, HIsAscList le a ok, HSortBy1 ok le a b, HEqByFn le) => HSortBy (le :: k) a b Source # 
Instance details

Defined in Data.HList.HSort

Methods

hSortBy :: Proxy le -> HList a -> HList b Source #

data HLeFn Source #

the "standard" <= for types. Reuses HEqBy

Note that ghc-7.6 is missing instances for Symbol and Nat, so that sorting only works HNat (as used by Data.HList.Label3).

Instances

Instances details
HEqByFn HLeFn Source # 
Instance details

Defined in Data.HList.HSort

(x <=? y) ~ b => HEqBy HLeFn (x :: Nat) (y :: Nat) b Source #

only in ghc >= 7.7

Instance details

Defined in Data.HList.HSort

(HEq (CmpSymbol x y) 'GT nb, HNot nb ~ b) => HEqBy HLeFn (x :: Symbol) (y :: Symbol) b Source #

only in ghc >= 7.7

>>> let b1 = Proxy :: HEqBy HLeFn "x" "y" b => Proxy b
>>> :t b1
b1 :: Proxy 'True
>>> let b2 = Proxy :: HEqBy HLeFn "x" "x" b => Proxy b
>>> :t b2
b2 :: Proxy 'True
>>> let b3 = Proxy :: HEqBy HLeFn "y" "x" b => Proxy b
>>> :t b3
b3 :: Proxy 'False
Instance details

Defined in Data.HList.HSort

HLe x y ~ b => HEqBy HLeFn (x :: HNat) (y :: HNat) b Source # 
Instance details

Defined in Data.HList.HSort

HEqBy HLeFn x y b => HEqBy HLeFn (Proxy x :: Type) (Proxy y :: Type) b Source # 
Instance details

Defined in Data.HList.HSort

HEqBy HLeFn x y b => HEqBy HLeFn (Label x :: Type) (Label y :: Type) b Source # 
Instance details

Defined in Data.HList.HSort

HEqBy HLeFn x y b => HEqBy HLeFn (Tagged x v :: Type) (Tagged y w :: Type) b Source # 
Instance details

Defined in Data.HList.HSort

(HEqBy HLeFn n m b, ns ~ ns') => HEqBy HLeFn (Lbl n ns desc :: Type) (Lbl m ns' desc' :: Type) b Source #

Data.HList.Label3 labels can only be compared if they belong to the same namespace.

Instance details

Defined in Data.HList.HSort

data HDown a Source #

analogous to Down

Instances

Instances details
HEqBy f y x b => HEqBy (HDown f :: Type) (x :: k2) (y :: k2) b Source # 
Instance details

Defined in Data.HList.HSort

HEqByFn a => HEqByFn (HDown a :: Type) Source # 
Instance details

Defined in Data.HList.HSort

class HSetBy (HNeq HLeFn) ps => HSet (ps :: [*]) Source #

Instances

Instances details
HSetBy (HNeq HLeFn) ps => HSet ps Source # 
Instance details

Defined in Data.HList.HSort

class HEqByFn lt => HSetBy lt (ps :: [*]) Source #

Provided the labels involved have an appropriate instance of HEqByFn, it would be possible to use the following definitions:

type HRLabelSet = HSet
type HLabelSet  = HSet

Instances

Instances details
(HEqByFn lt, HSortBy lt ps ps', HAscList lt ps') => HSetBy (lt :: k) ps Source # 
Instance details

Defined in Data.HList.HSort

class HIsSet (ps :: [*]) (b :: Bool) | ps -> b Source #

>>> let xx = Proxy :: HIsSet [Label "x", Label "x"] b => Proxy b
>>> :t xx
xx :: Proxy 'False
>>> let xy = Proxy :: HIsSet [Label "x", Label "y"] b => Proxy b
>>> :t xy
xy :: Proxy 'True

Instances

Instances details
HIsSetBy (HNeq HLeFn) ps b => HIsSet ps b Source # 
Instance details

Defined in Data.HList.HSort

class HEqByFn lt => HIsSetBy lt (ps :: [*]) (b :: Bool) | lt ps -> b Source #

Instances

Instances details
(HEqByFn lt, HSortBy lt ps ps', HIsAscList lt ps' b) => HIsSetBy (lt :: k) ps b Source # 
Instance details

Defined in Data.HList.HSort

class HEqByFn le => HAscList le (ps :: [*]) Source #

HAscList le xs confirms that xs is in ascending order, and reports which element is duplicated otherwise.

Instances

Instances details
(HEqByFn le, HAscList0 le ps ps) => HAscList (le :: k) ps Source # 
Instance details

Defined in Data.HList.HSort

class HEqByFn le => HIsAscList le (xs :: [*]) (b :: Bool) | le xs -> b Source #

HIsAscList le xs b is analogous to

b = all (\(x,y) -> x `le` y) (xs `zip` tail xs)

Instances

Instances details
HEqByFn le => HIsAscList (le :: k) ('[] :: [Type]) 'True Source # 
Instance details

Defined in Data.HList.HSort

(HEqBy le x y b1, HIsAscList le (y ': ys) b2, HAnd b1 b2 ~ b3) => HIsAscList (le :: k) (x ': (y ': ys)) b3 Source # 
Instance details

Defined in Data.HList.HSort

HEqByFn le => HIsAscList (le :: k) '[x] 'True Source # 
Instance details

Defined in Data.HList.HSort

A subset of Data.HList.HCurry

class HLengthEq xs n => HCurry' (n :: HNat) f xs r | f xs -> r, r xs -> f, n f -> xs, xs -> n where Source #

curry/uncurry for many arguments and HLists instead of tuples

XXX the last FD xs -> n is needed to make hCompose infer the right types: arguably it shouldn't be needed

Methods

hUncurry' :: Proxy n -> f -> HList xs -> r Source #

hCurry' :: Proxy n -> (HList xs -> r) -> f Source #

Instances

Instances details
HCurry' 'HZero b ('[] :: [Type]) b Source # 
Instance details

Defined in Data.HList.HCurry

Methods

hUncurry' :: Proxy 'HZero -> b -> HList '[] -> b Source #

hCurry' :: Proxy 'HZero -> (HList '[] -> b) -> b Source #

HCurry' n b xs r => HCurry' ('HSucc n) (x -> b) (x ': xs) r Source # 
Instance details

Defined in Data.HList.HCurry

Methods

hUncurry' :: Proxy ('HSucc n) -> (x -> b) -> HList (x ': xs) -> r Source #

hCurry' :: Proxy ('HSucc n) -> (HList (x ': xs) -> r) -> x -> b Source #

hCurry :: forall (n :: HNat) f (xs :: [Type]) r. (HCurry' n f xs r, ArityFwd f n, ArityRev f n) => (HList xs -> r) -> f Source #

Note: with ghc-7.10 the Arity constraint added here does not work properly with hCompose, so it is possible that other uses of hCurry are better served by hCurry' Proxy.

hUncurry :: forall (n :: HNat) f (xs :: [Type]) r. (HCurry' n f xs r, ArityFwd f n, ArityRev f n) => f -> HList xs -> r Source #

hCompose :: forall (xs1 :: [Type]) (xs2 :: [Type]) (xsys :: [Type]) (n1 :: HNat) f1 r (n2 :: HNat) b (n3 :: HNat) f2 x. (HAppendList1 xs1 xs2 xsys, HCurry' n1 f1 xsys r, HCurry' n2 b xs2 r, HCurry' n3 f2 xs1 x, ArityFwd b n2, ArityFwd f2 n3, ArityRev b n2, ArityRev f2 n3, HSplitAt1 ('[] :: [Type]) n3 xsys xs1 xs2) => (x -> b) -> f2 -> f1 Source #

compose two functions that take multiple arguments. The result of the second function is the first argument to the first function. An example is probably clearer:

>>> let f = hCompose (,,) (,)
>>> :t f
f :: ... -> ... -> ... -> ... -> ((..., ...), ..., ...)
>>> f 1 2 3 4
((1,2),3,4)

Note: polymorphism can make it confusing as to how many parameters a function actually takes. For example, the first two ids are id :: (a -> b) -> (a -> b) in

>>> (.) id id id 'y'
'y'
>>> hCompose id id id 'y'
'y'

still typechecks, but in that case hCompose i1 i2 i3 x == i1 ((i2 i3) x) has id with different types than @(.) i1 i2 i3 x == (i1 (i2 i3)) x

Prompted by http://stackoverflow.com/questions/28932054/can-hlistelim-be-composed-with-another-function

TIP

Public interface of Data.HList.TIP

data TIP (l :: [*]) Source #

TIPs are like Record, except element "i" of the list "l" has type Tagged e_i e_i

Instances

Instances details
TypeIndexed Record TIP Source # 
Instance details

Defined in Data.HList.TIC

Methods

typeIndexed :: forall p f (s :: [Type]) (t :: [Type]) (a :: [Type]) (b :: [Type]). (TypeIndexedCxt s t a b, Profunctor p, Functor f) => p (TIP (TagR a)) (f (TIP (TagR b))) -> p (Record s) (f (Record t)) Source #

(HUnzip TIP x y xy, HZipList xL yL xyL, lty ~ (HList xL -> HList yL -> HList xyL), Coercible lty (TIP x -> TIP y -> TIP xy), UntagR x ~ xL, UntagR y ~ yL, UntagR xy ~ xyL, UntagTag x, UntagTag y, UntagTag xy) => HZip TIP x y xy Source # 
Instance details

Defined in Data.HList.TIP

Methods

hZip :: TIP x -> TIP y -> TIP xy Source #

(HZipList xL yL xyL, lty ~ (HList xyL -> (HList xL, HList yL)), Coercible lty (TIP xy -> (TIP x, TIP y)), UntagR x ~ xL, TagR xL ~ x, UntagR y ~ yL, TagR yL ~ y, UntagR xy ~ xyL, TagR xyL ~ xy, SameLengths '[x, y, xy], UntagTag x, UntagTag y, UntagTag xy) => HUnzip TIP x y xy Source # 
Instance details

Defined in Data.HList.TIP

Methods

hUnzip :: TIP xy -> (TIP x, TIP y) Source #

(HDeleteAtLabel Record e v v', HTypeIndexed v') => HDeleteAtLabel TIP (e :: k) v v' Source # 
Instance details

Defined in Data.HList.TIP

Methods

hDeleteAtLabel :: Label e -> TIP v -> TIP v' Source #

LabelableTIPCxt x s t a b => Labelable (x :: k) TIP s t a b Source #

make a Lens' (TIP s) a.

tipyLens provides a Lens (TIP s) (TIP t) a b, which tends to need too many type annotations to be practical

Instance details

Defined in Data.HList.Labelable

Associated Types

type LabelableTy TIP :: LabeledOpticType Source #

Methods

hLens' :: Label x -> LabeledOptic x TIP s t a b Source #

HasField e (Record (x ': (y ': l))) e => HOccurs e (TIP (x ': (y ': l))) Source # 
Instance details

Defined in Data.HList.TIP

Methods

hOccurs :: TIP (x ': (y ': l)) -> e Source #

tee ~ Tagged e e => HOccurs e (TIP '[tee]) Source #

One occurrence and nothing is left

This variation provides an extra feature for singleton lists. That is, the result type is unified with the element in the list. Hence the explicit provision of a result type can be omitted.

Instance details

Defined in Data.HList.TIP

Methods

hOccurs :: TIP '[tee] -> e Source #

(HRLabelSet (Tagged e e ': l), HTypeIndexed l) => HExtend e (TIP l) Source # 
Instance details

Defined in Data.HList.TIP

Associated Types

type HExtendR e (TIP l) Source #

Methods

(.*.) :: e -> TIP l -> HExtendR e (TIP l) Source #

Bounded (HList r) => Bounded (TIP r) Source # 
Instance details

Defined in Data.HList.TIP

Methods

minBound :: TIP r #

maxBound :: TIP r #

Eq (HList a) => Eq (TIP a) Source # 
Instance details

Defined in Data.HList.TIP

Methods

(==) :: TIP a -> TIP a -> Bool #

(/=) :: TIP a -> TIP a -> Bool #

(TypeablePolyK xs, Typeable (HList xs), Data (HList xs)) => Data (TIP xs) Source # 
Instance details

Defined in Data.HList.Data

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> TIP xs -> c (TIP xs) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (TIP xs) #

toConstr :: TIP xs -> Constr #

dataTypeOf :: TIP xs -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (TIP xs)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (TIP xs)) #

gmapT :: (forall b. Data b => b -> b) -> TIP xs -> TIP xs #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TIP xs -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TIP xs -> r #

gmapQ :: (forall d. Data d => d -> u) -> TIP xs -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> TIP xs -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> TIP xs -> m (TIP xs) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> TIP xs -> m (TIP xs) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> TIP xs -> m (TIP xs) #

Ord (HList r) => Ord (TIP r) Source # 
Instance details

Defined in Data.HList.TIP

Methods

compare :: TIP r -> TIP r -> Ordering #

(<) :: TIP r -> TIP r -> Bool #

(<=) :: TIP r -> TIP r -> Bool #

(>) :: TIP r -> TIP r -> Bool #

(>=) :: TIP r -> TIP r -> Bool #

max :: TIP r -> TIP r -> TIP r #

min :: TIP r -> TIP r -> TIP r #

HMapOut (HComp HShow HUntag) l String => Show (TIP l) Source # 
Instance details

Defined in Data.HList.TIP

Methods

showsPrec :: Int -> TIP l -> ShowS #

show :: TIP l -> String #

showList :: [TIP l] -> ShowS #

Ix (HList r) => Ix (TIP r) Source # 
Instance details

Defined in Data.HList.TIP

Methods

range :: (TIP r, TIP r) -> [TIP r] #

index :: (TIP r, TIP r) -> TIP r -> Int #

unsafeIndex :: (TIP r, TIP r) -> TIP r -> Int #

inRange :: (TIP r, TIP r) -> TIP r -> Bool #

rangeSize :: (TIP r, TIP r) -> Int #

unsafeRangeSize :: (TIP r, TIP r) -> Int #

Semigroup (HList a) => Semigroup (TIP a) Source # 
Instance details

Defined in Data.HList.TIP

Methods

(<>) :: TIP a -> TIP a -> TIP a #

sconcat :: NonEmpty (TIP a) -> TIP a #

stimes :: Integral b => b -> TIP a -> TIP a #

Monoid (HList a) => Monoid (TIP a) Source # 
Instance details

Defined in Data.HList.TIP

Methods

mempty :: TIP a #

mappend :: TIP a -> TIP a -> TIP a #

mconcat :: [TIP a] -> TIP a #

(HUpdateAtLabel Record e' e r r', HTypeIndexed r', e ~ e') => HUpdateAtLabel TIP (e' :: Type) e r r' Source # 
Instance details

Defined in Data.HList.TIP

Methods

hUpdateAtLabel :: Label e' -> e -> TIP r -> TIP r' Source #

(e ~ e', HasField e (Record l) e') => HasField (e :: Type) (TIP l) e' Source # 
Instance details

Defined in Data.HList.TIP

Methods

hLookupByLabel :: Label e -> TIP l -> e' Source #

(HAppend (HList l) (HList l'), HTypeIndexed (HAppendListR l l')) => HAppend (TIP l) (TIP l') Source # 
Instance details

Defined in Data.HList.TIP

Methods

hAppend :: TIP l -> TIP l' -> HAppendR (TIP l) (TIP l') Source #

(HOccurs e (TIP l1), SubType (TIP l1) (TIP l2)) => SubType (TIP l1 :: Type) (TIP (e ': l2) :: Type) Source # 
Instance details

Defined in Data.HList.TIP

SubType (TIP l :: Type) (TIP ('[] :: [Type])) Source #

Subtyping for TIPs

Instance details

Defined in Data.HList.TIP

type LabelableTy TIP Source # 
Instance details

Defined in Data.HList.Labelable

type HExtendR e (TIP l) Source # 
Instance details

Defined in Data.HList.TIP

type HExtendR e (TIP l) = TIP (Tagged e e ': l)
type HAppendR (TIP l :: Type) (TIP l' :: Type) Source # 
Instance details

Defined in Data.HList.TIP

type HAppendR (TIP l :: Type) (TIP l' :: Type) = TIP (HAppendListR l l')

tipyUpdate :: forall record v (r :: [Type]). (HUpdateAtLabel record v v r r, SameLength' r r) => v -> record r -> record r Source #

tipyLens :: forall (n :: HNat) x (xs1 :: [Type]) (l1 :: [Type]) a1 (xs2 :: [Type]) (b :: Bool) a2 f. (HSplitAt1 ('[] :: [Type]) n (Tagged x x ': xs1) l1 (Tagged a1 a1 ': xs2), HAppendList1 l1 (Tagged a1 a1 ': xs2) (Tagged x x ': xs1), SameLength' (HReplicateR n ()) l1, HLengthEq1 l1 n, HLengthEq2 l1 n, HEq (Label a1) (Label x) b, HFind2 b (Label a1) (LabelsOf xs1) (Label x ': LabelsOf xs1) n, HAllTaggedEq (HAppendListR l1 (Tagged a2 a2 ': xs2)), HLabelSet (LabelsOf (HAppendListR l1 (Tagged a2 a2 ': xs2))), HAllTaggedLV (HAppendListR l1 (Tagged a2 a2 ': xs2)), HAppendList l1 (Tagged a2 a2 ': xs2), Functor f) => (a1 -> f a2) -> TIP (Tagged x x ': xs1) -> f (TIP (HAppendListR l1 (Tagged a2 a2 ': xs2))) Source #

provides a Lens (TIP s) (TIP t) a b

When using set (also known as .~), tipyLens' can address the ambiguity as to which field "a" should actually be updated.

tipyLens' :: forall a (t :: [Type]) f. (HasField a (Record t) a, HUpdateAtLabel2 a a t t, HAllTaggedEq t, HLabelSet (LabelsOf t), HAllTaggedLV t, SameLength' t t, SameLabels t t, Functor f) => (a -> f a) -> TIP t -> f (TIP t) Source #

provides a Lens' (TIP s) a. hLens' :: Label a -> Lens' (TIP s) a is another option.

projection

tipyProject :: forall (l :: [Type]) (ls :: [Type]) (t :: [Type]) (b :: [Type]) proxy. (HAllTaggedEq l, HLabelSet (LabelsOf l), HAllTaggedLV l, H2ProjectByLabels ls t l b) => proxy ls -> TIP t -> TIP l Source #

Use Labels to specify the first argument

tipyProject2 :: forall (ls :: [Type]) (r :: [Type]) (l1 :: [Type]) (l2 :: [Type]) proxy. (H2ProjectByLabels ls r l1 l2, HAllTaggedEq l1, HAllTaggedEq l2, HLabelSet (LabelsOf l1), HLabelSet (LabelsOf l2), HAllTaggedLV l1, HAllTaggedLV l2) => proxy ls -> TIP r -> (TIP l1, TIP l2) Source #

The same as tipyProject, except also return the types not requested in the proxy argument

tipyTuple :: forall b r (v1 :: [Type]) (v2 :: [Type]) a (v3 :: [Type]) (v'1 :: [Type]) (v'2 :: [Type]). (HOccurs b (r v1), HOccurs b (r v2), HOccurs a (r v2), HOccurs a (r v3), HDeleteAtLabel r b v1 v'1, HDeleteAtLabel r b v2 v3, HDeleteAtLabel r a v2 v1, HDeleteAtLabel r a v3 v'2) => r v2 -> (a, b) Source #

project a TIP (or HList) into a tuple

tipyTuple' x = (hOccurs x, hOccurs x)

behaves similarly, except tipyTuple excludes the possibility of looking up the same element twice, which allows inferring a concrete type in more situations. For example

(\x y z -> tipyTuple (x .*. y .*. emptyTIP) `asTypeOf` (x, z)) () 'x'

has type Char -> ((), Char). tipyTuple' would need a type annotation to decide whether the type should be Char -> ((), Char) or () -> ((), ())

tipyTuple3 :: forall b r (v1 :: [Type]) (v2 :: [Type]) (v3 :: [Type]) c (v4 :: [Type]) (v5 :: [Type]) a (v6 :: [Type]) (v7 :: [Type]) (v'1 :: [Type]) (v'2 :: [Type]) (v'3 :: [Type]). (HOccurs b (r v1), HOccurs b (r v2), HOccurs b (r v3), HOccurs c (r v4), HOccurs c (r v3), HOccurs c (r v5), HOccurs a (r v3), HOccurs a (r v6), HOccurs a (r v7), HDeleteAtLabel r b v1 v4, HDeleteAtLabel r b v2 v'1, HDeleteAtLabel r b v3 v5, HDeleteAtLabel r c v4 v'2, HDeleteAtLabel r c v3 v6, HDeleteAtLabel r c v5 v7, HDeleteAtLabel r a v3 v1, HDeleteAtLabel r a v6 v2, HDeleteAtLabel r a v7 v'3) => r v3 -> (a, b, c) Source #

tipyTuple4 :: forall b r (v1 :: [Type]) (v2 :: [Type]) (v3 :: [Type]) (v4 :: [Type]) c (v5 :: [Type]) (v6 :: [Type]) (v7 :: [Type]) d (v8 :: [Type]) (v9 :: [Type]) (v10 :: [Type]) a (v11 :: [Type]) (v12 :: [Type]) (v13 :: [Type]) (v'1 :: [Type]) (v'2 :: [Type]) (v'3 :: [Type]) (v'4 :: [Type]). (HOccurs b (r v1), HOccurs b (r v2), HOccurs b (r v3), HOccurs b (r v4), HOccurs c (r v5), HOccurs c (r v6), HOccurs c (r v4), HOccurs c (r v7), HOccurs d (r v8), HOccurs d (r v4), HOccurs d (r v9), HOccurs d (r v10), HOccurs a (r v4), HOccurs a (r v11), HOccurs a (r v12), HOccurs a (r v13), HDeleteAtLabel r b v1 v5, HDeleteAtLabel r b v2 v6, HDeleteAtLabel r b v3 v'1, HDeleteAtLabel r b v4 v7, HDeleteAtLabel r c v5 v8, HDeleteAtLabel r c v6 v'2, HDeleteAtLabel r c v4 v9, HDeleteAtLabel r c v7 v10, HDeleteAtLabel r d v8 v'3, HDeleteAtLabel r d v4 v11, HDeleteAtLabel r d v9 v12, HDeleteAtLabel r d v10 v13, HDeleteAtLabel r a v4 v1, HDeleteAtLabel r a v11 v2, HDeleteAtLabel r a v12 v3, HDeleteAtLabel r a v13 v'4) => r v4 -> (a, b, c, d) Source #

tipyTuple5 :: forall b r (v1 :: [Type]) (v2 :: [Type]) (v3 :: [Type]) (v4 :: [Type]) (v5 :: [Type]) c (v6 :: [Type]) (v7 :: [Type]) (v8 :: [Type]) (v9 :: [Type]) d (v10 :: [Type]) (v11 :: [Type]) (v12 :: [Type]) (v13 :: [Type]) e (v14 :: [Type]) (v15 :: [Type]) (v16 :: [Type]) (v17 :: [Type]) a (v18 :: [Type]) (v19 :: [Type]) (v20 :: [Type]) (v21 :: [Type]) (v'1 :: [Type]) (v'2 :: [Type]) (v'3 :: [Type]) (v'4 :: [Type]) (v'5 :: [Type]). (HOccurs b (r v1), HOccurs b (r v2), HOccurs b (r v3), HOccurs b (r v4), HOccurs b (r v5), HOccurs c (r v6), HOccurs c (r v7), HOccurs c (r v8), HOccurs c (r v5), HOccurs c (r v9), HOccurs d (r v10), HOccurs d (r v11), HOccurs d (r v5), HOccurs d (r v12), HOccurs d (r v13), HOccurs e (r v14), HOccurs e (r v5), HOccurs e (r v15), HOccurs e (r v16), HOccurs e (r v17), HOccurs a (r v5), HOccurs a (r v18), HOccurs a (r v19), HOccurs a (r v20), HOccurs a (r v21), HDeleteAtLabel r b v1 v6, HDeleteAtLabel r b v2 v7, HDeleteAtLabel r b v3 v8, HDeleteAtLabel r b v4 v'1, HDeleteAtLabel r b v5 v9, HDeleteAtLabel r c v6 v10, HDeleteAtLabel r c v7 v11, HDeleteAtLabel r c v8 v'2, HDeleteAtLabel r c v5 v12, HDeleteAtLabel r c v9 v13, HDeleteAtLabel r d v10 v14, HDeleteAtLabel r d v11 v'3, HDeleteAtLabel r d v5 v15, HDeleteAtLabel r d v12 v16, HDeleteAtLabel r d v13 v17, HDeleteAtLabel r e v14 v'4, HDeleteAtLabel r e v5 v18, HDeleteAtLabel r e v15 v19, HDeleteAtLabel r e v16 v20, HDeleteAtLabel r e v17 v21, HDeleteAtLabel r a v5 v1, HDeleteAtLabel r a v18 v2, HDeleteAtLabel r a v19 v3, HDeleteAtLabel r a v20 v4, HDeleteAtLabel r a v21 v'5) => r v5 -> (a, b, c, d, e) Source #

type TagUntag xs = TagUntagFD xs (TagR xs) Source #

class SameLength a ta => TagUntagFD a ta | a -> ta, ta -> a where Source #

TagR can also be used to avoid redundancy when defining types for TIC and TIP.

 type XShort = TagR [A,B,C,D]
 type XLong = [Tagged A A, Tagged B B, Tagged C C, Tagged D D]

an equivalent FD version, which is slightly better with respect to simplifying types containing type variables (in ghc-7.8 and 7.6): http://stackoverflow.com/questions/24110410/

With ghc-7.10 (http://ghc.haskell.org/trac/ghc/ticket/10009) the FD version is superior to the TF version:

class (UntagR (TagR a) ~ a) => TagUntag a where
    type TagR a :: [*]
    hTagSelf :: HList a -> HList (TagR a)
    hUntagSelf :: HList (TagR a) -> HList a

instance TagUntag '[] where
    type TagR '[] = '[]
    hTagSelf _ = HNil
    hUntagSelf _ = HNil

instance TagUntag xs => TagUntag (x ': xs) where
    type TagR (x ': xs) = Tagged x x ': TagR xs
    hTagSelf (HCons x xs) = Tagged x HCons hTagSelf xs
    hUntagSelf (HCons (Tagged x) xs) = x HCons hUntagSelf xs

type family UntagR (xs :: [*]) :: [*]
type instance UntagR '[] = '[]
type instance UntagR (x ': xs) = Untag1 x ': UntagR xs

Length information should flow backwards

>>> let len2 x = x `asTypeOf` (undefined :: HList '[a,b])
>>> let f = len2 $ hTagSelf (hReplicate Proxy ())
>>> :t f
f :: HList '[Tagged () (), Tagged () ()]

Methods

hTagSelf :: HList a -> HList ta Source #

hUntagSelf :: HList ta -> HList a Source #

Instances

Instances details
TagUntagFD ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.TIP

Methods

hTagSelf :: HList '[] -> HList '[] Source #

hUntagSelf :: HList '[] -> HList '[] Source #

(TagUntagFD xs ys, txx ~ Tagged x x) => TagUntagFD (x ': xs) (txx ': ys) Source # 
Instance details

Defined in Data.HList.TIP

Methods

hTagSelf :: HList (x ': xs) -> HList (txx ': ys) Source #

hUntagSelf :: HList (txx ': ys) -> HList (x ': xs) Source #

type family TagR (a :: [*]) :: [*] Source #

Instances

Instances details
type TagR ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.TIP

type TagR ('[] :: [Type]) = '[] :: [Type]
type TagR (x ': xs) Source # 
Instance details

Defined in Data.HList.TIP

type TagR (x ': xs) = Tagged x x ': TagR xs

TIP transform

class TransTIP op db where Source #

Transforming a TIP: applying to a TIP a (polyvariadic) function that takes arguments from a TIP and updates the TIP with the result.

In more detail: we have a typed-indexed collection TIP and we would like to apply a transformation function to it, whose argument types and the result type are all in the TIP. The function should locate its arguments based on their types, and update the TIP with the result. The function may have any number of arguments, including zero; the order of arguments should not matter.

The problem was posed by Andrew U. Frank on Haskell-Cafe, Sep 10, 2009. http://www.haskell.org/pipermail/haskell-cafe/2009-September/066217.html The problem is an interesting variation of the keyword argument problem.

Examples can be found in examples/TIPTransform.hs and examples/TIPTransformM.hs

Methods

ttip :: op -> TIP db -> TIP db Source #

Instances

Instances details
(HMember (Tagged op op) db b, Arity op n, TransTIP1 b n op db) => TransTIP op db Source # 
Instance details

Defined in Data.HList.TIP

Methods

ttip :: op -> TIP db -> TIP db Source #

class Monad m => TransTIPM m op db where Source #

In March 2010, Andrew Frank extended the problem for monadic operations. This is the monadic version of TIPTransform.hs in the present directory.

This is the TF implementation. When specifying the operation to perform over a TIP, we can leave it polymorphic over the monad. The type checker will instantiate the monad based on the context.

Methods

ttipM :: op -> TIP db -> m (TIP db) Source #

Instances

Instances details
(Monad m, HMember (Tagged op op) db b, Arity (m' op) n, TransTIPM1 b n m (m' op) db) => TransTIPM m (m' op) db Source # 
Instance details

Defined in Data.HList.TIP

Methods

ttipM :: m' op -> TIP db -> m (TIP db) Source #

TIC

Public interface of Data.HList.TIC

data TIC (l :: [*]) Source #

A datatype for type-indexed co-products. A TIC is just a Variant, where the elements of the type-level list "l" are in the form Tagged x x.

Instances

Instances details
TypeIndexed Variant TIC Source # 
Instance details

Defined in Data.HList.TIC

Methods

typeIndexed :: forall p f (s :: [Type]) (t :: [Type]) (a :: [Type]) (b :: [Type]). (TypeIndexedCxt s t a b, Profunctor p, Functor f) => p (TIC (TagR a)) (f (TIC (TagR b))) -> p (Variant s) (f (Variant t)) Source #

HMapAux Variant f xs ys => HMapAux TIC f xs ys Source # 
Instance details

Defined in Data.HList.TIC

Methods

hMapAux :: f -> TIC xs -> TIC ys Source #

(TICPrism s t a b, Label x ~ Label a, a ~ b, s ~ t, SameLength s t) => Labelable (x :: k) TIC s t a b Source #
hLens' :: Label a -> Prism' (TIC s) a

note that a more general function ticPrism :: Prism (TIC s) (TIC t) a b, cannot have an instance of Labelable

Note: `x :: k` according to the instance head, but the instance body forces the kind variable to be * later on. IE. (k ~ *)

Instance details

Defined in Data.HList.Labelable

Associated Types

type LabelableTy TIC :: LabeledOpticType Source #

Methods

hLens' :: Label x -> LabeledOptic x TIC s t a b Source #

(HasField o (TIC l) mo, mo ~ Maybe o) => HOccurs mo (TIC l) Source # 
Instance details

Defined in Data.HList.TIC

Methods

hOccurs :: TIC l -> mo Source #

(me ~ Maybe e, HOccursNot (Tagged e e) l) => HExtend me (TIC l) Source #
Nothing .*. x = x
Just a .*. y = mkTIC a
Instance details

Defined in Data.HList.TIC

Associated Types

type HExtendR me (TIC l) Source #

Methods

(.*.) :: me -> TIC l -> HExtendR me (TIC l) Source #

Bounded (Variant l) => Bounded (TIC l) Source # 
Instance details

Defined in Data.HList.TIC

Methods

minBound :: TIC l #

maxBound :: TIC l #

Enum (Variant l) => Enum (TIC l) Source # 
Instance details

Defined in Data.HList.TIC

Methods

succ :: TIC l -> TIC l #

pred :: TIC l -> TIC l #

toEnum :: Int -> TIC l #

fromEnum :: TIC l -> Int #

enumFrom :: TIC l -> [TIC l] #

enumFromThen :: TIC l -> TIC l -> [TIC l] #

enumFromTo :: TIC l -> TIC l -> [TIC l] #

enumFromThenTo :: TIC l -> TIC l -> TIC l -> [TIC l] #

Eq (Variant l) => Eq (TIC l) Source # 
Instance details

Defined in Data.HList.TIC

Methods

(==) :: TIC l -> TIC l -> Bool #

(/=) :: TIC l -> TIC l -> Bool #

(TypeablePolyK xs, Typeable (Variant xs), Data (Variant xs)) => Data (TIC xs) Source # 
Instance details

Defined in Data.HList.Data

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> TIC xs -> c (TIC xs) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (TIC xs) #

toConstr :: TIC xs -> Constr #

dataTypeOf :: TIC xs -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (TIC xs)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (TIC xs)) #

gmapT :: (forall b. Data b => b -> b) -> TIC xs -> TIC xs #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TIC xs -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TIC xs -> r #

gmapQ :: (forall d. Data d => d -> u) -> TIC xs -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> TIC xs -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> TIC xs -> m (TIC xs) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> TIC xs -> m (TIC xs) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> TIC xs -> m (TIC xs) #

Ord (Variant l) => Ord (TIC l) Source # 
Instance details

Defined in Data.HList.TIC

Methods

compare :: TIC l -> TIC l -> Ordering #

(<) :: TIC l -> TIC l -> Bool #

(<=) :: TIC l -> TIC l -> Bool #

(>) :: TIC l -> TIC l -> Bool #

(>=) :: TIC l -> TIC l -> Bool #

max :: TIC l -> TIC l -> TIC l #

min :: TIC l -> TIC l -> TIC l #

(ReadVariant l, HAllTaggedEq l, HRLabelSet l) => Read (TIC l) Source # 
Instance details

Defined in Data.HList.TIC

ShowVariant l => Show (TIC l) Source #

TICs are not opaque

Instance details

Defined in Data.HList.TIC

Methods

showsPrec :: Int -> TIC l -> ShowS #

show :: TIC l -> String #

showList :: [TIC l] -> ShowS #

Ix (Variant l) => Ix (TIC l) Source # 
Instance details

Defined in Data.HList.TIC

Methods

range :: (TIC l, TIC l) -> [TIC l] #

index :: (TIC l, TIC l) -> TIC l -> Int #

unsafeIndex :: (TIC l, TIC l) -> TIC l -> Int #

inRange :: (TIC l, TIC l) -> TIC l -> Bool #

rangeSize :: (TIC l, TIC l) -> Int #

unsafeRangeSize :: (TIC l, TIC l) -> Int #

Semigroup (Variant l) => Semigroup (TIC l) Source # 
Instance details

Defined in Data.HList.TIC

Methods

(<>) :: TIC l -> TIC l -> TIC l #

sconcat :: NonEmpty (TIC l) -> TIC l #

stimes :: Integral b => b -> TIC l -> TIC l #

Monoid (Variant l) => Monoid (TIC l) Source # 
Instance details

Defined in Data.HList.TIC

Methods

mempty :: TIC l #

mappend :: TIC l -> TIC l -> TIC l #

mconcat :: [TIC l] -> TIC l #

HasField o (Variant l) (Maybe o) => HasField (o :: Type) (TIC l) (Maybe o) Source #

Public destructor (or, open union's projection function)

Instance details

Defined in Data.HList.TIC

Methods

hLookupByLabel :: Label o -> TIC l -> Maybe o Source #

type LabelableTy TIC Source # 
Instance details

Defined in Data.HList.Labelable

type HExtendR me (TIC l) Source # 
Instance details

Defined in Data.HList.TIC

type HExtendR me (TIC l) = TIC (Tagged (UnMaybe me) (UnMaybe me) ': l)

creating TIC

mkTIC :: forall i (l :: [Type]) (n :: HNat). (HFind1 i (UnLabel i (LabelsOf l)) (UnLabel i (LabelsOf l)) n, HasField i (Record l) i, KnownNat (HNat2Nat n), HAllTaggedLV l, HLabelSet (LabelsOf l), HAllTaggedEq l) => i -> TIC l Source #

make a TIC for use in contexts where the result type is fixed

mkTIC1 :: forall i. MkVariant i i '[Tagged i i] => i -> TIC '[Tagged i i] Source #

make a TIC that contains one element

mkTIC' Source #

Arguments

:: forall i l proxy. (HTypeIndexed l, MkVariant i i l) 
=> i 
-> proxy l

the ordering of types in the l :: [*] matters. This argument is intended to fix the ordering it can be a Record, Variant, TIP, Proxy

-> TIC l 

Public constructor (or, open union's injection function)

get,set,modify

ticPrism :: (TICPrism s t a b, SameLength s t, Choice p, Applicative f) => (a `p` f b) -> TIC s `p` f (TIC t) Source #

ticPrism' :: forall s t a b. (HPrism a s t a b, a ~ b, s ~ t) => forall f p. (Applicative f, Choice p) => (a `p` f b) -> TIC s `p` f (TIC t) Source #

Prism' (TIC s) a

Variant

Public interface of Data.HList.Variant

data Variant (vs :: [*]) Source #

Variant vs has an implementation similar to Dynamic, except the contained value is one of the elements of the vs list, rather than being one particular instance of Typeable.

>>> v .!. _right
Nothing
>>> v .!. _left
Just 'x'

In some cases the pun quasiquote works with variants,

>>> let f [pun| left right |] = (left,right)
>>> f v
(Just 'x',Nothing)
>>> f w
(Nothing,Just 5)
>>> let add1 v = hMapV (Fun succ :: Fun '[Enum] '()) v
>>> f (add1 v)
(Just 'y',Nothing)
>>> f (add1 w)
(Nothing,Just 6)

Instances

Instances details
Relabeled Variant Source # 
Instance details

Defined in Data.HList.Variant

Methods

relabeled :: forall p f (s :: [Type]) (t :: [Type]) (a :: [Type]) (b :: [Type]). (HMapTaggedFn (RecordValuesR s) a, HMapTaggedFn (RecordValuesR b) t, SameLengths '[s, a, t, b], RecordValuesR t ~ RecordValuesR b, RecordValuesR s ~ RecordValuesR a, RecordValues b, RecordValues s, Profunctor p, Functor f) => p (Variant a) (f (Variant b)) -> p (Variant s) (f (Variant t)) Source #

TypeIndexed Variant TIC Source # 
Instance details

Defined in Data.HList.TIC

Methods

typeIndexed :: forall p f (s :: [Type]) (t :: [Type]) (a :: [Type]) (b :: [Type]). (TypeIndexedCxt s t a b, Profunctor p, Functor f) => p (TIC (TagR a)) (f (TIC (TagR b))) -> p (Variant s) (f (Variant t)) Source #

(ExtendsVariant b t, ProjectVariant s a, ProjectExtendVariant s t, HLeftUnion b s bs, HRLabelSet bs, HRearrange (LabelsOf t) bs t) => Projected Variant s t a b Source #
Prism (Variant s) (Variant t) (Variant a) (Variant b)
Instance details

Defined in Data.HList.Labelable

Methods

projected :: forall (ty :: LabeledOpticType) p f. (ty ~ LabelableTy Variant, LabeledOpticP ty p, LabeledOpticF ty f) => p (Variant a) (f (Variant b)) -> p (Variant s) (f (Variant t)) Source #

HUpdateVariantAtLabelCxt l e v v' n _e => HUpdateAtLabel Variant (l :: k) e v v' Source #
hUpdateAtLabel x e' (mkVariant x e proxy) == mkVariant x e' proxy
hUpdateAtLabel y e' (mkVariant x e proxy) == mkVariant x e  proxy
Instance details

Defined in Data.HList.Variant

Methods

hUpdateAtLabel :: Label l -> e -> Variant v -> Variant v' Source #

(HPrism x s t a b, to ~ ((->) :: Type -> Type -> Type)) => Labelable (x :: k) Variant s t a b Source #

make a Prism (Variant s) (Variant t) a b

Instance details

Defined in Data.HList.Labelable

Associated Types

type LabelableTy Variant :: LabeledOpticType Source #

Methods

hLens' :: Label x -> LabeledOptic x Variant s t a b Source #

(HasField x (Record vs) a, HFindLabel x vs n, HNat2Integral n) => HasField (x :: k) (Variant vs) (Maybe a) Source # 
Instance details

Defined in Data.HList.Variant

Methods

hLookupByLabel :: Label x -> Variant vs -> Maybe a Source #

(ApplyAB f te te', HMapCxt Variant f (l ': ls) (l' ': ls')) => HMapAux Variant f (te ': (l ': ls)) (te' ': (l' ': ls')) Source # 
Instance details

Defined in Data.HList.Variant

Methods

hMapAux :: f -> Variant (te ': (l ': ls)) -> Variant (te' ': (l' ': ls')) Source #

ApplyAB f te te' => HMapAux Variant f '[te] '[te'] Source # 
Instance details

Defined in Data.HList.Variant

Methods

hMapAux :: f -> Variant '[te] -> Variant '[te'] Source #

(le ~ Tagged l (Maybe e), HOccursNot (Label l) (LabelsOf v)) => HExtend le (Variant v) Source #

Extension for Variants prefers the first value

(l .=. Nothing) .*. v = v
(l .=. Just e)  .*. _ = mkVariant l e Proxy
Instance details

Defined in Data.HList.Variant

Associated Types

type HExtendR le (Variant v) Source #

Methods

(.*.) :: le -> Variant v -> HExtendR le (Variant v) Source #

(HasField l (Variant r) (Maybe u), HasFieldPath 'True ls u (Maybe v)) => HasFieldPath needJust (Label l ': ls) (Variant r) (Maybe v) Source # 
Instance details

Defined in Data.HList.Dredge

Methods

hLookupByLabelPath1 :: Proxy needJust -> Label (Label l ': ls) -> Variant r -> Maybe v Source #

(Unvariant '[txy] txy, tx ~ Tagged t x, ty ~ Tagged t y, txy ~ Tagged t (x, y)) => HUnzip Variant '[tx] '[ty] '[txy] Source # 
Instance details

Defined in Data.HList.Variant

Methods

hUnzip :: Variant '[txy] -> (Variant '[tx], Variant '[ty]) Source #

(HUnzip Variant (x2 ': xs) (y2 ': ys) (xy2 ': xys), SameLength xs ys, SameLength ys xys, tx ~ Tagged t x, ty ~ Tagged t y, txy ~ Tagged t (x, y)) => HUnzip Variant (tx ': (x2 ': xs)) (ty ': (y2 ': ys)) (txy ': (xy2 ': xys)) Source # 
Instance details

Defined in Data.HList.Variant

Methods

hUnzip :: Variant (txy ': (xy2 ': xys)) -> (Variant (tx ': (x2 ': xs)), Variant (ty ': (y2 ': ys))) Source #

(Bounded x, Bounded z, HRevAppR (Tagged s x ': xs) ('[] :: [Type]) ~ (Tagged t z ': sx), MkVariant t z (Tagged s x ': xs)) => Bounded (Variant (Tagged s x ': xs)) Source # 
Instance details

Defined in Data.HList.Variant

Methods

minBound :: Variant (Tagged s x ': xs) #

maxBound :: Variant (Tagged s x ': xs) #

Enum x => Enum (Variant '[Tagged s x]) Source #

While the instances could be written Enum (Variant '[]) Eq/Ord which cannot produce values, so they have instances for empty variants (unsafeEmptyVariant). Enum can produce values, so it is better that fromEnum 0 :: Variant '[] fails with No instance for Enum (Variant '[]) than producing an invalid variant.

Instance details

Defined in Data.HList.Variant

Methods

succ :: Variant '[Tagged s x] -> Variant '[Tagged s x] #

pred :: Variant '[Tagged s x] -> Variant '[Tagged s x] #

toEnum :: Int -> Variant '[Tagged s x] #

fromEnum :: Variant '[Tagged s x] -> Int #

enumFrom :: Variant '[Tagged s x] -> [Variant '[Tagged s x]] #

enumFromThen :: Variant '[Tagged s x] -> Variant '[Tagged s x] -> [Variant '[Tagged s x]] #

enumFromTo :: Variant '[Tagged s x] -> Variant '[Tagged s x] -> [Variant '[Tagged s x]] #

enumFromThenTo :: Variant '[Tagged s x] -> Variant '[Tagged s x] -> Variant '[Tagged s x] -> [Variant '[Tagged s x]] #

(Enum x, Bounded x, Enum (Variant (y ': z))) => Enum (Variant (Tagged s x ': (y ': z))) Source #
>>> let t = minBound :: Variant '[Tagged "x" Bool, Tagged "y" Bool]
>>> [t .. maxBound]
[V{x=False},V{x=True},V{y=False},V{y=True}]
Odd behavior
There are some arguments that this instance should not exist.

The last type in the Variant does not need to be Bounded. This means that enumFrom behaves a bit unexpectedly:

>>> [False .. ]
[False,True]
>>> [t .. ]
[V{x=False},V{x=True},V{y=False},V{y=True},V{y=*** Exception: Prelude.Enum.Bool.toEnum: bad argument

This is a "feature" because it allows an Enum (Variant '[Tagged "a" Bool, Tagged "n" Integer])

Another difficult choice is that the lower bound is fromEnum 0 rather than minBound:

>>> take 5 [ minBound :: Variant '[Tagged "b" Bool, Tagged "i" Int] .. ]
[V{b=False},V{b=True},V{i=0},V{i=1},V{i=2}]
Instance details

Defined in Data.HList.Variant

Methods

succ :: Variant (Tagged s x ': (y ': z)) -> Variant (Tagged s x ': (y ': z)) #

pred :: Variant (Tagged s x ': (y ': z)) -> Variant (Tagged s x ': (y ': z)) #

toEnum :: Int -> Variant (Tagged s x ': (y ': z)) #

fromEnum :: Variant (Tagged s x ': (y ': z)) -> Int #

enumFrom :: Variant (Tagged s x ': (y ': z)) -> [Variant (Tagged s x ': (y ': z))] #

enumFromThen :: Variant (Tagged s x ': (y ': z)) -> Variant (Tagged s x ': (y ': z)) -> [Variant (Tagged s x ': (y ': z))] #

enumFromTo :: Variant (Tagged s x ': (y ': z)) -> Variant (Tagged s x ': (y ': z)) -> [Variant (Tagged s x ': (y ': z))] #

enumFromThenTo :: Variant (Tagged s x ': (y ': z)) -> Variant (Tagged s x ': (y ': z)) -> Variant (Tagged s x ': (y ': z)) -> [Variant (Tagged s x ': (y ': z))] #

(Eq (Variant xs), Eq x) => Eq (Variant (x ': xs)) Source # 
Instance details

Defined in Data.HList.Variant

Methods

(==) :: Variant (x ': xs) -> Variant (x ': xs) -> Bool #

(/=) :: Variant (x ': xs) -> Variant (x ': xs) -> Bool #

Eq (Variant ('[] :: [Type])) Source # 
Instance details

Defined in Data.HList.Variant

Methods

(==) :: Variant '[] -> Variant '[] -> Bool #

(/=) :: Variant '[] -> Variant '[] -> Bool #

(Typeable (Variant v), GfoldlVariant v v, GunfoldVariant v v, VariantConstrs v) => Data (Variant v) Source # 
Instance details

Defined in Data.HList.Variant

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Variant v -> c (Variant v) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Variant v) #

toConstr :: Variant v -> Constr #

dataTypeOf :: Variant v -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Variant v)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Variant v)) #

gmapT :: (forall b. Data b => b -> b) -> Variant v -> Variant v #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Variant v -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Variant v -> r #

gmapQ :: (forall d. Data d => d -> u) -> Variant v -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Variant v -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Variant v -> m (Variant v) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Variant v -> m (Variant v) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Variant v -> m (Variant v) #

(Ord x, Ord (Variant xs)) => Ord (Variant (x ': xs)) Source # 
Instance details

Defined in Data.HList.Variant

Methods

compare :: Variant (x ': xs) -> Variant (x ': xs) -> Ordering #

(<) :: Variant (x ': xs) -> Variant (x ': xs) -> Bool #

(<=) :: Variant (x ': xs) -> Variant (x ': xs) -> Bool #

(>) :: Variant (x ': xs) -> Variant (x ': xs) -> Bool #

(>=) :: Variant (x ': xs) -> Variant (x ': xs) -> Bool #

max :: Variant (x ': xs) -> Variant (x ': xs) -> Variant (x ': xs) #

min :: Variant (x ': xs) -> Variant (x ': xs) -> Variant (x ': xs) #

Ord (Variant ('[] :: [Type])) Source # 
Instance details

Defined in Data.HList.Variant

Methods

compare :: Variant '[] -> Variant '[] -> Ordering #

(<) :: Variant '[] -> Variant '[] -> Bool #

(<=) :: Variant '[] -> Variant '[] -> Bool #

(>) :: Variant '[] -> Variant '[] -> Bool #

(>=) :: Variant '[] -> Variant '[] -> Bool #

max :: Variant '[] -> Variant '[] -> Variant '[] #

min :: Variant '[] -> Variant '[] -> Variant '[] #

ReadVariant v => Read (Variant v) Source #

A corresponding read instance

Instance details

Defined in Data.HList.Variant

ShowVariant vs => Show (Variant vs) Source #

Variants are not opaque

Instance details

Defined in Data.HList.Variant

Methods

showsPrec :: Int -> Variant vs -> ShowS #

show :: Variant vs -> String #

showList :: [Variant vs] -> ShowS #

(Semigroup x, Semigroup (Variant (a ': b))) => Semigroup (Variant (Tagged t x ': (a ': b))) Source # 
Instance details

Defined in Data.HList.Variant

Methods

(<>) :: Variant (Tagged t x ': (a ': b)) -> Variant (Tagged t x ': (a ': b)) -> Variant (Tagged t x ': (a ': b)) #

sconcat :: NonEmpty (Variant (Tagged t x ': (a ': b))) -> Variant (Tagged t x ': (a ': b)) #

stimes :: Integral b0 => b0 -> Variant (Tagged t x ': (a ': b)) -> Variant (Tagged t x ': (a ': b)) #

(Unvariant '[Tagged t x] x, Semigroup x) => Semigroup (Variant '[Tagged t x]) Source # 
Instance details

Defined in Data.HList.Variant

Methods

(<>) :: Variant '[Tagged t x] -> Variant '[Tagged t x] -> Variant '[Tagged t x] #

sconcat :: NonEmpty (Variant '[Tagged t x]) -> Variant '[Tagged t x] #

stimes :: Integral b => b -> Variant '[Tagged t x] -> Variant '[Tagged t x] #

(Monoid x, Monoid (Variant (a ': b))) => Monoid (Variant (Tagged t x ': (a ': b))) Source # 
Instance details

Defined in Data.HList.Variant

Methods

mempty :: Variant (Tagged t x ': (a ': b)) #

mappend :: Variant (Tagged t x ': (a ': b)) -> Variant (Tagged t x ': (a ': b)) -> Variant (Tagged t x ': (a ': b)) #

mconcat :: [Variant (Tagged t x ': (a ': b))] -> Variant (Tagged t x ': (a ': b)) #

(Unvariant '[Tagged t x] x, Monoid x) => Monoid (Variant '[Tagged t x]) Source # 
Instance details

Defined in Data.HList.Variant

Methods

mempty :: Variant '[Tagged t x] #

mappend :: Variant '[Tagged t x] -> Variant '[Tagged t x] -> Variant '[Tagged t x] #

mconcat :: [Variant '[Tagged t x]] -> Variant '[Tagged t x] #

(SameLength s a, ExtendsVariant s a, SameLength b t, ExtendsVariant b t) => Rearranged Variant (s :: [Type]) (t :: [Type]) (a :: [Type]) (b :: [Type]) Source # 
Instance details

Defined in Data.HList.Variant

Methods

rearranged :: (Profunctor p, Functor f) => p (Variant a) (f (Variant b)) -> p (Variant s) (f (Variant t)) Source #

type LabelableTy Variant Source # 
Instance details

Defined in Data.HList.Labelable

type HExtendR le (Variant v) Source # 
Instance details

Defined in Data.HList.Variant

type HExtendR le (Variant v) = Variant (UnMaybe le ': v)

mkVariant Source #

Arguments

:: MkVariant x v vs 
=> Label x

the tag

-> v

value to be stored

-> proxy vs

a helper to fix the ordering and types of the potential values that this variant contains. Typically this will be a Proxy, Record or another Variant

-> Variant vs 

mkVariant1 :: forall k (l :: k) e. Label l -> e -> Variant '[Tagged l e] Source #

castVariant :: (RecordValuesR v ~ RecordValuesR v', SameLength v v') => Variant v -> Variant v' Source #

in ghc>=7.8, coerce is probably a better choice

newtype HMapV f Source #

Apply a function to all possible elements of the variant

Constructors

HMapV f 

Instances

Instances details
(vx ~ Variant x, vy ~ Variant y, HMapAux Variant (HFmap f) x y, SameLength x y) => ApplyAB (HMapV f) vx vy Source #

apply a function to all values that could be in the variant.

Instance details

Defined in Data.HList.Variant

Methods

applyAB :: HMapV f -> vx -> vy Source #

hMapV :: forall f (x :: [Type]) (y :: [Type]). (HMapAux Variant (HFmap f) x y, SameLength' x y, SameLength' y x) => f -> Variant x -> Variant y Source #

shortcut for applyAB . HMapV. hMap is more general

hMapOutV :: forall x y z f. (SameLength x y, HMapAux Variant (HFmap f) x y, Unvariant y z, HMapOutV_gety x z ~ y) => f -> Variant x -> z Source #

hMapOutV f = unvariant . hMapV f, except an ambiguous type variable is resolved by HMapOutV_gety

class ZipVariant x y xy | x y -> xy, xy -> x y where Source #

Applies to variants that have the same labels in the same order. A generalization of

zipEither :: Either a b -> Either a b -> Maybe (Either (a,a) (b,b))
zipEither (Left a) (Left a') = Just (Left (a,a'))
zipEither (Right a) (Right a') = Just (Right (a,a'))
zipEither _ _ = Nothing

see HZip for zipping other collections

Methods

zipVariant :: Variant x -> Variant y -> Maybe (Variant xy) Source #

Instances

Instances details
ZipVariant ('[] :: [Type]) ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.Variant

Methods

zipVariant :: Variant '[] -> Variant '[] -> Maybe (Variant '[]) Source #

(tx ~ Tagged t x, ty ~ Tagged t y, txy ~ Tagged t (x, y), ZipVariant xs ys zs, MkVariant t (x, y) (txy ': zs)) => ZipVariant (tx ': xs) (ty ': ys) (txy ': zs) Source # 
Instance details

Defined in Data.HList.Variant

Methods

zipVariant :: Variant (tx ': xs) -> Variant (ty ': ys) -> Maybe (Variant (txy ': zs)) Source #

class (SameLength v v', SameLabels v v') => ZipVR fs v v' | fs v -> v' where Source #

Apply a record of functions to a variant of values. The functions are selected based on those having the same label as the value.

Methods

zipVR_ :: Record fs -> Variant v -> Variant v' Source #

zipVR is probably a better choice in most situations, since it requires that fs has one function for every element of v

Instances

Instances details
ZipVR fs ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.Variant

Methods

zipVR_ :: Record fs -> Variant '[] -> Variant '[] Source #

(lv ~ Tagged l v, lv' ~ Tagged l v', HMemberM (Label l) (LabelsOf fs) b, HasFieldM l (Record fs) f, DemoteMaybe (v -> v) f ~ (v -> v'), MkVariant l v' (lv' ': rs), ZipVR fs vs rs) => ZipVR fs (lv ': vs) (lv' ': rs) Source # 
Instance details

Defined in Data.HList.Variant

Methods

zipVR_ :: Record fs -> Variant (lv ': vs) -> Variant (lv' ': rs) Source #

zipVR :: (SameLabels fs v, SameLength fs v, ZipVR fs v v', ZipVRCxt fs v v') => Record fs -> Variant v -> Variant v' Source #

>>> let xy = x .*. y .*. emptyProxy
>>> let p = Proxy `asLabelsOf` xy
>>> let vs = [ mkVariant x 1.0 p, mkVariant y () p ]
>>> zipVR (hBuild (+1) id) `map` vs
[V{x=2.0},V{y=()}]

projection

many

class (ProjectVariant x yin, ProjectVariant x yout) => SplitVariant x yin yout where Source #

Methods

splitVariant :: Variant x -> Either (Variant yin) (Variant yout) Source #

Instances

Instances details
(ProjectVariant x yin, ProjectVariant x yout, H2ProjectByLabels (LabelsOf yin) x xi xo, HRearrange (LabelsOf yin) xi yin, HRearrange (LabelsOf yout) xo yout, HLeftUnion xi xo xixo, HRearrange (LabelsOf x) xixo x, HAllTaggedLV x, HAllTaggedLV yin, HAllTaggedLV yout) => SplitVariant x yin yout Source # 
Instance details

Defined in Data.HList.Variant

Methods

splitVariant :: Variant x -> Either (Variant yin) (Variant yout) Source #

class ProjectVariant x y where Source #

convert a variant with more fields into one with fewer (or the same) fields.

>>> let ty = Proxy :: Proxy [Tagged "left" Int, Tagged "right" Int]
>>> let l = mkVariant _left 1 ty
>>> let r = mkVariant _right 2 ty
>>> map projectVariant [l, r] :: [Maybe (Variant '[Tagged "left" Int])]
[Just V{left=1},Nothing]

rearrangeVariant = fromJust . projectVariant is one implementation of rearrangeVariant, since the result can have the same fields with a different order:

>>> let yt = Proxy :: Proxy [Tagged "right" Int, Tagged "left" Int]
>>> map projectVariant [l, r] `asTypeOf` [Just (mkVariant _left 0 yt)]
[Just V{left=1},Just V{right=2}]

Instances

Instances details
ProjectVariant x ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.Variant

(ProjectVariant x ys, HasField t (Variant x) (Maybe y), HOccursNot (Label t) (LabelsOf ys), ty ~ Tagged t y) => ProjectVariant x (ty ': ys) Source # 
Instance details

Defined in Data.HList.Variant

Methods

projectVariant :: Variant x -> Maybe (Variant (ty ': ys)) Source #

class (HAllTaggedLV y, HAllTaggedLV x) => ExtendsVariant x y where Source #

projectVariant . extendsVariant = Just (when the types match up)

extendVariant is a special case

Instances

Instances details
(HAllTaggedLV x, Unvariant '[le] e, MkVariant l e x, le ~ Tagged l e) => ExtendsVariant '[le] x Source # 
Instance details

Defined in Data.HList.Variant

Methods

extendsVariant :: Variant '[le] -> Variant x Source #

(MkVariant l e y, le ~ Tagged l e, ExtendsVariant (b ': bs) y) => ExtendsVariant (le ': (b ': bs)) y Source # 
Instance details

Defined in Data.HList.Variant

Methods

extendsVariant :: Variant (le ': (b ': bs)) -> Variant y Source #

class HAllTaggedLV y => ProjectExtendVariant x y where Source #

projectExtendVariant = fmap extendVariant . projectVariant

where intermediate variant is as large as possible. Used to implement Data.HList.Labelable.projected

Note that:

>>> let r = projectExtendVariant (mkVariant1 Label 1 :: Variant '[Tagged "x" Int])
>>> r :: Maybe (Variant '[Tagged "x" Integer])
Nothing

Instances

Instances details
HAllTaggedLV y => ProjectExtendVariant ('[] :: [Type]) y Source # 
Instance details

Defined in Data.HList.Variant

(lv ~ Tagged l v, HMemberM lv y inY, ProjectExtendVariant' inY lv y, ProjectExtendVariant xs y) => ProjectExtendVariant (lv ': xs) y Source # 
Instance details

Defined in Data.HList.Variant

Methods

projectExtendVariant :: Variant (lv ': xs) -> Maybe (Variant y) Source #

one

class (SameLength s t, SameLabels s t) => HPrism x s t a b | x s -> a, x t -> b, x s b -> t, x t a -> s where Source #

Make a Prism (Variant s) (Variant t) a b out of a Label.

See Data.HList.Labelable.hLens' is a more overloaded version.

Few type annotations are necessary because of the restriction that s and t have the same labels in the same order, and to get "t" the "a" in "s" is replaced with "b".

Methods

hPrism :: (Choice p, Applicative f) => Label x -> p a (f b) -> p (Variant s) (f (Variant t)) Source #

Instances

Instances details
(MkVariant x b t, HasField x (Variant s) (Maybe a), SameLength s t, SameLabels s t, H2ProjectByLabels '[Label x] s si so, H2ProjectByLabels '[Label x] t ti to, so ~ to, HUpdateAtLabel Variant x b s t, HUpdateAtLabel Variant x a t s) => HPrism (x :: k) s t a b Source # 
Instance details

Defined in Data.HList.Variant

Methods

hPrism :: (Choice p, Applicative f) => Label x -> p a (f b) -> p (Variant s) (f (Variant t)) Source #

unvarianted :: (Unvariant' s a, Unvariant' t b, SameLabels s t, SameLength s t, Functor f) => (a -> f b) -> Variant s -> f (Variant t) Source #

Lens (Variant s) (Variant t) a b

Analogue of Control.Lens.chosen :: Lens (Either a a) (Either b b) a b

unvarianted' :: forall (b :: Bool) (t :: [Type]) a f. (Unvariant1 b t a, HAllEqVal' (Tagged () a ': t), HAllEqVal t b, HAllEqVal (Tagged () a ': t) b, SameLabels t t, SameLength' t t, Functor f) => (a -> f a) -> Variant t -> f (Variant t) Source #

Lens' (Variant s) a

where we might have s ~ '[Tagged t1 a, Tagged t2 a]

splitVariant1 :: Variant (Tagged s x ': xs) -> Either x (Variant xs) Source #

splitVariant1' :: Variant (x ': xs) -> Either x (Variant xs) Source #

x ~ Tagged s t

implementation

class Unvariant v e | v -> e where Source #

Convert a Variant which has all possibilities having the same type into a value of that type. Analogous to either id id.

See also unvariant'

Methods

unvariant :: Variant v -> e Source #

Instances

Instances details
(Unvariant1 b v e, HAllEqVal v b, HAllEqVal (Tagged () e ': v) b) => Unvariant v e Source # 
Instance details

Defined in Data.HList.Variant

Methods

unvariant :: Variant v -> e Source #

class Unvariant' v e | v -> e where Source #

Similar to unvariant, except type variables in v will be made equal to e if possible. That allows the type of Nothing to be inferred as Maybe Char.

>>> unvariant' $ x .=. Nothing .*. mkVariant1 y 'y'
'y'

However, this difference leads to more local error messages (Couldn't match type ‘()’ with ‘Char’), rather than the following with unvariant:

Fail
   '("Variant",
     '[Tagged "left" Char, Tagged "right" ()],
     "must have all values equal to ",
     e))

Methods

unvariant' :: Variant v -> e Source #

Instances

Instances details
(HAllEqVal' (Tagged () e ': v), Unvariant v e) => Unvariant' v e Source # 
Instance details

Defined in Data.HList.Variant

Methods

unvariant' :: Variant v -> e Source #

Conversions between collections

class TypeIndexed r tr | r -> tr, tr -> r where Source #

Conversion between type indexed collections (TIC and TIP) and the corresponding collection that has other label types (Variant and Record respectively)

See typeIndexed'

Methods

typeIndexed :: forall p f s t a b. (TypeIndexedCxt s t a b, Profunctor p, Functor f) => p (tr (TagR a)) (f (tr (TagR b))) -> p (r s) (f (r t)) Source #

Iso (r s) (r t) (tr a) (tr b)

Instances

Instances details
TypeIndexed Record TIP Source # 
Instance details

Defined in Data.HList.TIC

Methods

typeIndexed :: forall p f (s :: [Type]) (t :: [Type]) (a :: [Type]) (b :: [Type]). (TypeIndexedCxt s t a b, Profunctor p, Functor f) => p (TIP (TagR a)) (f (TIP (TagR b))) -> p (Record s) (f (Record t)) Source #

TypeIndexed Variant TIC Source # 
Instance details

Defined in Data.HList.TIC

Methods

typeIndexed :: forall p f (s :: [Type]) (t :: [Type]) (a :: [Type]) (b :: [Type]). (TypeIndexedCxt s t a b, Profunctor p, Functor f) => p (TIC (TagR a)) (f (TIC (TagR b))) -> p (Variant s) (f (Variant t)) Source #

typeIndexed' :: forall r tr (t :: [Type]) p f. (TypeIndexed r tr, HMapAux HList TaggedFn (RecordValuesR t) t, RecordValues t, SameLabels t t, HAllTaggedLV t, HLabelSet (LabelsOf t), TagUntagFD (RecordValuesR t) (TagR (RecordValuesR t)), Profunctor p, Functor f, SameLength' t t, SameLength' (RecordValuesR t) (RecordValuesR t), Coercible (TagR (RecordValuesR t)) t) => p (tr (TagR (RecordValuesR t))) (f (tr (TagR (RecordValuesR t)))) -> p (r t) (f (r t)) Source #

Iso' (Variant s) (TIC a)
Iso' (Record s) (TIP a)

where s has a type like '[Tagged "x" Int], and a has a type like '[Tagged Int Int].

HList and Record

HList and TIP

tipHList :: forall p f (a1 :: [Type]) (ta :: [Type]) (a2 :: [Type]) (l :: [Type]). (Profunctor p, Functor f, TagUntagFD a1 ta, TagUntagFD a2 l) => p (HList a1) (f (HList a2)) -> p (TIP ta) (f (TIP l)) Source #

Iso (TIP (TagR a)) (TIP (TagR b)) (HList a) (HList b)

tipHList' :: forall p f (a :: [Type]) (l :: [Type]). (Profunctor p, Functor f, TagUntagFD a l) => p (HList a) (f (HList a)) -> p (TIP l) (f (TIP l)) Source #

Iso' (TIP (TagR s)) (HList a)

Record and RecordU

unboxed :: forall x y f p. (Profunctor p, Functor f, RecordToRecordU x, RecordUToRecord y) => (RecordU x `p` f (RecordU y)) -> Record x `p` f (Record y) Source #

Iso (Record x) (Record y) (RecordU x) (RecordU y)

unboxed' :: forall p f (y :: [Type]) (n :: HNat). (Profunctor p, Functor f, RecordValues y, HList2List (RecordValuesR y) (GetElemTy y), KnownNat (HNat2Nat n), HLengthEq1 y n, HLengthEq2 y n, IArray UArray (GetElemTy y), SameLength' (HReplicateR n ()) y, HMapAux HList TaggedFn (RecordValuesR y) y) => p (RecordU y) (f (RecordU y)) -> p (Record y) (f (Record y)) Source #

Iso' (Record x) (RecordU x)

Record and RecordUS

unboxedS :: forall (g1 :: [Type]) (u1 :: [Type]) (g2 :: [Type]) (u2 :: [Type]) (x1 :: [Type]) (x2 :: [Type]) p f. (HMapUnboxF g1 u1, HMapUnboxF g2 u2, HGroupBy EqTagValue x1 g1, HGroupBy EqTagValue x2 g2, Profunctor p, Functor f, HConcatFD g1 x1, SameLength' u2 g2, SameLength' g2 u2, SameLength' u1 g1, SameLength' g1 u1, HMapAux HList UnboxF g2 u2, HMapAux HList BoxF u1 g1) => p (RecordUS x2) (f (RecordUS x1)) -> p (Record x2) (f (Record x1)) Source #

Iso (Record x) (Record y) (RecordUS x) (RecordUS y)

unboxedS' :: forall (g :: [Type]) (u :: [Type]) (x :: [Type]) p f. (HMapUnboxF g u, HGroupBy EqTagValue x g, Profunctor p, Functor f, HConcatFD g x, SameLength' u g, SameLength' g u, HMapAux HList UnboxF g u, HMapAux HList BoxF u g) => p (RecordUS x) (f (RecordUS x)) -> p (Record x) (f (Record x)) Source #

Iso' (Record x) (RecordUS x)

Record and Variant

hMaybied :: forall (x :: [Type]) (v1 :: [Type]) (v2 :: [Type]) (r :: [Type]) p f. (HFoldr HMaybiedToVariantFs [Variant ('[] :: [Type])] x [Variant v1], VariantToHMaybied v2 r, VariantToHMaybied v1 x, SameLength' x r, SameLength' r x, HMapAux HList (HFmap HCastF) x r, Choice p, Applicative f) => p (Variant v1) (f (Variant v2)) -> p (Record x) (f (Record r)) Source #

Prism (Record tma) (Record tmb) (Variant ta) (Variant tb)

see hMaybied'

hMaybied' :: forall (x :: [Type]) (v :: [Type]) p f. (HFoldr HMaybiedToVariantFs [Variant ('[] :: [Type])] x [Variant v], VariantToHMaybied v x, SameLength' x x, HMapAux HList (HFmap HCastF) x x, Choice p, Applicative f) => p (Variant v) (f (Variant v)) -> p (Record x) (f (Record x)) Source #

Prism' (Record tma) (Variant ta)

where tma and tmb are lists like

tma ~ '[Tagged x (Maybe a), Tagged y (Maybe b)]
ta  ~ '[Tagged x        a , Tagged y        b ]

If one element of the record is Just, the Variant will contain that element. Otherwise, the prism fails.

Note

The types work out to define a prism:

l = prism' variantToHMaybied (listToMaybe . hMaybiedToVariants)

but the law: s^?l ≡ Just a ==> l # a ≡ s is not followed, because we could have:

  s, s2 :: Record '[Tagged "x" (Maybe Int), Tagged "y" (Maybe Char)]
  s = hBuild (Just 1) (Just '2')
  s2 = hBuild (Just 1) Nothing

  v :: Variant '[Tagged "x" Int, Tagged "y" Char]
  v = mkVariant (Label :: Label "x") 1 Proxy

So that s^?l == Just v. But l#v == s2 /= s, while the law requires l#v == s. hMaybied avoids this problem by only producing a value when there is only one present.

Newtype wrappers

ticVariant :: forall p f (l1 :: [Type]) (l2 :: [Type]). (Profunctor p, Functor f) => p (Variant l1) (f (Variant l2)) -> p (TIC l1) (f (TIC l2)) Source #

Iso (TIC s) (TIC t) (Variant s) (Variant t)

typeIndexed may be more appropriate

ticVariant' :: forall p f (l :: [Type]). (Profunctor p, Functor f) => p (Variant l) (f (Variant l)) -> p (TIC l) (f (TIC l)) Source #

Iso' (TIC s) (Variant s)

tipRecord :: forall p f (r :: [Type]) (l :: [Type]). (Profunctor p, Functor f) => p (Record r) (f (Record l)) -> p (TIP r) (f (TIP l)) Source #

Iso (TIP s) (TIP t) (Record s) (Record t)

typeIndexed may be more appropriate

tipRecord' :: forall p f (l :: [Type]). (Profunctor p, Functor f) => p (Record l) (f (Record l)) -> p (TIP l) (f (TIP l)) Source #

Iso' (TIP (TagR s)) (Record a)

implementation

class VariantToHMaybied v r | v -> r, r -> v where Source #

Instances

Instances details
VariantToHMaybied ('[] :: [Type]) ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.Variant

Methods

variantToHMaybied :: Variant '[] -> Record '[] Source #

(VariantToHMaybied v r, HReplicateF nr ConstTaggedNothing () r, tx ~ Tagged t x, tmx ~ Tagged t (Maybe x)) => VariantToHMaybied (tx ': v) (tmx ': r) Source # 
Instance details

Defined in Data.HList.Variant

Methods

variantToHMaybied :: Variant (tx ': v) -> Record (tmx ': r) Source #

data HMaybiedToVariantFs Source #

Instances

Instances details
(x ~ (Tagged t (Maybe e), [Variant v]), y ~ [Variant (Tagged t e ': v)], MkVariant t e (Tagged t e ': v)) => ApplyAB HMaybiedToVariantFs x y Source # 
Instance details

Defined in Data.HList.Variant

Methods

applyAB :: HMaybiedToVariantFs -> x -> y Source #

hMaybiedToVariants :: (HFoldr HMaybiedToVariantFs [Variant '[]] r [Variant v], VariantToHMaybied v r) => Record r -> [Variant v] Source #

Every element of the record that is Just becomes one element in the resulting list. See hMaybied' example types that r and v can take.

Data.HList.Keyword

the "public" parts. More examples are in the module documentation.

class Kw (fn :: *) (arg_def :: [*]) r where Source #

kw takes a HList whose first element is a function, and the rest of the elements are default values. A useful trick is to have a final argument () which is not eaten up by a label (A only takes 1 argument). That way when you supply the () it knows there are no more arguments (?).

>>> data A = A
>>> instance IsKeyFN (A -> a -> b) True
>>> let f A a () = a + 1
>>> let f' = f .*. A .*. 1 .*. HNil
>>> kw f' A 0 ()
1
>>> kw f' ()
2

Methods

kw :: HList (fn ': arg_def) -> r Source #

Instances

Instances details
(KW' rflag fn akws arg_def r, akws ~ Arg kws ('[] :: [Type]), ReflectFK' flag fn kws, IsKeyFN r rflag, IsKeyFN fn flag) => Kw fn arg_def r Source # 
Instance details

Defined in Data.HList.Keyword

Methods

kw :: HList (fn ': arg_def) -> r Source #

recToKW :: forall a b. (HMapCxt HList TaggedToKW a b, HConcat b) => Record a -> HList (HConcatR b) Source #

convert a Record into a list that can supply default arguments for kw

A bit of setup:

>>> :set -XQuasiQuotes
>>> import Data.HList.RecordPuns
>>> let f (_ :: Label "a") a (_ :: Label "b") b () = a `div` b
>>> let a = 2; b = 1; f' = f .*. recToKW [pun| a b |]
>>> kw f' ()
2
>>> kw f' (Label :: Label "a") 10 ()
10

class IsKeyFN (t :: *) (flag :: Bool) | t -> flag Source #

All our keywords must be registered

Instances

Instances details
'False ~ flag => IsKeyFN t flag Source #

overlapping/fallback case

Instance details

Defined in Data.HList.TypeEqO

IsKeyFN (Label s -> a -> b) 'True Source #

labels that impose no restriction on the type of the (single) argument which follows

>>> let testF (_ :: Label "a") (a :: Int) () = a+1
>>> kw (hBuild testF) (Label :: Label "a") 5 ()
6
Instance details

Defined in Data.HList.Keyword

r ~ (c -> b) => IsKeyFN (K s c -> r) 'True Source #

The purpose of this instance is to be able to use the same Symbol (type-level string) at different types. If they are supposed to be the same, then use Label instead of K

>>> let kA = K :: forall t. K "a" t
>>> let testF (K :: K "a" Int) a1 (K :: K "a" Integer) a2 () = a1-fromIntegral a2

therefore the following options works:

>>> kw (hBuild testF) kA (5 :: Int) kA (3 :: Integer) ()
2
>>> kw (hBuild testF) (K :: K "a" Integer) 3 (K :: K "a" Int) 5 ()
2

But you cannot leave off all Int or Integer annotations.

Instance details

Defined in Data.HList.Keyword

data K s (c :: *) Source #

Instances

Instances details
r ~ (c -> b) => IsKeyFN (K s c -> r) 'True Source #

The purpose of this instance is to be able to use the same Symbol (type-level string) at different types. If they are supposed to be the same, then use Label instead of K

>>> let kA = K :: forall t. K "a" t
>>> let testF (K :: K "a" Int) a1 (K :: K "a" Integer) a2 () = a1-fromIntegral a2

therefore the following options works:

>>> kw (hBuild testF) kA (5 :: Int) kA (3 :: Integer) ()
2
>>> kw (hBuild testF) (K :: K "a" Integer) 3 (K :: K "a" Int) 5 ()
2

But you cannot leave off all Int or Integer annotations.

Instance details

Defined in Data.HList.Keyword

Labels

By labels, we mean either the first argument to Tagged (in the type-level lists that are supplied to Record, RecordU, TIP, TIC), or the expressions used to specify those types to be able to look up the correct value in those collections.

Nearly all types can be labels. For example:

    r :: Record '[Tagged "x" Int,   -- kind GHC.TypeLits.Symbol 
                  Tagged () (),    -- see Data.HList.Label5
                  Tagged (Lbl HZero LabelUniverse LabelMember1) () -- Label3
                 ]
    r = hBuild 8 () () -- don't need to use .=. / .==. and .*.
                          -- if we have a type signature above
  

we could define these variables

   xLabel = Label :: Label "x" -- makeLabels6 ["x"] would define x with the same RHS
   xLens  = hLens' xLabel        -- makeLabelable "x" would define x with the same RHS
  

to access the 8 given above:

   r .!. xLabel
   r  ^.   xLens   -- alternatively Control.Lens.view
   r  ^. `x        -- with HListPP is used (not in ghci),
                   -- which avoids the issue of conflicting
                   -- definitions of x, which mean the same
                   -- thing
  

Instances from Data.HList.Label6

>>> :set -XDataKinds
>>> (Label :: Label "x") .=. (5::Int) .*. emptyRecord
Record{x=5}
>>> let x = Label :: Label "x"
>>> let r = x .=. (5::Int) .*. emptyRecord
>>> r .!. x
5

class Projected r s t a b where Source #

Sometimes it may be more convenient to operate on a record/variant that only contains the fields of interest. projected can then be used to apply that function to a record that contains additional elements.

>>> :set -XViewPatterns
>>> import Data.HList.RecordPuns
>>> let f [pun| (x y) |] = case x+y of z -> [pun| z |]
>>> :t f
f :: Num v =>
     Record '[Tagged "x" v, Tagged "y" v] -> Record '[Tagged "z" v]
>>> let r = (let x = 1; y = 2; z = () in [pun| x y z |])
>>> r
Record{x=1,y=2,z=()}
>>> r & sameLabels . projected %~ f
Record{x=1,y=2,z=3}

Methods

projected :: (ty ~ LabelableTy r, LabeledOpticP ty p, LabeledOpticF ty f) => (r a `p` f (r b)) -> r s `p` f (r t) Source #

Instances

Instances details
(H2ProjectByLabels (LabelsOf a) s a_ _s_minus_a, HRLabelSet a_, HRLabelSet a, HRearrange (LabelsOf a) a_ a, HLeftUnion b s bs, HRLabelSet bs, HRearrange (LabelsOf t) bs t, HRLabelSet t) => Projected Record s t a b Source #
Lens rs rt ra rb

where rs ~ Record s, rt ~ Record t, ra ~ Record a, rb ~ Record b

Instance details

Defined in Data.HList.Labelable

Methods

projected :: forall (ty :: LabeledOpticType) p f. (ty ~ LabelableTy Record, LabeledOpticP ty p, LabeledOpticF ty f) => p (Record a) (f (Record b)) -> p (Record s) (f (Record t)) Source #

(ExtendsVariant b t, ProjectVariant s a, ProjectExtendVariant s t, HLeftUnion b s bs, HRLabelSet bs, HRearrange (LabelsOf t) bs t) => Projected Variant s t a b Source #
Prism (Variant s) (Variant t) (Variant a) (Variant b)
Instance details

Defined in Data.HList.Labelable

Methods

projected :: forall (ty :: LabeledOpticType) p f. (ty ~ LabelableTy Variant, LabeledOpticP ty p, LabeledOpticF ty f) => p (Variant a) (f (Variant b)) -> p (Variant s) (f (Variant t)) Source #

toLabel :: EnsureLabel x y => x -> y Source #

class SameLength s t => Labelable (x :: k) (r :: [*] -> *) s t a b | x s -> a, x t -> b, x s b -> t, x t a -> s where Source #

r
is Record, Variant. TIP and TIC also have instances, but generally tipyLens' and ticPrism' are more appropriate.
x
is the label for the field. It tends to have kind Symbol, but others are supported in principle.

Associated Types

type LabelableTy r :: LabeledOpticType Source #

Methods

hLens' :: Label x -> LabeledOptic x r s t a b Source #

Instances

Instances details
LabelableTIPCxt x s t a b => Labelable (x :: k) TIP s t a b Source #

make a Lens' (TIP s) a.

tipyLens provides a Lens (TIP s) (TIP t) a b, which tends to need too many type annotations to be practical

Instance details

Defined in Data.HList.Labelable

Associated Types

type LabelableTy TIP :: LabeledOpticType Source #

Methods

hLens' :: Label x -> LabeledOptic x TIP s t a b Source #

(TICPrism s t a b, Label x ~ Label a, a ~ b, s ~ t, SameLength s t) => Labelable (x :: k) TIC s t a b Source #
hLens' :: Label a -> Prism' (TIC s) a

note that a more general function ticPrism :: Prism (TIC s) (TIC t) a b, cannot have an instance of Labelable

Note: `x :: k` according to the instance head, but the instance body forces the kind variable to be * later on. IE. (k ~ *)

Instance details

Defined in Data.HList.Labelable

Associated Types

type LabelableTy TIC :: LabeledOpticType Source #

Methods

hLens' :: Label x -> LabeledOptic x TIC s t a b Source #

(HPrism x s t a b, to ~ ((->) :: Type -> Type -> Type)) => Labelable (x :: k) Variant s t a b Source #

make a Prism (Variant s) (Variant t) a b

Instance details

Defined in Data.HList.Labelable

Associated Types

type LabelableTy Variant :: LabeledOpticType Source #

Methods

hLens' :: Label x -> LabeledOptic x Variant s t a b Source #

HLens x Record s t a b => Labelable (x :: k) Record s t a b Source #

make a Lens (Record s) (Record t) a b

Instance details

Defined in Data.HList.Labelable

Associated Types

type LabelableTy Record :: LabeledOpticType Source #

Methods

hLens' :: Label x -> LabeledOptic x Record s t a b Source #

LabeledCxt1 s t a b => Labelable (x :: k) LabeledR s t a b Source #

used with toLabel and/or .==.

Instance details

Defined in Data.HList.Labelable

Associated Types

type LabelableTy LabeledR :: LabeledOpticType Source #

Methods

hLens' :: Label x -> LabeledOptic x LabeledR s t a b Source #

(s ~ t, a ~ b, IArray UArray a, a ~ GetElemTy s, HLensCxt x RecordU s t a b) => Labelable (x :: k) RecordU s t a b Source #

make a Lens' (RecordU s) a

Instance details

Defined in Data.HList.RecordU

Associated Types

type LabelableTy RecordU :: LabeledOpticType Source #

Methods

hLens' :: Label x -> LabeledOptic x RecordU s t a b Source #

type LabeledOptic (x :: k) (r :: [*] -> *) (s :: [*]) (t :: [*]) (a :: *) (b :: *) = forall ty to p f. (ty ~ LabelableTy r, LabeledOpticF ty f, LabeledOpticP ty p, LabeledOpticTo ty x to) => (a `p` f b) `to` (r s `p` f (r t)) Source #

This alias is the same as Control.Lens.Optic, except the (->) in Optic is a type parameter to in LabeledOptic.

Depending on the collection type (see instances of LabelableTy), the type variables to, p, f are constrained such that the resulting type is a Lens (r s) (r t) a b, Prism (r s) (r t) a b or a LabeledTo x _ _. The latter can be used to recover the label (x) when used as an argument to .==. or equivalently toLabel.

(.==.) :: forall k x (l :: k) v. EnsureLabel x (Label l) => x -> v -> Tagged l v infixr 4 Source #

modification of .=. which works with the labels from this module, and those from Data.HList.Label6. Note that this is not strictly a generalization of .=., since it does not work with labels like Data.HList.Label3 which have the wrong kind.

projected' :: forall r p f (t :: [Type]) (b :: [Type]). (LabeledOpticP (LabelableTy r) p, LabeledOpticF (LabelableTy r) f, Projected r t t b b) => p (r b) (f (r b)) -> p (r t) (f (r t)) Source #

Lens' (Record s) (Record a)
Prism' (Variant s) (Variant a)

Rather than having the x = Label :: Label "x", the labels generated by makeLabelable also double as lenses for Control.Lens. Here is an example of how much better that is:

>>> :set -XNoMonomorphismRestriction -XDataKinds -XPolyKinds
>>> import Control.Lens
>>> import Data.HList.Labelable
>>> let x = hLens' (Label :: Label "x")
>>> let y = hLens' (Label :: Label "y")

The Label6 method:

>>> let r = (Label :: Label "x") .=. "5" .*. emptyRecord

The Labelable way:

>>> let r2 = x .==. "5" .*. emptyRecord
>>> r ^. x
"5"
>>> r2 ^. x
"5"
>>> r & x .~ ()
Record{x=()}

When a field is missing, the error names that field:

>>> :t r^.y
...
...No instance for (Fail (FieldNotFound "y"))
...

Data.HList.Dredge

lenses

dredge :: forall k1 k2 (vs1 :: [Type]) (ns1 :: [[Type]]) (vs :: [Type]) (ns :: [[Type]]) (xs :: [Type]) p v (fb :: k1) r (rft :: k1) (l :: k2) (ns2 :: [[Type]]) x. (SameLength' vs1 ns1, SameLength' vs ns, SameLength' ns1 vs1, SameLength' ns vs, LabelablePath xs (p v fb) (p r rft), MapFieldTree (TryCollectionListTF r) ns, MapFieldTreeVal r (TryCollectionListTF r) vs, FilterLastEq (Label l) ns ns ns1, FilterLastEq (Label l) ns vs vs1, FilterVEq1 v vs1 ns1 ns2, HGuardNonNull (NamesDontMatch r ns l) ns1, HSingleton (NonUnique r v l) (TypesDontMatch r ns1 vs1 v) ns2 xs, EnsureLabel x (Label l)) => x -> p v fb -> p r rft Source #

Using HListPP syntax for short hand, dredge `foo expands out to something like `path . `to . `foo, with the restriction that there is only one possible `path . `to which leads to the label foo.

For example, if we have the following definitions,

type BVal a = Record '[Tagged "x" a, Tagged "a" Char]
type R a = Record  [Tagged "a" Int, Tagged "b" (BVal a)]
type V a = Variant [Tagged "a" Int, Tagged "b" (BVal a)]
lx = Label :: Label "x"

Then we have:

dredge `x :: Lens (R a) (R b) a b
dredge lx :: Lens (R a) (R b) a b
dredge `x :: Traversal (V a) (V b) a b -- there were only variants along the path we'd get a Prism
dredge lx :: Traversal (V a) (V b) a b
result-type directed operations are supported

There are two ways to access a field with tag a in the R type defined above, but they result in fields with different types being looked up:

`a        :: Lens' (R a) Char
`b . `a   :: Lens' (R a) Int

so provided that the result type is disambiguated by the context, the following two types can happen

dredge `a :: Lens' (R a) Char
dredge `a :: Lens' (R a) Int
TIP & TIC

type indexed collections are allowed along those paths, but as explained in the Labelable instances, only simple optics (Lens' Prism' Traversal' ) are produced. dredgeTI' works better if the target is a TIP or TIC

dredge' :: forall k2 k (vs1 :: [Type]) (ns1 :: [[Type]]) (vs :: [Type]) (ns :: [[Type]]) (xs :: [Type]) p a (f :: Type -> k2) s (l :: k) (ns2 :: [[Type]]) x. (SameLength' vs1 ns1, SameLength' vs ns, SameLength' ns1 vs1, SameLength' ns vs, LabelablePath xs (p a (f a)) (p s (f s)), MapFieldTree (TryCollectionListTF s) ns, MapFieldTreeVal s (TryCollectionListTF s) vs, FilterLastEq (Label l) ns ns ns1, FilterLastEq (Label l) ns vs vs1, FilterVEq1 a vs1 ns1 ns2, HGuardNonNull (NamesDontMatch s ns l) ns1, HSingleton (NonUnique s a l) (TypesDontMatch s ns1 vs1 a) ns2 xs, EnsureLabel x (Label l)) => x -> p a (f a) -> p s (f s) Source #

dredge except a simple (s ~ t, a ~ b) optic is produced

dredgeND :: forall k1 k2 (xs :: [Type]) p a (fb :: k1) r (rft :: k1) (ns :: [[Type]]) (l :: k2) (ns' :: [[Type]]) x. (LabelablePath xs (p a fb) (p r rft), MapFieldTree (TryCollectionListTF r) ns, FilterLastEq (Label l) ns ns ns', HSingleton (NonUnique' r l) (NamesDontMatch r ns l) ns' xs, EnsureLabel x (Label l)) => x -> p a fb -> p r rft Source #

dredgeND (named directed only) is the same as dredge, except the result type (a) is not used when the label would otherwise be ambiguous. dredgeND might give better type errors, but otherwise there should be no reason to pick it over dredge

dredgeND' :: forall k2 k (xs :: [Type]) p a (f :: Type -> k2) s (ns :: [[Type]]) (l :: k) (ns' :: [[Type]]) x. (LabelablePath xs (p a (f a)) (p s (f s)), MapFieldTree (TryCollectionListTF s) ns, FilterLastEq (Label l) ns ns ns', HSingleton (NonUnique' s l) (NamesDontMatch s ns l) ns' xs, EnsureLabel x (Label l)) => x -> p a (f a) -> p s (f s) Source #

dredgeND except a simple (s ~ t, a ~ b) optic is produced

dredgeTI' :: forall k2 (xs :: [Type]) p a (f :: Type -> k2) s (ns :: [[Type]]) (ns' :: [[Type]]) q. (LabelablePath xs (p a (f a)) (p s (f s)), MapFieldTree (TryCollectionListTF s) ns, FilterLastEq (Label a) ns ns ns', HSingleton (NonUnique' s a) (NamesDontMatch s ns a) ns' xs) => q a -> p a (f a) -> p s (f s) Source #

The same as dredgeND', except intended for TIP/TICs because the assumption is made that l ~ v for the Tagged l v elements. In other words, ticPrism' and tipyLens' could usually be replaced by

dredgeTI' :: _ => Label a -> Lens'  (TIP s) a
dredgeTI' :: _ => Label a -> Prism' (TIC s) a

where we might have s ~ '[Tagged a a, Tagged b b]

plain lookup

hLookupByLabelDredge :: forall k (ls :: [Type]) r1 r2 v (ns :: [[Type]]) (l :: k) (ns' :: [[Type]]). (HasFieldPath 'False ls (r1 r2) v, MapFieldTree (TryCollectionListTF r2) ns, FilterLastEq (Label l) ns ns ns', HSingleton (NonUnique' r2 l) (NamesDontMatch r2 ns l) ns' ls) => Label l -> r1 r2 -> v Source #

class HasFieldPath (needJust :: Bool) (ls :: [*]) r v | needJust ls r -> v Source #

Minimal complete definition

hLookupByLabelPath1

Instances

Instances details
HasFieldPath 'False ('[] :: [Type]) v v Source # 
Instance details

Defined in Data.HList.Dredge

Methods

hLookupByLabelPath1 :: Proxy 'False -> Label '[] -> v -> v Source #

HasFieldPath 'True ('[] :: [Type]) v (Maybe v) Source # 
Instance details

Defined in Data.HList.Dredge

Methods

hLookupByLabelPath1 :: Proxy 'True -> Label '[] -> v -> Maybe v Source #

(HasField l (Record r) u, HasFieldPath needJust ls u v) => HasFieldPath needJust (Label l ': ls) (Record r) v Source # 
Instance details

Defined in Data.HList.Dredge

Methods

hLookupByLabelPath1 :: Proxy needJust -> Label (Label l ': ls) -> Record r -> v Source #

(HasField l (Variant r) (Maybe u), HasFieldPath 'True ls u (Maybe v)) => HasFieldPath needJust (Label l ': ls) (Variant r) (Maybe v) Source # 
Instance details

Defined in Data.HList.Dredge

Methods

hLookupByLabelPath1 :: Proxy needJust -> Label (Label l ': ls) -> Variant r -> Maybe v Source #

namespaced labels

type family AddLabel (x :: k) :: * where ... Source #

Equations

AddLabel (Label x) = Label x 
AddLabel x = Label x 

data Lbl (x :: HNat) (ns :: *) (desc :: *) Source #

Instances

Instances details
(HEqBy HLeFn n m b, ns ~ ns') => HEqBy HLeFn (Lbl n ns desc :: Type) (Lbl m ns' desc' :: Type) b Source #

Data.HList.Label3 labels can only be compared if they belong to the same namespace.

Instance details

Defined in Data.HList.HSort

Label t ~ Label (Lbl ix ns n) => SameLabels (Label t :: Type) (Lbl ix ns n :: Type) Source # 
Instance details

Defined in Data.HList.Label3

Show desc => ShowLabel (Lbl x ns desc :: Type) Source #

Equality on labels (descriptions are ignored) Use generic instance

Show label

Instance details

Defined in Data.HList.Label3

Methods

showLabel :: Label (Lbl x ns desc) -> String Source #

Show desc => Show (Label (Lbl x ns desc)) Source # 
Instance details

Defined in Data.HList.Label3

Methods

showsPrec :: Int -> Label (Lbl x ns desc) -> ShowS #

show :: Label (Lbl x ns desc) -> String #

showList :: [Label (Lbl x ns desc)] -> ShowS #

(to ~ LabeledTo x, ToSym (to p q) x) => HExtend (to p q) (Proxy (Lbl n ns desc ': xs)) Source #

if the proxy has Data.HList.Label3.Lbl, then everything has to be wrapped in Label to make the kinds match up.

Instance details

Defined in Data.HList.Labelable

Associated Types

type HExtendR (to p q) (Proxy (Lbl n ns desc ': xs)) Source #

Methods

(.*.) :: to p q -> Proxy (Lbl n ns desc ': xs) -> HExtendR (to p q) (Proxy (Lbl n ns desc ': xs)) Source #

HExtend (Label (Lbl n ns desc)) (Proxy (x ': xs)) Source #

Mixing two label kinds means we have to include Label:

>>> let r = label3 .*. label6 .*. emptyProxy
>>> :t r
r :: Proxy '[Label (Lbl 'HZero () ()), Label "6"]
Instance details

Defined in Data.HList.Label3

Associated Types

type HExtendR (Label (Lbl n ns desc)) (Proxy (x ': xs)) Source #

Methods

(.*.) :: Label (Lbl n ns desc) -> Proxy (x ': xs) -> HExtendR (Label (Lbl n ns desc)) (Proxy (x ': xs)) Source #

HExtend (Label (Lbl n ns desc)) (Proxy (Lbl n' ns' desc' ': xs)) Source #

If possible, Label is left off:

>>> let q = label3 .*. label3 .*. emptyProxy
>>> :t q
q :: Proxy '[Lbl 'HZero () (), Lbl 'HZero () ()]
Instance details

Defined in Data.HList.Label3

Associated Types

type HExtendR (Label (Lbl n ns desc)) (Proxy (Lbl n' ns' desc' ': xs)) Source #

Methods

(.*.) :: Label (Lbl n ns desc) -> Proxy (Lbl n' ns' desc' ': xs) -> HExtendR (Label (Lbl n ns desc)) (Proxy (Lbl n' ns' desc' ': xs)) Source #

type ZipTagged (Lbl ix ns n ': ts :: [Type]) (v ': vs) Source # 
Instance details

Defined in Data.HList.Label3

type ZipTagged (Lbl ix ns n ': ts :: [Type]) (v ': vs) = Tagged (Lbl ix ns n) v ': ZipTagged ts vs
type HExtendR (to p q) (Proxy (Lbl n ns desc ': xs)) Source # 
Instance details

Defined in Data.HList.Labelable

type HExtendR (to p q) (Proxy (Lbl n ns desc ': xs))
type HExtendR (Label (Lbl n ns desc)) (Proxy (Lbl n' ns' desc' ': xs)) Source # 
Instance details

Defined in Data.HList.Label3

type HExtendR (Label (Lbl n ns desc)) (Proxy (Lbl n' ns' desc' ': xs)) = Proxy (Lbl n ns desc ': (Lbl n' ns' desc' ': xs))
type HExtendR (Label (Lbl n ns desc)) (Proxy (x ': xs)) Source # 
Instance details

Defined in Data.HList.Label3

type HExtendR (Label (Lbl n ns desc)) (Proxy (x ': xs)) = Proxy (Label (Lbl n ns desc) ': MapLabel (x ': xs))

firstLabel :: ns -> desc -> Label (Lbl HZero ns desc) Source #

Construct the first label

nextLabel :: Label (Lbl x ns desc) -> desc' -> Label (Lbl (HSucc x) ns desc') Source #

Construct the next label

labels as any instance of Typeable

template haskell

Data.HList.Data

This modules provide useful instances. A useful application can be found in examples/cmdargs.hs

Overlapping instances are restricted to here

class TupleType (t :: *) (b :: Bool) | t -> b Source #

Instances

Instances details
TupleType () 'True Source # 
Instance details

Defined in Data.HList.TypeEqO

'False ~ b => TupleType x b Source # 
Instance details

Defined in Data.HList.TypeEqO

TupleType (x, y) 'True Source # 
Instance details

Defined in Data.HList.TypeEqO

TupleType (x, y, z) 'True Source # 
Instance details

Defined in Data.HList.TypeEqO

Internals

internals exported for type signature purposes

class HAllTaggedEq (l :: [*]) Source #

Instances

Instances details
HAllTaggedEq ('[] :: [Type]) Source # 
Instance details

Defined in Data.HList.TIP

(HAllTaggedEq l, tee ~ Tagged e e') => HAllTaggedEq (tee ': l) Source # 
Instance details

Defined in Data.HList.TIP