Safe Haskell | None |
---|---|
Language | Haskell2010 |
- Setup code
- Constructing a record and viewing its fields.
- Getting a subset of fields out of a record
- Creating a Record out of a conventional Haskell record
- Injecting into a Variant and eliminating it
- Working with a bigger error type inside a function
- Creating a Variant out of a sum type and matching on it
- Changing the way a specific record field is parsed from JSON
- Parsing a record from JSON using aliased fields
- Parsing a subset of a record's fields from JSON and inserting them in an existing record value
- Ensuring all branches of a sum type are parsed from JSON
- External examples
Synopsis
Setup code
>>>
:set -XDataKinds -XTypeApplications
>>>
:set -XFlexibleContexts -XTypeFamilies -XAllowAmbiguousTypes -XScopedTypeVariables
>>>
:set -XDeriveGeneric
>>>
:set -XPartialTypeSignatures
>>>
:set -XTypeOperators
>>>
:set -Wno-partial-type-signatures
>>>
import Data.RBR
>>>
import qualified Data.RBR.Subset as S
>>>
import Data.SOP
>>>
import Data.SOP.NP (cpure_NP,sequence_NP,liftA2_NP,collapse_NP)
>>>
import Data.String
>>>
import Data.Proxy
>>>
import Data.Foldable
>>>
import Data.Profunctor (Star(..))
>>>
import GHC.Generics (Generic)
>>>
import GHC.TypeLits
>>>
import qualified Data.Text
>>>
import Data.Aeson
>>>
import Data.Aeson.Types (explicitParseField,Parser,parseMaybe)
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 = S.getFieldSubset @(FromList [ '("age",_), '("whatever",_) ]) r in putStrLn (prettyShow_RecordI 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 (prettyShow_RecordI 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_Variant e b :} c
Working with a bigger error type inside a function
A function can use internally an error Variant
bigger than the one it
eventually returns. The internal branches of the Variant
can be removed with
winnow
.
This library makes it more involved than it should be, because inserting an
entry and then deleting it can result in structurally dissimilar type-level
maps. So we need extra type annotations in winnow
, and also a call to
injectSubset
to perform the conversion.
>>>
type Smaller = FromList '[ '("foo",Char), '("bar",Int) ]
>>>
:{
let func :: Int -> Variant I Smaller func i = let v = if (i == 0) then injectI @"baz" "internal" else injectI @"foo" 'c' r = case winnowI @"baz" @String @(Insert "baz" String Smaller) v of Right e -> error "this is the baz internal error" Left smaller -> smaller in S.injectSubset r in putStrLn $ prettyShow_VariantI (func 1) :} foo ('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. (IsRecordType r c, Maplike c, KeysValuesAll (KeyValueConstraints KnownSymbol FromJSON) c) => (Record ((,) String :.: Star Parser Data.Aeson.Value) c -> Record ((,) String :.: Star Parser Data.Aeson.Value) c) -> Data.Aeson.Value -> Parser r parseSpecial transform = let fieldParsers = transform $ cpure'_Record (Proxy @FromJSON) $ \fieldName -> Comp (fieldName,Star parseJSON) applyName (Comp (fieldName,Star f)) = Star (\o -> explicitParseField f o (Data.Text.pack fieldName)) Star objectParser = sequence_Record $ liftA_Record applyName fieldParsers in withObject "someobj" $ \o -> fromRecord <$> objectParser 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" (Comp ("anothername",Star (\_ -> pure "foo")))) :}
>>>
Data.Aeson.eitherDecode @Person (fromString "{ \"anothername\" : 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. (IsRecordType r c, Maplike c, KeysValuesAll (ValueConstraint FromJSON) c) => Record (K String) c -> Data.Aeson.Value -> Parser r parseWithAliases aliases = let fieldParsers = cpure_Record (Proxy @(ValueConstraint FromJSON)) (Star parseJSON) mapKSS (K name) (Star pf) = Star (\o -> explicitParseField pf o (Data.Text.pack name)) Star objectParser = sequence_Record $ liftA2_Record mapKSS aliases fieldParsers in withObject "someobj" $ \o -> fromRecord <$> objectParser 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 (S.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 c r. (IsRecordType r c, S.Subset subset c, Maplike subset, KeysValuesAll (KeyValueConstraints KnownSymbol FromJSON) subset) => r -> Data.Aeson.Value -> Parser r parseFieldSubset r = let subparser = sequence_Record $ cpure'_Record (Proxy @FromJSON) $ \fieldName -> Star (\o -> explicitParseField parseJSON o (Data.Text.pack fieldName)) intoOriginal subrecord = fromRecord (S.setFieldSubset @subset subrecord (toRecord r)) Star parser = intoOriginal <$> subparser in withObject "someobj" parser :}
>>>
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",_) ]) original Just s = parseMaybe subsetParser v in s :} Person {name = "Mark", age = 70, whatever = True}
Ensuring all branches of a sum type are parsed from JSON
To ensure that we don't forget any branch when parsing a sum type from JSON, we can create a n-ary product of parsers, one for each branch.
Then we create a n-ary product of injections. Each component of the product creates a n-ary sum out of the value of the corresponding branch.
We combine the n-ary product of parsers with the n-ary product of
injections, and collapse all the resulting parsers with
asum
.
Then we convert the n-ary sum value that "wins" into a Variant
and
finally back into the original type.
>>>
:{
let parseAll :: forall r c flat. (IsVariantType r c, Maplike c, KeysValuesAll (KeyValueConstraints KnownSymbol FromJSON) c) => Data.Aeson.Value -> Parser r parseAll = let fieldParsers = cpure'_Record (Proxy @FromJSON) $ \fieldName -> Star (\o -> explicitParseField parseJSON o (Data.Text.pack fieldName)) injected = liftA2_Record (\f star -> K [ runVariantInjection f . I <$> star ]) injections_Variant fieldParsers Star parser = asum $ collapse'_Record injected in withObject "someobj" (\o -> fromVariant <$> parser o) :}
>>>
data ThisOrThat = This String | That Int deriving (Generic, Show)
>>>
instance FromVariant ThisOrThat
>>>
instance ToVariant ThisOrThat
>>>
:{
let Just v = Data.Aeson.decode @Data.Aeson.Value (fromString "{ \"That\" : 70 }") Just s = parseMaybe (parseAll @ThisOrThat) v in s :} That 70
External examples
- Is there a canonical way of comparing/changing one/two records in haskell? (SO)
- Given a record of functions, and a record of data of the types acted on by the functions, how to generically apply the function record? (SO)
- Help with Generics. (Reddit)
- Adventures assembling records of capabilities. (Discourse)
- Creating a result piecewise from stateful computation. (SO)
- Extracting sections of function pipelines. (GitHub)
- Resources on sop-core and generics-sop. (GitHub)