Copyright | (c) 2016, Peter Trško |
---|---|
License | BSD3 |
Maintainer | peter.trsko@gmail.com |
Stability | experimental |
Portability | ConstraintKinds, DataKinds, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, FlexibleContexts, FunctionalDependencies, GADTs, LambdaCase, MagicHash, MultiParamTypeClasses, NoImplicitPrelude, RankNTypes, TypeFamilies, TypeOperators, UndecidableInstances |
Safe Haskell | None |
Language | Haskell2010 |
Magic classes for OverloadedRecordFields.
Implementation is based on: https://github.com/adamgundry/records-prototype/blob/master/CoherentPrototype.hs by Adam Gundry under MIT License.
- module Data.OverloadedLabels
- type family FieldType l s :: *
- class HasField l s a | l s -> a where
- data Getter s a
- get :: Getter s a -> s -> a
- type family UpdateType l s b :: *
- class HasField l s a => ModifyField l s t a b | l s -> a, l t -> b, l s b -> t, l t a -> s where
- type family R ts r :: Constraint
- type (:::) l a = `(l, a)`
- data Rec ts r where
- type Setting a s t b = Modifier s t a b
- setting :: Setting a s t b -> Proxy a -> b -> s -> t
- type Setter s t b = forall a. Modifier s t a b
- set :: Setter s t b -> b -> s -> t
- data Modifier s t a b
- modify :: Modifier s t a b -> (a -> b) -> s -> t
- type ModifyField' l s a = ModifyField l s s a a
- fieldLens' :: (Functor f, ModifyField' l s a) => Proxy# l -> (a -> f a) -> s -> f s
- modifyField' :: ModifyField' l s a => Proxy# l -> (a -> a) -> s -> s
- setField' :: ModifyField' l s a => Proxy# l -> s -> a -> s
- type Setter' s a = Modifier' s a
- set' :: Setter' s a -> a -> s -> s
- type Modifier' s a = Modifier s s a a
- modify' :: Modifier' s a -> (a -> a) -> s -> s
- type family FromArrow a :: Bool
- class (z ~ FromArrow x) => IsFieldAccessor l x y z | l y -> x where
- fieldAccessor :: Proxy# l -> x -> y
Usage Examples
-- Basic set of language extensions required when defining instances for -- classes and type families from Data.OverloadedRecords. {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -- Following language extensions are required by code like this: {-# LANGUAGE ConstraintKinds #-} -- Codomain of type familyR
is aConstraint
kind. {-# LANGUAGE FlexibleContexts #-} -- Required in example when field type (second argument of:::
) is a -- specific type instead of a polymorphic type. {-# LANGUAGE TypeOperators #-} -- Required due to usage of:::
type alias. -- Following language extensions are available only in GHC >=8: {-# LANGUAGE OverloadedLabels #-} -- Enables #label syntactic sugar. module Example where import Data.Default (Default(def)) -- Provided by one of these packages: -- -- * data-default -- * data-default-extra import Data.OverloadedRecords import Data.OverloadedRecords.TH (overloadedRecord
) data V3 a = V3 { v3x :: !a , v3y :: !a , v3z :: !a } deriving Show -- Following line derives instances for various type classes and type -- families that are provided by the overloaded-records library. -- -- However with def (default settings) this is done only for fields that -- start with type name, data constructor name, or underscore. Prefix is -- stripped. In example "v3x" is transformed in to "x" and so would be -- "_x".overloadedRecord
def ''V3 data V4 a = V4 { v4x :: !a , v4y :: !a , v4z :: !a , v4t :: !a } deriving ShowoverloadedRecord
def ''V4 zeroV3 :: (Num a,R
'["x":::
a, "y":::
a, "z":::
a] r) => r -> r zeroV3 =set'
#x 0 .set'
#y 0 .set'
#z 0
The following type signatures for zeroV3
are equivalent:
zeroV3 :: (Num a,R
'["x":::
a, "y":::
a, "z":::
a] r) => r -> r
zeroV3 :: ( Num a ,ModifyField'
"x" r a ,ModifyField'
"y" r a ,ModifyField'
"z" r a ) => r -> r
One of the biggest features of Overloaded Records is the possibility to
define functions that do not depend on concrete data types, but on the
"fields" they provide. In example function zeroV3
can be applied to
anything that has fields "x"
, "y"
, and "z"
that reference values
of some Num
type:
>>>
zeroV3 (V3 1 1 1 :: V3 Int)
V3 {_x = 0, _y = 0, _z = 0}
>>>
zeroV3 (V4 1 1 1 1 :: V4 Int)
V4 {_x = 0, _y = 0, _z = 0, _t = 1}
Function zeroV3
can be also defined using operators from
lens library:
import Control.Lens ((.~), simple) zeroV3 :: (Num a,R
'["x":::
a, "y":::
a, "z":::
a] r) => r -> r zeroV3 r = r & #x . simple .~ 0 & #y . simple .~ 0 & #z . simple .~ 0
However, following function would fail to compile:
incV3 :: (Num a,R
'["x":::
a, "y":::
a, "z":::
a] r) => r -> r incV3 r = r & #x . simple .~ #x r + 1 & #y . simple .~ #y r + 1 & #z . simple .~ #z r + 1
The problem is that we have two IsLabel
instances at play. One is for a
lens and the other one is for getter. Unfortunatelly these two instances are
mutually exclusive in case of polymorphic value. There are multiple
solutions to this. Use lenses all the time, e.g. in general by using ^.
for getting the value, or in this case by using +~
operator for
incrementing. Example of using +~
:
import Control.Lens ((.~), (+~), simple) incV3 :: (Num a,R
'["x":::
a, "y":::
a, "z":::
a] r) => r -> r incV3 r = r & #x . simple +~ 1 & #y . simple +~ 1 & #z . simple +~ 1
Oveloaded Labels
module Data.OverloadedLabels
Overloaded Record Fields
Getter
type family FieldType l s :: * Source
When accessing field named l :: Symbol
of a record s :: *
, then the
type of the value in that field is
.FieldType
l s
type FieldType "fieldDerivation" DeriveOverloadedRecordsParams = FieldDerivation Source | |
type FieldType "head" [a] = Maybe a Source | Since 0.4.0.0 |
type FieldType "tail" [a] = Maybe [a] Source | Since 0.4.0.0 |
type FieldType "curry" ((a, b) -> c) = a -> b -> c Source | Since 0.4.0.0 |
type FieldType "curry" ((a, b, c) -> d) = a -> b -> c -> d Source | Since 0.4.0.0 |
type FieldType "curry" ((a1, a2, a3, a4) -> r) = a1 -> a2 -> a3 -> a4 -> r Source | Since 0.4.0.0 |
type FieldType "curry" ((a1, a2, a3, a4, a5) -> r) = a1 -> a2 -> a3 -> a4 -> a5 -> r Source | Since 0.4.0.0 |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6) -> r) = a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> r Source | Since 0.4.0.0 |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6, a7) -> r) = a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> r Source | Since 0.4.0.0 |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6, a7, a8) -> r) = a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> r Source | Since 0.4.0.0 |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9) -> r) = a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> r Source | Since 0.4.0.0 |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> r) = a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> r Source | Since 0.4.0.0 |
type FieldType "fst" (a, b) = a Source | Since 0.4.0.0 |
type FieldType "snd" (a, b) = b Source | Since 0.4.0.0 |
type FieldType "fst" (a, b, c) = a Source | Since 0.4.0.0 |
type FieldType "snd" (a, b, c) = b Source | Since 0.4.0.0 |
type FieldType "thd" (a, b, c) = c Source | Since 0.4.0.0 |
type FieldType "fst" (a1, a2, a3, a4) = a1 Source | Since 0.4.0.0 |
type FieldType "snd" (a1, a2, a3, a4) = a2 Source | Since 0.4.0.0 |
type FieldType "thd" (a1, a2, a3, a4) = a3 Source | Since 0.4.0.0 |
type FieldType "fst" (a1, a2, a3, a4, a5) = a1 Source | Since 0.4.0.0 |
type FieldType "snd" (a1, a2, a3, a4, a5) = a2 Source | Since 0.4.0.0 |
type FieldType "thd" (a1, a2, a3, a4, a5) = a3 Source | Since 0.4.0.0 |
type FieldType "fst" (a1, a2, a3, a4, a5, a6) = a1 Source | Since 0.4.0.0 |
type FieldType "snd" (a1, a2, a3, a4, a5, a6) = a2 Source | Since 0.4.0.0 |
type FieldType "thd" (a1, a2, a3, a4, a5, a6) = a3 Source | Since 0.4.0.0 |
type FieldType "fst" (a1, a2, a3, a4, a5, a6, a7) = a1 Source | Since 0.4.0.0 |
type FieldType "snd" (a1, a2, a3, a4, a5, a6, a7) = a2 Source | Since 0.4.0.0 |
type FieldType "thd" (a1, a2, a3, a4, a5, a6, a7) = a3 Source | Since 0.4.0.0 |
type FieldType "fst" (a1, a2, a3, a4, a5, a6, a7, a8) = a1 Source | Since 0.4.0.0 |
type FieldType "snd" (a1, a2, a3, a4, a5, a6, a7, a8) = a2 Source | Since 0.4.0.0 |
type FieldType "thd" (a1, a2, a3, a4, a5, a6, a7, a8) = a3 Source | Since 0.4.0.0 |
type FieldType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9) = a1 Source | Since 0.4.0.0 |
type FieldType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9) = a2 Source | Since 0.4.0.0 |
type FieldType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9) = a3 Source | Since 0.4.0.0 |
type FieldType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = a1 Source | Since 0.4.0.0 |
type FieldType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = a2 Source | Since 0.4.0.0 |
type FieldType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = a3 Source | Since 0.4.0.0 |
class HasField l s a | l s -> a where Source
Definition of this class is based on: https://phabricator.haskell.org/D1687
HasField "fieldDerivation" DeriveOverloadedRecordsParams FieldDerivation Source | |
HasField "head" [a] (Maybe a) Source |
Since 0.4.0.0 |
HasField "tail" [a] (Maybe [a]) Source |
Since 0.4.0.0 |
HasField "fst" (a, b) a Source | Since 0.4.0.0 |
HasField "snd" (a, b) b Source | Since 0.4.0.0 |
HasField "curry" ((a, b) -> c) (a -> b -> c) Source | Since 0.4.0.0 |
HasField "curry" ((a, b, c) -> d) (a -> b -> c -> d) Source | Since 0.4.0.0 |
HasField "curry" ((a1, a2, a3, a4) -> r) (a1 -> a2 -> a3 -> a4 -> r) Source | Since 0.4.0.0 |
HasField "curry" ((a1, a2, a3, a4, a5) -> r) (a1 -> a2 -> a3 -> a4 -> a5 -> r) Source | Since 0.4.0.0 |
HasField "curry" ((a1, a2, a3, a4, a5, a6) -> r) (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> r) Source | Since 0.4.0.0 |
HasField "curry" ((a1, a2, a3, a4, a5, a6, a7) -> r) (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> r) Source | Since 0.4.0.0 |
HasField "curry" ((a1, a2, a3, a4, a5, a6, a7, a8) -> r) (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> r) Source | Since 0.4.0.0 |
HasField "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9) -> r) (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> r) Source | Since 0.4.0.0 |
HasField "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> r) (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> r) Source | Since 0.4.0.0 |
HasField "fst" (a, b, c) a Source | Since 0.4.0.0 |
HasField "snd" (a, b, c) b Source | Since 0.4.0.0 |
HasField "thd" (a, b, c) c Source | Since 0.4.0.0 |
HasField "fst" (a1, a2, a3, a4) a1 Source | Since 0.4.0.0 |
HasField "snd" (a1, a2, a3, a4) a2 Source | Since 0.4.0.0 |
HasField "thd" (a1, a2, a3, a4) a3 Source | Since 0.4.0.0 |
HasField "fst" (a1, a2, a3, a4, a5) a1 Source | Since 0.4.0.0 |
HasField "snd" (a1, a2, a3, a4, a5) a2 Source | Since 0.4.0.0 |
HasField "thd" (a1, a2, a3, a4, a5) a3 Source | Since 0.4.0.0 |
HasField "fst" (a1, a2, a3, a4, a5, a6) a1 Source | Since 0.4.0.0 |
HasField "snd" (a1, a2, a3, a4, a5, a6) a2 Source | Since 0.4.0.0 |
HasField "thd" (a1, a2, a3, a4, a5, a6) a3 Source | Since 0.4.0.0 |
HasField "fst" (a1, a2, a3, a4, a5, a6, a7) a1 Source | Since 0.4.0.0 |
HasField "snd" (a1, a2, a3, a4, a5, a6, a7) a2 Source | Since 0.4.0.0 |
HasField "thd" (a1, a2, a3, a4, a5, a6, a7) a3 Source | Since 0.4.0.0 |
HasField "fst" (a1, a2, a3, a4, a5, a6, a7, a8) a1 Source | Since 0.4.0.0 |
HasField "snd" (a1, a2, a3, a4, a5, a6, a7, a8) a2 Source | Since 0.4.0.0 |
HasField "thd" (a1, a2, a3, a4, a5, a6, a7, a8) a3 Source | Since 0.4.0.0 |
HasField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9) a1 Source | Since 0.4.0.0 |
HasField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9) a2 Source | Since 0.4.0.0 |
HasField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9) a3 Source | Since 0.4.0.0 |
HasField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) a1 Source | Since 0.4.0.0 |
HasField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) a2 Source | Since 0.4.0.0 |
HasField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) a3 Source | Since 0.4.0.0 |
get :: Getter s a -> s -> a Source
Extract a getter function from overloaded label.
Example:
newtype Bar a = Bar {_bar :: a} overloadedRecord ''Bar
>>>
get #bar (Bar False)
False
Since 0.4.1.0
Setter and Modifier
type family UpdateType l s b :: * Source
If field l :: Symbol
of a record s :: *
is set to new value which has
type b :: *
, then the modified record will have type
.UpdateType
l s b
type UpdateType "fieldDerivation" DeriveOverloadedRecordsParams FieldDerivation = DeriveOverloadedRecordsParams Source | |
type UpdateType "head" [a] (Maybe a) = [a] Source | Since 0.4.0.0 |
type UpdateType "tail" [a] (Maybe [a]) = [a] Source | Since 0.4.0.0 |
type UpdateType "fst" (a, b) a' = (a', b) Source | Since 0.4.0.0 |
type UpdateType "snd" (a, b) b' = (a, b') Source | Since 0.4.0.0 |
type UpdateType "fst" (a, b, c) a' = (a', b, c) Source | Since 0.4.0.0 |
type UpdateType "snd" (a, b, c) b' = (a, b', c) Source | Since 0.4.0.0 |
type UpdateType "thd" (a, b, c) c' = (a, b, c') Source | Since 0.4.0.0 |
type UpdateType "fst" (a1, a2, a3, a4) a1' = (a1', a2, a3, a4) Source | Since 0.4.0.0 |
type UpdateType "snd" (a1, a2, a3, a4) a2' = (a1, a2', a3, a4) Source | Since 0.4.0.0 |
type UpdateType "thd" (a1, a2, a3, a4) a3' = (a1, a3', a3, a4) Source | Since 0.4.0.0 |
type UpdateType "fst" (a1, a2, a3, a4, a5) a1' = (a1', a2, a3, a4, a5) Source | Since 0.4.0.0 |
type UpdateType "snd" (a1, a2, a3, a4, a5) a2' = (a1, a2', a3, a4, a5) Source | Since 0.4.0.0 |
type UpdateType "thd" (a1, a2, a3, a4, a5) a3' = (a1, a2, a3', a4, a5) Source | Since 0.4.0.0 |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6) a1' = (a1', a2, a3, a4, a5, a6) Source | Since 0.4.0.0 |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6) a2' = (a1, a2', a3, a4, a5, a6) Source | Since 0.4.0.0 |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6) a3' = (a1, a2, a3', a4, a5, a6) Source | Since 0.4.0.0 |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6, a7) a1' = (a1', a2, a3, a4, a5, a6, a7) Source | Since 0.4.0.0 |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6, a7) a2' = (a1, a2', a3, a4, a5, a6, a7) Source | Since 0.4.0.0 |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6, a7) a3' = (a1, a2, a3', a4, a5, a6, a7) Source | Since 0.4.0.0 |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6, a7, a8) a1' = (a1', a2, a3, a4, a5, a6, a7, a8) Source | Since 0.4.0.0 |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6, a7, a8) a2' = (a1, a2', a3, a4, a5, a6, a7, a8) Source | Since 0.4.0.0 |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6, a7, a8) a3' = (a1, a2, a3', a4, a5, a6, a7, a8) Source | Since 0.4.0.0 |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9) a1' = (a1', a2, a3, a4, a5, a6, a7, a8, a9) Source | Since 0.4.0.0 |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9) a2' = (a1, a2', a3, a4, a5, a6, a7, a8, a9) Source | Since 0.4.0.0 |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9) a3' = (a1, a2, a3', a4, a5, a6, a7, a8, a9) Source | Since 0.4.0.0 |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) a1' = (a1', a2, a3, a4, a5, a6, a7, a8, a9, a10) Source | Since 0.4.0.0 |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) a2' = (a1, a2', a3, a4, a5, a6, a7, a8, a9, a10) Source | Since 0.4.0.0 |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) a3' = (a1, a2, a3', a4, a5, a6, a7, a8, a9, a10) Source | Since 0.4.0.0 |
class HasField l s a => ModifyField l s t a b | l s -> a, l t -> b, l s b -> t, l t a -> s where Source
Represents overloaded record fields that can be modified, i.e. updated.
forall l a b s t.
ModifyField
l s t a b => a = b <==> s = t
In other words, if field is modified and its type has changed, then the type of the record has to change as well, and vice versa. Functional dependencies enforce this rule.
Since 0.4.0.0
modifyField :: Proxy# l -> (a -> b) -> s -> t Source
Modify overloaded field l ::
of record Symbol
s
using pure
function a -> b
, and produce new record t
.
setField :: Proxy# l -> s -> b -> t Source
Set overloaded field l ::
of record Symbol
s
to value of type
b
, and produce new record t
. Please note that there is no mention of
the type a
, therefore the compiler may not be able to derive it in
some cases.
fieldLens :: Functor f => Proxy# l -> (a -> f b) -> s -> f t Source
Lens for overloaded field l ::
of record Symbol
s
.
ModifyField "fieldDerivation" DeriveOverloadedRecordsParams DeriveOverloadedRecordsParams FieldDerivation FieldDerivation Source | |
ModifyField "head" [a] [a] (Maybe a) (Maybe a) Source |
Since 0.4.0.0 |
ModifyField "tail" [a] [a] (Maybe [a]) (Maybe [a]) Source |
Since 0.4.0.0 |
ModifyField "fst" (a, b) (a', b) a a' Source | Since 0.4.0.0 |
ModifyField "snd" (a, b) (a, b') b b' Source | Since 0.4.0.0 |
ModifyField "fst" (a, b, c) (a', b, c) a a' Source | Since 0.4.0.0 |
ModifyField "snd" (a, b, c) (a, b', c) b b' Source | Since 0.4.0.0 |
ModifyField "thd" (a, b, c) (a, b, c') c c' Source | Since 0.4.0.0 |
ModifyField "fst" (a1, a2, a3, a4) (a1', a2, a3, a4) a1 a1' Source | Since 0.4.0.0 |
ModifyField "snd" (a1, a2, a3, a4) (a1, a2', a3, a4) a2 a2' Source | Since 0.4.0.0 |
ModifyField "thd" (a1, a2, a3, a4) (a1, a2, a3', a4) a3 a3' Source | Since 0.4.0.0 |
ModifyField "fst" (a1, a2, a3, a4, a5) (a1', a2, a3, a4, a5) a1 a1' Source | Since 0.4.0.0 |
ModifyField "snd" (a1, a2, a3, a4, a5) (a1, a2', a3, a4, a5) a2 a2' Source | Since 0.4.0.0 |
ModifyField "thd" (a1, a2, a3, a4, a5) (a1, a2, a3', a4, a5) a3 a3' Source | Since 0.4.0.0 |
ModifyField "fst" (a1, a2, a3, a4, a5, a6) (a1', a2, a3, a4, a5, a6) a1 a1' Source | Since 0.4.0.0 |
ModifyField "snd" (a1, a2, a3, a4, a5, a6) (a1, a2', a3, a4, a5, a6) a2 a2' Source | Since 0.4.0.0 |
ModifyField "thd" (a1, a2, a3, a4, a5, a6) (a1, a2, a3', a4, a5, a6) a3 a3' Source | Since 0.4.0.0 |
ModifyField "fst" (a1, a2, a3, a4, a5, a6, a7) (a1', a2, a3, a4, a5, a6, a7) a1 a1' Source | Since 0.4.0.0 |
ModifyField "snd" (a1, a2, a3, a4, a5, a6, a7) (a1, a2', a3, a4, a5, a6, a7) a2 a2' Source | Since 0.4.0.0 |
ModifyField "thd" (a1, a2, a3, a4, a5, a6, a7) (a1, a2, a3', a4, a5, a6, a7) a3 a3' Source | Since 0.4.0.0 |
ModifyField "fst" (a1, a2, a3, a4, a5, a6, a7, a8) (a1', a2, a3, a4, a5, a6, a7, a8) a1 a1' Source | Since 0.4.0.0 |
ModifyField "snd" (a1, a2, a3, a4, a5, a6, a7, a8) (a1, a2', a3, a4, a5, a6, a7, a8) a2 a2' Source | Since 0.4.0.0 |
ModifyField "thd" (a1, a2, a3, a4, a5, a6, a7, a8) (a1, a2, a3', a4, a5, a6, a7, a8) a3 a3' Source | Since 0.4.0.0 |
ModifyField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9) (a1', a2, a3, a4, a5, a6, a7, a8, a9) a1 a1' Source | Since 0.4.0.0 |
ModifyField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9) (a1, a2', a3, a4, a5, a6, a7, a8, a9) a2 a2' Source | Since 0.4.0.0 |
ModifyField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9) (a1, a2, a3', a4, a5, a6, a7, a8, a9) a3 a3' Source | Since 0.4.0.0 |
ModifyField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) (a1', a2, a3, a4, a5, a6, a7, a8, a9, a10) a1 a1' Source | Since 0.4.0.0 |
ModifyField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) (a1, a2', a3, a4, a5, a6, a7, a8, a9, a10) a2 a2' Source | Since 0.4.0.0 |
ModifyField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) (a1, a2, a3', a4, a5, a6, a7, a8, a9, a10) a3 a3' Source | Since 0.4.0.0 |
type family R ts r :: Constraint Source
Using this type family provides more compact type signatures for multiple record fields.
data V3 a = V3 { _x :: a , _y :: a , _z :: a } deriving ShowoverloadedRecord
def ''V3 setV3 ::R
'["x":::
a, "y":::
a, "z":::
a] r => a -> a -> a -> r -> r setV3 x y z =set'
#x x .set'
#y y .set'
#z z
>>>
setV3 0 0 0 (V3 1 1 1 :: V3 Int)
V3 {_x = 0, _y = 0, _z = 0}
Since 0.4.0.0
R `[]` r = () | |
R (`(l, a)` : ts) r = (ModifyField' l r a, R ts r) |
type (:::) l a = `(l, a)` Source
This type alias is used for more readable type signatures when using R
type family.
Since 0.4.0.0
Pass polymorphic record as a value along with all necessary instances. By
pattern matching on Rec
data constructor all those instances come in to
scope.
Example:
{--} -- Required in addition to the basic set of language extensions. data V3 a = V3 { _x :: a , _y :: a , _z :: a } deriving ShowoverloadedRecord
def ''V3 zeroV3 ::Rec
'["x":::
a, "y":::
a, "z":::
a] r -> r -> r zeroV3 (Rec r) =set'
#x 0 .set'
#y 0 $set'
#z 0 r
>>>
zeroV3 (V3 1 1 1 :: V3 Int)
V3 {_x = 0, _y = 0, _z = 0}
Since 0.4.1.0
setting :: Setting a s t b -> Proxy a -> b -> s -> t Source
Same as set
, but allows us to use phantom type to restrict the type of a
value before it was changed.
newtype Bar a = Bar {_bar :: a} deriving Show overloadedRecord ''Bar
Now we can use setting
to change the value stored in Bar
. The type
signature in following example is not required, it is what type checker
would infer.
setting
#bar (Proxy
@Int) False :: Bar Int -> Bar Bool
Since 0.4.0.0
type Setter s t b = forall a. Modifier s t a b Source
Wrapper for a set function, lens naming convention is used for type
variables. Its instance for IsLabel
forces overloaded label to behave as a
setter. We could also define Setter
as:
typeSetter
s t b = forall a.Setting
a s t b
Notice that the forall a
forbids us from stating what exactly it is,
therefore functional dependencies in ModifyField
type class have to be
able to uniquely identify it. If that is not possible, then we may have to
use explicit type signature.
See also Setting
, Setter'
, Modifier
, and Modifier'
.
Definition changed in 0.4.0.0
modify :: Modifier s t a b -> (a -> b) -> s -> t Source
Modify field value using provided function.
Since 0.4.0.0
Simple Setter and Modifier
type ModifyField' l s a = ModifyField l s s a a Source
Same as ModifyField
, but type-changing assignment is prohibited.
Since 0.4.0.0
fieldLens' :: (Functor f, ModifyField' l s a) => Proxy# l -> (a -> f a) -> s -> f s Source
Same as modifyField
, but the field type can not be changed.
Since 0.4.0.0
modifyField' :: ModifyField' l s a => Proxy# l -> (a -> a) -> s -> s Source
Same as modifyField
, but the field type can not be changed.
Since 0.4.0.0
setField' :: ModifyField' l s a => Proxy# l -> s -> a -> s Source
Same as setFiend
, but the field type can not be changed.
Since 0.4.0.0
modify' :: Modifier' s a -> (a -> a) -> s -> s Source
Same as modify
, but the field type can not be changed.
Since 0.4.0.0
IsLabel For Getter and Lens
class (z ~ FromArrow x) => IsFieldAccessor l x y z | l y -> x where Source
Distinguish between getter and lens.
fieldAccessor :: Proxy# l -> x -> y Source
(HasField l s a, (~) Bool (FromArrow s) False) => IsFieldAccessor l s a False Source | Overloaded getter:
|
(Functor f, ModifyField l s t a b) => IsFieldAccessor l (a -> f b) (s -> f t) True Source | Overloaded lens:
|