Safe Haskell | None |
---|---|
Language | Haskell2010 |
- emptyBook :: Book '[]
- (?:) :: forall field book val. (Submap '[field :=> val] book, Contains book field val) => Book' book -> Key field -> val
- get :: forall field book val. (Submap '[field :=> val] book, Contains book field val) => Key field -> Book' book -> val
- set :: forall field val old mid1 mid2 new. (Unionable '[field :=> ChooseFirst val] mid1, Mappable ChooseFirst old mid1, Mappable ChooseFirst new mid2, mid1 ~ MapThere ChooseFirst old, mid2 ~ Union '[field :=> ChooseFirst val] mid1, new ~ MapBack ChooseFirst mid2) => Key field -> val -> Book' old -> Book' new
- (=:) :: forall field val old mid1 mid2 new. (Unionable '[field :=> ChooseFirst val] mid1, Mappable ChooseFirst old mid1, Mappable ChooseFirst new mid2, mid1 ~ MapThere ChooseFirst old, mid2 ~ Union '[field :=> ChooseFirst val] mid1, new ~ MapBack ChooseFirst mid2) => Key field -> val -> Book' old -> Book' new
- modify :: forall field val val' old mid1 mid2 new. (Unionable '[field :=> ChooseFirst val'] mid1, Mappable ChooseFirst old mid1, Mappable ChooseFirst new mid2, (Submap '[field :=> val] old, Contains old field val), mid1 ~ MapThere ChooseFirst old, mid2 ~ Union '[field :=> ChooseFirst val'] mid1, new ~ MapBack ChooseFirst mid2, AsMap new ~ new) => Key field -> (val -> val') -> Book' old -> Book new
- (%:) :: forall field val val' old mid1 mid2 new. (Unionable '[field :=> ChooseFirst val'] mid1, Mappable ChooseFirst old mid1, Mappable ChooseFirst new mid2, (Submap '[field :=> val] old, Contains old field val), mid1 ~ MapThere ChooseFirst old, mid2 ~ Union '[field :=> ChooseFirst val'] mid1, new ~ MapBack ChooseFirst mid2, AsMap new ~ new) => Key field -> (val -> val') -> Book' old -> Book new
- delete :: forall field old. Submap (AsMap (old :\ field)) old => Key field -> Book' old -> Book (old :\ field)
- type Book a = Book' (AsMap a)
- type (:=>) a b = a :-> b
- data Key a
- (&) :: a -> (a -> b) -> b
- newtype ChooseFirst a = ChooseFirst {
- getChooseFirst :: a
Preamble
The examples here presume the following setup:
>>>
import Data.Char (toUpper)
>>>
type Person = Book '[ "name" :=> String , "age" :=> Int ]
>>>
let julian :: Person = emptyBook & #age =: 28 & #name =: "Julian K. Arni"
The OverloadedLabels and TypeOperators extensions are also required.
A word of warning: The signatures for most of the functions are quite arcane, even though their behaviour is intuitive.
Initialization
emptyBook :: Book '[] Source #
A book with no records. You'll usually want to use this to construct books.
Getters
(?:) :: forall field book val. (Submap '[field :=> val] book, Contains book field val) => Book' book -> Key field -> val infixl 3 Source #
Flipped and infix version of get
.
>>>
julian ?: #name
"Julian K. Arni"
get :: forall field book val. (Submap '[field :=> val] book, Contains book field val) => Key field -> Book' book -> val Source #
Get a value by key, if it exists.
>>>
get #age julian
28
If the key does not exist, throws a type error >>> get #moneyFrom julian ... ... • The provided Book does not contain the field "moneyFrom" ... Book type: ... '["age" ':-> Int, "name" ':-> String] ... • In the expression: get #moneyFrom julian ...
Setters
set :: forall field val old mid1 mid2 new. (Unionable '[field :=> ChooseFirst val] mid1, Mappable ChooseFirst old mid1, Mappable ChooseFirst new mid2, mid1 ~ MapThere ChooseFirst old, mid2 ~ Union '[field :=> ChooseFirst val] mid1, new ~ MapBack ChooseFirst mid2) => Key field -> val -> Book' old -> Book' new Source #
Sets or updates a field to a value.
>>>
let julian' = set #likesDoctest True julian
>>>
get #likesDoctest julian'
True
(=:) :: forall field val old mid1 mid2 new. (Unionable '[field :=> ChooseFirst val] mid1, Mappable ChooseFirst old mid1, Mappable ChooseFirst new mid2, mid1 ~ MapThere ChooseFirst old, mid2 ~ Union '[field :=> ChooseFirst val] mid1, new ~ MapBack ChooseFirst mid2) => Key field -> val -> Book' old -> Book' new infix 3 Source #
Infix version of set
>>>
let julian' = julian & #age =: 29
>>>
get #age julian'
29
Modifying
modify :: forall field val val' old mid1 mid2 new. (Unionable '[field :=> ChooseFirst val'] mid1, Mappable ChooseFirst old mid1, Mappable ChooseFirst new mid2, (Submap '[field :=> val] old, Contains old field val), mid1 ~ MapThere ChooseFirst old, mid2 ~ Union '[field :=> ChooseFirst val'] mid1, new ~ MapBack ChooseFirst mid2, AsMap new ~ new) => Key field -> (val -> val') -> Book' old -> Book new Source #
Apply a function to a field.
>>>
let julian' = julian & modify #name (fmap toUpper)
>>>
get #name julian'
"JULIAN K. ARNI"
If the key does not exist, throws a type error >>> modify #height (_ -> 132) julian ... ... • The provided Book does not contain the field "height" ... Book type: ... '["age" ':-> Int, "name" ':-> String] ... • In the expression: modify #height ( _ -> 132) julian ...
(%:) :: forall field val val' old mid1 mid2 new. (Unionable '[field :=> ChooseFirst val'] mid1, Mappable ChooseFirst old mid1, Mappable ChooseFirst new mid2, (Submap '[field :=> val] old, Contains old field val), mid1 ~ MapThere ChooseFirst old, mid2 ~ Union '[field :=> ChooseFirst val'] mid1, new ~ MapBack ChooseFirst mid2, AsMap new ~ new) => Key field -> (val -> val') -> Book' old -> Book new infixr 3 Source #
Infix version of modify
.
>>>
let julian' = julian & #name %: fmap toUpper
>>>
get #name julian'
"JULIAN K. ARNI"
Deleting
delete :: forall field old. Submap (AsMap (old :\ field)) old => Key field -> Book' old -> Book (old :\ field) Source #
Delete a field from a Book
, if it exists. If it does not, returns the
Book
unmodified.
>>>
get #name $ delete #name julian
... ... • The provided Book does not contain the field "name" ... Book type: ... '["age" ':-> Int] ... • In the expression: get #name ...
Types
type (:=>) a b = a :-> b Source #
An alias for :->
because otherwise you'll have to tick your
constructors.
Key
is simply a proxy. You will usually not need to generate it
directly, as it is generated by the OverlodadedLabels magic.
Re-exports
For coercion
These types should not be used, but need to be in scope for coercion, which is used when setting or modifying a value.
newtype ChooseFirst a Source #
Warning: This should not be used
ChooseFirst | Warning: This should not be used |
|
Eq a => Eq (ChooseFirst a) Source # | |
Read a => Read (ChooseFirst a) Source # | |
Show a => Show (ChooseFirst a) Source # | |
Generic (ChooseFirst a) Source # | |
Combinable (ChooseFirst a) (ChooseFirst b) Source # | |
type Rep (ChooseFirst a) Source # | |
type Combine * (ChooseFirst a) (ChooseFirst b) Source # | |