Data.HList.Record

The HList library

(C) 2004-2006, Oleg Kiselyov, Ralf Laemmel, Keean Schupke

Extensible records

The three-ish models of labels that go with this module;

• Data.HList.Label3
• Data.HList.MakeLabels

These used to work:

• Data.HList.Label1
• Data.HList.Label2
• Data.HList.Label4
• Data.HList.Label5

labels used for doctests

>>> let x = Label :: Label "x"
>>> let y = Label :: Label "y"
>>> let z = Label :: Label "z"

Records

Labels

Record types as label-value pairs, where label is purely phantom. Thus the run-time representation of a field is the same as that of its value, and the record, at run-time, is indistinguishable from the HList of field values. At run-time, all information about the labels is erased.

The type from Data.Tagged is used.

module Data.Tagged

(.=.) :: Label l -> v -> Tagged l v

Create a value with the given label. Analagous to a data constructor such as Just, Left, or Right. Higher fixity than record-modification operations like (.*.), (.-.), etc. to support expression like the below w/o parentheses:

>>> x .=. "v1" .*. y .=. '2' .*. emptyRecord
Record{x="v1",y='2'}

(.-.) :: H2ProjectByLabels `[l]` r _r' r' => Record r -> Label l -> Record r'

Remove a field from a record. At the same level as other record modification options (.*.). Analagous to (\\) in lists.

 record1 .-. label1

 label1 .=. value1 .*.
 label2 .=. value2 .-.
 label2 .*.
 emptyRecord

 label1 .=. value1 .-.
 label1 .*.
 label2 .=. value2 .*.
 emptyRecord

 record1 .*. label1 .=. record2 .!. label1
         .*. label2 .=. record2 .!. label2
         .-. label1

Record

newtype Record r

Constructors

Record (HList r)

Instances

