red-black-record-2.1.4.0: Extensible records and variants indexed by a type-level Red-Black tree.

Safe HaskellNone
LanguageHaskell2010

Data.RBR.Subset

Contents

Description

This module contains versions of functions from Data.RBR, generalized to work with a subset of the fields of a Record or the branches of a Variant.

Besides working with subsets of fields and branches, this module is useful for another thing. The equality of type-level trees is unfortunately too strict: inserting the same elements but in different order can result in structurally different trees, which in its turn causes annoying errors when trying to combine Records, even as they have exactly the same fields.

To solve these kinds of problems, functions like projectSubset can be used to transform Records indexed by one map into records indexed by another.

For example, consider this code:

>>> :{
    prettyShow_RecordI $
      liftA2_Record
        (\_ x -> x)
        ( id
            $ S.projectSubset @(FromList ['("bar", _), '("foo", _)]) -- rearrange
            $ insertI @"foo"
              'a'
            $ insertI @"bar"
              True
            $ unit
        )
        ( id
            $ insertI @"bar"
              True
            $ insertI @"foo"
              'a'
            $ unit
        )
:}
"{bar = True, foo = 'a'}"

If we remove the projectSubset line that rearranges the structure of the first record's index map, the code ceases to compile.

Note: There are functions of the same name in the Data.RBR module, but they are deprecated. The functions from this module should be used instead, preferably qualified. The changes have to do mainly with the required constraints.

Synopsis

The subset constraint

type Subset (subset :: Map Symbol q) (whole :: Map Symbol q) = KeysValuesAll (PresentIn whole) subset Source #

A type-level map is a subset of another if all of its entries are present in the other map.

Record subset functions

fieldSubset :: forall subset whole f. (Maplike subset, Subset subset whole) => Record f whole -> (Record f subset -> Record f whole, Record f subset) Source #

Like field, but targets multiple fields at the same time

projectSubset :: forall subset whole f. (Maplike subset, Subset subset whole) => Record f whole -> Record f subset Source #

Like project, but extracts multiple fields at the same time.

The types in the subset tree can often be inferred and left as wildcards in type signature.

>>> :{
  prettyShow_RecordI
    $ S.projectSubset @(FromList ['("foo", _), '("bar", _)])
    $ insertI @"foo"
      'a'
    $ insertI @"bar"
      True
    $ insertI @"baz"
      (Just ())
    $ unit
:}
"{bar = True, foo = 'a'}"

This function also be used to convert between Records with structurally dissimilar type-level maps that nevertheless hold the same entries.

getFieldSubset :: forall subset whole f. (Maplike subset, Subset subset whole) => Record f whole -> Record f subset Source #

Alias for projectSubset.

setFieldSubset :: forall subset whole f. (Maplike subset, Subset subset whole) => Record f subset -> Record f whole -> Record f whole Source #

Like setField, but sets multiple fields at the same time.

modifyFieldSubset :: forall subset whole f. (Maplike subset, Subset subset whole) => (Record f subset -> Record f subset) -> Record f whole -> Record f whole Source #

Like modifyField, but modifies multiple fields at the same time.

Variant subset functions

branchSubset :: forall subset whole f. (Maplike subset, Maplike whole, Subset subset whole) => (Variant f whole -> Maybe (Variant f subset), Variant f subset -> Variant f whole) Source #

Like branch, but targets multiple branches at the same time.

injectSubset :: forall subset whole f. (Maplike subset, Maplike whole, Subset subset whole) => Variant f subset -> Variant f whole Source #

Like inject, but injects one of several possible branches.

Can also be used to convert between Variants with structurally dissimilar type-level maps that nevertheless hold the same entries.

matchSubset :: forall subset whole f. (Maplike subset, Maplike whole, Subset subset whole) => Variant f whole -> Maybe (Variant f subset) Source #

Like match, but matches more than one branch.

Miscellany functions

fromRecordSuperset :: forall r t whole. (IsRecordType r t, Maplike t, Subset t whole) => Record I whole -> r Source #

A common composition of fromRecord and projectSubset.

eliminateSubset :: forall subset whole f r. (Maplike subset, Maplike whole, Subset subset whole) => Record (Case f r) whole -> Variant f subset -> r Source #

Like eliminate, but allows the eliminator Record to have more fields than there are branches in the Variant.