{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE CPP #-}

module Data.Aeson.BetterErrors.Internal where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative, pure, (<$>), (<*>))
import Data.Foldable (foldMap)
#endif

import Control.Arrow (left)
import Control.Monad.Identity
import Control.Monad.Reader
import Control.Monad.Trans.Except
import Control.Monad.Error.Class (MonadError(..))

import Data.Void
import Data.Monoid
import Data.DList (DList)
import qualified Data.DList as DList
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString as B

import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import Data.Vector ((!?))
import qualified Data.Vector as V
import Data.Scientific (Scientific)
import qualified Data.Scientific as S

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Aeson.Key as Key
#else
import qualified Data.HashMap.Strict as HashMap
#endif

import Data.Aeson.BetterErrors.Utils

-- | 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.
newtype ParseT err m a
  = ParseT (ReaderT ParseReader (ExceptT (ParseError err) m) a)
  deriving (forall a b. a -> ParseT err m b -> ParseT err m a
forall a b. (a -> b) -> ParseT err m a -> ParseT err m b
forall err (m :: * -> *) a b.
Functor m =>
a -> ParseT err m b -> ParseT err m a
forall err (m :: * -> *) a b.
Functor m =>
(a -> b) -> ParseT err m a -> ParseT err m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ParseT err m b -> ParseT err m a
$c<$ :: forall err (m :: * -> *) a b.
Functor m =>
a -> ParseT err m b -> ParseT err m a
fmap :: forall a b. (a -> b) -> ParseT err m a -> ParseT err m b
$cfmap :: forall err (m :: * -> *) a b.
Functor m =>
(a -> b) -> ParseT err m a -> ParseT err m b
Functor, forall a. a -> ParseT err m a
forall a b. ParseT err m a -> ParseT err m b -> ParseT err m a
forall a b. ParseT err m a -> ParseT err m b -> ParseT err m b
forall a b.
ParseT err m (a -> b) -> ParseT err m a -> ParseT err m b
forall a b c.
(a -> b -> c) -> ParseT err m a -> ParseT err m b -> ParseT err m c
forall {err} {m :: * -> *}. Monad m => Functor (ParseT err m)
forall err (m :: * -> *) a. Monad m => a -> ParseT err m a
forall err (m :: * -> *) a b.
Monad m =>
ParseT err m a -> ParseT err m b -> ParseT err m a
forall err (m :: * -> *) a b.
Monad m =>
ParseT err m a -> ParseT err m b -> ParseT err m b
forall err (m :: * -> *) a b.
Monad m =>
ParseT err m (a -> b) -> ParseT err m a -> ParseT err m b
forall err (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> ParseT err m a -> ParseT err m b -> ParseT err m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. ParseT err m a -> ParseT err m b -> ParseT err m a
$c<* :: forall err (m :: * -> *) a b.
Monad m =>
ParseT err m a -> ParseT err m b -> ParseT err m a
*> :: forall a b. ParseT err m a -> ParseT err m b -> ParseT err m b
$c*> :: forall err (m :: * -> *) a b.
Monad m =>
ParseT err m a -> ParseT err m b -> ParseT err m b
liftA2 :: forall a b c.
(a -> b -> c) -> ParseT err m a -> ParseT err m b -> ParseT err m c
$cliftA2 :: forall err (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> ParseT err m a -> ParseT err m b -> ParseT err m c
<*> :: forall a b.
ParseT err m (a -> b) -> ParseT err m a -> ParseT err m b
$c<*> :: forall err (m :: * -> *) a b.
Monad m =>
ParseT err m (a -> b) -> ParseT err m a -> ParseT err m b
pure :: forall a. a -> ParseT err m a
$cpure :: forall err (m :: * -> *) a. Monad m => a -> ParseT err m a
Applicative, forall a. a -> ParseT err m a
forall a b. ParseT err m a -> ParseT err m b -> ParseT err m b
forall a b.
ParseT err m a -> (a -> ParseT err m b) -> ParseT err m b
forall err (m :: * -> *). Monad m => Applicative (ParseT err m)
forall err (m :: * -> *) a. Monad m => a -> ParseT err m a
forall err (m :: * -> *) a b.
Monad m =>
ParseT err m a -> ParseT err m b -> ParseT err m b
forall err (m :: * -> *) a b.
Monad m =>
ParseT err m a -> (a -> ParseT err m b) -> ParseT err m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> ParseT err m a
$creturn :: forall err (m :: * -> *) a. Monad m => a -> ParseT err m a
>> :: forall a b. ParseT err m a -> ParseT err m b -> ParseT err m b
$c>> :: forall err (m :: * -> *) a b.
Monad m =>
ParseT err m a -> ParseT err m b -> ParseT err m b
>>= :: forall a b.
ParseT err m a -> (a -> ParseT err m b) -> ParseT err m b
$c>>= :: forall err (m :: * -> *) a b.
Monad m =>
ParseT err m a -> (a -> ParseT err m b) -> ParseT err m b
Monad,
            MonadReader ParseReader, MonadError (ParseError err))
-- | This is the standard version of 'ParseT' over the 'Identity' Monad, for running pure parsers.
type Parse err a = ParseT err Identity a

instance MonadTrans (ParseT err) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ParseT err m a
lift m a
f = forall err (m :: * -> *) a.
ReaderT ParseReader (ExceptT (ParseError err) m) a
-> ParseT err m a
ParseT (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
f))

runParseT :: ParseT err m a -> A.Value -> m (Either (ParseError err) a)
runParseT :: forall err (m :: * -> *) a.
ParseT err m a -> Value -> m (Either (ParseError err) a)
runParseT (ParseT ReaderT ParseReader (ExceptT (ParseError err) m) a
p) Value
v = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT ParseReader (ExceptT (ParseError err) m) a
p (DList PathPiece -> Value -> ParseReader
ParseReader forall a. DList a
DList.empty Value
v))

runParse :: Parse err a -> A.Value -> Either (ParseError err) a
runParse :: forall err a. Parse err a -> Value -> Either (ParseError err) a
runParse Parse err a
p Value
v = forall a. Identity a -> a
runIdentity (forall err (m :: * -> *) a.
ParseT err m a -> Value -> m (Either (ParseError err) a)
runParseT Parse err a
p Value
v)

