extensible-0.2.10: Extensible, efficient, lens-friendly data types

Copyright(c) Fumiaki Kinoshita 2015
LicenseBSD3
MaintainerFumiaki Kinoshita <fumiexcel@gmail.com>
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell2010

Data.Extensible.Record

Contents

Description

Flexible records with well-typed fields. Example: https://github.com/fumieval/extensible/blob/master/examples/records.hs

Synopsis

Documentation

type Record = (:*) Field Source

The type of records which contain several fields.

(<:) :: h x -> (h :* xs) -> h :* (x : xs) infixr 0 Source

O(log n) Add an element to a product.

(<:*) :: forall h x xs. h x -> (h :* xs) -> h :* (x : xs) infixr 0 Source

An alias for (<:).

data h :* s where Source

The extensible product type

Constructors

Nil :: h :* [] 

Instances

Typeable ((k -> *) -> [k] -> *) ((:*) k) 
WrapForall k * Eq h xs => Eq ((:*) k h xs) 
(Eq ((:*) k h xs), WrapForall k * Ord h xs) => Ord ((:*) k h xs) 
WrapForall k * Show h xs => Show ((:*) k h xs) 
WrapForall k * Monoid h xs => Monoid ((:*) k h xs) 
WrapForall k * Binary h xs => Binary ((:*) k h xs) 

(@=) :: FieldName s -> FieldValue s -> Field s infix 1 Source

Annotate a value by the field name.

mkField :: String -> TypeQ -> DecsQ Source

Generate a field. mkField "foo" [t|Int|] defines:

type instance FieldValue "foo" = Int

foo :: FieldLens "foo"

The yielding field is a Lens.

recordType :: QuasiQuoter Source

[recordType|foo bar baz|] --> Record '["foo", "bar", "baz"]

data Field s Source

The type of fields.

Constructors

Field 

Fields

getField :: FieldValue s
 

Instances

(KnownSymbol s, Show (FieldValue s)) => Show (Field s)

Shows in field @= value style instead of the derived one.

type family FieldValue s :: * Source

Associates names with concrete types.

type FieldLens s = forall f p xs. (Functor f, Labelable s p, s xs) => p (FieldValue s) (f (FieldValue s)) -> Record xs -> f (Record xs) Source

FieldLens s is a type of lens that points a field named s.

FieldLens s = (s ∈ xs) => Lens' (Record xs) (FieldValue s)

type FieldName s = LabelPhantom s (FieldValue s) (Proxy (FieldValue s)) -> Record `[s]` -> Proxy (Record `[s]`) Source

When you see this type as an argument, it expects a FieldLens. This type is used to resolve the name of the field internally.

Internal

class Labelable s p where Source

An internal class to characterize FieldLens

Methods

unlabel :: proxy s -> p a b -> a -> b Source

Instances

Labelable k s (->) 
(~) k s t => Labelable k s (LabelPhantom k * * t) 

data LabelPhantom s a b Source

A ghostly type which reifies the field name

Instances

(~) k s t => Labelable k s (LabelPhantom k * * t)