api-tools-0.8.0.1: DSL for generating API boilerplate and docs

Safe HaskellNone
LanguageHaskell2010

Data.API.JSON

Contents

Description

This module defines a JSON parser, like Aeson's FromJSON, but with more detailed error-reporting capabilities. In particular, it reports errors in a structured format, and can report multiple independent errors rather than stopping on the first one encountered.

Synopsis

Parser with multiple error support

data ParserWithErrs a Source #

Like Parser, but keeping track of locations within the JSON structure and able to report multiple errors.

Careful! The Monad instance does not agree with the Applicative instance in all circumstances, and you should use the Applicative instance where possible. In particular:

  • pf <*> ps returns errors from both arguments
  • pf `ap` ps returns errors from pf only

data ParseFlags Source #

Options to modify the behaviour of the JSON parser

defaultParseFlags :: ParseFlags Source #

Use this as a basis for overriding individual fields of the ParseFlags record, in case more flags are added in the future.

runParserWithErrsTop :: ParseFlags -> ParserWithErrs a -> Either [(JSONError, Position)] (a, [(JSONWarning, Position)]) Source #

Run a parser with given flags, starting in the outermost location, and returning warnings even if the parse was successful

FromJSON class with multiple error support

class FromJSONWithErrs a where Source #

Like FromJSON, but keeping track of multiple errors and their positions. Moreover, this class is more liberal in accepting invalid inputs:

  • a string like "3" is accepted as an integer; and
  • the integers 0 and 1 are accepted as booleans.

Methods

parseJSONWithErrs :: Value -> ParserWithErrs a Source #

Parse a JSON value with structured error-reporting support. If this method is omitted, fromJSON will be used instead: note that this will result in less precise errors.

parseJSONWithErrs :: FromJSON a => Value -> ParserWithErrs a Source #

Parse a JSON value with structured error-reporting support. If this method is omitted, fromJSON will be used instead: note that this will result in less precise errors.

Instances

FromJSONWithErrs Bool Source # 
FromJSONWithErrs Int Source # 
FromJSONWithErrs Integer Source # 
FromJSONWithErrs () Source # 
FromJSONWithErrs Version Source # 
FromJSONWithErrs Text Source # 
FromJSONWithErrs UTCTime Source # 
FromJSONWithErrs Value Source # 
FromJSONWithErrs Binary Source # 
FromJSONWithErrs DefaultValue Source # 
FromJSONWithErrs BasicType Source # 
FromJSONWithErrs TypeRef Source # 
FromJSONWithErrs APIType Source # 
FromJSONWithErrs Field Source # 
FromJSONWithErrs Conversion Source # 
FromJSONWithErrs UTCRange Source # 
FromJSONWithErrs IntRange Source # 
FromJSONWithErrs RegularExpression Source # 
FromJSONWithErrs Filter Source # 
FromJSONWithErrs SpecNewtype Source # 
FromJSONWithErrs Spec Source # 
FromJSONWithErrs APINode Source # 
FromJSONWithErrs a => FromJSONWithErrs [a] Source # 
FromJSONWithErrs a => FromJSONWithErrs (Maybe a) Source # 

fromJSONWithErrs :: FromJSONWithErrs a => Value -> Either [(JSONError, Position)] a Source #

Run the JSON parser on a value to produce a result or a list of errors with their positions. This should not be used inside an implementation of parseJSONWithErrs as it will not pass on the current position.

fromJSONWithErrs' :: FromJSONWithErrs a => ParseFlags -> Value -> Either [(JSONError, Position)] a Source #

Run the JSON parser on a value to produce a result or a list of errors with their positions. This version allows the ParseFlags to be specified.

fromJSONWithErrs'' :: FromJSONWithErrs a => ParseFlags -> Value -> Either [(JSONError, Position)] (a, [(JSONWarning, Position)]) Source #

Run the JSON parser on a value to produce a result or a list of errors with their positions. This version allows the ParseFlags to be specified, and produces warnings even if the parse succeeded.

decodeWithErrs :: FromJSONWithErrs a => ByteString -> Either [(JSONError, Position)] a Source #

Decode a ByteString and run the JSON parser

decodeWithErrs' :: FromJSONWithErrs a => ParseFlags -> ByteString -> Either [(JSONError, Position)] a Source #

Decode a ByteString and run the JSON parser, allowing the ParseFlags to be specified

parseJSONDefault :: FromJSONWithErrs a => Value -> Parser a Source #

Suitable as an implementation of parseJSON that uses the FromJSONWithErrs instance (provided said instance was not defined using fromJSON!).

ParserWithErrs combinators

withInt :: String -> (Int -> ParserWithErrs a) -> Value -> ParserWithErrs a Source #

It's contrary to my principles, but I'll accept a string containing a number instead of an actual number, and will silently truncate floating point numbers to integers...

withField :: Text -> (Value -> ParserWithErrs a) -> Object -> ParserWithErrs a Source #

Look up the value of a field, treating missing fields as null

withDefaultField :: Bool -> Maybe Value -> Text -> (Value -> ParserWithErrs a) -> Object -> ParserWithErrs a Source #

Look up the value of a field, which may be read-only or use a default value (depending on the ParseFlags).

(.:.) :: FromJSONWithErrs a => Object -> Text -> ParserWithErrs a Source #

Parse the value of a field, treating missing fields as null

(.::) :: FromJSONWithErrs a => Object -> Text -> ParserWithErrs a Source #

Parse the value of a field, failing on missing fields

withUnion :: [(Text, Value -> ParserWithErrs a)] -> Value -> ParserWithErrs a Source #

Match an inhabitant of a disjoint union, which should be an object with a single field, and call the continuation corresponding to the field name.

Representation of JSON parsing errors

type JSONWarning = JSONError Source #

At present, we do not distinguish between errors and warnings

data Expected Source #

JSON type expected at a particular position, when a value of a different type was encountered

type Position = [Step] Source #

A position inside a JSON value is a list of steps, ordered innermost first (so going inside an object prepends a step).

data Step Source #

Each step may be into a field of an object, or a specific element of an array.

Constructors

InField Text 
InElem Int 

prettyJSONErrorPositions :: [(JSONError, Position)] -> String Source #

Human-readable presentation of a list of parse errors with their positions

prettyJSONError :: JSONError -> String Source #

Human-readable description of a JSON parse error

prettyStep :: Step -> String Source #

Human-readable description of a single step in a position

Error construction