mapParseT :: (ReaderT ParseReader (ExceptT (ParseError err) m) a -> ReaderT ParseReader (ExceptT (ParseError err') m') a') -> ParseT err m a -> ParseT err' m' a'
mapParseT :: forall err (m :: * -> *) a err' (m' :: * -> *) a'.
(ReaderT ParseReader (ExceptT (ParseError err) m) a
 -> ReaderT ParseReader (ExceptT (ParseError err') m') a')
-> ParseT err m a -> ParseT err' m' a'
mapParseT ReaderT ParseReader (ExceptT (ParseError err) m) a
-> ReaderT ParseReader (ExceptT (ParseError err') m') a'
f (ParseT ReaderT ParseReader (ExceptT (ParseError err) m) a
p) = forall err (m :: * -> *) a.
ReaderT ParseReader (ExceptT (ParseError err) m) a
-> ParseT err m a
ParseT (ReaderT ParseReader (ExceptT (ParseError err) m) a
-> ReaderT ParseReader (ExceptT (ParseError err') m') a'
f ReaderT ParseReader (ExceptT (ParseError err) m) a
p)

-- | Transform the error of a parser according to the given function.
mapError :: Functor m => (err -> err') -> ParseT err m a -> ParseT err' m a
mapError :: forall (m :: * -> *) err err' a.
Functor m =>
(err -> err') -> ParseT err m a -> ParseT err' m a
mapError err -> err'
f = forall err (m :: * -> *) a err' (m' :: * -> *) a'.
(ReaderT ParseReader (ExceptT (ParseError err) m) a
 -> ReaderT ParseReader (ExceptT (ParseError err') m') a')
-> ParseT err m a -> ParseT err' m' a'
mapParseT (forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap err -> err'
f)))

-- | An infix version of 'mapError'.
(.!) :: Functor m => ParseT err m a -> (err -> err') -> ParseT err' m a
.! :: forall (m :: * -> *) err a err'.
Functor m =>
ParseT err m a -> (err -> err') -> ParseT err' m a
(.!) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) err err' a.
Functor m =>
(err -> err') -> ParseT err m a -> ParseT err' m a
mapError

-- | First try the left parser, if that fails try the right.
-- | If both fail, the error will come from the right one.
(<|>) :: Monad m => ParseT err m a -> ParseT err m a -> ParseT err m a
ParseT err m a
l <|> :: forall (m :: * -> *) err a.
Monad m =>
ParseT err m a -> ParseT err m a -> ParseT err m a
<|> ParseT err m a
r = forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ParseT err m a
l (forall a b. a -> b -> a
const ParseT err m a
r)

infixl 3 <|>

-- | The type of parsers which never produce custom validation errors.
type Parse' a = Parse Void a

runParserT :: Monad m =>
  (s -> Either String A.Value) ->
  ParseT err m a ->
  s ->
  m (Either (ParseError err) a)
runParserT :: forall (m :: * -> *) s err a.
Monad m =>
(s -> Either String Value)
-> ParseT err m a -> s -> m (Either (ParseError err) a)
runParserT s -> Either String Value
decode ParseT err m a
p s
src =
  case s -> Either String Value
decode s
src of
    Left String
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall err. String -> ParseError err
InvalidJSON String
err)
    Right Value
value -> forall err (m :: * -> *) a.
ParseT err m a -> Value -> m (Either (ParseError err) a)
runParseT ParseT err m a
p Value
value

runParser ::
  (s -> Either String A.Value) ->
  Parse err a ->
  s ->
  Either (ParseError err) a
runParser :: forall s err a.
(s -> Either String Value)
-> Parse err a -> s -> Either (ParseError err) a
runParser s -> Either String Value
decode Parse err a
p s
src =
  forall a. Identity a -> a
runIdentity (forall (m :: * -> *) s err a.
Monad m =>
(s -> Either String Value)
-> ParseT err m a -> s -> m (Either (ParseError err) a)
runParserT s -> Either String Value
decode Parse err a
p s
src)

-- | Like 'parse' but runs the parser on an arbitrary underlying Monad.
parseM :: Monad m => ParseT err m a -> BL.ByteString -> m (Either (ParseError err) a)
parseM :: forall (m :: * -> *) err a.
Monad m =>
ParseT err m a -> ByteString -> m (Either (ParseError err) a)
parseM = forall (m :: * -> *) s err a.
Monad m =>
(s -> Either String Value)
-> ParseT err m a -> s -> m (Either (ParseError err) a)
runParserT forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode

-- | Run a parser with a lazy 'BL.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.
parse :: Parse err a -> BL.ByteString -> Either (ParseError err) a
parse :: forall err a.
Parse err a -> ByteString -> Either (ParseError err) a
parse = forall s err a.
(s -> Either String Value)
-> Parse err a -> s -> Either (ParseError err) a
runParser forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode

-- | Like 'parseStrict' but runs the parser on an arbitrary underlying Monad.
parseStrictM :: Monad m => ParseT err m a -> B.ByteString -> m (Either (ParseError err) a)
parseStrictM :: forall (m :: * -> *) err a.
Monad m =>
ParseT err m a -> ByteString -> m (Either (ParseError err) a)
parseStrictM = forall (m :: * -> *) s err a.
Monad m =>
(s -> Either String Value)
-> ParseT err m a -> s -> m (Either (ParseError err) a)
runParserT forall a. FromJSON a => ByteString -> Either String a
A.eitherDecodeStrict

-- | Run a parser with a strict 'B.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 -> B.ByteString -> Either (ParseError err) a
parseStrict :: forall err a.
Parse err a -> ByteString -> Either (ParseError err) a
parseStrict = forall s err a.
(s -> Either String Value)
-> Parse err a -> s -> Either (ParseError err) a
runParser forall a. FromJSON a => ByteString -> Either String a
A.eitherDecodeStrict

-- | Like 'parseValue' but runs the parser on an arbitrary underlying Monad.
parseValueM :: Monad m => ParseT err m a -> A.Value -> m (Either (ParseError err) a)
parseValueM :: forall (m :: * -> *) err a.
Monad m =>
ParseT err m a -> Value -> m (Either (ParseError err) a)
parseValueM = forall (m :: * -> *) s err a.
Monad m =>
(s -> Either String Value)
-> ParseT err m a -> s -> m (Either (ParseError err) a)
runParserT forall a b. b -> Either a b
Right

-- | Run a parser with a pre-parsed JSON 'A.Value'.
parseValue :: Parse err a -> A.Value -> Either (ParseError err) a
parseValue :: forall err a. Parse err a -> Value -> Either (ParseError err) a
parseValue = forall s err a.
(s -> Either String Value)
-> Parse err a -> s -> Either (ParseError err) a
runParser forall a b. b -> Either a b
Right

-- | This function is useful when you have a @'Parse' err a@ and you want to
-- obtain an instance for @'A.FromJSON' a@. Simply define:
--
-- @
--    parseJSON = toAesonParser showMyCustomError myParser
-- @
toAesonParser :: (err -> Text) -> Parse err a -> A.Value -> A.Parser a
toAesonParser :: forall err a. (err -> Text) -> Parse err a -> Value -> Parser a
toAesonParser err -> Text
showCustom Parse err a
p Value
val =
  case forall err a. Parse err a -> Value -> Either (ParseError err) a
parseValue Parse err a
p Value
val of
    Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    Left ParseError err
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail ([String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack (forall err. (err -> Text) -> ParseError err -> [Text]
displayError err -> Text
showCustom ParseError err
err)))

-- | 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.
toAesonParser' :: Parse' a -> A.Value -> A.Parser a
toAesonParser' :: forall a. Parse' a -> Value -> Parser a
toAesonParser' = forall err a. (err -> Text) -> Parse err a -> Value -> Parser a
toAesonParser forall a. Void -> a
absurd

-- | Create a parser for any type, using its FromJSON instance.  Generally, you
-- should prefer to write parsers using the other functions in this module;
-- 'key', 'asString', etc, since they will usually generate better error
-- messages. However this function is also useful occasionally.
fromAesonParser :: (Functor m, Monad m) => A.FromJSON a => ParseT e m a
fromAesonParser :: forall (m :: * -> *) a e.
(Functor m, Monad m, FromJSON a) =>
ParseT e m a
fromAesonParser = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
liftParse forall a b. (a -> b) -> a -> b
$ \Value
v ->
  case forall a. FromJSON a => Value -> Result a
A.fromJSON Value
v of
    A.Success a
x -> forall a b. b -> Either a b
Right a
x
    A.Error String
err -> forall a b. a -> Either a b
Left (forall err. String -> ErrorSpecifics err
FromAeson String
err)

-- | Data used internally by the 'Parse' type.
data ParseReader = ParseReader
  { ParseReader -> DList PathPiece
rdrPath  :: DList PathPiece
  , ParseReader -> Value
rdrValue :: A.Value
  }

appendPath :: PathPiece -> ParseReader -> ParseReader
appendPath :: PathPiece -> ParseReader -> ParseReader
appendPath PathPiece
p ParseReader
r = ParseReader
r { rdrPath :: DList PathPiece
rdrPath = forall a. DList a -> a -> DList a
DList.snoc (ParseReader -> DList PathPiece
rdrPath ParseReader
r) PathPiece
p }

setValue :: A.Value -> ParseReader -> ParseReader
setValue :: Value -> ParseReader -> ParseReader
setValue Value
v ParseReader
r = ParseReader
r { rdrValue :: Value
rdrValue = Value
v }

-- | 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 PathPiece
  = ObjectKey Text
  | ArrayIndex Int
  deriving (Int -> PathPiece -> ShowS
[PathPiece] -> ShowS
PathPiece -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathPiece] -> ShowS
$cshowList :: [PathPiece] -> ShowS
show :: PathPiece -> String
$cshow :: PathPiece -> String
showsPrec :: Int -> PathPiece -> ShowS
$cshowsPrec :: Int -> PathPiece -> ShowS
Show, PathPiece -> PathPiece -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathPiece -> PathPiece -> Bool
$c/= :: PathPiece -> PathPiece -> Bool
== :: PathPiece -> PathPiece -> Bool
$c== :: PathPiece -> PathPiece -> Bool
Eq, Eq PathPiece
PathPiece -> PathPiece -> Bool
PathPiece -> PathPiece -> Ordering
PathPiece -> PathPiece -> PathPiece
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PathPiece -> PathPiece -> PathPiece
$cmin :: PathPiece -> PathPiece -> PathPiece
max :: PathPiece -> PathPiece -> PathPiece
$cmax :: PathPiece -> PathPiece -> PathPiece
>= :: PathPiece -> PathPiece -> Bool
$c>= :: PathPiece -> PathPiece -> Bool
> :: PathPiece -> PathPiece -> Bool
$c> :: PathPiece -> PathPiece -> Bool
<= :: PathPiece -> PathPiece -> Bool
$c<= :: PathPiece -> PathPiece -> Bool
< :: PathPiece -> PathPiece -> Bool
$c< :: PathPiece -> PathPiece -> Bool
compare :: PathPiece -> PathPiece -> Ordering
$ccompare :: PathPiece -> PathPiece -> Ordering
Ord)

-- | A value indicating that the JSON could not be decoded successfully.
data ParseError err
  = 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.
  deriving (Int -> ParseError err -> ShowS
forall err. Show err => Int -> ParseError err -> ShowS
forall err. Show err => [ParseError err] -> ShowS
forall err. Show err => ParseError err -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseError err] -> ShowS
$cshowList :: forall err. Show err => [ParseError err] -> ShowS
show :: ParseError err -> String
$cshow :: forall err. Show err => ParseError err -> String
showsPrec :: Int -> ParseError err -> ShowS
$cshowsPrec :: forall err. Show err => Int -> ParseError err -> ShowS
Show, ParseError err -> ParseError err -> Bool
forall err. Eq err => ParseError err -> ParseError err -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseError err -> ParseError err -> Bool
$c/= :: forall err. Eq err => ParseError err -> ParseError err -> Bool
== :: ParseError err -> ParseError err -> Bool
$c== :: forall err. Eq err => ParseError err -> ParseError err -> Bool
Eq, forall a b. a -> ParseError b -> ParseError a
forall a b. (a -> b) -> ParseError a -> ParseError b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ParseError b -> ParseError a
$c<$ :: forall a b. a -> ParseError b -> ParseError a
fmap :: forall a b. (a -> b) -> ParseError a -> ParseError b
$cfmap :: forall a b. (a -> b) -> ParseError a -> ParseError b
Functor)

-- | The type of parse errors which never involve custom validation
-- errors.
type ParseError' = ParseError Void

-- | 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.
data ErrorSpecifics err
  = KeyMissing Text
  | OutOfBounds Int
  | WrongType JSONType A.Value -- ^ Expected type, actual value
  | ExpectedIntegral Double
  | FromAeson String -- ^ An error arising inside a 'A.FromJSON' instance.
  | CustomError err
  deriving (Int -> ErrorSpecifics err -> ShowS
forall err. Show err => Int -> ErrorSpecifics err -> ShowS
forall err. Show err => [ErrorSpecifics err] -> ShowS
forall err. Show err => ErrorSpecifics err -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorSpecifics err] -> ShowS
$cshowList :: forall err. Show err => [ErrorSpecifics err] -> ShowS
show :: ErrorSpecifics err -> String
$cshow :: forall err. Show err => ErrorSpecifics err -> String
showsPrec :: Int -> ErrorSpecifics err -> ShowS
$cshowsPrec :: forall err. Show err => Int -> ErrorSpecifics err -> ShowS
Show, ErrorSpecifics err -> ErrorSpecifics err -> Bool
forall err.
Eq err =>
ErrorSpecifics err -> ErrorSpecifics err -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorSpecifics err -> ErrorSpecifics err -> Bool
$c/= :: forall err.
Eq err =>
ErrorSpecifics err -> ErrorSpecifics err -> Bool
== :: ErrorSpecifics err -> ErrorSpecifics err -> Bool
$c== :: forall err.
Eq err =>
ErrorSpecifics err -> ErrorSpecifics err -> Bool
Eq, forall a b. a -> ErrorSpecifics b -> ErrorSpecifics a
forall a b. (a -> b) -> ErrorSpecifics a -> ErrorSpecifics b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ErrorSpecifics b -> ErrorSpecifics a
$c<$ :: forall a b. a -> ErrorSpecifics b -> ErrorSpecifics a
fmap :: forall a b. (a -> b) -> ErrorSpecifics a -> ErrorSpecifics b
$cfmap :: forall a b. (a -> b) -> ErrorSpecifics a -> ErrorSpecifics b
Functor)

-- | The type of error specifics which never involve custom validation
-- errors.
type ErrorSpecifics' = ErrorSpecifics Void

-- | An enumeration of the different types that JSON values may take.
data JSONType
  = TyObject
  | TyArray
  | TyString
  | TyNumber
  | TyBool
  | TyNull
  deriving (Int -> JSONType -> ShowS
[JSONType] -> ShowS
JSONType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONType] -> ShowS
$cshowList :: [JSONType] -> ShowS
show :: JSONType -> String
$cshow :: JSONType -> String
showsPrec :: Int -> JSONType -> ShowS
$cshowsPrec :: Int -> JSONType -> ShowS
Show, JSONType -> JSONType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONType -> JSONType -> Bool
$c/= :: JSONType -> JSONType -> Bool
== :: JSONType -> JSONType -> Bool
$c== :: JSONType -> JSONType -> Bool
Eq, Eq JSONType
JSONType -> JSONType -> Bool
JSONType -> JSONType -> Ordering
JSONType -> JSONType -> JSONType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JSONType -> JSONType -> JSONType
$cmin :: JSONType -> JSONType -> JSONType
max :: JSONType -> JSONType -> JSONType
$cmax :: JSONType -> JSONType -> JSONType
>= :: JSONType -> JSONType -> Bool
$c>= :: JSONType -> JSONType -> Bool
> :: JSONType -> JSONType -> Bool
$c> :: JSONType -> JSONType -> Bool
<= :: JSONType -> JSONType -> Bool
$c<= :: JSONType -> JSONType -> Bool
< :: JSONType -> JSONType -> Bool
$c< :: JSONType -> JSONType -> Bool
compare :: JSONType -> JSONType -> Ordering
$ccompare :: JSONType -> JSONType -> Ordering
Ord, Int -> JSONType
JSONType -> Int
JSONType -> [JSONType]
JSONType -> JSONType
JSONType -> JSONType -> [JSONType]
JSONType -> JSONType -> JSONType -> [JSONType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: JSONType -> JSONType -> JSONType -> [JSONType]
$cenumFromThenTo :: JSONType -> JSONType -> JSONType -> [JSONType]
enumFromTo :: JSONType -> JSONType -> [JSONType]
$cenumFromTo :: JSONType -> JSONType -> [JSONType]
enumFromThen :: JSONType -> JSONType -> [JSONType]
$cenumFromThen :: JSONType -> JSONType -> [JSONType]
enumFrom :: JSONType -> [JSONType]
$cenumFrom :: JSONType -> [JSONType]
fromEnum :: JSONType -> Int
$cfromEnum :: JSONType -> Int
toEnum :: Int -> JSONType
$ctoEnum :: Int -> JSONType
pred :: JSONType -> JSONType
$cpred :: JSONType -> JSONType
succ :: JSONType -> JSONType
$csucc :: JSONType -> JSONType
Enum, JSONType
forall a. a -> a -> Bounded a
maxBound :: JSONType
$cmaxBound :: JSONType
minBound :: JSONType
$cminBound :: JSONType
Bounded)

displayJSONType :: JSONType -> Text
displayJSONType :: JSONType -> Text
displayJSONType JSONType
t = case JSONType
t of
  JSONType
TyObject -> Text
"object"
  JSONType
TyArray  -> Text
"array"
  JSONType
TyString -> Text
"string"
  JSONType
TyNumber -> Text
"number"
  JSONType
TyBool   -> Text
"boolean"
  JSONType
TyNull   -> Text
"null"

-- | 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 :: (err -> Text) -> ParseError err -> [Text]
displayError :: forall err. (err -> Text) -> ParseError err -> [Text]
displayError err -> Text
_ (InvalidJSON String
str) =
  [ Text
"The input could not be parsed as JSON", Text
"aeson said: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
str ]
displayError err -> Text
f (BadSchema [] ErrorSpecifics err
specs) =
  forall err. (err -> Text) -> ErrorSpecifics err -> [Text]
displaySpecifics err -> Text
f ErrorSpecifics err
specs
displayError err -> Text
f (BadSchema [PathPiece]
path ErrorSpecifics err
specs) =
  [ Text
"At the path: " forall a. Semigroup a => a -> a -> a
<> [PathPiece] -> Text
displayPath [PathPiece]
path ] forall a. Semigroup a => a -> a -> a
<> forall err. (err -> Text) -> ErrorSpecifics err -> [Text]
displaySpecifics err -> Text
f ErrorSpecifics err
specs

-- | A version of 'displayError' for parsers which do not produce custom
-- validation errors.
displayError' :: ParseError' -> [Text]
displayError' :: ParseError' -> [Text]
displayError' = forall err. (err -> Text) -> ParseError err -> [Text]
displayError forall a. Void -> a
absurd

displayPath :: [PathPiece] -> Text
displayPath :: [PathPiece] -> Text
displayPath = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap PathPiece -> Text
showPiece
  where
  showPiece :: PathPiece -> Text
showPiece (ObjectKey Text
t)  = Text
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Text
t forall a. Semigroup a => a -> a -> a
<> Text
"]"
  showPiece (ArrayIndex Int
i) = Text
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
i forall a. Semigroup a => a -> a -> a
<> Text
"]"

displaySpecifics :: (err -> Text) -> ErrorSpecifics err -> [Text]
displaySpecifics :: forall err. (err -> Text) -> ErrorSpecifics err -> [Text]
displaySpecifics err -> Text
_ (KeyMissing Text
k) =
  [ Text
"The required key " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Text
k forall a. Semigroup a => a -> a -> a
<> Text
" is missing" ]
displaySpecifics err -> Text
_ (OutOfBounds Int
i) =
  [ Text
"The array index " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
i forall a. Semigroup a => a -> a -> a
<> Text
" is out of bounds" ]
displaySpecifics err -> Text
_ (WrongType JSONType
t Value
val) =
  [ Text
"Type mismatch:"
  , Text
"Expected a value of type " forall a. Semigroup a => a -> a -> a
<> JSONType -> Text
displayJSONType JSONType
t
  , Text
"Got: " forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 ([ByteString] -> ByteString
B.concat (ByteString -> [ByteString]
BL.toChunks (forall a. ToJSON a => a -> ByteString
A.encode Value
val)))
  ]
displaySpecifics err -> Text
_ (ExpectedIntegral Double
x) =
  [ Text
"Expected an integral value, got " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Double
x ]
displaySpecifics err -> Text
_ (FromAeson String
str) =
  [ Text
"Arising from an Aeson FromJSON instance:"
  , String -> Text
T.pack String
str
  ]
displaySpecifics err -> Text
f (CustomError err
err) =
  [ err -> Text
f err
err ]

-- | A version of `displaySpecifics` for parsers which do not produce
-- custom validation errors.
displaySpecifics' :: ErrorSpecifics' -> [Text]
displaySpecifics' :: ErrorSpecifics' -> [Text]
displaySpecifics' = forall err. (err -> Text) -> ErrorSpecifics err -> [Text]
displaySpecifics forall a. Void -> a
absurd

-- | Get the type of a JSON value.
jsonTypeOf :: A.Value -> JSONType
jsonTypeOf :: Value -> JSONType
jsonTypeOf (A.Object Object
_) = JSONType
TyObject
jsonTypeOf (A.Array Array
_)  = JSONType
TyArray
jsonTypeOf (A.String Text
_) = JSONType
TyString
jsonTypeOf (A.Number Scientific
_) = JSONType
TyNumber
jsonTypeOf (A.Bool Bool
_)   = JSONType
TyBool
jsonTypeOf Value
A.Null       = JSONType
TyNull

liftParseT :: (Functor m, Monad m) => (A.Value -> ExceptT (ErrorSpecifics err) m a) -> ParseT err m a
liftParseT :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> ExceptT (ErrorSpecifics err) m a) -> ParseT err m a
liftParseT Value -> ExceptT (ErrorSpecifics err) m a
f = forall err (m :: * -> *) a.
ReaderT ParseReader (ExceptT (ParseError err) m) a
-> ParseT err m a
ParseT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \(ParseReader DList PathPiece
path Value
value) ->
  forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
BadSchema (forall a. DList a -> [a]
DList.toList DList PathPiece
path)) (Value -> ExceptT (ErrorSpecifics err) m a
f Value
value)

liftParseM :: (Functor m, Monad m) => (A.Value -> m (Either (ErrorSpecifics err) a)) -> ParseT err m a
liftParseM :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> m (Either (ErrorSpecifics err) a)) -> ParseT err m a
liftParseM Value -> m (Either (ErrorSpecifics err) a)
f = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> ExceptT (ErrorSpecifics err) m a) -> ParseT err m a
liftParseT (forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> m (Either (ErrorSpecifics err) a)
f)

