large-anon-0.3.3: Scalable anonymous records
Safe HaskellNone
LanguageHaskell2010

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

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

Instances details
HasField n (Record I r) (I a) => HasField (n :: Symbol) (Record r) a Source # 
Instance details

Defined in Data.Record.Anon.Internal.Simple

Methods

getField :: Record r -> a #

HasField n (Record I r) (I a) => HasField (n :: Symbol) (Record r) a Source # 
Instance details

Defined in Data.Record.Anon.Internal.Simple

Methods

hasField :: Record r -> (a -> Record r, a) #

LabelOptic n A_Lens (Record I r) (Record I r) (I a) (I a) => LabelOptic n A_Lens (Record r) (Record r) a a Source # 
Instance details

Defined in Data.Record.Anon.Internal.Simple

Methods

labelOptic :: Optic A_Lens NoIx (Record r) (Record r) a a #

RecordConstraints r FromJSON => FromJSON (Record r) Source # 
Instance details

Defined in Data.Record.Anon.Internal.Simple

RecordConstraints r ToJSON => ToJSON (Record r) Source # 
Instance details

Defined in Data.Record.Anon.Internal.Simple

RecordConstraints r Show => Show (Record r) Source # 
Instance details

Defined in Data.Record.Anon.Internal.Simple

Methods

showsPrec :: Int -> Record r -> ShowS #

show :: Record r -> String #

showList :: [Record r] -> ShowS #

RecordConstraints r NFData => NFData (Record r) Source # 
Instance details

Defined in Data.Record.Anon.Internal.Simple

Methods

rnf :: Record r -> () #

RecordConstraints r Eq => Eq (Record r) Source # 
Instance details

Defined in Data.Record.Anon.Internal.Simple

Methods

(==) :: Record r -> Record r -> Bool #

(/=) :: Record r -> Record r -> Bool #

(RecordConstraints r Eq, RecordConstraints r Ord) => Ord (Record r) Source # 
Instance details

Defined in Data.Record.Anon.Internal.Simple

Methods

compare :: Record r -> Record r -> Ordering #

(<) :: Record r -> Record r -> Bool #

(<=) :: Record r -> Record r -> Bool #

(>) :: Record r -> Record r -> Bool #

(>=) :: Record r -> Record r -> Bool #

max :: Record r -> Record r -> Record r #

min :: Record r -> Record r -> Record r #

KnownFields r => Generic (Record r) Source # 
Instance details

Defined in Data.Record.Anon.Internal.Simple

Associated Types

type Constraints (Record r) 
Instance details

Defined in Data.Record.Anon.Internal.Simple

type MetadataOf (Record r) 
Instance details

Defined in Data.Record.Anon.Internal.Simple

Methods

from :: Record r -> Rep I (Record r) #

to :: Rep I (Record r) -> Record r #

dict :: forall (c :: Type -> Constraint). Constraints (Record r) c => Proxy c -> Rep (Dict c) (Record r) #

metadata :: proxy (Record r) -> Metadata (Record r) #

type Constraints (Record r) Source # 
Instance details

Defined in Data.Record.Anon.Internal.Simple

type MetadataOf (Record r) Source # 
Instance details

Defined in Data.Record.Anon.Internal.Simple

Construction

empty :: Record ('[] :: [Pair Symbol Type]) Source #

Empty record

insert :: forall (n :: Symbol) a (r :: Row Type). Field n -> a -> Record r -> Record ((n ':= a) ': r) Source #

Insert new field

>>> :{
example :: Record [ "a" := Bool, "b" := Int ]
example =
     insert #a True
   $ insert #b 1
   $ empty
:}

Instead of using insert and empty, you can also write this as

example = ANON {
      a = True
    , b = 1
    }

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 Merged 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 #

Lens from one record to another

See project for examples (project is just the lens getter, without the setter).

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
:}

letInsertAs Source #

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

Supporting definitions

castEqual :: Equal a b => a -> b Source #