Data.RBR.Examples

Constructing a record and viewing its fields.

We use addFieldI instead of addField because we are dealing with pure records.

>>> :{
    let r = addFieldI @"name" "Foo"
          . addFieldI @"age"  5
          $ unit
     in print (getFieldI @"name" r)
:}
"Foo"

Getting a subset of fields out of a record

Notice that the subset is specified as a type-level tree using FromList, a type family that takes a list of type-level tuples.

Because here the types of each field can be inferred, we can use a wildcard (enabled by the PartialTypeSignatures extension).

>>> :{
    let r = addFieldI @"name"      "Foo"
          . addFieldI @"age"       5
          . addFieldI @"whatever"  'x'
          $ unit
        s = getFieldSubset @(FromList [ '("age",_), '("whatever",_) ]) r
     in putStrLn (prettyShowRecordI s)
:}
{age = 5, whatever = 'x'} 

Creating a Record out of a conventional Haskell record

>>> data Person = Person { name :: String, age :: Int } deriving (Generic, Show)
>>> instance ToRecord Person
>>> :{
    let r = addFieldI @"whatever" 'x' (toRecord (Person "Foo" 50))
     in putStrLn (prettyShowRecordI r)
:}
{age = 50, name = "Foo", whatever = 'x'} 

Injecting into a Variant and eliminating it

Here the full type of the Variant is inferred from the type of its Record of eliminators.

>>> :{
    let b = injectI @"left" 'c'
        e = addCaseI @"left" putChar
          . addCaseI @"right" @Bool print
          $ unit
     in eliminate e b
:}
c

Creating a Variant out of a sum type and matching on it

>>> data Summy = Lefty Int | Righty Bool deriving (Generic,Show)
>>> instance ToVariant Summy
>>> :{
    let v = toVariant (Lefty 5)
     in matchI @"Lefty" v
:}
Just 5

Changing the way a specific record field is parsed from JSON

We start in the sop-core world, creating a product of parsing functions (one for each field) using cpure_NP.

Then we convert that product to a Record, apply to it a transformation that uses field selectors, and convert it back to a product.

Then we demote the field names and combine them with the product of Value parsers using liftA2_NP, getting a product of Object parsers.

Then we use sequence_NP to convert the product of parsers into a parser of Record.

>>> :{
    let parseSpecial
              :: forall r c flat. (Generic r, 
                                   FromRecord r, 
                                   RecordCode r ~ c, 
                                   KeysValuesAll KnownKey c, 
                                   Productlike '[] c flat, All FromJSON flat) 
              => (Record (Star Parser Data.Aeson.Value) c -> Record (Star Parser Data.Aeson.Value) c)
              -> Data.Aeson.Value 
              -> Parser r
        parseSpecial transform = 
            let mapKSS (K name) (Star pf) = Star (\o -> explicitParseField pf o (Data.Text.pack name))
                pr = transform $ fromNP @c (cpure_NP (Proxy @FromJSON) (Star parseJSON))
                Star parser = fromNP <$> sequence_NP (liftA2_NP mapKSS (toNP @c demoteKeys) (toNP pr))
             in withObject "someobj" $ \o -> fromRecord <$> parser o
    :}

>>> data Person = Person { name :: String, age :: Int } deriving (Generic, Show)
>>> instance ToRecord Person
>>> instance FromRecord Person
>>> :{
    instance FromJSON Person where 
        parseJSON = parseSpecial (setField @"name" (Star (\_ -> pure "foo")))
    :}

>>> Data.Aeson.eitherDecode @Person (fromString "{ \"name\" : null, \"age\" : 50 }")
Right (Person {name = "foo", age = 50})

Parsing a record from JSON using aliased fields

The aliases are passed as a Record with values wrapped in the K functor. This means that there aren't really any values of the type that corresponds to each field, only the String annotations.

>>> :{
    let parseWithAliases
              :: forall r c flat. (Generic r, 
                                   FromRecord r, 
                                   RecordCode r ~ c, 
                                   KeysValuesAll KnownKey c, 
                                   Productlike '[] c flat, All FromJSON flat) 
              => Record (K String) c
              -> Data.Aeson.Value 
              -> Parser r
        parseWithAliases aliases = 
            let mapKSS (K name) (Star pf) = Star (\o -> explicitParseField pf o (Data.Text.pack name))
                pr = fromNP @c (cpure_NP (Proxy @FromJSON) (Star parseJSON))
                Star parser = fromNP <$> sequence_NP (liftA2_NP mapKSS (toNP @c aliases) (toNP pr))
             in withObject "someobj" $ \o -> fromRecord <$> parser o
    :}

We have to use getFieldSubset because the aliases are listed in a different order than the record fields, and that might result in different type-level trees. If the orders were the same, we wouldn't need it.

>>> data Person = Person { name :: String, age :: Int } deriving (Generic, Show)
>>> instance ToRecord Person
>>> instance FromRecord Person
>>> :{
    instance FromJSON Person where 
        parseJSON = let aliases = addField @"age"  (K "bar")
                                . addField @"name" (K "foo")
                                $ unit
                     in parseWithAliases (getFieldSubset @(RecordCode Person) aliases)
    :}

>>> Data.Aeson.eitherDecode @Person (fromString "{ \"foo\" : \"John\", \"bar\" : 50 }")
Right (Person {name = "John", age = 50})

Parsing a subset of a record's fields from JSON and inserting them in an existing record value

>>> :{
    let parseFieldSubset
              :: forall subset whole flat wholeflat. (KeysValuesAll KnownKey whole, 
                                                      Productlike '[] whole wholeflat,
                                                      ProductlikeSubset subset whole flat,
                                                      All FromJSON wholeflat) 
              => Data.Aeson.Value 
              -> Parser (Record I subset)
        parseFieldSubset = 
            let mapKSS (K name) (Star pf) = Star (\o -> explicitParseField pf o (Data.Text.pack name))
                pNP = cpure_NP (Proxy @FromJSON) (Star parseJSON)
                objpNP = liftA2_NP mapKSS (toNP @whole demoteKeys) pNP
                subNP = toNP @subset $ getFieldSubset @subset $ fromNP @whole objpNP
                Star subparser = fromNP @subset <$> sequence_NP subNP
             in withObject "someobj" subparser
    :}

>>> data Person = Person { name :: String, age :: Int, whatever :: Bool } deriving (Generic, Show)
>>> instance ToRecord Person
>>> instance FromRecord Person
>>> :{
    let original = Person "John" 50 True
        Just v = Data.Aeson.decode @Data.Aeson.Value (fromString "{ \"name\" : \"Mark\", \"age\" : 70 }")
        subsetParser = parseFieldSubset @(FromList [ '("name",_), '("age",_) ]) @(RecordCode Person)
        Just s = parseMaybe subsetParser v
     in fromRecord @Person . setFieldSubset s $ toRecord original
    :}
Person {name = "Mark", age = 70, whatever = True}

Ensuring all branches of a sum type are parsed from JSON