-- | Lift any parsing function into the 'Parse' type.
liftParse :: (Functor m, Monad m) => (A.Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
liftParse :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
liftParse Value -> Either (ErrorSpecifics err) a
f = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> m (Either (ErrorSpecifics err) a)) -> ParseT err m a
liftParseM (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either (ErrorSpecifics err) a
f)

-- | Aborts parsing, due to an error in the structure of the JSON - that is,
-- any error other than the JSON not actually being parseable into a 'A.Value'.
badSchema :: (Functor m, Monad m) => ErrorSpecifics err -> ParseT err m a
badSchema :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ErrorSpecifics err -> ParseT err m a
badSchema = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
liftParse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left

as :: (Functor m, Monad m) => (A.Value -> Maybe a) -> JSONType -> ParseT err m a
as :: forall (m :: * -> *) a err.
(Functor m, Monad m) =>
(Value -> Maybe a) -> JSONType -> ParseT err m a
as Value -> Maybe a
pat JSONType
ty = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
liftParse forall a b. (a -> b) -> a -> b
$ \Value
v ->
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left (forall err. JSONType -> Value -> ErrorSpecifics err
WrongType JSONType
ty Value
v)) forall a b. b -> Either a b
Right (Value -> Maybe a
pat Value
v)

-- | Return the current JSON 'A.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.
asValue :: (Functor m, Monad m) => ParseT err m A.Value
asValue :: forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Value
asValue = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParseReader -> Value
rdrValue

