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.
Synopsis
- data ParseT err m a
- type Parse err a = ParseT err Identity a
- type Parse' a = Parse Void a
- mapError :: Functor m => (err -> err') -> ParseT err m a -> ParseT err' m a
- (.!) :: Functor m => ParseT err m a -> (err -> err') -> ParseT err' m a
- (<|>) :: Monad m => ParseT err m a -> ParseT err m a -> ParseT err m a
- asValue :: (Functor m, Monad m) => ParseT err m Value
- asText :: (Functor m, Monad m) => ParseT err m Text
- asString :: (Functor m, Monad m) => ParseT err m String
- asScientific :: (Functor m, Monad m) => ParseT err m Scientific
- asIntegral :: (Functor m, Monad m, Integral a) => ParseT err m a
- asRealFloat :: (Functor m, Monad m, RealFloat a) => ParseT err m a
- asBool :: (Functor m, Monad m) => ParseT err m Bool
- asNull :: (Functor m, Monad m) => ParseT err m ()
- asObject :: (Functor m, Monad m) => ParseT err m Object
- asArray :: (Functor m, Monad m) => ParseT err m Array
- perhaps :: (Functor m, Monad m) => ParseT err m a -> ParseT err m (Maybe a)
- key :: (Functor m, Monad m) => Text -> ParseT err m a -> ParseT err m a
- keyOrDefault :: (Functor m, Monad m) => Text -> a -> ParseT err m a -> ParseT err m a
- keyMay :: (Functor m, Monad m) => Text -> ParseT err m a -> ParseT err m (Maybe a)
- nth :: (Functor m, Monad m) => Int -> ParseT err m a -> ParseT err m a
- nthOrDefault :: (Functor m, Monad m) => Int -> a -> ParseT err m a -> ParseT err m a
- nthMay :: (Functor m, Monad m) => Int -> ParseT err m a -> ParseT err m (Maybe a)
- eachInArray :: (Functor m, Monad m) => ParseT err m a -> ParseT err m [a]
- forEachInObject :: (Functor m, Monad m) => (Text -> ParseT err m a) -> ParseT err m [a]
- eachInObject :: (Functor m, Monad m) => ParseT err m a -> ParseT err m [(Text, a)]
- eachInObjectWithKey :: (Functor m, Monad m) => (Text -> Either err k) -> ParseT err m a -> ParseT err m [(k, a)]
- withValue :: (Functor m, Monad m) => (Value -> Either err a) -> ParseT err m a
- withText :: (Functor m, Monad m) => (Text -> Either err a) -> ParseT err m a
- withString :: (Functor m, Monad m) => (String -> Either err a) -> ParseT err m a
- withScientific :: (Functor m, Monad m) => (Scientific -> Either err a) -> ParseT err m a
- withIntegral :: (Functor m, Monad m, Integral a) => (a -> Either err b) -> ParseT err m b
- withRealFloat :: (Functor m, Monad m, RealFloat a) => (a -> Either err b) -> ParseT err m b
- withBool :: (Functor m, Monad m) => (Bool -> Either err a) -> ParseT err m a
- withObject :: (Functor m, Monad m) => (Object -> Either err a) -> ParseT err m a
- withArray :: (Functor m, Monad m) => (Array -> Either err a) -> ParseT err m a
- throwCustomError :: (Functor m, Monad m) => err -> ParseT err m a
- withValueM :: (Functor m, Monad m) => (Value -> m (Either err a)) -> ParseT err m a
- withTextM :: (Functor m, Monad m) => (Text -> m (Either err a)) -> ParseT err m a
- withStringM :: (Functor m, Monad m) => (String -> m (Either err a)) -> ParseT err m a
- withScientificM :: (Functor m, Monad m) => (Scientific -> m (Either err a)) -> ParseT err m a
- withIntegralM :: (Functor m, Monad m, Integral a) => (a -> m (Either err b)) -> ParseT err m b
- withRealFloatM :: (Functor m, Monad m, RealFloat a) => (a -> m (Either err b)) -> ParseT err m b
- withBoolM :: (Functor m, Monad m) => (Bool -> m (Either err a)) -> ParseT err m a
- withObjectM :: (Functor m, Monad m) => (Object -> m (Either err a)) -> ParseT err m a
- withArrayM :: (Functor m, Monad m) => (Array -> m (Either err a)) -> ParseT err m 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
- parseM :: Monad m => ParseT err m a -> ByteString -> m (Either (ParseError err) a)
- parseStrictM :: Monad m => ParseT err m a -> ByteString -> m (Either (ParseError err) a)
- parseValueM :: Monad m => ParseT err m a -> Value -> m (Either (ParseError err) a)
- data ParseError err
- = InvalidJSON String
- | BadSchema [PathPiece] (ErrorSpecifics err)
- type ParseError' = ParseError Void
- data PathPiece
- data ErrorSpecifics err
- type ErrorSpecifics' = ErrorSpecifics Void
- displayError :: (err -> Text) -> ParseError err -> [Text]
- displayError' :: ParseError' -> [Text]
- displayPath :: [PathPiece] -> Text
- displaySpecifics :: (err -> Text) -> ErrorSpecifics err -> [Text]
- displaySpecifics' :: ErrorSpecifics' -> [Text]
- toAesonParser :: (err -> Text) -> Parse err a -> Value -> Parser a
- toAesonParser' :: Parse' a -> Value -> Parser a
- fromAesonParser :: (Functor m, Monad m) => FromJSON a => ParseT e m 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 custom validation errors; for parsers that
don't produce any custom validation errors, I recommend you just stick a
type variable in for full generality:
asTuple :: Parse e (Int, Int) asTuple = (,) <$> nth 0 asIntegral <*> nth 1 asIntegral
The m
parameter allows you to run the parser within an abitrary underlying Monad.
You may want to use Parse
in most cases instead, and all functions in this module work on either.
Instances
Monad m => MonadReader ParseReader (ParseT err m) Source # | |
Defined in Data.Aeson.BetterErrors.Internal ask :: ParseT err m ParseReader # local :: (ParseReader -> ParseReader) -> ParseT err m a -> ParseT err m a # reader :: (ParseReader -> a) -> ParseT err m a # | |
MonadTrans (ParseT err) Source # | |
Defined in Data.Aeson.BetterErrors.Internal | |
Monad m => MonadError (ParseError err) (ParseT err m) Source # | |
Defined in Data.Aeson.BetterErrors.Internal throwError :: ParseError err -> ParseT err m a # catchError :: ParseT err m a -> (ParseError err -> ParseT err m a) -> ParseT err m a # | |
Monad m => Monad (ParseT err m) Source # | |
Functor m => Functor (ParseT err m) Source # | |
Monad m => Applicative (ParseT err m) Source # | |
Defined in Data.Aeson.BetterErrors.Internal |
type Parse' a = Parse Void a Source #
The type of parsers which never produce custom validation errors.
mapError :: Functor m => (err -> err') -> ParseT err m a -> ParseT err' m a Source #
Transform the error of a parser according to the given function.
(.!) :: Functor m => ParseT err m a -> (err -> err') -> ParseT err' m a Source #
An infix version of mapError
.
(<|>) :: Monad m => ParseT err m a -> ParseT err m a -> ParseT err m a infixl 3 Source #
First try the left parser, if that fails try the right. | If both fail, the error will come from the right one.
Basic parsers
asValue :: (Functor m, Monad m) => ParseT err m Value Source #
Return the current JSON Value
as is. This does no error checking and
thus always succeeds. You probably don't want this parser unless the JSON
at the current part of your structure is truly arbitrary. You should prefer
to use more specific parsers, like asText
or asIntegral
, where possible.
asString :: (Functor m, Monad m) => ParseT err m String Source #
Parse a single JSON string as a String
.
asScientific :: (Functor m, Monad m) => ParseT err m Scientific Source #
Parse a single JSON number as a Scientific
.
asIntegral :: (Functor m, Monad m, Integral a) => ParseT err m a Source #
Parse a single JSON number as any Integral
type.
asRealFloat :: (Functor m, Monad m, RealFloat a) => ParseT err m a Source #
Parse a single JSON number as any RealFloat
type.
asNull :: (Functor m, Monad m) => ParseT err m () Source #
Parse a single JSON null value. Useful if you want to throw an error in the case where something is not null.
asObject :: (Functor m, Monad m) => ParseT err m 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 :: (Functor m, Monad m) => ParseT err m 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
perhaps :: (Functor m, Monad m) => ParseT err m a -> ParseT err m (Maybe a) Source #
Given a parser, transform it into a parser which returns Nothing
when
supplied with a JSON null
, and otherwise, attempts to parse with the
original parser; if this succeeds, the result becomes a Just
value.
key :: (Functor m, Monad m) => Text -> ParseT err m a -> ParseT err m a Source #
Take the value corresponding to a given key in the current object.
keyOrDefault :: (Functor m, Monad m) => Text -> a -> ParseT err m a -> ParseT err m 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 :: (Functor m, Monad m) => Text -> ParseT err m a -> ParseT err m (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 .
nth :: (Functor m, Monad m) => Int -> ParseT err m a -> ParseT err m a Source #
Take the nth value of the current array.
nthOrDefault :: (Functor m, Monad m) => Int -> a -> ParseT err m a -> ParseT err m a Source #
Take the nth value of the current array, or if no value exists with that index, use the supplied default.
nthMay :: (Functor m, Monad m) => Int -> ParseT err m a -> ParseT err m (Maybe a) Source #
Take the nth value of the current array, or if no value exists with that index, return Nothing.
eachInArray :: (Functor m, Monad m) => ParseT err m a -> ParseT err m [a] Source #
Attempt to parse each value in the array with the given parser, and collect the results.
forEachInObject :: (Functor m, Monad m) => (Text -> ParseT err m a) -> ParseT err m [a] Source #
Parse each property in an object with the given parser, given the key as an argument, and collect the results.
eachInObject :: (Functor m, Monad m) => ParseT err m a -> ParseT err m [(Text, a)] Source #
Attempt to parse each property value in the object with the given parser, and collect the results.
eachInObjectWithKey :: (Functor m, Monad m) => (Text -> Either err k) -> ParseT err m a -> ParseT err m [(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
withValue :: (Functor m, Monad m) => (Value -> Either err a) -> ParseT err m a Source #
Lifts a function attempting to validate an arbitrary JSON value into a parser. You should only use this if absolutely necessary; the other functions in this module will generally give better error reporting.
withScientific :: (Functor m, Monad m) => (Scientific -> Either err a) -> ParseT err m a Source #
withRealFloat :: (Functor m, Monad m, RealFloat a) => (a -> Either err b) -> ParseT err m b Source #
withObject :: (Functor m, Monad m) => (Object -> Either err a) -> ParseT err m a Source #
Prefer to use functions like key
or eachInObject
to this one where
possible, as they will generate better error messages.
withArray :: (Functor m, Monad m) => (Array -> Either err a) -> ParseT err m a Source #
Prefer to use functions like nth
or eachInArray
to this one where
possible, as they will generate better error messages.
throwCustomError :: (Functor m, Monad m) => err -> ParseT err m a Source #
Throw a custom validation error.
Monadic validators
withScientificM :: (Functor m, Monad m) => (Scientific -> m (Either err a)) -> ParseT err m a Source #
withIntegralM :: (Functor m, Monad m, Integral a) => (a -> m (Either err b)) -> ParseT err m b Source #
withRealFloatM :: (Functor m, Monad m, RealFloat a) => (a -> m (Either err b)) -> ParseT err m b Source #
withObjectM :: (Functor m, Monad m) => (Object -> m (Either err a)) -> ParseT err m a Source #
Prefer to use functions like key
or eachInObject
to this one where
possible, as they will generate better error messages.
withArrayM :: (Functor m, Monad m) => (Array -> m (Either err a)) -> ParseT err m 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
.
Monadic parsers
parseM :: Monad m => ParseT err m a -> ByteString -> m (Either (ParseError err) a) Source #
Like parse
but runs the parser on an arbitrary underlying Monad.
parseStrictM :: Monad m => ParseT err m a -> ByteString -> m (Either (ParseError err) a) Source #
Like parseStrict
but runs the parser on an arbitrary underlying Monad.
parseValueM :: Monad m => ParseT err m a -> Value -> m (Either (ParseError err) a) Source #
Like parseValue
but runs the parser on an arbitrary underlying Monad.
Errors
data ParseError err Source #
A value indicating that the JSON could not be decoded successfully.
InvalidJSON String | Indicates a syntax error in the JSON string. Unfortunately, in this case, Aeson's errors are not very helpful. |
BadSchema [PathPiece] (ErrorSpecifics err) | Indicates a decoding error; the input was parsed as JSON successfully, but a value of the required type could not be constructed, perhaps because of a missing key or type mismatch. |
Instances
Functor ParseError Source # | |
Defined in Data.Aeson.BetterErrors.Internal fmap :: (a -> b) -> ParseError a -> ParseError b # (<$) :: a -> ParseError b -> ParseError a # | |
Eq err => Eq (ParseError err) Source # | |
Defined in Data.Aeson.BetterErrors.Internal (==) :: ParseError err -> ParseError err -> Bool # (/=) :: ParseError err -> ParseError err -> Bool # | |
Show err => Show (ParseError err) Source # | |
Defined in Data.Aeson.BetterErrors.Internal showsPrec :: Int -> ParseError err -> ShowS # show :: ParseError err -> String # showList :: [ParseError err] -> ShowS # | |
Monad m => MonadError (ParseError err) (ParseT err m) Source # | |
Defined in Data.Aeson.BetterErrors.Internal throwError :: ParseError err -> ParseT err m a # catchError :: ParseT err m a -> (ParseError err -> ParseT err m a) -> ParseT err m a # |
type ParseError' = ParseError Void Source #
The type of parse errors which never involve custom validation errors.
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 | |
FromAeson String | An error arising inside a |
CustomError err |
Instances
Functor ErrorSpecifics Source # | |
Defined in Data.Aeson.BetterErrors.Internal fmap :: (a -> b) -> ErrorSpecifics a -> ErrorSpecifics b # (<$) :: a -> ErrorSpecifics b -> ErrorSpecifics a # | |
Eq err => Eq (ErrorSpecifics err) Source # | |
Defined in Data.Aeson.BetterErrors.Internal (==) :: ErrorSpecifics err -> ErrorSpecifics err -> Bool # (/=) :: ErrorSpecifics err -> ErrorSpecifics err -> Bool # | |
Show err => Show (ErrorSpecifics err) Source # | |
Defined in Data.Aeson.BetterErrors.Internal showsPrec :: Int -> ErrorSpecifics err -> ShowS # show :: ErrorSpecifics err -> String # showList :: [ErrorSpecifics err] -> ShowS # |
type ErrorSpecifics' = ErrorSpecifics Void Source #
The type of error specifics which never involve custom validation errors.
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
.
displayError' :: ParseError' -> [Text] Source #
A version of displayError
for parsers which do not produce custom
validation errors.
displayPath :: [PathPiece] -> Text Source #
displaySpecifics :: (err -> Text) -> ErrorSpecifics err -> [Text] Source #
displaySpecifics' :: ErrorSpecifics' -> [Text] Source #
A version of displaySpecifics
for parsers which do not produce
custom validation errors.
Miscellaneous
toAesonParser' :: Parse' a -> Value -> Parser a Source #
Take a parser which never produces custom validation errors and turn it into an Aeson parser. Note that in this case, there is no need to provide a display function.
An enumeration of the different types that JSON values may take.
Instances
Bounded JSONType Source # | |
Enum JSONType Source # | |
Defined in Data.Aeson.BetterErrors.Internal | |
Eq JSONType Source # | |
Ord JSONType Source # | |
Defined in Data.Aeson.BetterErrors.Internal | |
Show JSONType Source # | |
jsonTypeOf :: Value -> JSONType Source #
Get the type of a JSON value.