{-# 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 (a -> ParseT err m b -> ParseT err m a
(a -> b) -> ParseT err m a -> ParseT err m b
(forall a b. (a -> b) -> ParseT err m a -> ParseT err m b)
-> (forall a b. a -> ParseT err m b -> ParseT err m a)
-> Functor (ParseT err m)
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
<$ :: 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 :: (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, Functor (ParseT err m)
a -> ParseT err m a
Functor (ParseT err m)
-> (forall a. a -> ParseT err m a)
-> (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 a b. ParseT err m a -> ParseT err m b -> ParseT err m b)
-> (forall a b. ParseT err m a -> ParseT err m b -> ParseT err m a)
-> Applicative (ParseT err m)
ParseT err m a -> ParseT err m b -> ParseT err m b
ParseT err m a -> ParseT err m b -> ParseT err m a
ParseT err m (a -> b) -> ParseT err m a -> ParseT err m b
(a -> b -> c) -> ParseT err m a -> ParseT err m b -> ParseT err m c
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
<* :: 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
*> :: 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 :: (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
<*> :: 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 :: a -> ParseT err m a
$cpure :: forall err (m :: * -> *) a. Monad m => a -> ParseT err m a
$cp1Applicative :: forall err (m :: * -> *). Monad m => Functor (ParseT err m)
Applicative, Applicative (ParseT err m)
a -> ParseT err m a
Applicative (ParseT err m)
-> (forall a b.
    ParseT err m a -> (a -> ParseT err m b) -> ParseT err m b)
-> (forall a b. ParseT err m a -> ParseT err m b -> ParseT err m b)
-> (forall a. a -> ParseT err m a)
-> Monad (ParseT err m)
ParseT err m a -> (a -> ParseT err m b) -> ParseT err m b
ParseT err m a -> ParseT err m b -> ParseT err m b
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 :: a -> ParseT err m a
$creturn :: forall err (m :: * -> *) a. Monad m => a -> ParseT err m a
>> :: 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
>>= :: 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
$cp1Monad :: forall err (m :: * -> *). Monad m => Applicative (ParseT err m)
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 :: m a -> ParseT err m a
lift m a
f = ReaderT ParseReader (ExceptT (ParseError err) m) a
-> ParseT err m a
forall err (m :: * -> *) a.
ReaderT ParseReader (ExceptT (ParseError err) m) a
-> ParseT err m a
ParseT (ExceptT (ParseError err) m a
-> ReaderT ParseReader (ExceptT (ParseError err) m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ExceptT (ParseError err) m a
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 :: ParseT err m a -> Value -> m (Either (ParseError err) a)
runParseT (ParseT ReaderT ParseReader (ExceptT (ParseError err) m) a
p) Value
v = ExceptT (ParseError err) m a -> m (Either (ParseError err) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReaderT ParseReader (ExceptT (ParseError err) m) a
-> ParseReader -> ExceptT (ParseError err) m a
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 DList PathPiece
forall a. DList a
DList.empty Value
v))

runParse :: Parse err a -> A.Value -> Either (ParseError err) a
runParse :: Parse err a -> Value -> Either (ParseError err) a
runParse Parse err a
p Value
v = Identity (Either (ParseError err) a) -> Either (ParseError err) a
forall a. Identity a -> a
runIdentity (Parse err a -> Value -> Identity (Either (ParseError err) a)
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 :: (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) = ReaderT ParseReader (ExceptT (ParseError err') m') a'
-> ParseT err' m' a'
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 :: (err -> err') -> ParseT err m a -> ParseT err' m a
mapError err -> err'
f = (ReaderT ParseReader (ExceptT (ParseError err) m) a
 -> ReaderT ParseReader (ExceptT (ParseError err') m) a)
-> ParseT err m a -> ParseT err' m a
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 ((ExceptT (ParseError err) m a -> ExceptT (ParseError err') m a)
-> ReaderT ParseReader (ExceptT (ParseError err) m) a
-> ReaderT ParseReader (ExceptT (ParseError err') m) a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((ParseError err -> ParseError err')
-> ExceptT (ParseError err) m a -> ExceptT (ParseError err') m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ((err -> err') -> ParseError err -> ParseError err'
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
.! :: ParseT err m a -> (err -> err') -> ParseT err' m a
(.!) = ((err -> err') -> ParseT err m a -> ParseT err' m a)
-> ParseT err m a -> (err -> err') -> ParseT err' m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (err -> err') -> ParseT err m a -> ParseT err' m a
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 <|> :: ParseT err m a -> ParseT err m a -> ParseT err m a
<|> ParseT err m a
r = ParseT err m a
-> (ParseError err -> ParseT err m a) -> ParseT err m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ParseT err m a
l (ParseT err m a -> ParseError err -> ParseT err m a
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 :: (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 -> Either (ParseError err) a -> m (Either (ParseError err) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ParseError err) a -> m (Either (ParseError err) a))
-> Either (ParseError err) a -> m (Either (ParseError err) a)
forall a b. (a -> b) -> a -> b
$ ParseError err -> Either (ParseError err) a
forall a b. a -> Either a b
Left (String -> ParseError err
forall err. String -> ParseError err
InvalidJSON String
err)
    Right Value
value -> ParseT err m a -> Value -> m (Either (ParseError err) a)
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 :: (s -> Either String Value)
-> Parse err a -> s -> Either (ParseError err) a
runParser s -> Either String Value
decode Parse err a
p s
src =
  Identity (Either (ParseError err) a) -> Either (ParseError err) a
forall a. Identity a -> a
runIdentity ((s -> Either String Value)
-> Parse err a -> s -> Identity (Either (ParseError err) a)
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 :: ParseT err m a -> ByteString -> m (Either (ParseError err) a)
parseM = (ByteString -> Either String Value)
-> ParseT err m a -> ByteString -> m (Either (ParseError err) a)
forall (m :: * -> *) s err a.
Monad m =>
(s -> Either String Value)
-> ParseT err m a -> s -> m (Either (ParseError err) a)
runParserT ByteString -> Either String Value
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 :: Parse err a -> ByteString -> Either (ParseError err) a
parse = (ByteString -> Either String Value)
-> Parse err a -> ByteString -> Either (ParseError err) a
forall s err a.
(s -> Either String Value)
-> Parse err a -> s -> Either (ParseError err) a
runParser ByteString -> Either String Value
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 :: ParseT err m a -> ByteString -> m (Either (ParseError err) a)
parseStrictM = (ByteString -> Either String Value)
-> ParseT err m a -> ByteString -> m (Either (ParseError err) a)
forall (m :: * -> *) s err a.
Monad m =>
(s -> Either String Value)
-> ParseT err m a -> s -> m (Either (ParseError err) a)
runParserT ByteString -> Either String Value
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 :: Parse err a -> ByteString -> Either (ParseError err) a
parseStrict = (ByteString -> Either String Value)
-> Parse err a -> ByteString -> Either (ParseError err) a
forall s err a.
(s -> Either String Value)
-> Parse err a -> s -> Either (ParseError err) a
runParser ByteString -> Either String Value
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 :: ParseT err m a -> Value -> m (Either (ParseError err) a)
parseValueM = (Value -> Either String Value)
-> ParseT err m a -> Value -> m (Either (ParseError err) a)
forall (m :: * -> *) s err a.
Monad m =>
(s -> Either String Value)
-> ParseT err m a -> s -> m (Either (ParseError err) a)
runParserT Value -> Either String Value
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 :: Parse err a -> Value -> Either (ParseError err) a
parseValue = (Value -> Either String Value)
-> Parse err a -> Value -> Either (ParseError err) a
forall s err a.
(s -> Either String Value)
-> Parse err a -> s -> Either (ParseError err) a
runParser Value -> Either String Value
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 :: (err -> Text) -> Parse err a -> Value -> Parser a
toAesonParser err -> Text
showCustom Parse err a
p Value
val =
  case Parse err a -> Value -> Either (ParseError err) a
forall err a. Parse err a -> Value -> Either (ParseError err) a
parseValue Parse err a
p Value
val of
    Right a
x -> a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    Left ParseError err
err -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ([String] -> String
unlines ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ((err -> Text) -> ParseError err -> [Text]
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' :: Parse' a -> Value -> Parser a
toAesonParser' = (Void -> Text) -> Parse' a -> Value -> Parser a
forall err a. (err -> Text) -> Parse err a -> Value -> Parser a
toAesonParser Void -> Text
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 :: ParseT e m a
fromAesonParser = (Value -> Either (ErrorSpecifics e) a) -> ParseT e m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
liftParse ((Value -> Either (ErrorSpecifics e) a) -> ParseT e m a)
-> (Value -> Either (ErrorSpecifics e) a) -> ParseT e m a
forall a b. (a -> b) -> a -> b
$ \Value
v ->
  case Value -> Result a
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
v of
    A.Success a
x -> a -> Either (ErrorSpecifics e) a
forall a b. b -> Either a b
Right a
x
    A.Error String
err -> ErrorSpecifics e -> Either (ErrorSpecifics e) a
forall a b. a -> Either a b
Left (String -> ErrorSpecifics e
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 = DList PathPiece -> PathPiece -> DList PathPiece
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
(Int -> PathPiece -> ShowS)
-> (PathPiece -> String)
-> ([PathPiece] -> ShowS)
-> Show PathPiece
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
(PathPiece -> PathPiece -> Bool)
-> (PathPiece -> PathPiece -> Bool) -> Eq PathPiece
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
Eq PathPiece
-> (PathPiece -> PathPiece -> Ordering)
-> (PathPiece -> PathPiece -> Bool)
-> (PathPiece -> PathPiece -> Bool)
-> (PathPiece -> PathPiece -> Bool)
-> (PathPiece -> PathPiece -> Bool)
-> (PathPiece -> PathPiece -> PathPiece)
-> (PathPiece -> PathPiece -> PathPiece)
-> Ord 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
$cp1Ord :: Eq PathPiece
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
[ParseError err] -> ShowS
ParseError err -> String
(Int -> ParseError err -> ShowS)
-> (ParseError err -> String)
-> ([ParseError err] -> ShowS)
-> Show (ParseError err)
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
(ParseError err -> ParseError err -> Bool)
-> (ParseError err -> ParseError err -> Bool)
-> Eq (ParseError err)
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, a -> ParseError b -> ParseError a
(a -> b) -> ParseError a -> ParseError b
(forall a b. (a -> b) -> ParseError a -> ParseError b)
-> (forall a b. a -> ParseError b -> ParseError a)
-> Functor ParseError
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
<$ :: a -> ParseError b -> ParseError a
$c<$ :: forall a b. a -> ParseError b -> ParseError a
fmap :: (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
[ErrorSpecifics err] -> ShowS
ErrorSpecifics err -> String
(Int -> ErrorSpecifics err -> ShowS)
-> (ErrorSpecifics err -> String)
-> ([ErrorSpecifics err] -> ShowS)
-> Show (ErrorSpecifics err)
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
(ErrorSpecifics err -> ErrorSpecifics err -> Bool)
-> (ErrorSpecifics err -> ErrorSpecifics err -> Bool)
-> Eq (ErrorSpecifics err)
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, a -> ErrorSpecifics b -> ErrorSpecifics a
(a -> b) -> ErrorSpecifics a -> ErrorSpecifics b
(forall a b. (a -> b) -> ErrorSpecifics a -> ErrorSpecifics b)
-> (forall a b. a -> ErrorSpecifics b -> ErrorSpecifics a)
-> Functor ErrorSpecifics
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
<$ :: a -> ErrorSpecifics b -> ErrorSpecifics a
$c<$ :: forall a b. a -> ErrorSpecifics b -> ErrorSpecifics a
fmap :: (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
(Int -> JSONType -> ShowS)
-> (JSONType -> String) -> ([JSONType] -> ShowS) -> Show JSONType
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
(JSONType -> JSONType -> Bool)
-> (JSONType -> JSONType -> Bool) -> Eq JSONType
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
Eq JSONType
-> (JSONType -> JSONType -> Ordering)
-> (JSONType -> JSONType -> Bool)
-> (JSONType -> JSONType -> Bool)
-> (JSONType -> JSONType -> Bool)
-> (JSONType -> JSONType -> Bool)
-> (JSONType -> JSONType -> JSONType)
-> (JSONType -> JSONType -> JSONType)
-> Ord 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
$cp1Ord :: Eq JSONType
Ord, Int -> JSONType
JSONType -> Int
JSONType -> [JSONType]
JSONType -> JSONType
JSONType -> JSONType -> [JSONType]
JSONType -> JSONType -> JSONType -> [JSONType]
(JSONType -> JSONType)
-> (JSONType -> JSONType)
-> (Int -> JSONType)
-> (JSONType -> Int)
-> (JSONType -> [JSONType])
-> (JSONType -> JSONType -> [JSONType])
-> (JSONType -> JSONType -> [JSONType])
-> (JSONType -> JSONType -> JSONType -> [JSONType])
-> Enum 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
JSONType -> JSONType -> Bounded 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 :: (err -> Text) -> ParseError err -> [Text]
displayError err -> Text
_ (InvalidJSON String
str) =
  [ Text
"The input could not be parsed as JSON", Text
"aeson said: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
str ]
displayError err -> Text
f (BadSchema [] ErrorSpecifics err
specs) =
  (err -> Text) -> ErrorSpecifics err -> [Text]
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: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [PathPiece] -> Text
displayPath [PathPiece]
path ] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (err -> Text) -> ErrorSpecifics err -> [Text]
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' = (Void -> Text) -> ParseError' -> [Text]
forall err. (err -> Text) -> ParseError err -> [Text]
displayError Void -> Text
forall a. Void -> a
absurd

displayPath :: [PathPiece] -> Text
displayPath :: [PathPiece] -> Text
displayPath = (PathPiece -> Text) -> [PathPiece] -> Text
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
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
  showPiece (ArrayIndex Int
i) = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

displaySpecifics :: (err -> Text) -> ErrorSpecifics err -> [Text]
displaySpecifics :: (err -> Text) -> ErrorSpecifics err -> [Text]
displaySpecifics err -> Text
_ (KeyMissing Text
k) =
  [ Text
"The required key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is missing" ]
displaySpecifics err -> Text
_ (OutOfBounds Int
i) =
  [ Text
"The array index " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
i Text -> Text -> Text
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> JSONType -> Text
displayJSONType JSONType
t
  , Text
"Got: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 ([ByteString] -> ByteString
B.concat (ByteString -> [ByteString]
BL.toChunks (Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode Value
val)))
  ]
displaySpecifics err -> Text
_ (ExpectedIntegral Double
x) =
  [ Text
"Expected an integral value, got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
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' = (Void -> Text) -> ErrorSpecifics' -> [Text]
forall err. (err -> Text) -> ErrorSpecifics err -> [Text]
displaySpecifics Void -> Text
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 :: (Value -> ExceptT (ErrorSpecifics err) m a) -> ParseT err m a
liftParseT Value -> ExceptT (ErrorSpecifics err) m a
f = ReaderT ParseReader (ExceptT (ParseError err) m) a
-> ParseT err m a
forall err (m :: * -> *) a.
ReaderT ParseReader (ExceptT (ParseError err) m) a
-> ParseT err m a
ParseT (ReaderT ParseReader (ExceptT (ParseError err) m) a
 -> ParseT err m a)
-> ReaderT ParseReader (ExceptT (ParseError err) m) a
-> ParseT err m a
forall a b. (a -> b) -> a -> b
$ (ParseReader -> ExceptT (ParseError err) m a)
-> ReaderT ParseReader (ExceptT (ParseError err) m) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((ParseReader -> ExceptT (ParseError err) m a)
 -> ReaderT ParseReader (ExceptT (ParseError err) m) a)
-> (ParseReader -> ExceptT (ParseError err) m a)
-> ReaderT ParseReader (ExceptT (ParseError err) m) a
forall a b. (a -> b) -> a -> b
$ \(ParseReader DList PathPiece
path Value
value) ->
  (ErrorSpecifics err -> ParseError err)
-> ExceptT (ErrorSpecifics err) m a -> ExceptT (ParseError err) m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ([PathPiece] -> ErrorSpecifics err -> ParseError err
forall err. [PathPiece] -> ErrorSpecifics err -> ParseError err
BadSchema (DList PathPiece -> [PathPiece]
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 :: (Value -> m (Either (ErrorSpecifics err) a)) -> ParseT err m a
liftParseM Value -> m (Either (ErrorSpecifics err) a)
f = (Value -> ExceptT (ErrorSpecifics err) m a) -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> ExceptT (ErrorSpecifics err) m a) -> ParseT err m a
liftParseT (m (Either (ErrorSpecifics err) a)
-> ExceptT (ErrorSpecifics err) m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either (ErrorSpecifics err) a)
 -> ExceptT (ErrorSpecifics err) m a)
-> (Value -> m (Either (ErrorSpecifics err) a))
-> Value
-> ExceptT (ErrorSpecifics err) m a
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 :: (Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
liftParse Value -> Either (ErrorSpecifics err) a
f = (Value -> m (Either (ErrorSpecifics err) a)) -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> m (Either (ErrorSpecifics err) a)) -> ParseT err m a
liftParseM (Either (ErrorSpecifics err) a -> m (Either (ErrorSpecifics err) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (ErrorSpecifics err) a
 -> m (Either (ErrorSpecifics err) a))
-> (Value -> Either (ErrorSpecifics err) a)
-> Value
-> m (Either (ErrorSpecifics err) a)
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 :: ErrorSpecifics err -> ParseT err m a
badSchema = (Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
liftParse ((Value -> Either (ErrorSpecifics err) a) -> ParseT err m a)
-> (ErrorSpecifics err -> Value -> Either (ErrorSpecifics err) a)
-> ErrorSpecifics err
-> ParseT err m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ErrorSpecifics err) a
-> Value -> Either (ErrorSpecifics err) a
forall a b. a -> b -> a
const (Either (ErrorSpecifics err) a
 -> Value -> Either (ErrorSpecifics err) a)
-> (ErrorSpecifics err -> Either (ErrorSpecifics err) a)
-> ErrorSpecifics err
-> Value
-> Either (ErrorSpecifics err) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorSpecifics err -> Either (ErrorSpecifics err) a
forall a b. a -> Either a b
Left

as :: (Functor m, Monad m) => (A.Value -> Maybe a) -> JSONType -> ParseT err m a
as :: (Value -> Maybe a) -> JSONType -> ParseT err m a
as Value -> Maybe a
pat JSONType
ty = (Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
liftParse ((Value -> Either (ErrorSpecifics err) a) -> ParseT err m a)
-> (Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
forall a b. (a -> b) -> a -> b
$ \Value
v ->
  Either (ErrorSpecifics err) a
-> (a -> Either (ErrorSpecifics err) a)
-> Maybe a
-> Either (ErrorSpecifics err) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ErrorSpecifics err -> Either (ErrorSpecifics err) a
forall a b. a -> Either a b
Left (JSONType -> Value -> ErrorSpecifics err
forall err. JSONType -> Value -> ErrorSpecifics err
WrongType JSONType
ty Value
v)) a -> Either (ErrorSpecifics err) a
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 :: ParseT err m Value
asValue = (ParseReader -> Value) -> ParseT err m Value
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 :: ParseT err m Text
asText = (Value -> Maybe Text) -> JSONType -> ParseT err m Text
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 :: ParseT err m String
asString = Text -> String
T.unpack (Text -> String) -> ParseT err m Text -> ParseT err m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseT err m Text
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 :: ParseT err m Scientific
asScientific = (Value -> Maybe Scientific) -> JSONType -> ParseT err m Scientific
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 :: ParseT err m a
asIntegral =
  ParseT err m Scientific
forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Scientific
asScientific
    ParseT err m Scientific
-> (Scientific -> ParseT err m a) -> ParseT err m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
liftParse ((Value -> Either (ErrorSpecifics err) a) -> ParseT err m a)
-> (Scientific -> Value -> Either (ErrorSpecifics err) a)
-> Scientific
-> ParseT err m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ErrorSpecifics err) a
-> Value -> Either (ErrorSpecifics err) a
forall a b. a -> b -> a
const (Either (ErrorSpecifics err) a
 -> Value -> Either (ErrorSpecifics err) a)
-> (Scientific -> Either (ErrorSpecifics err) a)
-> Scientific
-> Value
-> Either (ErrorSpecifics err) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> ErrorSpecifics err)
-> Either Double a -> Either (ErrorSpecifics err) a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Double -> ErrorSpecifics err
forall err. Double -> ErrorSpecifics err
ExpectedIntegral (Either Double a -> Either (ErrorSpecifics err) a)
-> (Scientific -> Either Double a)
-> Scientific
-> Either (ErrorSpecifics err) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Either Double a
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 :: ParseT err m a
asRealFloat =
  (a -> a) -> (Integer -> a) -> Either a Integer -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id Integer -> a
forall a. Num a => Integer -> a
fromInteger (Either a Integer -> a)
-> (Scientific -> Either a Integer) -> Scientific -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Either a Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
S.floatingOrInteger (Scientific -> a) -> ParseT err m Scientific -> ParseT err m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseT err m Scientific
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 :: ParseT err m Bool
asBool = (Value -> Maybe Bool) -> JSONType -> ParseT err m Bool
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 :: ParseT err m Object
asObject = (Value -> Maybe Object) -> JSONType -> ParseT err m Object
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 :: ParseT err m Array
asArray = (Value -> Maybe Array) -> JSONType -> ParseT err m Array
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 :: ParseT err m ()
asNull = (Value -> Maybe ()) -> JSONType -> ParseT err m ()
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 :: ParseT err m a -> ParseT err m (Maybe a)
perhaps ParseT err m a
p = do
  Value
v <- (ParseReader -> Value) -> ParseT err m Value
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParseReader -> Value
rdrValue
  case Value
v of
    Value
A.Null -> Maybe a -> ParseT err m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Value
_      -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> ParseT err m a -> ParseT err m (Maybe a)
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 :: Text -> ParseT err m a -> ParseT err m a
key Text
k ParseT err m a
p = ParseT err m a -> Text -> ParseT err m a -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> Text -> ParseT err m a -> ParseT err m a
key' (ErrorSpecifics err -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ErrorSpecifics err -> ParseT err m a
badSchema (Text -> ErrorSpecifics err
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 :: Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
k a
def ParseT err m a
p = ParseT err m a -> Text -> ParseT err m a -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> Text -> ParseT err m a -> ParseT err m a
key' (a -> ParseT err m a
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 :: Text -> ParseT err m a -> ParseT err m (Maybe a)
keyMay Text
k ParseT err m a
p = Text -> Maybe a -> ParseT err m (Maybe a) -> ParseT err m (Maybe a)
forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Text -> a -> ParseT err m a -> ParseT err m a
keyOrDefault Text
k Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> ParseT err m a -> ParseT err m (Maybe a)
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' :: 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 <- (ParseReader -> Value) -> ParseT err m Value
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 Key -> Object -> Maybe Value
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' ->
          (ParseReader -> ParseReader) -> ParseT err m a -> ParseT err m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (PathPiece -> ParseReader -> ParseReader
appendPath (Text -> PathPiece
ObjectKey Text
k) (ParseReader -> ParseReader)
-> (ParseReader -> ParseReader) -> ParseReader -> ParseReader
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
_ ->
      ErrorSpecifics err -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ErrorSpecifics err -> ParseT err m a
badSchema (JSONType -> Value -> ErrorSpecifics err
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 :: Int -> ParseT err m a -> ParseT err m a
nth Int
n ParseT err m a
p = ParseT err m a -> Int -> ParseT err m a -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> Int -> ParseT err m a -> ParseT err m a
nth' (ErrorSpecifics err -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ErrorSpecifics err -> ParseT err m a
badSchema (Int -> ErrorSpecifics err
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 :: Int -> a -> ParseT err m a -> ParseT err m a
nthOrDefault Int
n a
def ParseT err m a
p =
  ParseT err m a -> Int -> ParseT err m a -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> Int -> ParseT err m a -> ParseT err m a
nth' (a -> ParseT err m a
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 :: Int -> ParseT err m a -> ParseT err m (Maybe a)
nthMay Int
n ParseT err m a
p = Int -> Maybe a -> ParseT err m (Maybe a) -> ParseT err m (Maybe a)
forall (m :: * -> *) a err.
(Functor m, Monad m) =>
Int -> a -> ParseT err m a -> ParseT err m a
nthOrDefault Int
n Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> ParseT err m a -> ParseT err m (Maybe a)
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' :: 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 <- (ParseReader -> Value) -> ParseT err m Value
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 Array -> Int -> Maybe Value
forall a. Vector a -> Int -> Maybe a
!? Int
n of
        Just Value
v' ->
          (ParseReader -> ParseReader) -> ParseT err m a -> ParseT err m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (PathPiece -> ParseReader -> ParseReader
appendPath (Int -> PathPiece
ArrayIndex Int
n) (ParseReader -> ParseReader)
-> (ParseReader -> ParseReader) -> ParseReader -> ParseReader
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
_ ->
      ErrorSpecifics err -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ErrorSpecifics err -> ParseT err m a
badSchema (JSONType -> Value -> ErrorSpecifics err
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 :: ParseT err m a -> ParseT err m [a]
eachInArray ParseT err m a
p = do
  [(Int, Value)]
xs <- [Int] -> [Value] -> [(Int, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Value] -> [(Int, Value)])
-> (Array -> [Value]) -> Array -> [(Int, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall a. Vector a -> [a]
V.toList (Array -> [(Int, Value)])
-> ParseT err m Array -> ParseT err m [(Int, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseT err m Array
forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Array
asArray
  [(Int, Value)]
-> ((Int, Value) -> ParseT err m a) -> ParseT err m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Int, Value)]
xs (((Int, Value) -> ParseT err m a) -> ParseT err m [a])
-> ((Int, Value) -> ParseT err m a) -> ParseT err m [a]
forall a b. (a -> b) -> a -> b
$ \(Int
i, Value
x) ->
    (ParseReader -> ParseReader) -> ParseT err m a -> ParseT err m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (PathPiece -> ParseReader -> ParseReader
appendPath (Int -> PathPiece
ArrayIndex Int
i) (ParseReader -> ParseReader)
-> (ParseReader -> ParseReader) -> ParseReader -> ParseReader
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 :: (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 <- Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList (Object -> [(Key, Value)])
-> ParseT err m Object -> ParseT err m [(Key, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseT err m Object
forall (m :: * -> *) err.
(Functor m, Monad m) =>
ParseT err m Object
asObject
  [(Key, Value)]
-> ((Key, Value) -> ParseT err m a) -> ParseT err m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Key, Value)]
xs (((Key, Value) -> ParseT err m a) -> ParseT err m [a])
-> ((Key, Value) -> ParseT err m a) -> ParseT err m [a]
forall a b. (a -> b) -> a -> b
$ \(Key
k, Value
x) ->
    (ParseReader -> ParseReader) -> ParseT err m a -> ParseT err m a
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)) (ParseReader -> ParseReader)
-> (ParseReader -> ParseReader) -> ParseReader -> ParseReader
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 :: ParseT err m a -> ParseT err m [(Text, a)]
eachInObject = (Text -> Either err Text)
-> ParseT err m a -> ParseT err m [(Text, a)]
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 Text
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 :: (Text -> Either err k) -> ParseT err m a -> ParseT err m [(k, a)]
eachInObjectWithKey Text -> Either err k
parseKey ParseT err m a
parseVal = (Text -> ParseT err m (k, a)) -> ParseT err m [(k, a)]
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> ParseT err m a) -> ParseT err m [a]
forEachInObject ((Text -> ParseT err m (k, a)) -> ParseT err m [(k, a)])
-> (Text -> ParseT err m (k, a)) -> ParseT err m [(k, a)]
forall a b. (a -> b) -> a -> b
$ \Text
k ->
  (,) (k -> a -> (k, a)) -> ParseT err m k -> ParseT err m (a -> (k, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either err k -> ParseT err m k
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Either err a -> ParseT err m a
liftEither (Text -> Either err k
parseKey Text
k) ParseT err m (a -> (k, a)) -> ParseT err m a -> ParseT err m (k, a)
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 :: (Value -> Either err a) -> ParseT err m a
withValue Value -> Either err a
f = (Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either (ErrorSpecifics err) a) -> ParseT err m a
liftParse ((err -> ErrorSpecifics err)
-> Either err a -> Either (ErrorSpecifics err) a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left err -> ErrorSpecifics err
forall err. err -> ErrorSpecifics err
CustomError (Either err a -> Either (ErrorSpecifics err) a)
-> (Value -> Either err a)
-> Value
-> Either (ErrorSpecifics err) a
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 :: (Value -> m (Either err a)) -> ParseT err m a
withValueM Value -> m (Either err a)
f = (Value -> m (Either (ErrorSpecifics err) a)) -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> m (Either (ErrorSpecifics err) a)) -> ParseT err m a
liftParseM ((Either err a -> Either (ErrorSpecifics err) a)
-> m (Either err a) -> m (Either (ErrorSpecifics err) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((err -> ErrorSpecifics err)
-> Either err a -> Either (ErrorSpecifics err) a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left err -> ErrorSpecifics err
forall err. err -> ErrorSpecifics err
CustomError) (m (Either err a) -> m (Either (ErrorSpecifics err) a))
-> (Value -> m (Either err a))
-> Value
-> m (Either (ErrorSpecifics err) a)
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 :: Either err a -> ParseT err m a
liftEither = (Value -> Either err a) -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either err a) -> ParseT err m a
withValue ((Value -> Either err a) -> ParseT err m a)
-> (Either err a -> Value -> Either err a)
-> Either err a
-> ParseT err m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either err a -> Value -> Either err a
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 :: 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 ParseT err m a
-> (a -> ParseT err m (Either err b))
-> ParseT err m (Either err b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (Either err b) -> ParseT err m (Either err b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either err b) -> ParseT err m (Either err b))
-> (a -> m (Either err b)) -> a -> ParseT err m (Either err b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Either err b)
f ParseT err m (Either err b)
-> (Either err b -> ParseT err m b) -> ParseT err m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either err b -> ParseT err 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 :: ParseT err m a -> (a -> Either err b) -> ParseT err m b
with ParseT err m a
g a -> Either err b
f = ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
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 (Either err b -> m (Either err b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either err b -> m (Either err b))
-> (a -> Either err b) -> a -> m (Either err b)
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 :: (Text -> m (Either err a)) -> ParseT err m a
withTextM = ParseT err m Text -> (Text -> m (Either err a)) -> ParseT err m a
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 Text
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 :: (Text -> Either err a) -> ParseT err m a
withText = ParseT err m Text -> (Text -> Either err a) -> ParseT err m a
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 Text
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 :: (String -> m (Either err a)) -> ParseT err m a
withStringM = ParseT err m String
-> (String -> m (Either err a)) -> ParseT err m a
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 String
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 :: (String -> Either err a) -> ParseT err m a
withString = ParseT err m String -> (String -> Either err a) -> ParseT err m a
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 String
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 :: (Scientific -> m (Either err a)) -> ParseT err m a
withScientificM = ParseT err m Scientific
-> (Scientific -> m (Either err a)) -> ParseT err m a
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 Scientific
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 :: (Scientific -> Either err a) -> ParseT err m a
withScientific = ParseT err m Scientific
-> (Scientific -> Either err a) -> ParseT err m a
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 Scientific
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 :: (a -> m (Either err b)) -> ParseT err m b
withIntegralM = ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
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
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 :: (a -> Either err b) -> ParseT err m b
withIntegral = ParseT err m a -> (a -> Either err b) -> ParseT err m b
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
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 :: (a -> m (Either err b)) -> ParseT err m b
withRealFloatM = ParseT err m a -> (a -> m (Either err b)) -> ParseT err m b
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
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 :: (a -> Either err b) -> ParseT err m b
withRealFloat = ParseT err m a -> (a -> Either err b) -> ParseT err m b
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
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 :: (Bool -> m (Either err a)) -> ParseT err m a
withBoolM = ParseT err m Bool -> (Bool -> m (Either err a)) -> ParseT err m a
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 Bool
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 :: (Bool -> Either err a) -> ParseT err m a
withBool = ParseT err m Bool -> (Bool -> Either err a) -> ParseT err m a
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 Bool
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 :: (Object -> m (Either err a)) -> ParseT err m a
withObjectM = ParseT err m Object
-> (Object -> m (Either err a)) -> ParseT err m a
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 Object
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 :: (Object -> Either err a) -> ParseT err m a
withObject = ParseT err m Object -> (Object -> Either err a) -> ParseT err m a
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 Object
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 :: (Array -> m (Either err a)) -> ParseT err m a
withArrayM = ParseT err m Array -> (Array -> m (Either err a)) -> ParseT err m a
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 Array
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 :: (Array -> Either err a) -> ParseT err m a
withArray = ParseT err m Array -> (Array -> Either err a) -> ParseT err m a
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 Array
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 :: err -> ParseT err m a
throwCustomError = Either err a -> ParseT err m a
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Either err a -> ParseT err m a
liftEither (Either err a -> ParseT err m a)
-> (err -> Either err a) -> err -> ParseT err m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> Either err a
forall a b. a -> Either a b
Left

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