Safe Haskell | None |
---|---|
Language | Haskell2010 |
Data.Record.Anon.Simple
Description
Simple interface (without a functor argument)
See Data.Record.Anon.Advanced for the advanced interface. You will probably also want to import Data.Record.Anon.
Intended for qualified import.
import Data.Record.Anon import Data.Record.Anon.Simple (Record) import qualified Data.Record.Anon.Simple as Anon
Synopsis
- data Record (r :: Row Type)
- empty :: Record ('[] :: [Pair Symbol Type])
- insert :: forall (n :: Symbol) a (r :: Row Type). Field n -> a -> Record r -> Record ((n ':= a) ': r)
- insertA :: forall m (n :: Symbol) a (r :: Row Type). Applicative m => Field n -> m a -> m (Record r) -> m (Record ((n ':= a) ': r))
- applyPending :: forall (r :: Row Type). Record r -> Record r
- get :: forall (n :: Symbol) (r :: Row Type) a. RowHasField n r a => Field n -> Record r -> a
- set :: forall (n :: Symbol) (r :: Row Type) a. RowHasField n r a => Field n -> a -> Record r -> Record r
- project :: forall (r :: Row Type) (r' :: Row Type). SubRow r r' => Record r -> Record r'
- inject :: forall (r :: Row Type) (r' :: Row Type). SubRow r r' => Record r' -> Record r -> Record r
- lens :: forall (r :: Row Type) (r' :: Row Type). SubRow r r' => Record r -> (Record r', Record r' -> Record r)
- merge :: forall (r :: Row Type) (r' :: Row Type). Record r -> Record r' -> Record (Merge r r')
- toAdvanced :: forall (r :: Row Type). Record r -> Record I r
- fromAdvanced :: forall (r :: Row Type). Record I r -> Record r
- sequenceA :: forall m (r :: Row Type). Applicative m => Record m r -> m (Record r)
- letRecordT :: forall (r :: Row Type). (forall (r' :: Row Type). Let r' r => Proxy r' -> Record r) -> Record r
- letInsertAs :: forall (r :: Row Type) (r' :: Row Type) (n :: Symbol) a. Proxy r -> Field n -> a -> Record r' -> (forall (r'' :: [Pair Symbol Type]). Let r'' ((n ':= a) ': r') => Record r'' -> Record r) -> Record r
- castEqual :: Equal a b => a -> b
Documentation
data Record (r :: Row Type) Source #
Anonymous record
A Record r
has a field n
of type x
for every (n := x)
in r
.
To construct a Record
, use insert
and
empty
, or use the ANON
syntax. See
insert
for examples.
To access fields of the record, either use the HasField
instances (possibly using the record-dot-preprocessor
), or using
get
and set
.
Remember to enable the plugin when working with anonymous records:
{-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-}
NOTE: For some applications it is useful to have an additional functor
parameter f
, so that every field has type f x
instead.
See Data.Record.Anon.Advanced.
Instances
Construction
insert :: forall (n :: Symbol) a (r :: Row Type). Field n -> a -> Record r -> Record ((n ':= a) ': r) Source #
insertA :: forall m (n :: Symbol) a (r :: Row Type). Applicative m => Field n -> m a -> m (Record r) -> m (Record ((n ':= a) ': r)) Source #
Applicative insert
This is a simple wrapper around insert
, but can be quite useful when
constructing records. Consider code like
>>>
:{
example :: Applicative m => m a -> m b -> m (a, b) example ma mb = (,) <$> ma <*> mb :}
We cannot really extend this to the world of named records, but we can do something comparable using anonymous records:
>>>
:{
example :: Applicative m => m a -> m b -> m (Record [ "a" := a, "b" := b ]) example ma mb = insertA #a ma $ insertA #b mb $ pure empty :}
However, it may be more convenient to use the advanced API for this.
See insertA
.
applyPending :: forall (r :: Row Type). Record r -> Record r Source #
Apply all pending changes to the record
Updates to a record are stored in a hashtable. As this hashtable grows,
record field access and update will become more expensive. Applying the
updates, resulting in a flat vector, is an O(n)
operation. This will happen
automatically whenever another O(n)
operation is applied (for example,
mapping a function over the record). However, occassionally it is useful to
explicitly apply these changes, for example after constructing a record or
updating a lot of fields.
Field access
get :: forall (n :: Symbol) (r :: Row Type) a. RowHasField n r a => Field n -> Record r -> a Source #
Get field from the record
This is just a wrapper around getField
.
>>>
:{
example :: Record [ "a" := Bool, "b" := Int ] -> Bool example r = get #a r :}
If using record-dot-preprocessor
, you can also write this example as
example r = r.a
See get
for additional discussion.
set :: forall (n :: Symbol) (r :: Row Type) a. RowHasField n r a => Field n -> a -> Record r -> Record r Source #
Update field in the record
This is just a wrapper around setField
.
>>>
:{
example :: Record [ "a" := Bool, "b" := Int ] -> Record [ "a" := Bool, "b" := Int ] example r = set #a False r :}
If using record-dot-preprocessor
, can also write this example as
example r = r{a = False}
Changing rows
project :: forall (r :: Row Type) (r' :: Row Type). SubRow r r' => Record r -> Record r' Source #
Project from one record to another
Both the source record and the target record must be fully known.
The target record can omit fields from the source record, as well as rearrange them:
>>>
:{
example :: Record [ "a" := Char, "b" := Int, "c" := Bool ] -> Record [ "c" := Bool, "a" := Char ] example = project :}
As we saw in merge
, project
can also flatten Merge
d rows.
See project
for additional discussion.
inject :: forall (r :: Row Type) (r' :: Row Type). SubRow r r' => Record r' -> Record r -> Record r Source #
Inject smaller record into larger record
This is just the lens
setter.
lens :: forall (r :: Row Type) (r' :: Row Type). SubRow r r' => Record r -> (Record r', Record r' -> Record r) Source #
merge :: forall (r :: Row Type) (r' :: Row Type). Record r -> Record r' -> Record (Merge r r') Source #
Merge two records
The Merge
type family does not reduce:
>>>
:{
example :: Record (Merge '[ "a" := Bool ] '[]) example = merge (insert #a True empty) empty :}
If you want to flatten the row after merging, you can use project
:
>>>
:{
example :: Record '[ "a" := Bool ] example = project $ merge (insert #a True empty) empty :}
See merge
for additional discussion.
Interop with the advanced API
toAdvanced :: forall (r :: Row Type). Record r -> Record I r Source #
Move from the simple to the advanced interface
This is an O(1)
operation.
fromAdvanced :: forall (r :: Row Type). Record I r -> Record r Source #
Move from the advanced to the simple interface
This is an O(1)
operation.
sequenceA :: forall m (r :: Row Type). Applicative m => Record m r -> m (Record r) Source #
Sequence all actions
Experimental integration with typelet
The typelet
plugin provides support for type sharing. These functions
can be used to construct records that result in ghc core that is truly
linear in size.
letRecordT :: forall (r :: Row Type). (forall (r' :: Row Type). Let r' r => Proxy r' -> Record r) -> Record r Source #
Introduce type variable for a row
This can be used in conjunction with letInsertAs
:
>>>
:{
example :: Record '[ "a" := Int, "b" := Char, "c" := Bool ] example = letRecordT $ \p -> castEqual $ letInsertAs p #c True empty $ \xs02 -> letInsertAs p #b 'X' xs02 $ \xs01 -> letInsertAs p #a 1 xs01 $ \xs00 -> castEqual xs00 :}
Arguments
:: forall (r :: Row Type) (r' :: Row Type) (n :: Symbol) a. Proxy r | Type of the record we are constructing |
-> Field n | New field to be inserted |
-> a | Value of the new field |
-> Record r' | Record constructed so far |
-> (forall (r'' :: [Pair Symbol Type]). Let r'' ((n ':= a) ': r') => Record r'' -> Record r) | Assign type variable to new partial record, and continue |
-> Record r |
Insert field into a record and introduce type variable for the result