Safe Haskell | None |
---|---|
Language | Haskell2010 |
Data.Aeson.BetterErrors
Contents
Description
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)]
- 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 ()
.
Instances
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 array 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.
Constructors
InvalidJSON String | |
BadSchema [PathPiece] (ErrorSpecifics err) |
Instances
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.
Constructors
ObjectKey Text | |
ArrayIndex Int |
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.
Constructors
KeyMissing Text | |
OutOfBounds Int | |
WrongType JSONType Value | Expected type, actual value |
ExpectedIntegral Double | |
CustomError err |
Instances
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.