{-# 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
  !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 a. a -> Parser ByteString a
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 a. a -> Parser ByteString a
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
== Word8
W8.RIGHT_CURLY
    then Parser Word8
A.anyWord8 Parser Word8
-> Parser ByteString Object -> Parser ByteString Object
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Object -> Parser ByteString Object
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
forall v. KeyMap v
KM.empty
    else [(Key, Value)] -> Parser ByteString Object
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
    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 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
"':'")
    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 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
    Word8
ch <- (Word8 -> Bool) -> Parser Word8
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) Parser Word8 -> String -> Parser Word8
forall i a. Parser i a -> String -> Parser i a
A.<?> String
"',' 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
== Word8
W8.COMMA
      then Parser ()
skipSpace Parser () -> Parser ByteString Object -> Parser ByteString Object
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
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 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
  !Array
vals <- Parser Value -> Parser ByteString Array
arrayValues Parser Value
val
  Value -> Parser Value
forall a. a -> Parser ByteString a
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
== Word8
W8.RIGHT_SQUARE
    then Parser Word8
A.anyWord8 Parser Word8 -> Parser ByteString Array -> Parser ByteString Array
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Array -> Parser ByteString Array
forall a. a -> Parser ByteString a
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 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
      Word8
ch <- (Word8 -> Bool) -> Parser Word8
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) Parser Word8 -> String -> Parser Word8
forall i a. Parser i a -> String -> Parser i a
A.<?> String
"',' or ']'"
      if Word8
ch Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.COMMA
        then Parser ()
skipSpace Parser () -> Parser ByteString Array -> Parser ByteString Array
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
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 a. a -> Parser ByteString a
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 #-}

-- | 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
  Word8
w <- Parser Word8
A.peekWord8'
  case Word8
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
  Word8
w <- Parser Word8
A.peekWord8'
  case Word8
w of
    Word8
W8.DOUBLE_QUOTE  -> do
                       !Text
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_
                       Value -> Parser Value
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Value
String Text
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
                       !Scientific
n <- Parser ByteString Scientific
scientific
                       Value -> Parser Value
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> Value
Number Scientific
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
  ByteString
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)
  Maybe Word8
mw <- Parser (Maybe Word8)
A.peekWord8
  case Maybe Word8
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
  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
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 ByteString -> Either UnicodeException Text
unescapeText (ByteString -> ByteString -> ByteString
B.append ByteString
s' ByteString
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
  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
W8.DIGIT_0
    then String -> Parser Integer
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"leading zero"
    else Integer -> Parser Integer
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Integer
byteStringToInteger ByteString
digits)

-- | Parse a JSON number.
scientific :: Parser Scientific
scientific :: Parser ByteString Scientific
scientific = do
  Word8
sign <- Parser Word8
A.peekWord8'
  let !positive :: Bool
positive = Bool -> Bool
not (Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.HYPHEN)
  Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.PLUS Bool -> Bool -> Bool
|| Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
W8.HYPHEN) (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}. 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 -> Word8 -> a
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)

  Maybe Word8
dotty <- Parser (Maybe Word8)
A.peekWord8
  SP Integer
c Int
e <- case Maybe Word8
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 :: Integer
signedCoeff | Bool
positive  =  Integer
c
                   | Bool
otherwise = -Integer
c

  ((Word8 -> Bool) -> Parser Word8
A.satisfy (\Word8
ex -> case Word8
ex of Word8
W8.LOWER_E -> Bool
True; Word8
W8.UPPER_E -> Bool
True; Word8
_ -> Bool
False) Parser Word8
-> Parser ByteString Scientific -> Parser ByteString Scientific
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      (Int -> Scientific)
-> Parser ByteString Int -> Parser ByteString Scientific
forall a b. (a -> b) -> Parser ByteString a -> Parser ByteString b
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 a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Scientific -> Parser ByteString Scientific
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int -> Scientific
Sci.scientific Integer
signedCoeff    Int
e)
{-# INLINE scientific #-}