composite-aeson-0.5.1.0: JSON for Vinyl/Frames records

Safe HaskellNone
LanguageHaskell2010

Composite.Aeson.Record

Synopsis

Documentation

newtype ToField a Source #

Function to encode a single field of a record, possibly choosing to elide the field with Nothing.

Constructors

ToField 

Fields

Instances

Contravariant ToField Source # 

Methods

contramap :: (a -> b) -> ToField b -> ToField a #

(>$) :: b -> ToField b -> ToField a #

newtype FromField e a Source #

Function to decode a single field of a record.

Constructors

FromField 

Fields

Instances

Functor (FromField e) Source # 

Methods

fmap :: (a -> b) -> FromField e a -> FromField e b #

(<$) :: a -> FromField e b -> FromField e a #

data JsonField e a Source #

Descriptor of how to handle a single record field with functions to parse and emit the field which can handle missing fields on parse and elide fields on encode.

Constructors

JsonField (a -> Maybe Value) (Text -> Parse e a) 

field :: (Wrapped a', Unwrapped a' ~ a) => JsonFormat e a -> JsonField e a' Source #

Given a JsonFormat for some type a, produce a JsonField for fields of type a which fails if the field is missing and never elides the field.

field' :: JsonFormat e a -> JsonField e a Source #

Given a JsonFormat for some type a, produce a JsonField for fields of type a which fails if the field is missing and never elides the field.

optionalField :: (Wrapped a', Unwrapped a' ~ Maybe a) => JsonFormat e a -> JsonField e a' Source #

Given a JsonFormat for some type a, produce a JsonField for fields of type Maybe a which substitutes Nothing for either null or missing field, and which elides the field on Nothing.

optionalField' :: JsonFormat e a -> JsonField e (Maybe a) Source #

Given a JsonFormat for some type a, produce a JsonField for fields of type Maybe a which substitutes Nothing for either null or missing field, and which elides the field on Nothing.

type JsonFormatRecord e rs = Rec (JsonField e) rs Source #

Type of a Vinyl/Frames record which describes how to map fields of a record to JSON and back.

This record type has the same field names and types as a regular record with Identity but instead of Identity uses 'JsonFormat e'.

For example, given:

type FId   = "id"   :-> Int
type FName = "name" :-> Text
type User = '[FId, FName]

A JsonFormatRecord for User might be:

  userFormatRec :: JsonFormatRecord e User
  userFormatRec = field integralJsonFormat
               :& field textJsonFormat
               :& RNil

Or, using the default mappings for each field type:

  userFormatRec :: JsonFormatRecord e User
  userFormatRec = defaultJsonFormatRecord

Such a record is a first-class value like any other record, so can be composed into larger records, modified, etc. This is particularly useful in combination with defaultJsonFormatRecord, where you can automatically derive a format record for all fields you want defaults for and then extend or override formats for particular fields, e.g.

  fId :: Proxy FId
  fId = Proxy

  userFormatRec :: JsonFormatRecord e User
  userFormatRec = over (rlens fId) ('Composite.Aeson.Base.dimapJsonFormat (+10) (subtract 10)) defaultJsonFormatRecord

Would use the same JSON schema as the other examples, but the id field would be encoded in JSON as 10 higher.

Once you've produced an appropriate JsonFormatRecord for your case, use recordJsonFormat to make a JsonFormat e (Record '[…]) of it.

class DefaultJsonFormatRecord rs where Source #

Class to make a JsonFormatRecord with defaultJsonFormat for each field.

Minimal complete definition

defaultJsonFormatRecord

Methods

defaultJsonFormatRecord :: JsonFormatRecord e rs Source #

Produce a JsonFormatRecord for a record with fields rs by using the default JsonFormat for each field in rs, as provided by DefaultJsonFormat.

defaultJsonFormatRecord :: DefaultJsonFormatRecord rs => JsonFormatRecord e rs Source #

Produce a JsonFormatRecord for a record with fields rs by using the default JsonFormat for each field in rs, as provided by DefaultJsonFormat.

class RecordToJsonObject rs where Source #

Helper class which induces over the structure of a record, reflecting the name of each field and applying each ToJson to its corresponding value to produce JSON.

Minimal complete definition

recordToJsonObject

Methods

recordToJsonObject :: Rec ToField rs -> Rec Identity rs -> Object Source #

Given a record of ToField functions for each field in rs, convert an Identity record to Object.

Instances

RecordToJsonObject ([] *) Source # 
(KnownSymbol s, RecordToJsonObject rs) => RecordToJsonObject ((:) * ((:->) s a) rs) Source # 

Methods

recordToJsonObject :: Rec * ToField ((* ': (s :-> a)) rs) -> Rec * Identity ((* ': (s :-> a)) rs) -> Object Source #

recordToJsonObject :: RecordToJsonObject rs => Rec ToField rs -> Rec Identity rs -> Object Source #

Given a record of ToField functions for each field in rs, convert an Identity record to Object.

recordToJson :: RecordToJsonObject rs => Rec ToField rs -> Rec Identity rs -> Value Source #

Given a record of ToField functions for each field in rs, convert an Identity record to JSON. Equivalent to Aeson.Object . recordToJsonObject fmt

class RecordFromJson rs where Source #

Class which induces over the structure of a record, parsing fields using a record of FromJson and assembling an Identity record.

Minimal complete definition

recordFromJson

Methods

recordFromJson :: Rec (FromField e) rs -> Parse e (Rec Identity rs) Source #

Given a record of FromJson parsers for each field in rs, produce an Parse to make an Identity record.

Instances

RecordFromJson ([] *) Source # 

Methods

recordFromJson :: Rec * (FromField e) [*] -> Parse e (Rec * Identity [*]) Source #

(KnownSymbol s, RecordFromJson rs) => RecordFromJson ((:) * ((:->) s a) rs) Source # 

Methods

recordFromJson :: Rec * (FromField e) ((* ': (s :-> a)) rs) -> Parse e (Rec * Identity ((* ': (s :-> a)) rs)) Source #

recordFromJson :: RecordFromJson rs => Rec (FromField e) rs -> Parse e (Rec Identity rs) Source #

Given a record of FromJson parsers for each field in rs, produce an Parse to make an Identity record.

recordJsonFormat :: (RecordToJsonObject rs, RecordFromJson rs) => JsonFormatRecord e rs -> JsonFormat e (Rec Identity rs) Source #

Take a JsonFormatRecord describing how to map a record with field rs to and from JSON and produce a JsonFormat e (Record rs).

See JsonFormatRecord for more.