{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module:      Data.Aeson.Parser.Internal
-- Copyright:   (c) 2011-2016 Bryan O'Sullivan
--              (c) 2011 MailRank, Inc.
-- License:     BSD3
-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
-- Stability:   experimental
-- Portability: portable
--
-- Efficiently and correctly parse a JSON string.  The string must be
-- encoded as UTF-8.

module Data.Aeson.Parser.Internal
    (
    -- * Lazy parsers
      json, jsonEOF
    , jsonWith
    , jsonLast
    , jsonAccum
    , jsonNoDup
    , value
    , jstring
    , jstring_
    , scientific
    -- * Strict parsers
    , json', jsonEOF'
    , jsonWith'
    , jsonLast'
    , jsonAccum'
    , jsonNoDup'
    , value'
    -- * Helpers
    , decodeWith
    , decodeStrictWith
    , eitherDecodeWith
    , eitherDecodeStrictWith
    -- ** Handling objects with duplicate keys
    , fromListAccum
    , parseListNoDup
    -- * Text literal unescaping
    , unescapeText
    ) where

import Control.Applicative ((<|>))
import Control.Monad (when, void)
import Data.Attoparsec.ByteString.Char8 (Parser, char, decimal, endOfInput, isDigit_w8, signed, string)
import Data.Function (fix)
import Data.Functor (($>))
import Data.Integer.Conversion (byteStringToInteger)
import Data.Scientific (Scientific)
import Data.Text (Text)
import Data.Vector (Vector)

#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>))
#endif

import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.Lazy as L
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C
import qualified Data.ByteString.Unsafe as B
import qualified Data.Scientific as Sci
import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse)
import qualified Data.Word8.Patterns as W8

import Data.Aeson.Types (IResult(..), JSONPath, Object, Result(..), Value(..), Key)
import Data.Aeson.Internal.Text
import Data.Aeson.Decoding (unescapeText)

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Data.Aeson.Types

-------------------------------------------------------------------------------
-- Parsers
-------------------------------------------------------------------------------

-- | Parse any JSON value.
--
-- The conversion of a parsed value to a Haskell value is deferred
-- until the Haskell value is needed.  This may improve performance if
-- only a subset of the results of conversions are needed, but at a
-- cost in thunk allocation.
--
-- This function is an alias for 'value'. In aeson 0.8 and earlier, it
-- parsed only object or array types, in conformance with the
-- now-obsolete RFC 4627.
--
-- ==== Warning
--
-- If an object contains duplicate keys, only the first one will be kept.
-- For a more flexible alternative, see 'jsonWith'.
json :: Parser Value
json :: Parser Value
json = Parser Value
value

-- | Parse any JSON value.
--
-- This is a strict version of 'json' which avoids building up thunks
-- during parsing; it performs all conversions immediately.  Prefer
-- this version if most of the JSON data needs to be accessed.
--
-- This function is an alias for 'value''. In aeson 0.8 and earlier, it
-- parsed only object or array types, in conformance with the
-- now-obsolete RFC 4627.
--
-- ==== Warning
--
-- If an object contains duplicate keys, only the first one will be kept.
-- For a more flexible alternative, see 'jsonWith''.
json' :: Parser Value
json' :: Parser Value
json' = Parser Value
value'

-- Open recursion: object_, object_', array_, array_' are parameterized by the
-- toplevel Value parser to be called recursively, to keep the parameter
-- mkObject outside of the recursive loop for proper inlining.

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 = 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' = do
  !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'
  return (Object vals)
 where
  key' :: Parser Key
key' = do
    !s <- Parser Key
key
    return 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
  w <- Parser Word8
A.peekWord8'
  if w == W8.RIGHT_CURLY
    then A.anyWord8 >> return KM.empty
    else loop []
 where
  -- Why use acc pattern here, you may ask? because then the underlying 'KM.fromList'
  -- implementation can make use of mutation when constructing a map. For example,
  -- 'HashMap` uses 'unsafeInsert' and it's much faster because it's doing in place
  -- update to the 'HashMap'!
  loop :: [(Key, Value)] -> Parser ByteString Object
loop [(Key, Value)]
acc = do
    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 a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Key -> Parser ByteString Char -> Parser Key
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
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
"':'")
    v <- (val A.<?> "object value") <* skipSpace
    ch <- A.satisfy (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.COMMA Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.RIGHT_CURLY) A.<?> "',' or '}'"
    let acc' = (Key