-- | Parse a single JSON string as 'Text'.
asText :: (Functor m, Monad m) => ParseT err m Text
asText :: forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText = forall (m :: * -> *) a err.
(Functor m, Monad m) =>
(Value -> Maybe a) -> JSONType -> ParseT err m a
as Value -> Maybe Text
patString JSONType
TyString

-- | Parse a single JSON string as a 'String'.
asString :: (Functor m, Monad m) => ParseT err m String
asString :: forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m String
asString = Text -> String
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText

-- | Parse a single JSON number as a 'Scientific'.
asScientific :: (Functor m, Monad m) => ParseT err m Scientific
asScientific :: forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Scientific
asScientific = forall (m :: * -> *) a err.
(Functor m, Monad m) =>
(Value -> Maybe a) -> JSONType -> ParseT err m a
as Value -> Maybe Scientific
patNumber JSONType
TyNumber

-- | Parse a single JSON number as any 'Integral' type.
asIntegral :: (Functor m, Monad m, Integral a) => ParseT err m a
asIntegral :: forall (m :: * -> *) a err.
(Functor m, Monad m, Integral a) =>
ParseT err m a
asIntegral =
  forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Scientific
asScientific
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
liftParse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall err. Double -> ErrorSpecifics err
ExpectedIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
S.floatingOrInteger

