api-tools-0.9.0.0: DSL for generating API boilerplate and docs
Safe HaskellNone
LanguageHaskell2010

Data.API.Value

Description

This module defines a generic representation of values belonging to a schema, for use during data migration.

Synopsis

Types

data Value Source #

Generic representation of a data value belonging to a schema type. This representation has the following properties:

  • it is straightforward to convert into either CBOR or JSON;
  • decoding CBOR or parsing JSON requires the schema, and takes advantage of it by introducing type distinctions and interning field names;
  • decoding CBOR is relatively efficient.

Instances

Instances details
Eq Value Source # 
Instance details

Defined in Data.API.Value

Methods

(==) :: Value -> Value -> Bool #

(/=) :: Value -> Value -> Bool #

Show Value Source # 
Instance details

Defined in Data.API.Value

Methods

showsPrec :: Int -> Value -> ShowS #

show :: Value -> String #

showList :: [Value] -> ShowS #

ToJSON Value Source # 
Instance details

Defined in Data.API.Value

NFData Value Source # 
Instance details

Defined in Data.API.Value

Methods

rnf :: Value -> () #

type Record = [Field] Source #

A record is represented as a list of (field name, value) pairs.

Invariant: these are in ascending order by field name, and there are no duplicates.

TODO: consider if it would be worth using Map instead.

data Field Source #

Constructors

Field 

Instances

Instances details
Eq Field Source # 
Instance details

Defined in Data.API.Value

Methods

(==) :: Field -> Field -> Bool #

(/=) :: Field -> Field -> Bool #

Show Field Source # 
Instance details

Defined in Data.API.Value

Methods

showsPrec :: Int -> Field -> ShowS #

show :: Field -> String #

showList :: [Field] -> ShowS #

NFData Field Source # 
Instance details

Defined in Data.API.Value

Methods

rnf :: Field -> () #

Converting to and from generic values

fromDefaultValue :: NormAPI -> APIType -> DefaultValue -> Maybe Value Source #

Convert a DefaultValue into a generic Value, failing if the type is not compatible. This requires type information so that it can introduce type distinctions absent in DefaultValue, e.g. when DefValList is used at type TyMaybe (TyList t).

fromJSON :: NormAPI -> APIType -> Value -> Either [(JSONError, Position)] (Value, [(JSONWarning, Position)]) Source #

Parse a generic Value from a JSON Value, given the schema and expected type. This is not particularly optimized. For the other direction, use toJSON.

encode :: Value -> Encoding Source #

Efficiently encode a generic Value in CBOR format.

decode :: NormAPI -> APIType -> Decoder s Value Source #

Efficiently decode CBOR as a generic Value, given the schema and expected type.

Data validation

matchesNormAPI :: NormAPI -> APIType -> Value -> Position -> Either (ValueError, Position) () Source #

Check that the value is of the given type in the schema, reporting the first error encountered if it does not conform.

Manipulating records

insertField :: FieldName -> Value -> Record -> Record Source #

Insert a (field, value) pair into a record, replacing the existing field if it is present and preserving the ordering invariant.

renameField :: FieldName -> FieldName -> Record -> Record Source #

Rename a field in a record, preserving the ordering invariant.

deleteField :: FieldName -> Record -> Record Source #

Delete a field from a record, trivially preserving the ordering invariant.

findField :: FieldName -> Record -> Maybe (Record, Value, Record) Source #

Split a record at a given field, returning the preceding fields, value and succeeding fields. Fails if the field is absent.

joinRecords :: Record -> FieldName -> Value -> Record -> Record Source #

Join together two records with a (field, value) pair in between. The ordering invariant is not checked!

QuickCheck test infrastructure

arbitrary :: NormAPI -> Gen (APIType, Value) Source #

Given a schema, generate an arbitrary type corresponding to the schema and an arbitrary value of that type.

arbitraryOfType :: NormAPI -> APIType -> Gen Value Source #

Given a schema and a type, generate an arbitrary value of that type.

arbitraryJSONValue :: Gen Value Source #

A reasonably varied generator for JSON Values.

Hack alert: we do not generate Null, because Aeson fails to round-trip Just Null :: Maybe Value.

prop_jsonRoundTrip :: NormAPI -> Property Source #

QuickCheck property that converting a Value to and from JSON gives back the original value.

prop_jsonGeneric :: ToJSON a => API -> TypeName -> a -> Result Source #

QuickCheck property that the type-specific JSON serialisation agrees with deserialising as generic JSON and then serialising again.

prop_cborRoundTrip :: NormAPI -> Property Source #

QuickCheck property that converting a Value to and from CBOR gives back the original value.

prop_cborGeneric :: Serialise a => API -> TypeName -> a -> Result Source #

QuickCheck property that the type-specific CBOR serialisation agrees with deserialising as generic CBOR and then serialising again.