k, Value
v) (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: [(Key, Value)]
acc
    if ch == W8.COMMA
      then skipSpace >> loop acc'
      else case mkObject acc' of
        Left String
err -> String -> Parser ByteString Object
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
        Right Object
obj -> Object -> Parser ByteString Object
forall a. a -> Parser ByteString a
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 = 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 = do
  !vals <- Parser Value -> Parser ByteString Array
arrayValues Parser Value
val
  return (Array vals)
{-# INLINE array_' #-}

arrayValues :: Parser Value -> Parser (Vector Value)
arrayValues :: Parser Value -> Parser ByteString Array
arrayValues Parser Value
val = do
  Parser ()
skipSpace
  w <- Parser Word8
A.peekWord8'
  if w == W8.RIGHT_SQUARE
    then A.anyWord8 >> return Vector.empty
    else loop [] 1
  where
    loop :: [Value] -> Int -> Parser ByteString Array
loop [Value]
acc !Int
len = do
      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 a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
      ch <- A.satisfy (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.COMMA Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.RIGHT_SQUARE) A.<?> "',' or ']'"
      if ch == W8.COMMA
        then skipSpace >> loop (v:acc) (len+1)
        else return (Vector.reverse (Vector.fromListN len (v:acc)))
{-# INLINE arrayValues #-}

-- | Parse any JSON value. Synonym of 'json'.
value :: Parser Value
value :: Parser Value
value = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith (Object -> Either String Object
forall a. a -> Either String a
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)

-- | Parse any JSON value.
--
-- This parser is parameterized by a function to construct an 'Object'
-- from a raw list of key-value pairs, where duplicates are preserved.
-- The pairs appear in __reverse order__ from the source.
--
-- ==== __Examples__
--
-- 'json' keeps only the first occurrence of each key, using 'Data.Aeson.KeyMap.fromList'.
--
-- @
-- 'json' = 'jsonWith' ('Right' '.' 'H.fromList')
-- @
--
-- 'jsonLast' keeps the last occurrence of each key, using
-- @'HashMap.Lazy.fromListWith' ('const' 'id')@.
--
-- @
-- 'jsonLast' = 'jsonWith' ('Right' '.' 'HashMap.Lazy.fromListWith' ('const' 'id'))
-- @
--
-- 'jsonAccum' keeps wraps all values in arrays to keep duplicates, using
-- 'fromListAccum'.
--
-- @
-- 'jsonAccum' = 'jsonWith' ('Right' . 'fromListAccum')
-- @
--
-- 'jsonNoDup' fails if any object contains duplicate keys, using 'parseListNoDup'.
--
-- @
-- 'jsonNoDup' = 'jsonWith' 'parseListNoDup'
-- @
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
  w <- Parser Word8
A.peekWord8'
  case w of
    Word8
W8.DOUBLE_QUOTE  -> Parser Word8
A.anyWord8 Parser Word8 -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Value
String (Text -> Value) -> Parser ByteString Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
jstring_)
    Word8
W8.LEFT_CURLY    -> Parser Word8
A.anyWord8 Parser Word8 -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([(Key, Value)] -> Either String Object)
-> Parser Value -> Parser Value
object_ [(Key, Value)] -> Either String Object
mkObject Parser Value
value_
    Word8
W8.LEFT_SQUARE   -> Parser Word8
A.anyWord8 Parser Word8 -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Value -> Parser Value
array_ Parser Value
value_
    Word8
W8.LOWER_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
W8.LOWER_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
W8.LOWER_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
W8.DIGIT_0 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
W8.DIGIT_9 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.HYPHEN
                     -> 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 a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a valid json value"
{-# INLINE jsonWith #-}

-- | Variant of 'json' which keeps only the last occurrence of every key.
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))

-- | Variant of 'json' wrapping all object mappings in 'Array' to preserve
-- key-value pairs with the same keys.
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)

-- | Variant of 'json' which fails if any object contains duplicate keys.
jsonNoDup :: Parser Value
jsonNoDup :: Parser Value
jsonNoDup = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith [(Key, Value)] -> Either String Object
parseListNoDup

