{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
#if __GLASGOW_HASKELL__ <= 800 && __GLASGOW_HASKELL__ >= 706
{-# OPTIONS_GHC -fsimpl-tick-factor=300 #-}
#endif
module Data.Aeson.Parser.Internal
(
json, jsonEOF
, jsonWith
, jsonLast
, jsonAccum
, jsonNoDup
, value
, jstring
, jstring_
, scientific
, json', jsonEOF'
, jsonWith'
, jsonLast'
, jsonAccum'
, jsonNoDup'
, value'
, decodeWith
, decodeStrictWith
, eitherDecodeWith
, eitherDecodeStrictWith
, fromListAccum
, parseListNoDup
) where
import Prelude.Compat
import Control.Applicative ((<|>))
import Control.Monad (void, when)
import Data.Aeson.Types.Internal (IResult(..), JSONPath, Object, Result(..), Value(..), Key)
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Aeson.Key as Key
import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string)
import Data.Function (fix)
import Data.Functor.Compat (($>))
import Data.Scientific (Scientific)
import Data.Text (Text)
import qualified Data.Text.Encoding as TE
import Data.Vector (Vector)
import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse)
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.Lazy as L
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as C
import qualified Data.ByteString.Builder as B
import qualified Data.Scientific as Sci
import Data.Aeson.Parser.Unescape (unescapeText)
#define BACKSLASH 92
#define CLOSE_CURLY 125
#define CLOSE_SQUARE 93
#define COMMA 44
#define DOUBLE_QUOTE 34
#define OPEN_CURLY 123
#define OPEN_SQUARE 91
#define C_0 48
#define C_9 57
#define C_A 65
#define C_F 70
#define C_a 97
#define C_f 102
#define C_n 110
#define C_t 116
json :: Parser Value
json :: Parser Value
json = Parser Value
value
json' :: Parser Value
json' :: Parser Value
json' = Parser Value
value'
object_ :: ([(Key, Value)] -> Either String Object) -> Parser Value -> Parser Value
object_ :: ([(Key, Value)] -> Either String Object)
-> Parser Value -> Parser Value
object_ [(Key, Value)] -> Either String Object
mkObject Parser Value
val = {-# SCC "object_" #-} Object -> Value
Object (Object -> Value) -> Parser ByteString Object -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Key, Value)] -> Either String Object)
-> Parser Key -> Parser Value -> Parser ByteString Object
objectValues [(Key, Value)] -> Either String Object
mkObject Parser Key
key Parser Value
val
{-# INLINE object_ #-}
object_' :: ([(Key, Value)] -> Either String Object) -> Parser Value -> Parser Value
object_' :: ([(Key, Value)] -> Either String Object)
-> Parser Value -> Parser Value
object_' [(Key, Value)] -> Either String Object
mkObject Parser Value
val' = {-# SCC "object_'" #-} do
!Object
vals <- ([(Key, Value)] -> Either String Object)
-> Parser Key -> Parser Value -> Parser ByteString Object
objectValues [(Key, Value)] -> Either String Object
mkObject Parser Key
key' Parser Value
val'
Value -> Parser Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> Value
Object Object
vals)
where
key' :: Parser Key
key' = do
!Key
s <- Parser Key
key
Key -> Parser Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
s
{-# INLINE object_' #-}
objectValues :: ([(Key, Value)] -> Either String Object)
-> Parser Key -> Parser Value -> Parser (KM.KeyMap Value)
objectValues :: ([(Key, Value)] -> Either String Object)
-> Parser Key -> Parser Value -> Parser ByteString Object
objectValues [(Key, Value)] -> Either String Object
mkObject Parser Key
str Parser Value
val = do
Parser ()
skipSpace
Word8
w <- Parser Word8
A.peekWord8'
if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== CLOSE_CURLY
then Parser Word8
A.anyWord8 Parser Word8
-> Parser ByteString Object -> Parser ByteString Object
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Object -> Parser ByteString Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
forall v. KeyMap v
KM.empty
else [(Key, Value)] -> Parser ByteString Object
loop []
where
loop :: [(Key, Value)] -> Parser ByteString Object
loop [(Key, Value)]
acc = do
Key
k <- (Parser Key
str Parser Key -> String -> Parser Key
forall i a. Parser i a -> String -> Parser i a
A.<?> String
"object key") Parser Key -> Parser () -> Parser Key
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Key -> Parser ByteString Char -> Parser Key
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Parser ByteString Char
char Char
':' Parser ByteString Char -> String -> Parser ByteString Char
forall i a. Parser i a -> String -> Parser i a
A.<?> String
"':'")
Value
v <- (Parser Value
val Parser Value -> String -> Parser Value
forall i a. Parser i a -> String -> Parser i a
A.<?> String
"object value") Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
Word8
ch <- (Word8 -> Bool) -> Parser Word8
A.satisfy (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== COMMA || w == CLOSE_CURLY) A.<?> "',' or '}'"
let acc' :: [(Key, Value)]
acc' = (Key
k, Value
v) (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: [(Key, Value)]
acc
if Word8
ch Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== COMMA
then Parser ()
skipSpace Parser () -> Parser ByteString Object -> Parser ByteString Object
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Key, Value)] -> Parser ByteString Object
loop [(Key, Value)]
acc'
else case [(Key, Value)] -> Either String Object
mkObject [(Key, Value)]
acc' of
Left String
err -> String -> Parser ByteString Object
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
Right Object
obj -> Object -> Parser ByteString Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
obj
{-# INLINE objectValues #-}
array_ :: Parser Value -> Parser Value
array_ :: Parser Value -> Parser Value
array_ Parser Value
val = {-# SCC "array_" #-} Array -> Value
Array (Array -> Value) -> Parser ByteString Array -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Value -> Parser ByteString Array
arrayValues Parser Value
val
{-# INLINE array_ #-}
array_' :: Parser Value -> Parser Value
array_' :: Parser Value -> Parser Value
array_' Parser Value
val = {-# SCC "array_'" #-} do
!Array
vals <- Parser Value -> Parser ByteString Array
arrayValues Parser Value
val
Value -> Parser Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Value
Array Array
vals)
{-# INLINE array_' #-}
arrayValues :: Parser Value -> Parser (Vector Value)
arrayValues :: Parser Value -> Parser ByteString Array
arrayValues Parser Value
val = do
Parser ()
skipSpace
Word8
w <- Parser Word8
A.peekWord8'
if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== CLOSE_SQUARE
then Parser Word8
A.anyWord8 Parser Word8 -> Parser ByteString Array -> Parser ByteString Array
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Array -> Parser ByteString Array
forall (m :: * -> *) a. Monad m => a -> m a
return Array
forall a. Vector a
Vector.empty
else [Value] -> Int -> Parser ByteString Array
loop [] Int
1
where
loop :: [Value] -> Int -> Parser ByteString Array
loop [Value]
acc !Int
len = do
Value
v <- (Parser Value
val Parser Value -> String -> Parser Value
forall i a. Parser i a -> String -> Parser i a
A.<?> String
"json list value") Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
Word8
ch <- (Word8 -> Bool) -> Parser Word8
A.satisfy (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== COMMA || w Word8
== CLOSE_SQUARE) A.<?> "',' or ']'"
if Word8
ch Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== COMMA
then Parser ()
skipSpace Parser () -> Parser ByteString Array -> Parser ByteString Array
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Value] -> Int -> Parser ByteString Array
loop (Value
vValue -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:[Value]
acc) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
else Array -> Parser ByteString Array
forall (m :: * -> *) a. Monad m => a -> m a
return (Array -> Array
forall a. Vector a -> Vector a
Vector.reverse (Int -> [Value] -> Array
forall a. Int -> [a] -> Vector a
Vector.fromListN Int
len (Value
vValue -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:[Value]
acc)))
{-# INLINE arrayValues #-}
value :: Parser Value
value :: Parser Value
value = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith (Object -> Either String Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Either String Object)
-> ([(Key, Value)] -> Object)
-> [(Key, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList)
jsonWith :: ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith :: ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith [(Key, Value)] -> Either String Object
mkObject = (Parser Value -> Parser Value) -> Parser Value
forall a. (a -> a) -> a
fix ((Parser Value -> Parser Value) -> Parser Value)
-> (Parser Value -> Parser Value) -> Parser Value
forall a b. (a -> b) -> a -> b
$ \Parser Value
value_ -> do
Parser ()
skipSpace
Word8
w <- Parser Word8
A.peekWord8'
case Word8
w of
DOUBLE_QUOTE -> A.anyWord8 *> (String <$> jstring_)
OPEN_CURLY -> A.anyWord8 *> object_ mkObject value_
OPEN_SQUARE -> A.anyWord8 *> array_ value_
Word8
C_f -> ByteString -> Parser ByteString
string ByteString
"false" Parser ByteString -> Value -> Parser Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> Value
Bool Bool
False
Word8
C_t -> ByteString -> Parser ByteString
string ByteString
"true" Parser ByteString -> Value -> Parser Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> Value
Bool Bool
True
Word8
C_n -> ByteString -> Parser ByteString
string ByteString
"null" Parser ByteString -> Value -> Parser Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Value
Null
Word8
_ | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
45
-> Scientific -> Value
Number (Scientific -> Value)
-> Parser ByteString Scientific -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Scientific
scientific
| Bool
otherwise -> String -> Parser Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a valid json value"
{-# INLINE jsonWith #-}
jsonLast :: Parser Value
jsonLast :: Parser Value
jsonLast = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith (Object -> Either String Object
forall a b. b -> Either a b
Right (Object -> Either String Object)
-> ([(Key, Value)] -> Object)
-> [(Key, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Value -> Value) -> [(Key, Value)] -> Object
forall v. (v -> v -> v) -> [(Key, v)] -> KeyMap v
KM.fromListWith ((Value -> Value) -> Value -> Value -> Value
forall a b. a -> b -> a
const Value -> Value
forall a. a -> a
id))
jsonAccum :: Parser Value
jsonAccum :: Parser Value
jsonAccum = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith (Object -> Either String Object
forall a b. b -> Either a b
Right (Object -> Either String Object)
-> ([(Key, Value)] -> Object)
-> [(Key, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
fromListAccum)
jsonNoDup :: Parser Value
jsonNoDup :: Parser Value
jsonNoDup = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith [(Key, Value)] -> Either String Object
parseListNoDup
fromListAccum :: [(Key, Value)] -> Object
fromListAccum :: [(Key, Value)] -> Object
fromListAccum =
(([Value] -> [Value]) -> Value)
-> KeyMap ([Value] -> [Value]) -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Array -> Value
Array (Array -> Value)
-> (([Value] -> [Value]) -> Array) -> ([Value] -> [Value]) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Array)
-> (([Value] -> [Value]) -> [Value])
-> ([Value] -> [Value])
-> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Value] -> [Value]) -> [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ [])) (KeyMap ([Value] -> [Value]) -> Object)
-> ([(Key, Value)] -> KeyMap ([Value] -> [Value]))
-> [(Key, Value)]
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Value] -> [Value])
-> ([Value] -> [Value]) -> [Value] -> [Value])
-> [(Key, [Value] -> [Value])] -> KeyMap ([Value] -> [Value])
forall v. (v -> v -> v) -> [(Key, v)] -> KeyMap v
KM.fromListWith ([Value] -> [Value]) -> ([Value] -> [Value]) -> [Value] -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ([(Key, [Value] -> [Value])] -> KeyMap ([Value] -> [Value]))
-> ([(Key, Value)] -> [(Key, [Value] -> [Value])])
-> [(Key, Value)]
-> KeyMap ([Value] -> [Value])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Key, Value) -> (Key, [Value] -> [Value]))
-> [(Key, Value)] -> [(Key, [Value] -> [Value])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Key, Value) -> (Key, [Value] -> [Value]))
-> [(Key, Value)] -> [(Key, [Value] -> [Value])])
-> ((Value -> [Value] -> [Value])
-> (Key, Value) -> (Key, [Value] -> [Value]))
-> (Value -> [Value] -> [Value])
-> [(Key, Value)]
-> [(Key, [Value] -> [Value])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> [Value] -> [Value])
-> (Key, Value) -> (Key, [Value] -> [Value])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (:)
parseListNoDup :: [(Key, Value)] -> Either String Object
parseListNoDup :: [(Key, Value)] -> Either String Object
parseListNoDup =
(Key -> Maybe Value -> Either String Value)
-> KeyMap (Maybe Value) -> Either String Object
forall (f :: * -> *) v1 v2.
Applicative f =>
(Key -> v1 -> f v2) -> KeyMap v1 -> f (KeyMap v2)
KM.traverseWithKey Key -> Maybe Value -> Either String Value
forall a b. Show a => a -> Maybe b -> Either String b
unwrap (KeyMap (Maybe Value) -> Either String Object)
-> ([(Key, Value)] -> KeyMap (Maybe Value))
-> [(Key, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value -> Maybe Value -> Maybe Value)
-> [(Key, Maybe Value)] -> KeyMap (Maybe Value)
forall v. (v -> v -> v) -> [(Key, v)] -> KeyMap v
KM.fromListWith (\Maybe Value
_ Maybe Value
_ -> Maybe Value
forall a. Maybe a
Nothing) ([(Key, Maybe Value)] -> KeyMap (Maybe Value))
-> ([(Key, Value)] -> [(Key, Maybe Value)])
-> [(Key, Value)]
-> KeyMap (Maybe Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Key, Value) -> (Key, Maybe Value))
-> [(Key, Value)] -> [(Key, Maybe Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Key, Value) -> (Key, Maybe Value))
-> [(Key, Value)] -> [(Key, Maybe Value)])
-> ((Value -> Maybe Value) -> (Key, Value) -> (Key, Maybe Value))
-> (Value -> Maybe Value)
-> [(Key, Value)]
-> [(Key, Maybe Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Maybe Value) -> (Key, Value) -> (Key, Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Value -> Maybe Value
forall a. a -> Maybe a
Just
where
unwrap :: a -> Maybe b -> Either String b
unwrap a
k Maybe b
Nothing = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
"found duplicate key: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
k
unwrap a
_ (Just b
v) = b -> Either String b
forall a b. b -> Either a b
Right b
v
value' :: Parser Value
value' :: Parser Value
value' = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith' (Object -> Either String Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Either String Object)
-> ([(Key, Value)] -> Object)
-> [(Key, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KM.fromList)
jsonWith' :: ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith' :: ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith' [(Key, Value)] -> Either String Object
mkObject = (Parser Value -> Parser Value) -> Parser Value
forall a. (a -> a) -> a
fix ((Parser Value -> Parser Value) -> Parser Value)
-> (Parser Value -> Parser Value) -> Parser Value
forall a b. (a -> b) -> a -> b
$ \Parser Value
value_ -> do
Parser ()
skipSpace
Word8
w <- Parser Word8
A.peekWord8'
case Word8
w of
DOUBLE_QUOTE -> do
!s <- A.anyWord8 *> jstring_
return (String s)
OPEN_CURLY -> A.anyWord8 *> object_' mkObject value_
OPEN_SQUARE -> A.anyWord8 *> array_' value_
Word8
C_f -> ByteString -> Parser ByteString
string ByteString
"false" Parser ByteString -> Value -> Parser Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> Value
Bool Bool
False
Word8
C_t -> ByteString -> Parser ByteString
string ByteString
"true" Parser ByteString -> Value -> Parser Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> Value
Bool Bool
True
Word8
C_n -> ByteString -> Parser ByteString
string ByteString
"null" Parser ByteString -> Value -> Parser Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Value
Null
Word8
_ | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
45
-> do
!Scientific
n <- Parser ByteString Scientific
scientific
Value -> Parser Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> Value
Number Scientific
n)
| Bool
otherwise -> String -> Parser Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a valid json value"
{-# INLINE jsonWith' #-}
jsonLast' :: Parser Value
jsonLast' :: Parser Value
jsonLast' = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith' (Object -> Either String Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Either String Object)
-> ([(Key, Value)] -> Object)
-> [(Key, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Value -> Value) -> [(Key, Value)] -> Object
forall v. (v -> v -> v) -> [(Key, v)] -> KeyMap v
KM.fromListWith ((Value -> Value) -> Value -> Value -> Value
forall a b. a -> b -> a
const Value -> Value
forall a. a -> a
id))
jsonAccum' :: Parser Value
jsonAccum' :: Parser Value
jsonAccum' = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith' (Object -> Either String Object
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Either String Object)
-> ([(Key, Value)] -> Object)
-> [(Key, Value)]
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
fromListAccum)
jsonNoDup' :: Parser Value
jsonNoDup' :: Parser Value
jsonNoDup' = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith' [(Key, Value)] -> Either String Object
parseListNoDup
jstring :: Parser Text
jstring :: Parser ByteString Text
jstring = Word8 -> Parser Word8
A.word8 DOUBLE_QUOTE *> jstring_
key :: Parser Key
key :: Parser Key
key = Text -> Key
Key.fromText (Text -> Key) -> Parser ByteString Text -> Parser Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
jstring
jstring_ :: Parser Text
{-# INLINE jstring_ #-}
jstring_ :: Parser ByteString Text
jstring_ = do
ByteString
s <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= DOUBLE_QUOTE && w /= BACKSLASH && w >= 0x20 && w < 0x80)
let txt :: Text
txt = ByteString -> Text
unsafeDecodeASCII ByteString
s
Maybe Word8
mw <- Parser (Maybe Word8)
A.peekWord8
case Maybe Word8
mw of
Maybe Word8
Nothing -> String -> Parser ByteString Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"string without end"
Just DOUBLE_QUOTE -> A.anyWord8 $> txt
Just Word8
w | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x20 -> String -> Parser ByteString Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unescaped control character"
Maybe Word8
_ -> ByteString -> Parser ByteString Text
jstringSlow ByteString
s
unsafeDecodeASCII :: B.ByteString -> Text
unsafeDecodeASCII :: ByteString -> Text
unsafeDecodeASCII = ByteString -> Text
TE.decodeLatin1
jstringSlow :: B.ByteString -> Parser Text
{-# INLINE jstringSlow #-}
jstringSlow :: ByteString -> Parser ByteString Text
jstringSlow ByteString
s' = {-# SCC "jstringSlow" #-} do
ByteString
s <- Bool -> (Bool -> Word8 -> Maybe Bool) -> Parser ByteString
forall s. s -> (s -> Word8 -> Maybe s) -> Parser ByteString
A.scan Bool
startState Bool -> Word8 -> Maybe Bool
forall a. (Num a, Eq a) => Bool -> a -> Maybe Bool
go Parser ByteString -> Parser Word8 -> Parser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Word8
A.anyWord8
case ByteString -> Either UnicodeException Text
unescapeText (ByteString -> ByteString -> ByteString
B.append ByteString
s' ByteString
s) of
Right Text
r -> Text -> Parser ByteString Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
r
Left UnicodeException
err -> String -> Parser ByteString Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString Text)
-> String -> Parser ByteString Text
forall a b. (a -> b) -> a -> b
$ UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
err
where
startState :: Bool
startState = Bool
False
go :: Bool -> a -> Maybe Bool
go Bool
a a
c
| Bool
a = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
| a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== DOUBLE_QUOTE = Nothing
| Bool
otherwise = let a' :: Bool
a' = a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
backslash
in Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
a'
where backslash :: a
backslash = BACKSLASH
decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a
decodeWith :: Parser Value -> (Value -> Result a) -> ByteString -> Maybe a
decodeWith Parser Value
p Value -> Result a
to ByteString
s =
case Parser Value -> ByteString -> Result Value
forall a. Parser a -> ByteString -> Result a
L.parse Parser Value
p ByteString
s of
L.Done ByteString
_ Value
v -> case Value -> Result a
to Value
v of
Success a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
Result a
_ -> Maybe a
forall a. Maybe a
Nothing
Result Value
_ -> Maybe a
forall a. Maybe a
Nothing
{-# INLINE decodeWith #-}
decodeStrictWith :: Parser Value -> (Value -> Result a) -> B.ByteString
-> Maybe a
decodeStrictWith :: Parser Value -> (Value -> Result a) -> ByteString -> Maybe a
decodeStrictWith Parser Value
p Value -> Result a
to ByteString
s =
case (String -> Result a)
-> (Value -> Result a) -> Either String Value -> Result a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Result a
forall a. String -> Result a
Error Value -> Result a
to (Parser Value -> ByteString -> Either String Value
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser Value
p ByteString
s) of
Success a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
Result a
_ -> Maybe a
forall a. Maybe a
Nothing
{-# INLINE decodeStrictWith #-}
eitherDecodeWith :: Parser Value -> (Value -> IResult a) -> L.ByteString
-> Either (JSONPath, String) a
eitherDecodeWith :: Parser Value
-> (Value -> IResult a)
-> ByteString
-> Either (JSONPath, String) a
eitherDecodeWith Parser Value
p Value -> IResult a
to ByteString
s =
case Parser Value -> ByteString -> Result Value
forall a. Parser a -> ByteString -> Result a
L.parse Parser Value
p ByteString
s of
L.Done ByteString
_ Value
v -> case Value -> IResult a
to Value
v of
ISuccess a
a -> a -> Either (JSONPath, String) a
forall a b. b -> Either a b
Right a
a
IError JSONPath
path String
msg -> (JSONPath, String) -> Either (JSONPath, String) a
forall a b. a -> Either a b
Left (JSONPath
path, String
msg)
L.Fail ByteString
notparsed [String]
ctx String
msg -> (JSONPath, String) -> Either (JSONPath, String) a
forall a b. a -> Either a b
Left ([], ByteString -> [String] -> String -> String
buildMsg ByteString
notparsed [String]
ctx String
msg)
where
buildMsg :: L.ByteString -> [String] -> String -> String
buildMsg :: ByteString -> [String] -> String -> String
buildMsg ByteString
notYetParsed [] String
msg = String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
formatErrorLine ByteString
notYetParsed
buildMsg ByteString
notYetParsed (String
expectation:[String]
_) String
msg =
String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Expecting " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expectation String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
formatErrorLine ByteString
notYetParsed
{-# INLINE eitherDecodeWith #-}
formatErrorLine :: L.ByteString -> String
formatErrorLine :: ByteString -> String
formatErrorLine ByteString
bs =
ByteString -> String
C.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\ByteString
bs' ->
if ByteString -> Bool
BSL.null ByteString
bs'
then ByteString
BSL.empty
else
Builder -> ByteString
B.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
String -> Builder
B.stringUtf8 String
" at '" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.lazyByteString ByteString
bs' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
B.stringUtf8 String
"'"
) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Word8 -> Bool) -> ByteString -> ByteString
BSL.takeWhile (Word8
10 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/=) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Word8 -> Bool) -> ByteString -> ByteString
BSL.filter (Word8 -> [Word8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Word8
9, Word8
13, Word8
32, Word8
34, Word8
47, Word8
92]) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int64 -> ByteString -> ByteString
BSL.take Int64
100 (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString
bs
eitherDecodeStrictWith :: Parser Value -> (Value -> IResult a) -> B.ByteString
-> Either (JSONPath, String) a
eitherDecodeStrictWith :: Parser Value
-> (Value -> IResult a)
-> ByteString
-> Either (JSONPath, String) a
eitherDecodeStrictWith Parser Value
p Value -> IResult a
to ByteString
s =
case (String -> IResult a)
-> (Value -> IResult a) -> Either String Value -> IResult a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (JSONPath -> String -> IResult a
forall a. JSONPath -> String -> IResult a
IError []) Value -> IResult a
to (Parser Value -> ByteString -> Either String Value
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser Value
p ByteString
s) of
ISuccess a
a -> a -> Either (JSONPath, String) a
forall a b. b -> Either a b
Right a
a
IError JSONPath
path String
msg -> (JSONPath, String) -> Either (JSONPath, String) a
forall a b. a -> Either a b
Left (JSONPath
path, String
msg)
{-# INLINE eitherDecodeStrictWith #-}
jsonEOF :: Parser Value
jsonEOF :: Parser Value
jsonEOF = Parser Value
json Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput
jsonEOF' :: Parser Value
jsonEOF' :: Parser Value
jsonEOF' = Parser Value
json' Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Value -> Parser () -> Parser Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput
skipSpace :: Parser ()
skipSpace :: Parser ()
skipSpace = (Word8 -> Bool) -> Parser ()
A.skipWhile ((Word8 -> Bool) -> Parser ()) -> (Word8 -> Bool) -> Parser ()
forall a b. (a -> b) -> a -> b
$ \Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0a Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0d Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09
{-# INLINE skipSpace #-}
data SP = SP !Integer {-# UNPACK #-}!Int
decimal0 :: Parser Integer
decimal0 :: Parser Integer
decimal0 = do
let zero :: Word8
zero = Word8
48
ByteString
digits <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 Word8 -> Bool
isDigit_w8
if ByteString -> Int
B.length ByteString
digits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& ByteString -> Word8
B.unsafeHead ByteString
digits Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
zero
then String -> Parser Integer
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"leading zero"
else Integer -> Parser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Integer
bsToInteger ByteString
digits)
scientific :: Parser Scientific
scientific :: Parser ByteString Scientific
scientific = do
let minus :: Word8
minus = Word8
45
plus :: Word8
plus = Word8
43
Word8
sign <- Parser Word8
A.peekWord8'
let !positive :: Bool
positive = Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
plus Bool -> Bool -> Bool
|| Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
minus
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
plus Bool -> Bool -> Bool
|| Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
minus) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Parser Word8 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Word8
A.anyWord8
Integer
n <- Parser Integer
decimal0
let f :: ByteString -> SP
f ByteString
fracDigits = Integer -> Int -> SP
SP ((Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Integer -> Word8 -> Integer
forall a a. (Integral a, Num a) => a -> a -> a
step Integer
n ByteString
fracDigits)
(Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
fracDigits)
step :: a -> a -> a
step a
a a
w = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
48)
Maybe Word8
dotty <- Parser (Maybe Word8)
A.peekWord8
SP Integer
c Int
e <- case Maybe Word8
dotty of
Just Word8
46 -> Parser Word8
A.anyWord8 Parser Word8 -> Parser ByteString SP -> Parser ByteString SP
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> SP
f (ByteString -> SP) -> Parser ByteString -> Parser ByteString SP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 Word8 -> Bool
isDigit_w8)
Maybe Word8
_ -> SP -> Parser ByteString SP
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Int -> SP
SP Integer
n Int
0)
let !signedCoeff :: Integer
signedCoeff | Bool
positive = Integer
c
| Bool
otherwise = -Integer
c
let littleE :: Word8
littleE = Word8
101
bigE :: Word8
bigE = Word8
69
((Word8 -> Bool) -> Parser Word8
A.satisfy (\Word8
ex -> Word8
ex Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
littleE Bool -> Bool -> Bool
|| Word8
ex Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bigE) Parser Word8
-> Parser ByteString Scientific -> Parser ByteString Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
(Int -> Scientific)
-> Parser ByteString Int -> Parser ByteString Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Int -> Scientific
Sci.scientific Integer
signedCoeff (Int -> Scientific) -> (Int -> Int) -> Int -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+)) (Parser ByteString Int -> Parser ByteString Int
forall a. Num a => Parser a -> Parser a
signed Parser ByteString Int
forall a. Integral a => Parser a
decimal)) Parser ByteString Scientific
-> Parser ByteString Scientific -> Parser ByteString Scientific
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Scientific -> Parser ByteString Scientific
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int -> Scientific
Sci.scientific Integer
signedCoeff Int
e)
{-# INLINE scientific #-}
bsToInteger :: B.ByteString -> Integer
bsToInteger :: ByteString -> Integer
bsToInteger ByteString
bs
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
40 = Integer -> Int -> [Integer] -> Integer
valInteger Integer
10 Int
l [ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48) | Word8
w <- ByteString -> [Word8]
B.unpack ByteString
bs ]
| Bool
otherwise = ByteString -> Integer
bsToIntegerSimple ByteString
bs
where
l :: Int
l = ByteString -> Int
B.length ByteString
bs
bsToIntegerSimple :: B.ByteString -> Integer
bsToIntegerSimple :: ByteString -> Integer
bsToIntegerSimple = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Integer -> Word8 -> Integer
forall a a. (Integral a, Num a) => a -> a -> a
step Integer
0 where
step :: a -> a -> a
step a
a a
b = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
48)
valInteger :: Integer -> Int -> [Integer] -> Integer
valInteger :: Integer -> Int -> [Integer] -> Integer
valInteger = Integer -> Int -> [Integer] -> Integer
go
where
go :: Integer -> Int -> [Integer] -> Integer
go :: Integer -> Int -> [Integer] -> Integer
go Integer
_ Int
_ [] = Integer
0
go Integer
_ Int
_ [Integer
d] = Integer
d
go Integer
b Int
l [Integer]
ds
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
40 = Integer
b' Integer -> Integer -> Integer
`seq` Integer -> Int -> [Integer] -> Integer
go Integer
b' Int
l' (Integer -> [Integer] -> [Integer]
forall a. Num a => a -> [a] -> [a]
combine Integer
b [Integer]
ds')
| Bool
otherwise = Integer -> [Integer] -> Integer
valSimple Integer
b [Integer]
ds
where
ds' :: [Integer]
ds' = if Int -> Bool
forall a. Integral a => a -> Bool
even Int
l then [Integer]
ds else Integer
0 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ds
b' :: Integer
b' = Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b
l' :: Int
l' = (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
combine :: a -> [a] -> [a]
combine a
b (a
d1 : a
d2 : [a]
ds) = a
d a -> [a] -> [a]
`seq` (a
d a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
combine a
b [a]
ds)
where
d :: a
d = a
d1 a -> a -> a
forall a. Num a => a -> a -> a
* a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
d2
combine a
_ [] = []
combine a
_ [a
_] = String -> [a]
forall a. String -> a
errorWithoutStackTrace String
"this should not happen"
valSimple :: Integer -> [Integer] -> Integer
valSimple :: Integer -> [Integer] -> Integer
valSimple Integer
base = Integer -> [Integer] -> Integer
forall a. Integral a => Integer -> [a] -> Integer
go Integer
0
where
go :: Integer -> [a] -> Integer
go Integer
r [] = Integer
r
go Integer
r (a
d : [a]
ds) = Integer
r' Integer -> Integer -> Integer
`seq` Integer -> [a] -> Integer
go Integer
r' [a]
ds
where
r' :: Integer
r' = Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
base Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d