-- | Parse a single JSON number as any 'RealFloat' type.
asRealFloat :: (Functor m, Monad m, RealFloat a) => ParseT err m a
asRealFloat :: forall (m :: * -> *) a err.
(Functor m, Monad m, RealFloat a) =>
ParseT err m a
asRealFloat =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
S.floatingOrInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Scientific
asScientific

-- | Parse a single JSON boolean as a 'Bool'.
asBool :: (Functor m, Monad m) => ParseT err m Bool
asBool :: forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Bool
asBool = forall (m :: * -> *) a err.
(Functor m, Monad m) =>
(Value -> Maybe a) -> JSONType -> ParseT err m a
as Value -> Maybe Bool
patBool JSONType
TyBool

-- | Parse a JSON object, as an 'A.Object'. You should prefer functions like
-- 'eachInObject' where possible, since they will usually generate better
-- error messages.
asObject :: (Functor m, Monad m) => ParseT err m A.Object
asObject :: forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Object
asObject = forall (m :: * -> *) a err.
(Functor m, Monad m) =>
(Value -> Maybe a) -> JSONType -> ParseT err m a
as Value -> Maybe Object
patObject JSONType
TyObject

-- | Parse a JSON array, as an 'A.Array'. You should prefer functions like
-- 'eachInArray' where possible, since they will usually generate better
-- error messages.
asArray :: (Functor m, Monad m) => ParseT err m A.Array
asArray :: forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Array
asArray = forall (m :: * -> *) a err.
(Functor m, Monad m) =>
(Value -> Maybe a) -> JSONType -> ParseT err m a
as Value -> Maybe Array
patArray JSONType
TyArray

