overloaded-records-0.4.1.0: Overloaded Records based on current GHC proposal.

Copyright(c) 2016, Peter Trško
LicenseBSD3
Maintainerpeter.trsko@gmail.com
Stabilityexperimental
PortabilityConstraintKinds, DataKinds, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, FlexibleContexts, FunctionalDependencies, GADTs, LambdaCase, MagicHash, MultiParamTypeClasses, NoImplicitPrelude, RankNTypes, TypeFamilies, TypeOperators, UndecidableInstances
Safe HaskellNone
LanguageHaskell2010

Data.OverloadedRecords

Contents

Description

Magic classes for OverloadedRecordFields.

Implementation is based on: https://github.com/adamgundry/records-prototype/blob/master/CoherentPrototype.hs by Adam Gundry under MIT License.

Synopsis

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 family R is a Constraint 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 Show

overloadedRecord 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

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.

Instances

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

Methods

getField :: Proxy# l -> s -> a Source

Get value of a field.

Instances

HasField "fieldDerivation" DeriveOverloadedRecordsParams FieldDerivation Source 
HasField "head" [a] (Maybe a) Source
>>> #head []
Nothing
>>> #head [1, 2, 3]
Just 1

Since 0.4.0.0

HasField "tail" [a] (Maybe [a]) Source
>>> #tail []
Nothing
>>> #tail [1, 2, 3]
Just [2, 3]

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

data Getter s a Source

Provides alternative to the "native" IsLabel instance for getter. Since mixing getter instance and lens instance for IsLabel on polymorphic records is not possible, one may want to use Getter as an alternative.

Since 0.4.1.0

Instances

HasField l s a => IsLabel l (Getter s a) Source

Since 0.4.1.0

Generic1 (Getter s) Source 
Generic (Getter s a) Source 
type Rep1 (Getter s) Source 
type Rep (Getter s a) Source 

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.

Instances

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

Minimal complete definition

modifyField | setField

Methods

modifyField :: Proxy# l -> (a -> b) -> s -> t Source

Modify overloaded field l :: Symbol of record s using pure function a -> b, and produce new record t.

setField :: Proxy# l -> s -> b -> t Source

Set overloaded field l :: Symbol of record 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 :: Symbol of record s.

Instances

ModifyField "fieldDerivation" DeriveOverloadedRecordsParams DeriveOverloadedRecordsParams FieldDerivation FieldDerivation Source 
ModifyField "head" [a] [a] (Maybe a) (Maybe a) Source
>>> set' #head [] Nothing :: [Int]
[]
>>> set' #head [] (Just 1)
[1]
>>> set' #head [1, 2, 3] Nothing
[2, 3]
>>> set' #head [1, 2, 3] (Just 4)
[4, 2, 3]

Since 0.4.0.0

ModifyField "tail" [a] [a] (Maybe [a]) (Maybe [a]) Source
>>> set' #tail [] Nothing :: [Int]
[]
>>> set' #tail [] (Just [2, 3])
[2, 3]
>>> set' #tail [1, 2, 3] Nothing
[1]
>>> set' #tail [1, 2, 3] (Just [4, 5, 6])
[1, 4, 5, 6]

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 Show

overloadedRecord 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

Equations

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

data Rec ts r where Source

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 Show

overloadedRecord 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

Constructors

Rec :: R ts r => r -> Rec ts r 

type Setting a s t b = Modifier s t a b Source

Setting is just a form of a Modifier that allows us to specify what was the original type of the value we are changing.

See also Setter, Setter', Modifier, and Modifier'.

Since 0.4.0.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:

type Setter 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

set :: Setter s t b -> b -> s -> t Source

Extract set function from Setter. Using Modifier instance for IsLabel forces overloaded label to behave as a setter.

Usage example:

newtype Bar a = Bar {_bar :: a}
  deriving Show

overloadedRecord ''Bar
>>> set #bar (Nothing :: Maybe Int) (Bar (Just False))
Bar {_bar = Nothing}

data 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

Instances

ModifyField l s t a b => IsLabel l (Modifier s t a b) Source

Since 0.4.0.0

Generic (Modifier s t a b) Source 
type Rep (Modifier s t a b) Source 

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

type Setter' s a = Modifier' s a Source

Simple Setter which forbids changing the field type. It can be also defined in terms of Setting:

type Setter' s a = Setting a s s a

See also Setting, Setter, Modifier, and Modifier'.

Definition changed in 0.4.0.0

set' :: Setter' s a -> a -> s -> s Source

Same as set, but the field type can not be changed.

type Modifier' s a = Modifier s s a a Source

Simple Modifier which forbids changing the field type.

See also Modifier, Modifier', Setting, Setter, and Setter'.

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

type family FromArrow a :: Bool Source

Returns True if type a :: * is a function.

Equations

FromArrow (x -> y) = True 
FromArrow t = False 

class (z ~ FromArrow x) => IsFieldAccessor l x y z | l y -> x where Source

Distinguish between getter and lens.

Methods

fieldAccessor :: Proxy# l -> x -> y Source

Instances

(HasField l s a, (~) Bool (FromArrow s) False) => IsFieldAccessor l s a False Source

Overloaded getter:

Proxy# l -> r -> a
(Functor f, ModifyField l s t a b) => IsFieldAccessor l (a -> f b) (s -> f t) True Source

Overloaded lens:

Functor f => Proxy# l -> (a -> f b) -> s -> f t