Safe Haskell | None |
---|---|
Language | Haskell2010 |
A module for decoding JSON, and generating good error messages. Note,
however, that this package only deals with generating good error messages
after the JSON has been parsed into a Value
- unfortunately,
invalid JSON will still produce poor error messages.
See http://harry.garrood.me/blog/aeson-better-errors/ for a tutorial.
Any kind of feedback is very welcome: suggestions for a better designed API, bug reports, whatever - the best place for it is probably the GitHub issue tracker: https://github.com/hdgarrood/aeson-better-errors/issues.
- data Parse err a
- asText :: Parse err Text
- asString :: Parse err String
- asScientific :: Parse err Scientific
- asIntegral :: Integral a => Parse err a
- asRealFloat :: RealFloat a => Parse err a
- asBool :: Parse err Bool
- asNull :: Parse err ()
- asObject :: Parse err Object
- asArray :: Parse err Array
- key :: Text -> Parse err a -> Parse err a
- keyOrDefault :: Text -> a -> Parse err a -> Parse err a
- keyMay :: Text -> Parse err a -> Parse err (Maybe a)
- nth :: Int -> Parse err a -> Parse err a
- nthOrDefault :: Int -> a -> Parse err a -> Parse err a
- nthMay :: Int -> Parse err a -> Parse err (Maybe a)
- eachInArray :: Parse err a -> Parse err [a]
- eachInObject :: Parse err a -> Parse err [(Text, a)]
- eachInObjectWithKey :: (Text -> Either err k) -> Parse err a -> Parse err [(k, a)]
- withText :: (Text -> Either err a) -> Parse err a
- withString :: (String -> Either err a) -> Parse err a
- withScientific :: (Scientific -> Either err a) -> Parse err a
- withIntegral :: Integral a => (a -> Either err b) -> Parse err b
- withRealFloat :: RealFloat a => (a -> Either err b) -> Parse err b
- withBool :: (Bool -> Either err a) -> Parse err a
- withObject :: (Object -> Either err a) -> Parse err a
- withArray :: (Array -> Either err a) -> Parse err a
- parse :: Parse err a -> ByteString -> Either (ParseError err) a
- parseStrict :: Parse err a -> ByteString -> Either (ParseError err) a
- parseValue :: Parse err a -> Value -> Either (ParseError err) a
- data ParseError err
- = InvalidJSON String
- | BadSchema [PathPiece] (ErrorSpecifics err)
- data PathPiece
- data ErrorSpecifics err
- displayError :: (err -> Text) -> ParseError err -> [Text]
- displayPath :: [PathPiece] -> Text
- displaySpecifics :: (err -> Text) -> ErrorSpecifics err -> [Text]
- toAesonParser :: (err -> Text) -> Parse err a -> Value -> Parser a
- data JSONType
- jsonTypeOf :: Value -> JSONType
The Parser type
The type of parsers: things which consume JSON values and produce either detailed errors or successfully parsed values (of other types).
The err
type parameter is for your own errors; if you don't need to use
any errors of your own, simply set it to ()
.
MonadReader ParseReader (Parse err) | |
Monad (Parse err) | |
Functor (Parse err) | |
Applicative (Parse err) | |
MonadError (ParseError err) (Parse err) |
Basic parsers
asScientific :: Parse err Scientific Source
Parse a single JSON number as a Scientific
.
asIntegral :: Integral a => Parse err a Source
Parse a single JSON number as any Integral
type.
asRealFloat :: RealFloat a => Parse err a Source
Parse a single JSON number as any RealFloat
type.
Parse a single JSON null value. Useful if you want to throw an error in the case where something is not null.
asObject :: Parse err Object Source
Parse a JSON object, as an Object
. You should prefer functions like
eachInObject
where possible, since they will usually generate better
error messages.
asArray :: Parse err Array Source
Parse a JSON array, as an Array
. You should prefer functions like
eachInArray
where possible, since they will usually generate better
error messages.
Traversing JSON
key :: Text -> Parse err a -> Parse err a Source
Take the value corresponding to a given key in the current object.
keyOrDefault :: Text -> a -> Parse err a -> Parse err a Source
Take the value corresponding to a given key in the current object, or if no property exists with that key, use the supplied default.
keyMay :: Text -> Parse err a -> Parse err (Maybe a) Source
Take the value corresponding to a given key in the current object, or if no property exists with that key, return Nothing .
nthOrDefault :: Int -> a -> Parse err a -> Parse err a Source
Take the nth value of the current array, or if no value exists with that index, use the supplied default.
nthMay :: Int -> Parse err a -> Parse err (Maybe a) Source
Take the nth value of the current array, or if no value exists with that index, return Nothing.
eachInArray :: Parse err a -> Parse err [a] Source
Attempt to parse each value in the array with the given parser, and collect the results.
eachInObject :: Parse err a -> Parse err [(Text, a)] Source
Attempt to parse each property value in the object with the given parser, and collect the results.
eachInObjectWithKey :: (Text -> Either err k) -> Parse err a -> Parse err [(k, a)] Source
Attempt to parse each property in the object: parse the key with the given validation function, parse the value with the given parser, and collect the results.
Custom validations
withString :: (String -> Either err a) -> Parse err a Source
withScientific :: (Scientific -> Either err a) -> Parse err a Source
withIntegral :: Integral a => (a -> Either err b) -> Parse err b Source
withRealFloat :: RealFloat a => (a -> Either err b) -> Parse err b Source
withObject :: (Object -> Either err a) -> Parse err a Source
Prefer to use functions like 'key or eachInObject
to this one where
possible, as they will generate better error messages.
withArray :: (Array -> Either err a) -> Parse err a Source
Prefer to use functions like nth
or eachInArray
to this one where
possible, as they will generate better error messages.
Running parsers
parse :: Parse err a -> ByteString -> Either (ParseError err) a Source
Run a parser with a lazy ByteString
containing JSON data. Note that
the normal caveat applies: the JSON supplied must contain either an object
or an array for this to work.
parseStrict :: Parse err a -> ByteString -> Either (ParseError err) a Source
Run a parser with a strict ByteString
containing JSON data. Note that
the normal caveat applies: the JSON supplied must contain either an object
or an array for this to work.
parseValue :: Parse err a -> Value -> Either (ParseError err) a Source
Run a parser with a pre-parsed JSON Value
.
Errors
data ParseError err Source
A value indicating that the JSON could not be decoded successfully.
Eq err => Eq (ParseError err) | |
Show err => Show (ParseError err) | |
MonadError (ParseError err) (Parse err) |
A piece of a path leading to a specific part of the JSON data. Internally, a list of these is maintained as the parser traverses the JSON data. This list is included in the error if one occurs.
data ErrorSpecifics err Source
Detailed information in the case where a value could be parsed as JSON, but a value of the required type could not be constructed from it, for some reason.
KeyMissing Text | |
OutOfBounds Int | |
WrongType JSONType Value | Expected type, actual value |
ExpectedIntegral Double | |
CustomError err |
Eq err => Eq (ErrorSpecifics err) | |
Show err => Show (ErrorSpecifics err) |
displayError :: (err -> Text) -> ParseError err -> [Text] Source
Turn a ParseError
into a human-readable list of Text
values.
They will be in a sensible order. For example, you can feed the result to
mapM putStrLn
, or unlines
.
displayPath :: [PathPiece] -> Text Source
displaySpecifics :: (err -> Text) -> ErrorSpecifics err -> [Text] Source
Miscellaneous
An enumeration of the different types that JSON values may take.
jsonTypeOf :: Value -> JSONType Source
Get the type of a JSON value.