{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TemplateHaskell #-}
module Data.API.JSON
(
ParserWithErrs
, ParseFlags(useDefaults, enforceReadOnlyFields, enforceFilters)
, defaultParseFlags
, runParserWithErrsTop
, FromJSONWithErrs(..)
, fromJSONWithErrs
, fromJSONWithErrs'
, fromJSONWithErrs''
, decodeWithErrs
, decodeWithErrs'
, parseJSONDefault
, withParseFlags
, withInt
, withIntRange
, withBinary
, withBool
, withText
, withRegEx
, withUTC
, withUTCRange
, withVersion
, withField
, withDefaultField
, (.:.)
, (.::)
, withUnion
, JSONError(..)
, JSONWarning
, Expected(..)
, FormatExpected(..)
, Position
, Step(..)
, prettyJSONErrorPositions
, prettyJSONError
, prettyStep
, failWith
, expectedArray
, expectedBool
, expectedInt
, expectedObject
, expectedString
, badFormat
) where
import Data.API.Error
import Data.API.JSON.Compat
import Data.API.Time
import Data.API.Types
import Data.API.Utils
import Control.Applicative
import qualified Control.Monad.Fail as Fail
import qualified Data.Aeson as JS
import qualified Data.Aeson.Parser as JS
import qualified Data.Aeson.Types as JS
import Data.Attoparsec.ByteString
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy as BL
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time
import Data.Traversable
import qualified Data.Vector as V
import Data.Version
import Text.Regex
import Prelude
newtype ParserWithErrs a = ParserWithErrs {
forall a.
ParserWithErrs a
-> ParseFlags -> Position -> ([(JSONError, Position)], Maybe a)
runParserWithErrs :: ParseFlags -> Position -> ([(JSONError, Position)], Maybe a) }
deriving forall a b. a -> ParserWithErrs b -> ParserWithErrs a
forall a b. (a -> b) -> ParserWithErrs a -> ParserWithErrs 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 -> ParserWithErrs b -> ParserWithErrs a
$c<$ :: forall a b. a -> ParserWithErrs b -> ParserWithErrs a
fmap :: forall a b. (a -> b) -> ParserWithErrs a -> ParserWithErrs b
$cfmap :: forall a b. (a -> b) -> ParserWithErrs a -> ParserWithErrs b
Functor
instance Applicative ParserWithErrs where
pure :: forall a. a -> ParserWithErrs a
pure a
x = forall a.
(ParseFlags -> Position -> ([(JSONError, Position)], Maybe a))
-> ParserWithErrs a
ParserWithErrs forall a b. (a -> b) -> a -> b
$ \ ParseFlags
_ Position
_ -> ([], forall a. a -> Maybe a
Just a
x)
ParserWithErrs (a -> b)
pf <*> :: forall a b.
ParserWithErrs (a -> b) -> ParserWithErrs a -> ParserWithErrs b
<*> ParserWithErrs a
ps = forall a.
(ParseFlags -> Position -> ([(JSONError, Position)], Maybe a))
-> ParserWithErrs a
ParserWithErrs forall a b. (a -> b) -> a -> b
$ \ ParseFlags
q Position
z ->
let ([(JSONError, Position)]
es_f, Maybe (a -> b)
mb_f) = forall a.
ParserWithErrs a
-> ParseFlags -> Position -> ([(JSONError, Position)], Maybe a)
runParserWithErrs ParserWithErrs (a -> b)
pf ParseFlags
q Position
z
([(JSONError, Position)]
es_s, Maybe a
mb_s) = forall a.
ParserWithErrs a
-> ParseFlags -> Position -> ([(JSONError, Position)], Maybe a)
runParserWithErrs ParserWithErrs a
ps ParseFlags
q Position
z
in ([(JSONError, Position)]
es_f forall a. [a] -> [a] -> [a]
++ [(JSONError, Position)]
es_s, Maybe (a -> b)
mb_f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a
mb_s)
instance Alternative ParserWithErrs where
empty :: forall a. ParserWithErrs a
empty = forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ String -> JSONError
SyntaxError String
"No alternative"
ParserWithErrs a
px <|> :: forall a. ParserWithErrs a -> ParserWithErrs a -> ParserWithErrs a
<|> ParserWithErrs a
py = forall a.
(ParseFlags -> Position -> ([(JSONError, Position)], Maybe a))
-> ParserWithErrs a
ParserWithErrs forall a b. (a -> b) -> a -> b
$ \ ParseFlags
q Position
z -> case forall a.
ParserWithErrs a
-> ParseFlags -> Position -> ([(JSONError, Position)], Maybe a)
runParserWithErrs ParserWithErrs a
px ParseFlags
q Position
z of
r :: ([(JSONError, Position)], Maybe a)
r@([(JSONError, Position)]
_, Just a
_) -> ([(JSONError, Position)], Maybe a)
r
([(JSONError, Position)]
_, Maybe a
Nothing) -> forall a.
ParserWithErrs a
-> ParseFlags -> Position -> ([(JSONError, Position)], Maybe a)
runParserWithErrs ParserWithErrs a
py ParseFlags
q Position
z
instance Monad ParserWithErrs where
return :: forall a. a -> ParserWithErrs a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
ParserWithErrs a
px >>= :: forall a b.
ParserWithErrs a -> (a -> ParserWithErrs b) -> ParserWithErrs b
>>= a -> ParserWithErrs b
f = forall a.
(ParseFlags -> Position -> ([(JSONError, Position)], Maybe a))
-> ParserWithErrs a
ParserWithErrs forall a b. (a -> b) -> a -> b
$ \ ParseFlags
q Position
z ->
case forall a.
ParserWithErrs a
-> ParseFlags -> Position -> ([(JSONError, Position)], Maybe a)
runParserWithErrs ParserWithErrs a
px ParseFlags
q Position
z of
([(JSONError, Position)]
es, Just a
x ) -> let ([(JSONError, Position)]
es', Maybe b
r) = forall a.
ParserWithErrs a
-> ParseFlags -> Position -> ([(JSONError, Position)], Maybe a)
runParserWithErrs (a -> ParserWithErrs b
f a
x) ParseFlags
q Position
z
in ([(JSONError, Position)]
es forall a. [a] -> [a] -> [a]
++ [(JSONError, Position)]
es', Maybe b
r)
([(JSONError, Position)]
es, Maybe a
Nothing) -> ([(JSONError, Position)]
es, forall a. Maybe a
Nothing)
#if !(MIN_VERSION_base(4,13,0))
fail = Fail.fail
#endif
instance Fail.MonadFail ParserWithErrs where
fail :: forall a. String -> ParserWithErrs a
fail = forall a. JSONError -> ParserWithErrs a
failWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JSONError
SyntaxError
data ParseFlags = ParseFlags
{ ParseFlags -> Bool
useDefaults :: Bool
, ParseFlags -> Bool
enforceReadOnlyFields :: Bool
, ParseFlags -> Bool
enforceFilters :: Bool
}
defaultParseFlags :: ParseFlags
defaultParseFlags :: ParseFlags
defaultParseFlags = ParseFlags { useDefaults :: Bool
useDefaults = Bool
False
, enforceReadOnlyFields :: Bool
enforceReadOnlyFields = Bool
False
, enforceFilters :: Bool
enforceFilters = Bool
True
}
runParserWithErrsTop :: ParseFlags -> ParserWithErrs a
-> Either [(JSONError, Position)] (a, [(JSONWarning, Position)])
runParserWithErrsTop :: forall a.
ParseFlags
-> ParserWithErrs a
-> Either [(JSONError, Position)] (a, [(JSONError, Position)])
runParserWithErrsTop ParseFlags
q ParserWithErrs a
p = case forall a.
ParserWithErrs a
-> ParseFlags -> Position -> ([(JSONError, Position)], Maybe a)
runParserWithErrs ParserWithErrs a
p ParseFlags
q [] of
([(JSONError, Position)]
es, Maybe a
Nothing) -> forall a b. a -> Either a b
Left [(JSONError, Position)]
es
([(JSONError, Position)]
es, Just a
v) -> forall a b. b -> Either a b
Right (a
v, [(JSONError, Position)]
es)
class FromJSONWithErrs a where
parseJSONWithErrs :: JS.Value -> ParserWithErrs a
default parseJSONWithErrs :: JS.FromJSON a => JS.Value -> ParserWithErrs a
parseJSONWithErrs Value
v = case forall a. FromJSON a => Value -> Result a
JS.fromJSON Value
v of
JS.Error String
e -> forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ String -> JSONError
SyntaxError String
e
JS.Success a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
instance FromJSONWithErrs JS.Value where
parseJSONWithErrs :: Value -> ParserWithErrs Value
parseJSONWithErrs = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromJSONWithErrs () where
parseJSONWithErrs :: Value -> ParserWithErrs ()
parseJSONWithErrs (JS.Array Array
a) | forall a. Vector a -> Bool
V.null Array
a = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
parseJSONWithErrs Value
_ = forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ String -> JSONError
SyntaxError String
"Expected empty array"
instance FromJSONWithErrs a => FromJSONWithErrs (Maybe a) where
parseJSONWithErrs :: Value -> ParserWithErrs (Maybe a)
parseJSONWithErrs Value
JS.Null = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
parseJSONWithErrs Value
v = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSONWithErrs a => Value -> ParserWithErrs a
parseJSONWithErrs Value
v
instance FromJSONWithErrs a => FromJSONWithErrs [a] where
parseJSONWithErrs :: Value -> ParserWithErrs [a]
parseJSONWithErrs (JS.Array Array
a) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {a}. FromJSONWithErrs a => (Value, Int) -> ParserWithErrs a
help forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Vector a -> [a]
V.toList Array
a) [Int
0..]
where
help :: (Value, Int) -> ParserWithErrs a
help (Value
x, Int
i) = forall a. Step -> ParserWithErrs a -> ParserWithErrs a
stepInside (Int -> Step
InElem Int
i) forall a b. (a -> b) -> a -> b
$ forall a. FromJSONWithErrs a => Value -> ParserWithErrs a
parseJSONWithErrs Value
x
parseJSONWithErrs Value
JS.Null = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
parseJSONWithErrs Value
v = forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ Value -> JSONError
expectedArray Value
v
instance FromJSONWithErrs Int where
parseJSONWithErrs :: Value -> ParserWithErrs Int
parseJSONWithErrs = forall a.
String -> (Int -> ParserWithErrs a) -> Value -> ParserWithErrs a
withInt String
"Int" forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromJSONWithErrs Integer where
parseJSONWithErrs :: Value -> ParserWithErrs Integer
parseJSONWithErrs = forall n a.
Integral n =>
String -> (n -> ParserWithErrs a) -> Value -> ParserWithErrs a
withNum String
"Integer" forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromJSONWithErrs Bool where
parseJSONWithErrs :: Value -> ParserWithErrs Bool
parseJSONWithErrs = forall a.
String -> (Bool -> ParserWithErrs a) -> Value -> ParserWithErrs a
withBool String
"Bool" forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromJSONWithErrs Binary where
parseJSONWithErrs :: Value -> ParserWithErrs Binary
parseJSONWithErrs = forall a.
String -> (Binary -> ParserWithErrs a) -> Value -> ParserWithErrs a
withBinary String
"Binary" forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromJSONWithErrs T.Text where
parseJSONWithErrs :: Value -> ParserWithErrs Text
parseJSONWithErrs = forall a.
String -> (Text -> ParserWithErrs a) -> Value -> ParserWithErrs a
withText String
"Text" forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromJSONWithErrs UTCTime where
parseJSONWithErrs :: Value -> ParserWithErrs UTCTime
parseJSONWithErrs = forall a.
String
-> (UTCTime -> ParserWithErrs a) -> Value -> ParserWithErrs a
withUTC String
"UTC" forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromJSONWithErrs Version where
parseJSONWithErrs :: Value -> ParserWithErrs Version
parseJSONWithErrs = forall a.
String
-> (Version -> ParserWithErrs a) -> Value -> ParserWithErrs a
withVersion String
"Version" forall (f :: * -> *) a. Applicative f => a -> f a
pure
fromJSONWithErrs :: FromJSONWithErrs a => JS.Value -> Either [(JSONError, Position)] a
fromJSONWithErrs :: forall a.
FromJSONWithErrs a =>
Value -> Either [(JSONError, Position)] a
fromJSONWithErrs = forall a.
FromJSONWithErrs a =>
ParseFlags -> Value -> Either [(JSONError, Position)] a
fromJSONWithErrs' ParseFlags
defaultParseFlags
fromJSONWithErrs' :: FromJSONWithErrs a => ParseFlags -> JS.Value -> Either [(JSONError, Position)] a
fromJSONWithErrs' :: forall a.
FromJSONWithErrs a =>
ParseFlags -> Value -> Either [(JSONError, Position)] a
fromJSONWithErrs' ParseFlags
q = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
FromJSONWithErrs a =>
ParseFlags
-> Value
-> Either [(JSONError, Position)] (a, [(JSONError, Position)])
fromJSONWithErrs'' ParseFlags
q
fromJSONWithErrs'' :: FromJSONWithErrs a => ParseFlags -> JS.Value
-> Either [(JSONError, Position)] (a, [(JSONWarning, Position)])
fromJSONWithErrs'' :: forall a.
FromJSONWithErrs a =>
ParseFlags
-> Value
-> Either [(JSONError, Position)] (a, [(JSONError, Position)])
fromJSONWithErrs'' ParseFlags
q = forall a.
ParseFlags
-> ParserWithErrs a
-> Either [(JSONError, Position)] (a, [(JSONError, Position)])
runParserWithErrsTop ParseFlags
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSONWithErrs a => Value -> ParserWithErrs a
parseJSONWithErrs
decodeWithErrs :: FromJSONWithErrs a => BL.ByteString -> Either [(JSONError, Position)] a
decodeWithErrs :: forall a.
FromJSONWithErrs a =>
ByteString -> Either [(JSONError, Position)] a
decodeWithErrs = forall a.
FromJSONWithErrs a =>
ParseFlags -> ByteString -> Either [(JSONError, Position)] a
decodeWithErrs' ParseFlags
defaultParseFlags
decodeWithErrs' :: FromJSONWithErrs a => ParseFlags -> BL.ByteString -> Either [(JSONError, Position)] a
decodeWithErrs' :: forall a.
FromJSONWithErrs a =>
ParseFlags -> ByteString -> Either [(JSONError, Position)] a
decodeWithErrs' ParseFlags
q ByteString
x = case forall a. FromJSON a => ByteString -> Either String a
JS.eitherDecode ByteString
x of
Left String
e -> forall a b. a -> Either a b
Left [(String -> JSONError
SyntaxError String
e, [])]
Right Value
v -> forall a.
FromJSONWithErrs a =>
ParseFlags -> Value -> Either [(JSONError, Position)] a
fromJSONWithErrs' ParseFlags
q Value
v
parseJSONDefault :: FromJSONWithErrs a => JS.Value -> JS.Parser a
parseJSONDefault :: forall a. FromJSONWithErrs a => Value -> Parser a
parseJSONDefault Value
v = case forall a.
FromJSONWithErrs a =>
Value -> Either [(JSONError, Position)] a
fromJSONWithErrs Value
v of
Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
Left [(JSONError, Position)]
es -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [(JSONError, Position)] -> String
prettyJSONErrorPositions [(JSONError, Position)]
es
withParseFlags :: (ParseFlags -> ParserWithErrs a) -> ParserWithErrs a
withParseFlags :: forall a. (ParseFlags -> ParserWithErrs a) -> ParserWithErrs a
withParseFlags ParseFlags -> ParserWithErrs a
k = forall a.
(ParseFlags -> Position -> ([(JSONError, Position)], Maybe a))
-> ParserWithErrs a
ParserWithErrs forall a b. (a -> b) -> a -> b
$ \ ParseFlags
q -> forall a.
ParserWithErrs a
-> ParseFlags -> Position -> ([(JSONError, Position)], Maybe a)
runParserWithErrs (ParseFlags -> ParserWithErrs a
k ParseFlags
q) ParseFlags
q
failWith :: JSONError -> ParserWithErrs a
failWith :: forall a. JSONError -> ParserWithErrs a
failWith JSONError
e = forall a.
(ParseFlags -> Position -> ([(JSONError, Position)], Maybe a))
-> ParserWithErrs a
ParserWithErrs forall a b. (a -> b) -> a -> b
$ \ ParseFlags
_ Position
z -> ([(JSONError
e, Position
z)], forall a. Maybe a
Nothing)
warning :: JSONError -> ParserWithErrs ()
warning :: JSONError -> ParserWithErrs ()
warning JSONError
e = forall a.
(ParseFlags -> Position -> ([(JSONError, Position)], Maybe a))
-> ParserWithErrs a
ParserWithErrs forall a b. (a -> b) -> a -> b
$ \ ParseFlags
_ Position
z -> ([(JSONError
e, Position
z)], forall a. a -> Maybe a
Just ())
stepInside :: Step -> ParserWithErrs a -> ParserWithErrs a
stepInside :: forall a. Step -> ParserWithErrs a -> ParserWithErrs a
stepInside Step
s ParserWithErrs a
p = forall a.
(ParseFlags -> Position -> ([(JSONError, Position)], Maybe a))
-> ParserWithErrs a
ParserWithErrs forall a b. (a -> b) -> a -> b
$ \ ParseFlags
q Position
z -> forall a.
ParserWithErrs a
-> ParseFlags -> Position -> ([(JSONError, Position)], Maybe a)
runParserWithErrs ParserWithErrs a
p ParseFlags
q (Step
sforall a. a -> [a] -> [a]
:Position
z)
modifyTopError :: (JSONError -> JSONError)
-> ParserWithErrs a -> ParserWithErrs a
modifyTopError :: forall a.
(JSONError -> JSONError) -> ParserWithErrs a -> ParserWithErrs a
modifyTopError JSONError -> JSONError
f ParserWithErrs a
p = forall a.
(ParseFlags -> Position -> ([(JSONError, Position)], Maybe a))
-> ParserWithErrs a
ParserWithErrs forall a b. (a -> b) -> a -> b
$ \ ParseFlags
q Position
z -> case forall a.
ParserWithErrs a
-> ParseFlags -> Position -> ([(JSONError, Position)], Maybe a)
runParserWithErrs ParserWithErrs a
p ParseFlags
q Position
z of
([(JSONError, Position)]
es, Maybe a
r) -> (forall a b. (a -> b) -> [a] -> [b]
map (forall {b}. Eq b => b -> (JSONError, b) -> (JSONError, b)
modifyIfAt Position
z) [(JSONError, Position)]
es, Maybe a
r)
where
modifyIfAt :: b -> (JSONError, b) -> (JSONError, b)
modifyIfAt b
z x :: (JSONError, b)
x@(JSONError
e, b
z') | b
z forall a. Eq a => a -> a -> Bool
== b
z' = (JSONError -> JSONError
f JSONError
e, b
z')
| Bool
otherwise = (JSONError, b)
x
withFilter :: Bool -> JSONError -> ParserWithErrs a -> ParserWithErrs a
withFilter :: forall a. Bool -> JSONError -> ParserWithErrs a -> ParserWithErrs a
withFilter Bool
p JSONError
err ParserWithErrs a
m | Bool
p = ParserWithErrs a
m
| Bool
otherwise = forall a. (ParseFlags -> ParserWithErrs a) -> ParserWithErrs a
withParseFlags forall a b. (a -> b) -> a -> b
$ \ ParseFlags
pf -> if ParseFlags -> Bool
enforceFilters ParseFlags
pf then forall a. JSONError -> ParserWithErrs a
failWith JSONError
err
else JSONError -> ParserWithErrs ()
warning JSONError
err forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserWithErrs a
m
withInt :: String -> (Int -> ParserWithErrs a) -> JS.Value -> ParserWithErrs a
withInt :: forall a.
String -> (Int -> ParserWithErrs a) -> Value -> ParserWithErrs a
withInt = forall n a.
Integral n =>
String -> (n -> ParserWithErrs a) -> Value -> ParserWithErrs a
withNum
withNum :: Integral n => String -> (n -> ParserWithErrs a) -> JS.Value -> ParserWithErrs a
withNum :: forall n a.
Integral n =>
String -> (n -> ParserWithErrs a) -> Value -> ParserWithErrs a
withNum String
_ n -> ParserWithErrs a
f (JS.Number Scientific
n) = n -> ParserWithErrs a
f (forall a b. (RealFrac a, Integral b) => a -> b
truncate Scientific
n)
withNum String
s n -> ParserWithErrs a
f (JS.String Text
t)
| Right Value
v' <- forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser ByteString Value
JS.value forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput) (Text -> ByteString
T.encodeUtf8 Text
t) = forall n a.
Integral n =>
String -> (n -> ParserWithErrs a) -> Value -> ParserWithErrs a
withNum String
s n -> ParserWithErrs a
f Value
v'
withNum String
s n -> ParserWithErrs a
_ Value
v = forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ Expected -> String -> Value -> JSONError
Expected Expected
ExpInt String
s Value
v
withIntRange :: IntRange -> String -> (Int -> ParserWithErrs a)
-> JS.Value -> ParserWithErrs a
withIntRange :: forall a.
IntRange
-> String -> (Int -> ParserWithErrs a) -> Value -> ParserWithErrs a
withIntRange IntRange
ir String
dg Int -> ParserWithErrs a
f = forall a.
String -> (Int -> ParserWithErrs a) -> Value -> ParserWithErrs a
withInt String
dg forall a b. (a -> b) -> a -> b
$ \ Int
i -> forall a. Bool -> JSONError -> ParserWithErrs a -> ParserWithErrs a
withFilter (Int
i Int -> IntRange -> Bool
`inIntRange` IntRange
ir) (String -> Int -> IntRange -> JSONError
IntRangeError String
dg Int
i IntRange
ir) (Int -> ParserWithErrs a
f Int
i)
withBinary :: String -> (Binary -> ParserWithErrs a) -> JS.Value -> ParserWithErrs a
withBinary :: forall a.
String -> (Binary -> ParserWithErrs a) -> Value -> ParserWithErrs a
withBinary String
lab Binary -> ParserWithErrs a
f = forall a.
String -> (Text -> ParserWithErrs a) -> Value -> ParserWithErrs a
withText String
lab Text -> ParserWithErrs a
g
where
g :: Text -> ParserWithErrs a
g Text
t =
case ByteString -> Either String ByteString
B64.decode forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t of
Left String
_ -> forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ FormatExpected -> String -> Text -> JSONError
BadFormat FormatExpected
FmtBinary String
lab Text
t
Right ByteString
bs -> Binary -> ParserWithErrs a
f forall a b. (a -> b) -> a -> b
$ ByteString -> Binary
Binary ByteString
bs
withBool :: String -> (Bool -> ParserWithErrs a)
-> JS.Value -> ParserWithErrs a
withBool :: forall a.
String -> (Bool -> ParserWithErrs a) -> Value -> ParserWithErrs a
withBool String
_ Bool -> ParserWithErrs a
f (JS.Bool Bool
b) = Bool -> ParserWithErrs a
f Bool
b
withBool String
_ Bool -> ParserWithErrs a
f (JS.Number Scientific
x) | Scientific
x forall a. Eq a => a -> a -> Bool
== Scientific
0 = Bool -> ParserWithErrs a
f Bool
False
| Scientific
x forall a. Eq a => a -> a -> Bool
== Scientific
1 = Bool -> ParserWithErrs a
f Bool
True
withBool String
s Bool -> ParserWithErrs a
_ Value
v = forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ Expected -> String -> Value -> JSONError
Expected Expected
ExpBool String
s Value
v
withText :: String -> (T.Text -> ParserWithErrs a)
-> JS.Value -> ParserWithErrs a
withText :: forall a.
String -> (Text -> ParserWithErrs a) -> Value -> ParserWithErrs a
withText String
_ Text -> ParserWithErrs a
f (JS.String Text
t) = Text -> ParserWithErrs a
f Text
t
withText String
s Text -> ParserWithErrs a
_ Value
v = forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ Expected -> String -> Value -> JSONError
Expected Expected
ExpString String
s Value
v
withRegEx :: RegEx -> String -> (T.Text -> ParserWithErrs a)
-> JS.Value -> ParserWithErrs a
withRegEx :: forall a.
RegEx
-> String
-> (Text -> ParserWithErrs a)
-> Value
-> ParserWithErrs a
withRegEx RegEx
re String
dg Text -> ParserWithErrs a
f = forall a.
String -> (Text -> ParserWithErrs a) -> Value -> ParserWithErrs a
withText String
dg forall a b. (a -> b) -> a -> b
$ \ Text
txt -> forall a. Bool -> JSONError -> ParserWithErrs a -> ParserWithErrs a
withFilter (Text -> Bool
ok Text
txt) (String -> Text -> RegEx -> JSONError
RegexError String
dg Text
txt RegEx
re) (Text -> ParserWithErrs a
f Text
txt)
where
ok :: Text -> Bool
ok Text
txt = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ Regex -> String -> Maybe [String]
matchRegex (RegEx -> Regex
re_regex RegEx
re) forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
txt
withUTC :: String -> (UTCTime -> ParserWithErrs a)
-> JS.Value -> ParserWithErrs a
withUTC :: forall a.
String
-> (UTCTime -> ParserWithErrs a) -> Value -> ParserWithErrs a
withUTC String
lab UTCTime -> ParserWithErrs a
f = forall a.
String -> (Text -> ParserWithErrs a) -> Value -> ParserWithErrs a
withText String
lab Text -> ParserWithErrs a
g
where
g :: Text -> ParserWithErrs a
g Text
t = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ FormatExpected -> String -> Text -> JSONError
BadFormat FormatExpected
FmtUTC String
lab Text
t) UTCTime -> ParserWithErrs a
f forall a b. (a -> b) -> a -> b
$ Text -> Maybe UTCTime
parseUTC Text
t
withUTCRange :: UTCRange -> String -> (UTCTime -> ParserWithErrs a)
-> JS.Value -> ParserWithErrs a
withUTCRange :: forall a.
UTCRange
-> String
-> (UTCTime -> ParserWithErrs a)
-> Value
-> ParserWithErrs a
withUTCRange UTCRange
ur String
dg UTCTime -> ParserWithErrs a
f = forall a.
String
-> (UTCTime -> ParserWithErrs a) -> Value -> ParserWithErrs a
withUTC String
dg forall a b. (a -> b) -> a -> b
$ \ UTCTime
u -> forall a. Bool -> JSONError -> ParserWithErrs a -> ParserWithErrs a
withFilter (UTCTime
u UTCTime -> UTCRange -> Bool
`inUTCRange` UTCRange
ur) (String -> UTCTime -> UTCRange -> JSONError
UTCRangeError String
dg UTCTime
u UTCRange
ur) (UTCTime -> ParserWithErrs a
f UTCTime
u)
withVersion :: String -> (Version -> ParserWithErrs a)
-> JS.Value -> ParserWithErrs a
withVersion :: forall a.
String
-> (Version -> ParserWithErrs a) -> Value -> ParserWithErrs a
withVersion String
lab Version -> ParserWithErrs a
f (JS.String Text
s) = case String -> Maybe Version
simpleParseVersion (Text -> String
T.unpack Text
s) of
Just Version
ver -> Version -> ParserWithErrs a
f Version
ver
Maybe Version
Nothing -> forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ String -> Text -> JSONError
badFormat String
lab Text
s
withVersion String
lab Version -> ParserWithErrs a
_ Value
v = forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ Expected -> String -> Value -> JSONError
Expected Expected
ExpString String
lab Value
v
withField :: T.Text -> (JS.Value -> ParserWithErrs a)
-> JS.Object -> ParserWithErrs a
withField :: forall a.
Text -> (Value -> ParserWithErrs a) -> Object -> ParserWithErrs a
withField Text
k Value -> ParserWithErrs a
f Object
m = forall a. Step -> ParserWithErrs a -> ParserWithErrs a
stepInside (Text -> Step
InField Text
k) forall a b. (a -> b) -> a -> b
$ forall a.
(JSONError -> JSONError) -> ParserWithErrs a -> ParserWithErrs a
modifyTopError JSONError -> JSONError
treatAsMissing forall a b. (a -> b) -> a -> b
$ Value -> ParserWithErrs a
f Value
v
where
v :: Value
v = forall a. a -> Maybe a -> a
fromMaybe Value
JS.Null forall a b. (a -> b) -> a -> b
$ forall a. Text -> KeyMap a -> Maybe a
lookupKey Text
k Object
m
treatAsMissing :: JSONError -> JSONError
treatAsMissing :: JSONError -> JSONError
treatAsMissing (Expected Expected
_ String
_ Value
JS.Null) = JSONError
MissingField
treatAsMissing JSONError
e = JSONError
e
withDefaultField :: Bool -> Maybe JS.Value -> T.Text -> (JS.Value -> ParserWithErrs a)
-> JS.Object -> ParserWithErrs a
withDefaultField :: forall a.
Bool
-> Maybe Value
-> Text
-> (Value -> ParserWithErrs a)
-> Object
-> ParserWithErrs a
withDefaultField Bool
readOnly Maybe Value
mb_defVal Text
k Value -> ParserWithErrs a
f Object
m =
forall a. Step -> ParserWithErrs a -> ParserWithErrs a
stepInside (Text -> Step
InField Text
k) forall a b. (a -> b) -> a -> b
$ forall a.
(JSONError -> JSONError) -> ParserWithErrs a -> ParserWithErrs a
modifyTopError JSONError -> JSONError
treatAsMissing forall a b. (a -> b) -> a -> b
$ forall a. (ParseFlags -> ParserWithErrs a) -> ParserWithErrs a
withParseFlags ParseFlags -> ParserWithErrs a
foo
where
foo :: ParseFlags -> ParserWithErrs a
foo ParseFlags
q | Bool
readOnly Bool -> Bool -> Bool
&& ParseFlags -> Bool
enforceReadOnlyFields ParseFlags
q = Value -> ParserWithErrs a
f Value
defVal
| ParseFlags -> Bool
useDefaults ParseFlags
q = Value -> ParserWithErrs a
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Value
defVal forall a b. (a -> b) -> a -> b
$ forall a. Text -> KeyMap a -> Maybe a
lookupKey Text
k Object
m
| Bool
otherwise = Value -> ParserWithErrs a
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Value
JS.Null forall a b. (a -> b) -> a -> b
$ forall a. Text -> KeyMap a -> Maybe a
lookupKey Text
k Object
m
defVal :: Value
defVal = forall a. a -> Maybe a -> a
fromMaybe Value
JS.Null Maybe Value
mb_defVal
withStrictField :: T.Text -> (JS.Value -> ParserWithErrs a)
-> JS.Object -> ParserWithErrs a
withStrictField :: forall a.
Text -> (Value -> ParserWithErrs a) -> Object -> ParserWithErrs a
withStrictField Text
k Value -> ParserWithErrs a
f Object
m = forall a. Step -> ParserWithErrs a -> ParserWithErrs a
stepInside (Text -> Step
InField Text
k) forall a b. (a -> b) -> a -> b
$ case forall a. Text -> KeyMap a -> Maybe a
lookupKey Text
k Object
m of
Maybe Value
Nothing -> forall a. JSONError -> ParserWithErrs a
failWith JSONError
MissingField
Just Value
r -> Value -> ParserWithErrs a
f Value
r
(.:.) :: FromJSONWithErrs a => JS.Object -> T.Text -> ParserWithErrs a
Object
m .:. :: forall a. FromJSONWithErrs a => Object -> Text -> ParserWithErrs a
.:. Text
k = forall a.
Text -> (Value -> ParserWithErrs a) -> Object -> ParserWithErrs a
withField Text
k forall a. FromJSONWithErrs a => Value -> ParserWithErrs a
parseJSONWithErrs Object
m
(.::) :: FromJSONWithErrs a => JS.Object -> T.Text -> ParserWithErrs a
Object
m .:: :: forall a. FromJSONWithErrs a => Object -> Text -> ParserWithErrs a
.:: Text
k = forall a.
Text -> (Value -> ParserWithErrs a) -> Object -> ParserWithErrs a
withStrictField Text
k forall a. FromJSONWithErrs a => Value -> ParserWithErrs a
parseJSONWithErrs Object
m
withUnion :: [(T.Text, JS.Value -> ParserWithErrs a)] -> JS.Value -> ParserWithErrs a
withUnion :: forall a.
[(Text, Value -> ParserWithErrs a)] -> Value -> ParserWithErrs a
withUnion [(Text, Value -> ParserWithErrs a)]
xs (JS.Object Object
hs) =
case forall a. KeyMap a -> [(Text, a)]
objectToList Object
hs of
[(Text
k, Value
v)] -> case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [(Text, Value -> ParserWithErrs a)]
xs of
Just Value -> ParserWithErrs a
c -> forall a. Step -> ParserWithErrs a -> ParserWithErrs a
stepInside (Text -> Step
InField Text
k) forall a b. (a -> b) -> a -> b
$ Value -> ParserWithErrs a
c Value
v
Maybe (Value -> ParserWithErrs a)
Nothing -> forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ [String] -> JSONError
MissingAlt forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, Value -> ParserWithErrs a)]
xs
[] -> forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ [String] -> JSONError
MissingAlt forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, Value -> ParserWithErrs a)]
xs
(Text, Value)
_:(Text, Value)
_:[(Text, Value)]
_ -> forall a. JSONError -> ParserWithErrs a
failWith JSONError
UnexpectedField
withUnion [(Text, Value -> ParserWithErrs a)]
_ Value
val = forall a. JSONError -> ParserWithErrs a
failWith forall a b. (a -> b) -> a -> b
$ Expected -> String -> Value -> JSONError
Expected Expected
ExpObject String
"Union" Value
val