extensible-0.3.3: 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

Synopsis

Documentation

(@=) :: FieldName k -> v -> Field (k :> v) infix 1 Source

Annotate a value by the field name.

(<@=>) :: Functor f => FieldName k -> f v -> Comp f Field (k :> v) infix 1 Source

Lifted (@=)

mkField :: String -> DecsQ Source

Generate fields using fieldOptic. mkField "foo bar" defines:

foo :: FieldOptic "foo"
bar :: FieldOptic "bar"

data Field kv where Source

The type of fields.

Constructors

Field :: v -> Field (k :> v) 

Instances

(KnownSymbol k, Show v) => Show (Field Symbol ((:>) Symbol * k v))

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

getField :: Field (k :> v) -> v Source

Get a value of a field.

type FieldOptic k = forall f p q t xs v. (Functor f, Profunctor p, Extensible f p q t, Associate k v xs, Labelling k p) => p v (f v) -> q (t Field xs) (f (t Field xs)) Source

FieldOptic s is a type of optics that points a field/constructor named s.

The yielding fields can be Lenses for Records and Prisms for Variants.

FieldOptic "foo" = Associate "foo" a xs => Lens' (Record xs) a
FieldOptic "foo" = Associate "foo" a xs => Prism' (Variant xs) a

type FieldName k = forall v. LabelPhantom k v (Proxy v) -> Record `[k :> v]` -> Proxy (Record `[k :> v]`) 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.

fieldOptic :: forall proxy k. proxy k -> FieldOptic k Source

Generate a field optic from the given name.

Records and variants

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.

data h :* s where Source

The type of extensible products.

Constructors

Nil :: h :* [] 

Instances

Functor f => Extensible k * f (->) (->) ((:*) k) 
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) 

type Variant = (:|) Field Source

The dual of Record

Internal

data LabelPhantom s a b Source

A ghostly type which spells the field name

Instances

Extensible k k f (LabelPhantom k * k s) q t 
Profunctor (LabelPhantom k * * s) 

type family Labelling s p :: Constraint Source

Equations

Labelling s (LabelPhantom t) = s ~ t 
Labelling s p = ()