-- | Parse a single JSON null value. Useful if you want to throw an error in
-- the case where something is not null.
asNull :: (Functor m, Monad m) => ParseT err m ()
asNull :: forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m ()
asNull = forall (m :: * -> *) a err.
(Functor m, Monad m) =>
(Value -> Maybe a) -> JSONType -> ParseT err m a
as Value -> Maybe ()
patNull JSONType
TyNull

-- | 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.
perhaps :: (Functor m, Monad m) => ParseT err m a -> ParseT err m (Maybe a)
perhaps :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
perhaps ParseT err m a
p = do
  Value
v <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParseReader -> Value
rdrValue
  case Value
v of
    Value
A.Null -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Value
_      -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseT err m a
p

-- | Take the value corresponding to a given key in the current object.
key :: (Functor m, Monad m) => Text -> ParseT err m a -> ParseT err m a
key :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m a
key Text
k ParseT err m a
p = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> Text -> ParseT err m a -> ParseT err m a
key' (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ErrorSpecifics err -> ParseT err m a
badSchema (forall err. Text -> ErrorSpecifics err
KeyMissing Text
k)) Text
k ParseT err m a
p

-- | Take the value corresponding to a given key in the current object, or
-- if no property exists with that key, use the supplied default.
keyOrDefault :: (Functor m, Monad m) => Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault :: forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
k a
def ParseT err m a
p = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> Text -> ParseT err m a -> ParseT err m a
key' (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
def) Text
k ParseT err m a
p

-- | Take the value corresponding to a given key in the current object, or
-- if no property exists with that key, return Nothing .
keyMay :: (Functor m, Monad m) => Text -> ParseT err m a -> ParseT err m (Maybe a)
keyMay :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m (Maybe a)
keyMay Text
k ParseT err m a
p = forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
k forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseT err m a
p)

key' :: (Functor m, Monad m) => ParseT err m a -> Text -> ParseT err m a -> ParseT err m a
key' :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> Text -> ParseT err m a -> ParseT err m a
key' ParseT err m a
onMissing Text
k ParseT err m a
p = do
  Value
v <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParseReader -> Value
rdrValue
  case Value
v of
    A.Object Object
obj ->
#if MIN_VERSION_aeson(2,0,0)
      case forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (Text -> Key
Key.fromText Text
k) Object
obj of
#else
      case HashMap.lookup k obj of
#endif
        Just Value
