Copyright | (c) 2016, Peter Trško |
---|---|
License | BSD3 |
Maintainer | peter.trsko@gmail.com |
Stability | experimental |
Portability | GHC specific language extensions. |
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 :: Symbol) (s :: *) :: *
- class HasField l s a | l s -> a where
- data Getter s a
- get :: Getter s a -> s -> a
- type family UpdateType (l :: Symbol) (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 :: [(Symbol, *)]) (r :: *) :: Constraint where ...
- type family Rs (cs :: [[(Symbol, *)]]) (r :: *) where ...
- type (:::) l a = '(l, a)
- data Rec ctx 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
- newtype Modifier s t a b = Modifier ((a -> b) -> s -> t)
- modify :: Modifier s t a b -> (a -> b) -> s -> t
- newtype WrappedLensLike f s t a b = WrappedLensLike ((a -> f b) -> s -> f t)
- lns :: WrappedLensLike f s t a b -> (a -> f b) -> s -> f t
- class ModifyRec# l a cs (Position l a cs) (Position l a cs == 0) => ModifyRec l a cs where
- weakenRec :: Rec ((l ::: a) ': ctx) r -> Rec ctx r
- strengthenRec :: ModifyField' l r a => Rec ctx r -> Rec ((l ::: a) ': ctx) r
- type family Position (l :: Symbol) (a :: *) (cs :: [(Symbol, *)]) :: Nat where ...
- 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 WrappedLensLike' f s a = WrappedLensLike f s s a a
- lns' :: WrappedLensLike' f s a -> (a -> f a) -> s -> f s
- type family FromArrow (a :: *) :: Bool where ...
- class z ~ FromArrow x => IsFieldAccessor l x y z | l y -> x where
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 :: Symbol) (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 Source # | |
type FieldType "head" [a] Source # | |
type FieldType "tail" [a] Source # | |
type FieldType "curry" ((a, b) -> c) Source # | |
type FieldType "curry" ((a, b, c) -> d) Source # | |
type FieldType "curry" ((a1, a2, a3, a4) -> r) Source # | |
type FieldType "curry" ((a1, a2, a3, a4, a5) -> r) Source # | |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6) -> r) Source # | |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6, a7) -> r) Source # | |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6, a7, a8) -> r) Source # | |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9) -> r) Source # | |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) -> r) Source # | |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) -> r) Source # | |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) -> r) Source # | |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) -> r) Source # | |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) -> r) Source # | |
type FieldType "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) -> r) Source # | |
type FieldType "fst" (a, b) Source # | |
type FieldType "snd" (a, b) Source # | |
type FieldType "fst" (a, b, c) Source # | |
type FieldType "snd" (a, b, c) Source # | |
type FieldType "thd" (a, b, c) Source # | |
type FieldType "fst" (a1, a2, a3, a4) Source # | |
type FieldType "snd" (a1, a2, a3, a4) Source # | |
type FieldType "thd" (a1, a2, a3, a4) Source # | |
type FieldType "fst" (a1, a2, a3, a4, a5) Source # | |
type FieldType "snd" (a1, a2, a3, a4, a5) Source # | |
type FieldType "thd" (a1, a2, a3, a4, a5) Source # | |
type FieldType "fst" (a1, a2, a3, a4, a5, a6) Source # | |
type FieldType "snd" (a1, a2, a3, a4, a5, a6) Source # | |
type FieldType "thd" (a1, a2, a3, a4, a5, a6) Source # | |
type FieldType "fst" (a1, a2, a3, a4, a5, a6, a7) Source # | |
type FieldType "snd" (a1, a2, a3, a4, a5, a6, a7) Source # | |
type FieldType "thd" (a1, a2, a3, a4, a5, a6, a7) Source # | |
type FieldType "fst" (a1, a2, a3, a4, a5, a6, a7, a8) Source # | |
type FieldType "snd" (a1, a2, a3, a4, a5, a6, a7, a8) Source # | |
type FieldType "thd" (a1, a2, a3, a4, a5, a6, a7, a8) Source # | |
type FieldType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9) Source # | |
type FieldType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9) Source # | |
type FieldType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9) Source # | |
type FieldType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) Source # | |
type FieldType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) Source # | |
type FieldType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) Source # | |
type FieldType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) Source # | |
type FieldType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) Source # | |
type FieldType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) Source # | |
type FieldType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) Source # | |
type FieldType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) Source # | |
type FieldType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) Source # | |
type FieldType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) Source # | |
type FieldType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) Source # | |
type FieldType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) Source # | |
type FieldType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) Source # | |
type FieldType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) Source # | |
type FieldType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) Source # | |
type FieldType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) Source # | |
type FieldType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) Source # | |
type FieldType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) Source # | |
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 "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) -> r) (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> r) Source # | Since 0.4.2.0 |
HasField "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) -> r) (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> r) Source # | Since 0.4.2.0 |
HasField "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) -> r) (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> a13 -> r) Source # | Since 0.4.2.0 |
HasField "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) -> r) (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> a13 -> a14 -> r) Source # | Since 0.4.2.0 |
HasField "curry" ((a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) -> r) (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> a13 -> a14 -> a15 -> r) Source # | Since 0.4.2.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 |
HasField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) a1 Source # | Since 0.4.2.0 |
HasField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) a2 Source # | Since 0.4.2.0 |
HasField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) a3 Source # | Since 0.4.2.0 |
HasField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) a1 Source # | Since 0.4.2.0 |
HasField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) a2 Source # | Since 0.4.2.0 |
HasField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) a3 Source # | Since 0.4.2.0 |
HasField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) a1 Source # | Since 0.4.2.0 |
HasField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) a2 Source # | Since 0.4.2.0 |
HasField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) a3 Source # | Since 0.4.2.0 |
HasField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) a1 Source # | Since 0.4.2.0 |
HasField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) a2 Source # | Since 0.4.2.0 |
HasField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) a3 Source # | Since 0.4.2.0 |
HasField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) a1 Source # | Since 0.4.2.0 |
HasField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) a2 Source # | Since 0.4.2.0 |
HasField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) a3 Source # | Since 0.4.2.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, Modifier and Lens
type family UpdateType (l :: Symbol) (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 Source # | |
type UpdateType "head" [a] (Maybe a) Source # | |
type UpdateType "tail" [a] (Maybe [a]) Source # | |
type UpdateType "fst" (a, b) a' Source # | |
type UpdateType "snd" (a, b) b' Source # | |
type UpdateType "fst" (a, b, c) a' Source # | |
type UpdateType "snd" (a, b, c) b' Source # | |
type UpdateType "thd" (a, b, c) c' Source # | |
type UpdateType "fst" (a1, a2, a3, a4) a1' Source # | |
type UpdateType "snd" (a1, a2, a3, a4) a2' Source # | |
type UpdateType "thd" (a1, a2, a3, a4) a3' Source # | |
type UpdateType "fst" (a1, a2, a3, a4, a5) a1' Source # | |
type UpdateType "snd" (a1, a2, a3, a4, a5) a2' Source # | |
type UpdateType "thd" (a1, a2, a3, a4, a5) a3' Source # | |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6) a1' Source # | |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6) a2' Source # | |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6) a3' Source # | |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6, a7) a1' Source # | |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6, a7) a2' Source # | |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6, a7) a3' Source # | |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6, a7, a8) a1' Source # | |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6, a7, a8) a2' Source # | |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6, a7, a8) a3' Source # | |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9) a1' Source # | |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9) a2' Source # | |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9) a3' Source # | |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) a1' Source # | |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) a2' Source # | |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) a3' Source # | |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) a1' Source # | |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) a2' Source # | |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) a3' Source # | |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) a1' Source # | |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) a2' Source # | |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) a3' Source # | |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) a1' Source # | |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) a2' Source # | |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) a3' Source # | |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) a1' Source # | |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) a2' Source # | |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) a3' Source # | |
type UpdateType "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) a1' Source # | |
type UpdateType "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) a2' Source # | |
type UpdateType "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) a3' Source # | |
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 |
ModifyField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) (a1', a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) a1 a1' Source # | Since 0.4.2.0 |
ModifyField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) (a1, a2', a3, a4, a5, a6, a7, a8, a9, a10, a11) a2 a2' Source # | Since 0.4.2.0 |
ModifyField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) (a1, a2, a3', a4, a5, a6, a7, a8, a9, a10, a11) a3 a3' Source # | Since 0.4.2.0 |
ModifyField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) (a1', a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) a1 a1' Source # | Since 0.4.2.0 |
ModifyField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) (a1, a2', a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) a2 a2' Source # | Since 0.4.2.0 |
ModifyField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) (a1, a2, a3', a4, a5, a6, a7, a8, a9, a10, a11, a12) a3 a3' Source # | Since 0.4.2.0 |
ModifyField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) (a1', a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) a1 a1' Source # | Since 0.4.2.0 |
ModifyField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) (a1, a2', a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) a2 a2' Source # | Since 0.4.2.0 |
ModifyField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) (a1, a2, a3', a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) a3 a3' Source # | Since 0.4.2.0 |
ModifyField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) (a1', a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) a1 a1' Source # | Since 0.4.2.0 |
ModifyField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) (a1, a2', a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) a2 a2' Source # | Since 0.4.2.0 |
ModifyField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) (a1, a2, a3', a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) a3 a3' Source # | Since 0.4.2.0 |
ModifyField "fst" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) (a1', a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) a1 a1' Source # | Since 0.4.2.0 |
ModifyField "snd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) (a1, a2', a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) a2 a2' Source # | Since 0.4.2.0 |
ModifyField "thd" (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) (a1, a2, a3', a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) a3 a3' Source # | Since 0.4.2.0 |
type family R (ts :: [(Symbol, *)]) (r :: *) :: Constraint where ... 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 family Rs (cs :: [[(Symbol, *)]]) (r :: *) where ... Source #
Union/concatenation of record constraints.
Since 0.4.2.0
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:
{-# LANGUAGE GADTs #-} -- May be 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}
Difference between using a constraint, via R
type family, and using Rec
,
is that Rec
retains run-time proof that the record has a specified fields.
More about this distinction can be found for example in
Hasochism: The Pleasure and Pain of Dependently Typed Haskell Programming
by Sam Lindley and Conor McBride available on-line
https://personal.cis.strath.ac.uk/conor.mcbride/pub/hasochism.pdf.
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
newtype Modifier s t a b Source #
Wrapper for a modification function, lens naming convention is used for
type variables. Its instance for IsLabel
forces overloaded label to behave
as a modification function.
See also Modifier'
, Setting
, Setter
, and Setter'
.
Since 0.4.0.0
Modifier ((a -> b) -> s -> t) |
modify :: Modifier s t a b -> (a -> b) -> s -> t Source #
Modify field value using provided function.
Since 0.4.0.0
newtype WrappedLensLike f s t a b Source #
Since 0.4.2.0
WrappedLensLike ((a -> f b) -> s -> f t) |
(Functor f, ModifyField l s t a b) => IsLabel l (WrappedLensLike f s t a b) Source # | Since 0.4.2.0 |
lns :: WrappedLensLike f s t a b -> (a -> f b) -> s -> f t Source #
Since 0.4.2.0
class ModifyRec# l a cs (Position l a cs) (Position l a cs == 0) => ModifyRec l a cs where Source #
This type class provides functionality as HasField
and ModifyField
,
but for overloaded records wrapped in Rec
type.
strengthenRec :: ModifyField' l r a => Rec ctx r -> Rec ((l ::: a) ': ctx) r Source #
Strengthening a record constraint.
type family Position (l :: Symbol) (a :: *) (cs :: [(Symbol, *)]) :: Nat where ... Source #
Calculate position of (l :: Symbol, a :: *)
in type level list (cs ::
[(Symbol, *)])
. It is used to move through type level list via the type
class instance chain until the correct element is reached.
Simple Setter, Modifier and Lens
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
type WrappedLensLike' f s a = WrappedLensLike f s s a a Source #
Since 0.4.2.0
lns' :: WrappedLensLike' f s a -> (a -> f a) -> s -> f s Source #
Since 0.4.2.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 #
Orphan instances
IsFieldAccessor l x y (FromArrow x) => IsLabel l (x -> y) Source # | |