-- | @'fromListAccum' kvs@ is an object mapping keys to arrays containing all
-- associated values from the original list @kvs@.
--
-- >>> fromListAccum [("apple", Bool True), ("apple", Bool False), ("orange", Bool False)]
-- fromList [("apple",Array [Bool False,Bool True]),("orange",Array [Bool False])]
fromListAccum :: [(Key, Value)] -> Object
fromListAccum :: [(Key, Value)] -> Object
fromListAccum =
  (([Value] -> [Value]) -> Value)
-> KeyMap ([Value] -> [Value]) -> Object
forall a b. (a -> b) -> KeyMap a -> KeyMap b
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 a b. (a -> b) -> [a] -> [b]
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 a b. (a -> b) -> (Key, a) -> (Key, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (:)

-- | @'fromListNoDup' kvs@ fails if @kvs@ contains duplicate keys.
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 a b. (a -> b) -> [a] -> [b]
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 a b. (a -> b) -> (Key, a) -> (Key, b)
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

-- | Strict version of 'value'. Synonym of 'json''.
value' :: Parser Value
value' :: Parser Value
value' = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith' (Object -> Either String Object
forall a. a -> Either String a
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)

-- | Strict version of 'jsonWith'.
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
  w <- Parser Word8
A.peekWord8'
  case w of
    Word8
W8.DOUBLE_QUOTE  -> do
                       !s <- Parser Word8
A.anyWord8 Parser Word8 -> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
jstring_
                       return (String s)
    Word8
W8.LEFT_CURLY    -> Parser Word8
A.anyWord8 Parser Word8 -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([(Key, Value)] -> Either String Object)
-> Parser Value -> Parser Value
object_' [(Key, Value)] -> Either String Object
mkObject Parser Value
value_
    Word8
W8.LEFT_SQUARE   -> Parser Word8
A.anyWord8 Parser Word8 -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Value -> Parser Value
array_' Parser Value
value_
    Word8
W8.LOWER_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
W8.LOWER_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
W8.LOWER_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
W8.DIGIT_0 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
W8.DIGIT_9 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.HYPHEN
                     -> do
                       !n <- Parser ByteString Scientific
scientific
                       return (Number n)
                      | Bool
otherwise -> String -> Parser Value
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a valid json value"
{-# INLINE jsonWith' #-}

-- | Variant of 'json'' which keeps only the last occurrence of every key.
jsonLast' :: Parser Value
jsonLast' :: Parser Value
jsonLast' = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith' (Object -> Either String Object
forall a. a -> Either String a
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))

-- | Variant of 'json'' wrapping all object mappings in 'Array' to preserve
-- key-value pairs with the same keys.
jsonAccum' :: Parser Value
jsonAccum' :: Parser Value
jsonAccum' = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith' (Object -> Either String Object
forall a. a -> Either String a
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)

-- | Variant of 'json'' which fails if any object contains duplicate keys.
jsonNoDup' :: Parser Value
jsonNoDup' :: Parser Value
jsonNoDup' = ([(Key, Value)] -> Either String Object) -> Parser Value
jsonWith' [(Key, Value)] -> Either String Object
parseListNoDup

-- | Parse a quoted JSON string.
jstring :: Parser Text
jstring :: Parser ByteString Text
jstring = Word8 -> Parser Word8
A.word8 Word8
W8.DOUBLE_QUOTE Parser Word8 -> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
jstring_

-- | Parse a JSON Key
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

-- | Parse a string without a leading quote.
jstring_ :: Parser Text
{-# INLINE jstring_ #-}
jstring_ :: Parser ByteString Text
jstring_ = do
  s <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
W8.DOUBLE_QUOTE Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
W8.BACKSLASH Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x20 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x80)
  mw <- A.peekWord8
  case mw of
    Maybe Word8
Nothing              -> String -> Parser ByteString Text
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"string without end"
    Just Word8
W8.DOUBLE_QUOTE -> Parser Word8
A.anyWord8 Parser Word8 -> Text -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ByteString -> Text
unsafeDecodeASCII ByteString
s
    Just Word8
w | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x20    -> String -> Parser ByteString Text
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unescaped control character"
    Maybe Word8
_                    -> ByteString -> Parser ByteString Text
jstringSlow ByteString
s

jstringSlow :: B.ByteString -> Parser Text
{-# INLINE jstringSlow #-}
jstringSlow :: ByteString -> Parser ByteString Text
jstringSlow ByteString
s' = do
  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
go Parser ByteString -> Parser Word8 -> Parser ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Word8
A.anyWord8
  case unescapeText (B.append s' s) of
    Right Text
r  -> Text -> Parser ByteString Text
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
r
    Left UnicodeException
err -> String -> Parser ByteString Text
forall a. String -> Parser ByteString a
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 -> Word8 -> Maybe Bool
go Bool
a Word8
c
      | Bool
a                     = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
      | Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.DOUBLE_QUOTE  = Maybe Bool
forall a. Maybe a
Nothing
      | Bool
otherwise = let a' :: Bool
a' = Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.BACKSLASH
                    in Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
a'

decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a
decodeWith :: forall a.
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 :: forall a.
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 :: forall a.
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 #-}

-- | Grab the first 100 bytes from the non parsed portion and
-- format to get nicer error messages
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
.
  -- if formatting results in empty ByteString just return that
  -- otherwise construct the error message with the bytestring builder
  (\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
.
  -- if newline is present cut at that position
  (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
.
  -- remove spaces, CR's, tabs, backslashes and quotes characters
  (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
.
  -- take 100 bytes
  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 :: forall a.
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 #-}

-- $lazy
--
-- The 'json' and 'value' parsers decouple identification from
-- conversion.  Identification occurs immediately (so that an invalid
-- JSON document can be rejected as early as possible), but conversion
-- to a Haskell value is deferred until that value is needed.
--
-- This decoupling can be time-efficient if only a smallish subset of
-- elements in a JSON value need to be inspected, since the cost of
-- conversion is zero for uninspected elements.  The trade off is an
-- increase in memory usage, due to allocation of thunks for values
-- that have not yet been converted.

-- $strict
--
-- The 'json'' and 'value'' parsers combine identification with
-- conversion.  They consume more CPU cycles up front, but have a
-- smaller memory footprint.

-- | Parse a top-level JSON value followed by optional whitespace and
-- end-of-input.  See also: 'json'.
jsonEOF :: Parser Value
jsonEOF :: Parser Value
jsonEOF = Parser Value
json Parser Value -> Parser () -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Value -> Parser () -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput

-- | Parse a top-level JSON value followed by optional whitespace and
-- end-of-input.  See also: 'json''.
jsonEOF' :: Parser Value
jsonEOF' :: Parser Value
jsonEOF' = Parser Value
json' Parser Value -> Parser () -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser Value -> Parser () -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput

-- | The only valid whitespace in a JSON document is space, newline,
-- carriage return, and tab.
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
W8.SPACE Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.LF Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.CR Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.TAB
{-# INLINE skipSpace #-}

------------------ Copy-pasted and adapted from attoparsec ------------------

-- A strict pair
data SP = SP !Integer {-# UNPACK #-}!Int

decimal0 :: Parser Integer
decimal0 :: Parser Integer
decimal0 = do
  digits <- (Word8 -> Bool) -> Parser ByteString
A.takeWhile1 Word8 -> Bool
isDigit_w8
  if B.length digits > 1 && B.unsafeHead digits == W8.DIGIT_0
    then fail "leading zero"
    else return (byteStringToInteger digits)

-- | Parse a JSON number.
scientific :: Parser Scientific
scientific :: Parser ByteString Scientific
scientific = do
  sign <- Parser Word8
A.peekWord8'
  let !positive = Bool -> Bool
not (Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.HYPHEN)
  when (sign == W8.PLUS || sign == W8.HYPHEN) $
    void A.anyWord8

  n <- decimal0

  let 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}. Num a => a -> Word8 -> 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 Word8
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
+ Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
W8.DIGIT_0)

  dotty <- A.peekWord8
  SP c e <- case dotty of
              Just Word8
W8.PERIOD -> Parser Word8
A.anyWord8 Parser Word8 -> Parser ByteString SP -> Parser ByteString SP
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
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 a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Int -> SP
SP Integer
n Int
0)

  let !signedCoeff | Bool
positive  =  Integer
c
                   | Bool
otherwise = -Integer
c

  (A.satisfy (\Word8
ex -> case Word8
ex of Word8
W8.LOWER_E -> Bool
True; Word8
W8.UPPER_E -> Bool
True; Word8
_ -> Bool
False) *>
      fmap (Sci.scientific signedCoeff . (e +)) (signed decimal)) <|>
    return (Sci.scientific signedCoeff    e)
{-# INLINE scientific #-}