v' ->
          forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (PathPiece -> ParseReader -> ParseReader
appendPath (Text -> PathPiece
ObjectKey Text
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ParseReader -> ParseReader
setValue Value
v') ParseT err m a
p
        Maybe Value
Nothing ->
          ParseT err m a
onMissing
    Value
_ ->
      forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ErrorSpecifics err -> ParseT err m a
badSchema (forall err. JSONType -> Value -> ErrorSpecifics err
WrongType JSONType
TyObject Value
v)

-- | Take the nth value of the current array.
nth :: (Functor m, Monad m) => Int -> ParseT err m a -> ParseT err m a
nth :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m a
nth Int
n ParseT err m a
p = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> Int -> ParseT err m a -> ParseT err m a
nth' (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ErrorSpecifics err -> ParseT err m a
badSchema (forall err. Int -> ErrorSpecifics err
OutOfBounds Int
n)) Int
n ParseT err m a
p

-- | Take the nth value of the current array, or if no value exists with that
-- index, use the supplied default.
nthOrDefault :: (Functor m, Monad m) => Int -> a -> ParseT err m a -> ParseT err m a
nthOrDefault :: forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Int -> a -> ParseT err m a -> ParseT err m a
nthOrDefault Int
n a
def ParseT err m a
p =
  forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> Int -> ParseT err m a -> ParseT err m a
nth' (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
def) Int
n ParseT err m a
p

-- | Take the nth value of the current array, or if no value exists with that
-- index, return Nothing.
nthMay :: (Functor m, Monad m) => Int -> ParseT err m a -> ParseT err m (Maybe a)
nthMay :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m (Maybe a)
nthMay Int
n ParseT err m a
p = forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Int -> a -> ParseT err m a -> ParseT err m a
nthOrDefault Int
n forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseT err m a
p)

nth' :: (Functor m, Monad m) => ParseT err m a -> Int -> ParseT err m a -> ParseT err m a
nth' :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> Int -> ParseT err m a -> ParseT err m a
nth' ParseT err m a
onMissing Int
n ParseT err m a
p = do
  Value
v <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParseReader -> Value
rdrValue
  case Value
v of
    A.Array Array
vect ->
      case Array
vect forall a. Vector a -> Int -> Maybe a
!? Int
n of
        Just Value
v' ->
          forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (PathPiece -> ParseReader -> ParseReader
appendPath (Int -> PathPiece
ArrayIndex Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ParseReader -> ParseReader
setValue Value
v') ParseT err m a
p
        Maybe Value
Nothing ->
          ParseT err m a
onMissing
    Value
_ ->
      forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ErrorSpecifics err -> ParseT err m a
badSchema (forall err. JSONType -> Value -> ErrorSpecifics err
WrongType JSONType
TyArray Value
v)

-- | Attempt to parse each value in the array with the given parser, and
-- collect the results.
eachInArray :: (Functor m, Monad m) => ParseT err m a -> ParseT err m [a]
eachInArray :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [a]
eachInArray ParseT err m a
p = do
  [(Int, Value)]
xs <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
V.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Array
asArray
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Int, Value)]
xs forall a b. (a -> b) -> a -> b
$ \(Int
i, Value
x) ->
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (PathPiece -> ParseReader -> ParseReader
appendPath (Int -> PathPiece
ArrayIndex Int
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ParseReader -> ParseReader
setValue Value
x) ParseT err m a
p

-- | Parse each property in an object with the given parser, given the key as
-- an argument, and collect the results.
forEachInObject :: (Functor m, Monad m) => (Text -> ParseT err m a) -> ParseT err m [a]
forEachInObject :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> ParseT err m a) -> ParseT err m [a]
forEachInObject Text -> ParseT err m a
p = do
#if MIN_VERSION_aeson(2,0,0)
  [(Key, Value)]
xs <- forall v. KeyMap v -> [(Key, v)]
KeyMap.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Object
asObject
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Key, Value)]
xs forall a b. (a -> b) -> a -> b
$ \(Key
k, Value
x) ->
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (PathPiece -> ParseReader -> ParseReader
appendPath (Text -> PathPiece
ObjectKey (Key -> Text
Key.toText Key
k)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ParseReader -> ParseReader
setValue Value
x) (Text -> ParseT err m a
p (Key -> Text
Key.toText Key
k))
#else
  xs <- HashMap.toList <$> asObject
  forM xs $ \(k, x) ->
    local (appendPath (ObjectKey k) . setValue x) (p k)
#endif

-- | Attempt to parse each property value in the object with the given parser,
-- and collect the results.
eachInObject :: (Functor m, Monad m) => ParseT err m a -> ParseT err m [(Text, a)]
eachInObject :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [(Text, a)]
eachInObject = forall (m :: * -> *) err k a.
(Functor m, Monad m) =>
(Text -> Either err k) -> ParseT err m a -> ParseT err m [(k, a)]
eachInObjectWithKey forall a b. b -> Either a b
Right

-- | 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.
eachInObjectWithKey :: (Functor m, Monad m) => (Text -> Either err k) -> ParseT err m a -> ParseT err m [(k, a)]
eachInObjectWithKey :: forall (m :: * -> *) err k a.
(Functor m, Monad m) =>
(Text -> Either err k) -> ParseT err m a -> ParseT err m [(k, a)]
eachInObjectWithKey Text -> Either err k
parseKey ParseT err m a
parseVal = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> ParseT err m a) -> ParseT err m [a]
forEachInObject forall a b. (a -> b) -> a -> b
$ \Text
k ->
  (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Either err a -> ParseT err m a
liftEither (Text -> Either err k
parseKey Text
k) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParseT err m a
parseVal

-- | 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.
withValue :: (Functor m, Monad m) => (A.Value -> Either err a) -> ParseT err m a
withValue :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either err a) -> ParseT err m a
withValue Value -> Either err a
f = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
liftParse (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall err. err -> ErrorSpecifics err
CustomError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Either err a
f)

withValueM :: (Functor m, Monad m) => (A.Value -> m (Either err a)) -> ParseT err m a
withValueM :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> m (Either err a)) -> ParseT err m a
withValueM Value -> m (Either err a)
f = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> m (Either (ErrorSpecifics err) a)) -> ParseT err m a
liftParseM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall err. err -> ErrorSpecifics err
CustomError) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> m (Either err a)
f)