(HEq k l l1 b, HasField' k b l (: * (Tagged k l1 v1) r) v) => HasField k l (Record (: * (Tagged k l1 v1) r)) v

H2ProjectByLabels k (RecordLabels k r2) r1 r2 rout => SubType * * (Record r1) (Record r2)

Subtyping for records

DataRecordCxt a => Data (Record a)

ShowComponents r => Show (Record r)

TypeRepsList (Record xs) => Typeable (Record xs)

(TypeRepsList (Prime xs), ConvHList xs) => TypeRepsList (Record xs)

(HRLabelSet (HAppendList * r1 r2), HAppend (HList r1) (HList r2)) => HAppend (Record r1) (Record r2)

(.*.)

Add a field to a record. Analagous to (++) for lists.

 record .*. field1
        .*. field2

HRLabelSet (: * (Tagged k l v) r) => HExtend (Tagged k l v) (Record r)

mkRecord :: HRLabelSet r => HList r -> Record r

Build a record

emptyRecord :: Record `[]`

Build an empty record

Getting Labels

type family RecordLabels r :: [k]

Construct the (phantom) list of labels of the record.

recordLabels :: Record r -> Proxy (RecordLabels r)

type family LabelsOf ls :: [*]

Making this ls::[*] and [k] breaks the MainGhcGeneric1.hs...

hLabels :: HList l -> Proxy (LabelsOf l)

Getting Values

class RecordValues r where

Construct the HList of values of the record.

Associated Types

type RecordValuesR r :: [*]

Methods

recordValues' :: HList r -> HList (RecordValuesR r)

Instances

RecordValues ([] *)

RecordValues r => RecordValues (: * (Tagged k l v) r)

recordValues :: RecordValues r => Record r -> HList (RecordValuesR r)

Operations

Show

A corresponding Show instance exists as

 show x = "Record {" ++ showComponents "" x ++ "}"

class ShowComponents l where

Methods

showComponents :: String -> HList l -> String

Instances

ShowComponents ([] *)

(ShowLabel k l, Show v, ShowComponents r) => ShowComponents (: * (Tagged k l v) r)

class ShowLabel l where

Methods

showLabel :: Label l -> String

Instances

SingI Symbol x => ShowLabel Symbol x

Show desc => ShowLabel * (Lbl k * x ns desc)

Equality on labels (descriptions are ignored) Use generic instance

Show label

Delete

hDeleteAtLabel label record

hDeleteAtLabel :: forall l t t1 t2. H2ProjectByLabels `[l]` t t1 t2 => Label l -> Record t -> Record t2

Lookup/update

Lens-based setters/getters are popular.

This is a provisional method to make a Lens (Record s) (Record t) a b, out of a Label x. Refer to examples/lens.hs for an example.

hLens :: (Functor f, HFind k l (RecordLabels k r) n, HUpdateAtHNat n (Tagged k l v) r, HasField k l (Record r) v1) => Label k l -> (v1 -> f v) -> Record r -> f (Record (HUpdateAtHNatR n (Tagged k l v) r))

Lookup

class HasField l r v | l r -> v where

This is a baseline implementation. We use a helper class, HasField, to abstract from the implementation.

Because hLookupByLabel is so frequent and important, we implement it separately, more efficiently. The algorithm is familiar assq, only the comparison operation is done at compile-time

Methods

hLookupByLabel :: Label l -> r -> v

Instances

(HEq k l l1 b, HasField' k b l (: * (Tagged k l1 v1) r) v) => HasField k l (Record (: * (Tagged k l1 v1) r)) v

class HasField' b l r v | b l r -> v where

Methods

hLookupByLabel' :: Proxy b -> Label l -> HList r -> v

Instances

HasField k l (Record r) v => HasField' k False l (: * fld r) v

HasField' k True l (: * (Tagged k l v) r) v

(.!.) :: HasField l r v => r -> Label l -> v

Lookup a value in a record by its label. Analagous to (!!), the list indexing operation. Highest fixity, like (!!).

>>> :{
let record1 = x .=. 3 .*.
              y .=. 'y' .*.
              emptyRecord
:}

>>> record1 .!. x
3

>>> record1 .!. y
'y'

>>> :{
let r2 = y .=. record1 .!. x .*.
         z .=. record1 .!. y .*.
         emptyRecord
:}

>>> r2
Record{y=3,z='y'}

Note that labels made following Data.HList.Labelable allow using Control.Lens.^. instead.

Update

(.@.) :: (HFind k l (RecordLabels k r) n, HUpdateAtHNat n (Tagged k l v) r) => Tagged k l v -> Record r -> Record (HUpdateAtHNatR n (Tagged k l v) r)

Update a field with a particular value. Same fixity as (.*.) so that extensions and updates can be chained. There is no real list analogue, since there is no Prelude defined update.

 label1 .=. value1 .@. record1

hUpdateAtLabel :: forall r l n v. (HFind l (RecordLabels r) n, HUpdateAtHNat n (Tagged l v) r) => Label l -> v -> Record r -> Record (HUpdateAtHNatR n (Tagged l v) r)

hUpdateAtLabel label value record

type-preserving versions

(.<.) :: (HFind k l (RecordLabels k r) n, HUpdateAtHNat n (Tagged k l v) r, HasField k l (Record r) v) => Tagged k l v -> Record r -> Record (HUpdateAtHNatR n (Tagged k l v) r)

The same as .@., except type preserving. It has the same fixity as (.@.).

hTPupdateAtLabel :: (HFind k l (RecordLabels k r) n, HUpdateAtHNat n (Tagged k l v) r, HasField k l (Record r) v) => Label k l -> v -> Record r -> Record (HUpdateAtHNatR n (Tagged k l v) r)

A variation on hUpdateAtLabel: type-preserving update.

We could also say:

 hTPupdateAtLabel l v r = hUpdateAtLabel l v r `asTypeOf` r

Then we were taking a dependency on Haskell's type equivalence. This would also constrain the actual implementation of hUpdateAtLabel.

Rename Label

hRenameLabel :: (H2ProjectByLabels k (: k l ([] k)) t t1 t2, HasField k l (Record t) v, HRLabelSet (: * (Tagged k1 l1 v) t2)) => Label k l -> Label k1 l1 -> Record t -> Record (: * (Tagged k1 l1 v) t2)

Rename the label of record

>>> hRenameLabel x y (x .=. () .*. emptyRecord)
Record{y=()}

Projection

It is also an important operation: the basis of many deconstructors -- so we try to implement it efficiently.

hProjectByLabels :: (HRLabelSet a, H2ProjectByLabels ls t a b) => Proxy ls -> Record t -> Record a

hProjectByLabels ls r returns r with only the labels in ls remaining

hProjectByLabels2 :: (H2ProjectByLabels ls t t1 t2, HRLabelSet t1, HRLabelSet t2) => Proxy ls -> Record t -> (Record t1, Record t2)

See H2ProjectByLabels

Unions

Left

class HLeftUnion r r' r'' | r r' -> r'' where

Methods

hLeftUnion :: Record r -> Record r' -> Record r''

Instances

HLeftUnion r ([] *) r

(~ [k] (RecordLabels k r) ls, HMember k l ls b, HLeftUnionBool b r (Tagged k l v) r''', HLeftUnion r''' r' r'') => HLeftUnion r (: * (Tagged k l v) r') r''

class HLeftUnionBool b r f r' | b r f -> r' where

Methods

hLeftUnionBool :: Proxy b -> Record r -> f -> Record r'

Instances

HLeftUnionBool True r f r

HLeftUnionBool False r f (: * f r)

(.<++.) :: HLeftUnion r r' r'' => Record r -> Record r' -> Record r''

Similar to list append, so give this slightly lower fixity than (.*.), so we can write:

 field1 .=. value .*. record1 .<++. record2

Symmetric

Compute the symmetric union of two records r1 and r2 and return the pair of records injected into the union (ru1, ru2).

To be more precise, we compute the symmetric union type ru of two record types r1 and r2. The emphasis on types is important.

The two records (ru1,ru2) in the result of unionSR have the same type ru, but they are generally different values. Here the simple example: suppose

  r1 = (Label .=. True)  .*. emptyRecord
  r2 = (Label .=. False) .*. emptyRecord

Then unionSR r1 r2 will return (r1,r2). Both components of the result are different records of the same type.

To project from the union ru, use hProjectByLabels. It is possible to project from the union obtaining a record that was not used at all when creating the union.

We do assure however that if unionSR r1 r2 gave (r1u,r2u), then projecting r1u onto the type of r1 gives the value identical to r1. Ditto for r2.

class UnionSymRec r1 r2 ru | r1 r2 -> ru where

Methods

unionSR :: Record r1 -> Record r2 -> (Record ru, Record ru)

Instances

UnionSymRec r1 ([] *) r1

(~ [k] (RecordLabels k r1) ls, HMember k l ls b, UnionSymRec' b r1 (Tagged k l v) r2' ru) => UnionSymRec r1 (: * (Tagged k l v) r2') ru

Reorder Labels

hRearrange :: (HLabelSet ls, HRearrange ls r (HList r')) => Proxy ls -> Record r -> Record r'

Rearranges a record by labels. Returns the record r, rearranged such that the labels are in the order given by ls. (recordLabels r) must be a permutation of ls.

Extension

hExtend, hAppend

(.*.) :: HExtend e l => e -> l -> HExtendR e l

Hints for type errors

data DuplicatedLabel l

Propery of a proper label set for a record: no duplication of labels

data ExtraField l

Constructors

ExtraField

Instances

Fail * (ExtraField k1 l) => HRearrange [k] ([] k) (: * (Tagged k1 l v) a) (ExtraField k1 l)

For improved error messages

data FieldNotFound l

Constructors

FieldNotFound

Instances

Fail * (FieldNotFound k1 l) => HRearrange' k1 k l ls ([] *) rout (FieldNotFound k1 l)

For improved error messages

Unclassified

Probably internals, that may not be useful

class H2ProjectByLabels ls r rin rout | ls r -> rin rout where

Invariant:

 r === rin `disjoint-union` rout
 labels rin === ls
     where (rin,rout) = hProjectByLabels ls r

Methods

h2projectByLabels :: Proxy ls -> HList r -> (HList rin, HList rout)

Instances

H2ProjectByLabels k ([] k) r ([] *) r

H2ProjectByLabels k (: k l ls) ([] *) ([] *) ([] *)

(HMemberM k l1 (: k l ls) b, H2ProjectByLabels' k b (: k l ls) (: * (Tagged k l1 v1) r1) rin rout) => H2ProjectByLabels k (: k l ls) (: * (Tagged k l1 v1) r1) rin rout

class H2ProjectByLabels' b ls r rin rout | b ls r -> rin rout where

Methods

h2projectByLabels' :: Proxy b -> Proxy ls -> HList r -> (HList rin, HList rout)

Instances

H2ProjectByLabels k ls r rin rout => H2ProjectByLabels' k (Nothing [k]) ls (: * f r) rin (: * f rout)

H2ProjectByLabels k ls1 r rin rout => H2ProjectByLabels' k (Just [k] ls1) ls (: * f r) (: * f rin) rout

class HLabelSet ls

Relation between HLabelSet and HRLabelSet

Instances

HLabelSet [k] ([] k)

(HEq k l1 l2 leq, HLabelSet' k k [k] l1 l2 leq r) => HLabelSet [k] (: k l1 (: k l2 r))

HLabelSet [k] (: k x ([] k))

class HLabelSet' l1 l2 leq r

Instances

Fail * (DuplicatedLabel k l1) => HLabelSet' k k1 k2 l1 l2 True r

(HLabelSet [k] (: k l2 r), HLabelSet [k] (: k l1 r)) => HLabelSet' k k [k] l1 l2 False r

class HRLabelSet ps

Instances

HRLabelSet ([] *)

HRLabelSet (: * x ([] *))

(HEq k l1 l2 leq, HRLabelSet' k k l1 l2 leq r) => HRLabelSet (: * (Tagged k l1 v1) (: * (Tagged k l2 v2) r))

class HRLabelSet' l1 l2 leq r

Instances

Fail * (DuplicatedLabel k l1) => HRLabelSet' k k1 l1 l2 True r

(HRLabelSet (: * (Tagged k1 l2 ()) r), HRLabelSet (: * (Tagged k l1 ()) r)) => HRLabelSet' k k1 l1 l2 False r

class HRearrange ls r r' where

Helper class for hRearrange

Methods

hRearrange2 :: Proxy ls -> HList r -> r'

Instances

~ * (HList ([] *)) r => HRearrange [k] ([] k) ([] *) r

Fail * (ExtraField k1 l) => HRearrange [k] ([] k) (: * (Tagged k1 l v) a) (ExtraField k1 l)

For improved error messages

(H2ProjectByLabels k (: k l ([] k)) r rin rout, HRearrange' k [k] l ls rin rout (HList r'), ~ * r'' (HList r')) => HRearrange [k] (: k l ls) r r''

class HRearrange' l ls rin rout r' where

Helper class 2 for hRearrange

Methods

hRearrange2' :: Proxy l -> Proxy ls -> HList rin -> HList rout -> r'

Instances

Fail * (FieldNotFound k1 l) => HRearrange' k1 k l ls ([] *) rout (FieldNotFound k1 l)

For improved error messages

(HRearrange k ls rout (HList r'), ~ * r'' (HList (: * (Tagged k1 l v) r'))) => HRearrange' k1 k l ls (: * (Tagged k1 l v) ([] *)) rout r''

class UnionSymRec' b r1 f2 r2' ru | b r1 f2 r2' -> ru where

Methods

unionSR' :: Proxy b -> Record r1 -> f2 -> Record r2' -> (Record ru, Record ru)

Instances

(UnionSymRec r1 r2' ru, HExtend f2 (Record ru), ~ * (HExtendR f2 (Record ru)) (Record f2ru)) => UnionSymRec' False r1 f2 r2' f2ru

(UnionSymRec r1 r2' ru, HasField k l2 (Record ru) v2, HUpdateAtHNat n (Tagged k l2 v2) ru, ~ [*] ru (HUpdateAtHNatR n (Tagged k l2 v2) ru), ~ [k] (RecordLabels k ru) ls, ~ * f2 (Tagged k l2 v2), HFind k l2 ls n) => UnionSymRec' True r1 f2 r2' ru

labelLVPair :: Tagged l v -> Label l

Label accessor

newLVPair :: Label l -> v -> Tagged l v