liftEither :: (Functor m, Monad m) => Either err a -> ParseT err m a
liftEither :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Either err a -> ParseT err m a
liftEither = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either err a) -> ParseT err m a
withValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

withM :: (Functor m, Monad m) => ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
withM :: forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
withM ParseT err m a
g a -> m (Either err b)
f = ParseT err m a
g forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Either err b)
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Either err a -> ParseT err m a
liftEither

with :: (Functor m, Monad m) => ParseT err m a -> (a -> Either err b) -> ParseT err m b
with :: forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> Either err b) -> ParseT err m b
with ParseT err m a
g a -> Either err b
f = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
withM ParseT err m a
g (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either err b
f)

withTextM :: (Functor m, Monad m) => (Text -> m (Either err a)) -> ParseT err m a
withTextM :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> m (Either err a)) -> ParseT err m a
withTextM = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
withM forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText

withText :: (Functor m, Monad m) => (Text -> Either err a) -> ParseT err m a
withText :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> Either err b) -> ParseT err m b
with forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText

withStringM :: (Functor m, Monad m) => (String -> m (Either err a)) -> ParseT err m a
withStringM :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(String -> m (Either err a)) -> ParseT err m a
withStringM = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
withM forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m String
asString

withString :: (Functor m, Monad m) => (String -> Either err a) -> ParseT err m a
withString :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(String -> Either err a) -> ParseT err m a
withString = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> Either err b) -> ParseT err m b
with forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m String
asString

withScientificM :: (Functor m, Monad m) => (Scientific -> m (Either err a)) -> ParseT err m a
withScientificM :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Scientific -> m (Either err a)) -> ParseT err m a
withScientificM = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
withM forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Scientific
asScientific

withScientific :: (Functor m, Monad m) => (Scientific -> Either err a) -> ParseT err m a
withScientific :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Scientific -> Either err a) -> ParseT err m a
withScientific = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> Either err b) -> ParseT err m b
with forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Scientific
asScientific

withIntegralM :: (Functor m, Monad m, Integral a) => (a -> m (Either err b)) -> ParseT err m b
withIntegralM :: forall (m :: * -> *) a err b.
(Functor m, Monad m, Integral a) =>
(a -> m (Either err b)) -> ParseT err m b
withIntegralM = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
withM forall (m :: * -> *) a err.
(Functor m, Monad m, Integral a) =>
ParseT err m a
asIntegral

withIntegral :: (Functor m, Monad m, Integral a) => (a -> Either err b) -> ParseT err m b
withIntegral :: forall (m :: * -> *) a err b.
(Functor m, Monad m, Integral a) =>
(a -> Either err b) -> ParseT err m b
withIntegral = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> Either err b) -> ParseT err m b
with forall (m :: * -> *) a err.
(Functor m, Monad m, Integral a) =>
ParseT err m a
asIntegral

withRealFloatM :: (Functor m, Monad m, RealFloat a) => (a -> m (Either err b)) -> ParseT err m b
withRealFloatM :: forall (m :: * -> *) a err b.
(Functor m, Monad m, RealFloat a) =>
(a -> m (Either err b)) -> ParseT err m b
withRealFloatM = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
withM forall (m :: * -> *) a err.
(Functor m, Monad m, RealFloat a) =>
ParseT err m a
asRealFloat

withRealFloat :: (Functor m, Monad m, RealFloat a) => (a -> Either err b) -> ParseT err m b
withRealFloat :: forall (m :: * -> *) a err b.
(Functor m, Monad m, RealFloat a) =>
(a -> Either err b) -> ParseT err m b
withRealFloat = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> Either err b) -> ParseT err m b
with forall (m :: * -> *) a err.
(Functor m, Monad m, RealFloat a) =>
ParseT err m a
asRealFloat

withBoolM :: (Functor m, Monad m) => (Bool -> m (Either err a)) -> ParseT err m a
withBoolM :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Bool -> m (Either err a)) -> ParseT err m a
withBoolM = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
withM forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Bool
asBool

withBool :: (Functor m, Monad m) => (Bool -> Either err a) -> ParseT err m a
withBool :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Bool -> Either err a) -> ParseT err m a
withBool = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> Either err b) -> ParseT err m b
with forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Bool
asBool

-- | Prefer to use functions like 'key' or 'eachInObject' to this one where
-- possible, as they will generate better error messages.
withObjectM :: (Functor m, Monad m) => (A.Object -> m (Either err a)) -> ParseT err m a
withObjectM :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Object -> m (Either err a)) -> ParseT err m a
withObjectM = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
withM forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Object
asObject

-- | Prefer to use functions like 'key' or 'eachInObject' to this one where
-- possible, as they will generate better error messages.
withObject :: (Functor m, Monad m) => (A.Object -> Either err a) -> ParseT err m a
withObject :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Object -> Either err a) -> ParseT err m a
withObject = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> Either err b) -> ParseT err m b
with forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Object
asObject

-- | Prefer to use functions like 'nth' or 'eachInArray' to this one where
-- possible, as they will generate better error messages.
withArrayM :: (Functor m, Monad m) => (A.Array -> m (Either err a)) -> ParseT err m a
withArrayM :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Array -> m (Either err a)) -> ParseT err m a
withArrayM = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
withM forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Array
asArray

-- | Prefer to use functions like 'nth' or 'eachInArray' to this one where
-- possible, as they will generate better error messages.
withArray :: (Functor m, Monad m) => (A.Array -> Either err a) -> ParseT err m a
withArray :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Array -> Either err a) -> ParseT err m a
withArray = forall (m :: * -> *) err a b.
(Functor m, Monad m) =>
ParseT err m a -> (a -> Either err b) -> ParseT err m b
with forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Array
asArray

-- | Throw a custom validation error.
throwCustomError :: (Functor m, Monad m) => err -> ParseT err m a
throwCustomError :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
err -> ParseT err m a
throwCustomError = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Either err a -> ParseT err m a
liftEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left

liftCustomT :: (Functor m, Monad m) => ExceptT err m a -> ParseT err m a
liftCustomT :: forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ExceptT err m a -> ParseT err m a
liftCustomT ExceptT err m a
f = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT err m a
f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Either err a -> ParseT err m a
liftEither