{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}

-- |
-- Module : Data.JsonStream.Parser
-- License     : BSD-style
--
-- Maintainer  : palkovsky.ondrej@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- An incremental applicative-style JSON parser, suitable for high performance
-- memory efficient stream parsing.
--
-- The parser is using "Data.Aeson" types and 'FromJSON' instance, it can be
-- easily combined with aeson monadic parsing instances when appropriate.

module Data.JsonStream.Parser (
    -- * How to use this library
    -- $use

    -- * Performance
    -- $performance

    -- * Constant space decoding
    -- $constant

    -- * Aeson compatibility
    -- $aeson

    -- * The @Parser@ type
    Parser
  , ParseOutput(..)
    -- * Parsing functions
  , runParser
  , runParser'
  , parseByteString
  , parseLazyByteString
    -- * Aeson in-place replacement functions
  , decode
  , eitherDecode
  , decodeStrict
  , eitherDecodeStrict
    -- * FromJSON parser
  , value
  , valueWith
  , string
  , byteString
    -- * Constant space parsers
  , safeString
  , number
  , integer
  , real
  , bool
  , jNull
  , safeByteString
    -- * Structure operators
  , (.:)
  , (.:?)
  , (.|)
  , (.!)
    -- * Structure parsers
  , objectWithKey
  , objectItems
  , objectValues
  , objectKeyValues
  , arrayOf
  , arrayWithIndexOf
  , indexedArrayOf
  , nullable
    -- * Parsing modifiers
  , filterI
  , takeI
  , mapWithFailure
  , manyReverse
    -- * SAX-like parsers
  , arrayFound
  , objectFound
) where

#if !MIN_VERSION_bytestring(0,10,6)
import           Data.Monoid                 (Monoid, mappend, mempty)
#endif

#if MIN_VERSION_base(4,10,0)
import           Data.Semigroup                 (Semigroup(..))
#endif

import           Control.Applicative
import qualified Data.Aeson                  as AE
import qualified Data.Aeson.Types            as AE
import qualified Data.ByteString.Char8       as BS
import qualified Data.ByteString.Lazy.Char8  as BL
import qualified Data.ByteString.Lazy.Internal as BL
import           Data.Char                   (isSpace)
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap           as AEK
import qualified Data.Aeson.Key              as AEK
import           Data.Bifunctor              (first)
#else
import qualified Data.HashMap.Strict         as HMap
#endif
import           Data.Scientific             (Scientific, isInteger,
                                              toBoundedInteger, toRealFloat)
import qualified Data.Text                   as T
import qualified Data.Vector                 as Vec
import           Foreign.C.Types

import           Data.JsonStream.CLexer
import           Data.JsonStream.TokenParser
import Data.JsonStream.Unescape (unsafeDecodeASCII)

-- | Limit for the size of an object key
objectKeyStringLimit :: Int
objectKeyStringLimit :: Int
objectKeyStringLimit = Int
65536

-- | Private parsing result
data ParseResult v =  MoreData (Parser v, BS.ByteString -> TokenResult)
                    | Failed String
                    | Done BS.ByteString TokenResult
                    -- The bytestring is remaining unparsed data, we need to return it somehow
                    | Yield v (ParseResult v)


instance Functor ParseResult where
  fmap :: forall a b. (a -> b) -> ParseResult a -> ParseResult b
fmap a -> b
f (MoreData (Parser a
np, ByteString -> TokenResult
ntok)) = forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Parser a
np, ByteString -> TokenResult
ntok)
  fmap a -> b
_ (Failed String
err) = forall v. String -> ParseResult v
Failed String
err
  fmap a -> b
_ (Done ByteString
ctx TokenResult
tok) = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
tok
  fmap a -> b
f (Yield a
v ParseResult a
np) = forall v. v -> ParseResult v -> ParseResult v
Yield (a -> b
f a
v) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ParseResult a
np)

-- | A representation of the parser.
newtype Parser a = Parser {
    forall a. Parser a -> TokenResult -> ParseResult a
callParse :: TokenResult -> ParseResult a
}

instance Functor Parser where
  fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f (Parser TokenResult -> ParseResult a
p) = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
d -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (TokenResult -> ParseResult a
p TokenResult
d)

-- | Yield list of results, finish with last action
yieldResults :: [a] -> ParseResult a -> ParseResult a
yieldResults :: forall a. [a] -> ParseResult a -> ParseResult a
yieldResults [a]
values ParseResult a
end = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall v. v -> ParseResult v -> ParseResult v
Yield ParseResult a
end [a]
values

-- | '<*>' will run both parsers in parallel and combine results.
--
-- It behaves as a list functor (produces all combinations), but the typical
-- use is:
--
-- >>> :set -XOverloadedStrings
-- >>> let text = "[{\"name\": \"John\", \"age\": 20}, {\"age\": 30, \"name\": \"Frank\"}]"
-- >>> let parser = arrayOf $ (,) <$> "name" .: string <*> "age"  .: integer
-- >>> parseByteString parser text :: [(T.Text,Int)]
-- [("John",20),("Frank",30)]
instance Applicative Parser where
  pure :: forall a. a -> Parser a
pure a
x = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> forall {a}. ParseResult a -> ParseResult a
process (forall a. Parser a -> TokenResult -> ParseResult a
callParse forall a. Parser a
ignoreVal TokenResult
tok)
    where
      process :: ParseResult a -> ParseResult a
process (Failed String
err) = forall v. String -> ParseResult v
Failed String
err
      process (Done ByteString
ctx TokenResult
tok) = forall v. v -> ParseResult v -> ParseResult v
Yield a
x (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
tok)
      process (MoreData (Parser a
np, ByteString -> TokenResult
ntok)) = forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (ParseResult a -> ParseResult a
process forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
np), ByteString -> TokenResult
ntok)
      process ParseResult a
_ = forall v. String -> ParseResult v
Failed String
"Internal error in pure, ignoreVal doesn't yield"

  <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
(<*>) Parser (a -> b)
m1 Parser a
m2 = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> forall {t} {v}.
([t -> v], [t])
-> ParseResult (t -> v) -> ParseResult t -> ParseResult v
process ([], []) (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser (a -> b)
m1 TokenResult
tok) (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
m2 TokenResult
tok)
    where
      process :: ([t -> v], [t])
-> ParseResult (t -> v) -> ParseResult t -> ParseResult v
process ([], [t]
_) (Done ByteString
ctx TokenResult
ntok) ParseResult t
_ = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok -- Optimize, return immediately when first parser fails
      process ([t -> v]
lst1, [t]
lst2) (Yield t -> v
v ParseResult (t -> v)
np1) ParseResult t
p2 = ([t -> v], [t])
-> ParseResult (t -> v) -> ParseResult t -> ParseResult v
process (t -> v
vforall a. a -> [a] -> [a]
:[t -> v]
lst1, [t]
lst2) ParseResult (t -> v)
np1 ParseResult t
p2
      process ([t -> v]
lst1, [t]
lst2) ParseResult (t -> v)
p1 (Yield t
v ParseResult t
np2) = ([t -> v], [t])
-> ParseResult (t -> v) -> ParseResult t -> ParseResult v
process ([t -> v]
lst1, t
vforall a. a -> [a] -> [a]
:[t]
lst2) ParseResult (t -> v)
p1 ParseResult t
np2
      process ([t -> v]
lst1, [t]
lst2) (Done ByteString
ctx TokenResult
ntok) (Done {}) =
        forall a. [a] -> ParseResult a -> ParseResult a
yieldResults [ t -> v
mx t
my | t -> v
mx <- forall a. [a] -> [a]
reverse [t -> v]
lst1, t
my <- forall a. [a] -> [a]
reverse [t]
lst2 ] (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok)
      process ([t -> v], [t])
lsts (MoreData (Parser (t -> v)
np1, ByteString -> TokenResult
ntok1)) (MoreData (Parser t
np2, ByteString -> TokenResult
_)) =
        forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (\TokenResult
tok -> ([t -> v], [t])
-> ParseResult (t -> v) -> ParseResult t -> ParseResult v
process ([t -> v], [t])
lsts (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser (t -> v)
np1 TokenResult
tok) (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser t
np2 TokenResult
tok)), ByteString -> TokenResult
ntok1)
      process ([t -> v], [t])
_ (Failed String
err) ParseResult t
_ = forall v. String -> ParseResult v
Failed String
err
      process ([t -> v], [t])
_ ParseResult (t -> v)
_ (Failed String
err) = forall v. String -> ParseResult v
Failed String
err
      process ([t -> v], [t])
_ ParseResult (t -> v)
_ ParseResult t
_ = forall v. String -> ParseResult v
Failed String
"Unexpected error in parallel processing <*>."


-- | '<>' will run both parsers in parallel yielding from both as the data comes
--
-- >>> :m +Data.Monoid
-- >>> let test = "[{\"key1\": [1,2], \"key2\": [5,6], \"key3\": [8,9]}]"
-- >>> let parser = arrayOf $ "key1" .: (arrayOf value) <> "key2" .: (arrayOf value)
-- >>> parseByteString parser test :: [Int]
-- [1,2,5,6]
#if MIN_VERSION_base(4,10,0)
instance Monoid (Parser a) where
  mempty :: Parser a
mempty = forall a. Parser a
ignoreVal
  mappend :: Parser a -> Parser a -> Parser a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup (Parser a) where
  <> :: Parser a -> Parser a -> Parser a
(<>) Parser a
m1 Parser a
m2 =
#else
instance Monoid (Parser a) where
  mempty = ignoreVal
  mappend m1 m2 =
#endif
    forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> forall {v}. ParseResult v -> ParseResult v -> ParseResult v
process (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
m1 TokenResult
tok) (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
m2 TokenResult
tok)
    where
      process :: ParseResult v -> ParseResult v -> ParseResult v
process (Yield v
v ParseResult v
np1) ParseResult v
p2 = forall v. v -> ParseResult v -> ParseResult v
Yield v
v (ParseResult v -> ParseResult v -> ParseResult v
process ParseResult v
np1 ParseResult v
p2)
      process ParseResult v
p1 (Yield v
v ParseResult v
np2) = forall v. v -> ParseResult v -> ParseResult v
Yield v
v (ParseResult v -> ParseResult v -> ParseResult v
process ParseResult v
p1 ParseResult v
np2)
      process (Done ByteString
ctx TokenResult
ntok) Done {} = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok
      process (MoreData (Parser v
np1, ByteString -> TokenResult
ntok)) (MoreData (Parser v
np2, ByteString -> TokenResult
_)) =
          forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> ParseResult v -> ParseResult v -> ParseResult v
process (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser v
np1 TokenResult
tok) (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser v
np2 TokenResult
tok), ByteString -> TokenResult
ntok)
      process (Failed String
err) ParseResult v
_ = forall v. String -> ParseResult v
Failed String
err
      process ParseResult v
_ (Failed String
err) = forall v. String -> ParseResult v
Failed String
err
      process ParseResult v
_ ParseResult v
_ = forall v. String -> ParseResult v
Failed String
"Unexpected error in parallel processing <|>"

-- | Match items from the first parser, if none is matched, return items
-- from the second parser. Constant-space if second parser returns
-- constant number of items. '.|' is implemented using this operator.
--
-- >>> let json = "[{\"key1\": [1,2], \"key2\": [5,6], \"key3\": [8,9]}]"
-- >>> let parser = arrayOf $ "key1" .: (arrayOf value) <|> "key2" .: (arrayOf value)
-- >>> parseByteString parser json :: [Int]
-- [1,2]
-- >>> let parser = arrayOf $ "key-non" .: (arrayOf value) <|> "key2" .: (arrayOf value)
-- >>> parseByteString parser json :: [Int]
-- [5,6]
--
-- 'many' - Gather matches and return them as list.
--
-- >>> let json = "[{\"keys\":[1,2], \"values\":[5,6]}, {\"keys\":[9,8], \"values\":[7,6]}]"
-- >>> let parser = arrayOf $ (,) <$> many ("keys" .: arrayOf integer) <*> many ("values" .: arrayOf integer)
-- >>> parseByteString parser json :: [([Int], [Int])]
-- [([1,2],[5,6]),([9,8],[7,6])]
instance Alternative Parser where
  empty :: forall a. Parser a
empty = forall a. Parser a
ignoreVal
  Parser a
m1 <|> :: forall a. Parser a -> Parser a -> Parser a
<|> Parser a
m2 = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> forall {a}.
[a] -> ParseResult a -> Maybe (ParseResult a) -> ParseResult a
process [] (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
m1 TokenResult
tok) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
m2 TokenResult
tok)
    where
      -- First returned item -> disable second parser
      process :: [a] -> ParseResult a -> Maybe (ParseResult a) -> ParseResult a
process [a]
_ (Yield a
v ParseResult a
np1) Maybe (ParseResult a)
_ = forall v. v -> ParseResult v -> ParseResult v
Yield a
v ([a] -> ParseResult a -> Maybe (ParseResult a) -> ParseResult a
process [] ParseResult a
np1 forall a. Maybe a
Nothing)
      -- First done with disabled second -> exit
      process [a]
_ (Done ByteString
ctx TokenResult
ntok) Maybe (ParseResult a)
Nothing = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok
      -- Both done but second not disabled -> yield items from the second
      process [a]
lst (Done ByteString
ctx TokenResult
ntok) (Just (Done {})) = forall a. [a] -> ParseResult a -> ParseResult a
yieldResults (forall a. [a] -> [a]
reverse [a]
lst) (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok)
      -- Second yield - remember data
      process [a]
lst ParseResult a
np1 (Just (Yield a
v ParseResult a
np2)) = [a] -> ParseResult a -> Maybe (ParseResult a) -> ParseResult a
process (a
vforall a. a -> [a] -> [a]
:[a]
lst) ParseResult a
np1 (forall a. a -> Maybe a
Just ParseResult a
np2)
      -- Moredata processing
      process [a]
lst (MoreData (Parser a
np1, ByteString -> TokenResult
ntok)) Maybe (ParseResult a)
Nothing =
          forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> [a] -> ParseResult a -> Maybe (ParseResult a) -> ParseResult a
process [a]
lst (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
np1 TokenResult
tok) forall a. Maybe a
Nothing, ByteString -> TokenResult
ntok)
      process [a]
lst (MoreData (Parser a
np1, ByteString -> TokenResult
ntok)) (Just (MoreData (Parser a
np2, ByteString -> TokenResult
_))) =
          forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> [a] -> ParseResult a -> Maybe (ParseResult a) -> ParseResult a
process [a]
lst (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
np1 TokenResult
tok) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
np2 TokenResult
tok), ByteString -> TokenResult
ntok)
      process [a]
_ (Failed String
err) Maybe (ParseResult a)
_ = forall v. String -> ParseResult v
Failed String
err
      process [a]
_ ParseResult a
_ (Just (Failed String
err)) = forall v. String -> ParseResult v
Failed String
err
      process [a]
_ ParseResult a
_ Maybe (ParseResult a)
_ = forall v. String -> ParseResult v
Failed String
"Unexpected error in parallel processing <|>"

  some :: forall a. Parser a -> Parser [a]
some = forall a. (a -> Bool) -> Parser a -> Parser a
filterI (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
  many :: forall a. Parser a -> Parser [a]
many Parser a
f = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
ntok -> forall {a} {v}. ([a] -> v) -> ParseResult a -> ParseResult v
loop forall a. a -> a
id (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
f TokenResult
ntok)
    where
      loop :: ([a] -> v) -> ParseResult a -> ParseResult v
loop [a] -> v
acc (Done ByteString
ctx TokenResult
ntp) = forall v. v -> ParseResult v -> ParseResult v
Yield ([a] -> v
acc []) (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntp)
      loop [a] -> v
acc (MoreData (Parser TokenResult -> ParseResult a
np, ByteString -> TokenResult
ntok)) = forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (([a] -> v) -> ParseResult a -> ParseResult v
loop [a] -> v
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult a
np), ByteString -> TokenResult
ntok)
      loop [a] -> v
acc (Yield a
v ParseResult a
np) = ([a] -> v) -> ParseResult a -> ParseResult v
loop (\[a]
nxt -> [a] -> v
acc (a
v forall a. a -> [a] -> [a]
: [a]
nxt)) ParseResult a
np
      loop [a] -> v
_ (Failed String
err) = forall v. String -> ParseResult v
Failed String
err

array' :: (Int -> Parser a) -> Parser a
array' :: forall a. (Int -> Parser a) -> Parser a
array' Int -> Parser a
valparse = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
tp ->
  case TokenResult
tp of
    (PartialResult Element
ArrayBegin TokenResult
ntp) -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Int -> TokenResult -> Element -> TokenResult -> ParseResult a
nextitem Int
0) TokenResult
ntp
    (PartialResult Element
_ TokenResult
_) -> forall a. Parser a -> TokenResult -> ParseResult a
callParse forall a. Parser a
ignoreVal TokenResult
tp -- Run ignoreval parser on the same output we got
    (TokMoreData ByteString -> TokenResult
ntok) -> forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (Int -> Parser a) -> Parser a
array' Int -> Parser a
valparse, ByteString -> TokenResult
ntok)
    (TokenResult
TokFailed) -> forall v. String -> ParseResult v
Failed String
"Array - token failed"
  where
    nextitem :: Int -> TokenResult -> Element -> TokenResult -> ParseResult a
nextitem !Int
_ TokenResult
_ (ArrayEnd ByteString
ctx) TokenResult
ntok = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok
    nextitem !Int
i TokenResult
tok Element
_ TokenResult
_ = Int -> ParseResult a -> ParseResult a
arrcontent Int
i (forall a. Parser a -> TokenResult -> ParseResult a
callParse (Int -> Parser a
valparse Int
i) TokenResult
tok)

    arrcontent :: Int -> ParseResult a -> ParseResult a
arrcontent !Int
i (Done ByteString
_ TokenResult
ntp) = forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Int -> TokenResult -> Element -> TokenResult -> ParseResult a
nextitem (Int
iforall a. Num a => a -> a -> a
+Int
1)) TokenResult
ntp
    arrcontent !Int
i (MoreData (Parser TokenResult -> ParseResult a
np, ByteString -> TokenResult
ntp)) = forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (Int -> ParseResult a -> ParseResult a
arrcontent Int
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult a
np), ByteString -> TokenResult
ntp)
    arrcontent !Int
i (Yield a
v ParseResult a
np) = forall v. v -> ParseResult v -> ParseResult v
Yield a
v (Int -> ParseResult a -> ParseResult a
arrcontent Int
i ParseResult a
np)
    arrcontent !Int
_ (Failed String
err) = forall v. String -> ParseResult v
Failed String
err

-- | Match all items of an array.
arrayOf :: Parser a -> Parser a
arrayOf :: forall a. Parser a -> Parser a
arrayOf Parser a
valparse = forall a. (Int -> Parser a) -> Parser a
array' (forall a b. a -> b -> a
const Parser a
valparse)

-- | Generate start/end objects when an element is found, in between run a parser.
-- The inner parser is not run if an array is not found.
elemFound :: Element -> a -> a -> Parser a -> Parser a
elemFound :: forall a. Element -> a -> a -> Parser a -> Parser a
elemFound Element
elsearch a
start a
end Parser a
parser = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData forall {p}. TokenResult -> Element -> p -> ParseResult a
handle
  where
    handle :: TokenResult -> Element -> p -> ParseResult a
handle TokenResult
tok Element
el p
_
      | Element
el forall a. Eq a => a -> a -> Bool
== Element
elsearch = forall v. v -> ParseResult v -> ParseResult v
Yield a
start (ParseResult a -> ParseResult a
parseAndAppend (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
parser TokenResult
tok))
    handle TokenResult
tok Element
_ p
_ = forall a. Parser a -> TokenResult -> ParseResult a
callParse forall a. Parser a
ignoreVal TokenResult
tok

    parseAndAppend :: ParseResult a -> ParseResult a
parseAndAppend (Failed String
err) = forall v. String -> ParseResult v
Failed String
err
    parseAndAppend (Yield a
v ParseResult a
np) = forall v. v -> ParseResult v -> ParseResult v
Yield a
v (ParseResult a -> ParseResult a
parseAndAppend ParseResult a
np)
    parseAndAppend (MoreData (Parser TokenResult -> ParseResult a
np, ByteString -> TokenResult
ntp)) = forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (ParseResult a -> ParseResult a
parseAndAppend forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult a
np), ByteString -> TokenResult
ntp)
    parseAndAppend (Done ByteString
ctx TokenResult
ntp) = forall v. v -> ParseResult v -> ParseResult v
Yield a
end (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntp)

-- | Generate start/end values when an object is found, in between run a parser.
-- The inner parser is not run if an array is not found.
objectFound :: a -> a -> Parser a -> Parser a
objectFound :: forall a. a -> a -> Parser a -> Parser a
objectFound = forall a. Element -> a -> a -> Parser a -> Parser a
elemFound Element
ObjectBegin

-- | Generate start/end values when an array is found, in between run a parser.
-- The inner parser is not run if an array is not found.
--
-- >>> let test = "[[1,2,3],true,[],false,{\"key\":1}]" :: BS.ByteString
-- >>> parseByteString (arrayOf (arrayFound 10 20 (1 .! integer))) test :: [Int]
-- [10,2,20,10,20]
arrayFound :: a -> a -> Parser a -> Parser a
arrayFound :: forall a. a -> a -> Parser a -> Parser a
arrayFound = forall a. Element -> a -> a -> Parser a -> Parser a
elemFound Element
ArrayBegin

-- | Match nith item in an array.
arrayWithIndexOf :: Int -> Parser a -> Parser a
arrayWithIndexOf :: forall a. Int -> Parser a -> Parser a
arrayWithIndexOf Int
idx Parser a
valparse = forall a. (Int -> Parser a) -> Parser a
array' Int -> Parser a
itemFn
  where
    itemFn :: Int -> Parser a
itemFn Int
aidx
      | Int
aidx forall a. Eq a => a -> a -> Bool
== Int
idx = Parser a
valparse
      | Bool
otherwise = forall a. Parser a
ignoreVal

-- | Match all items of an array, add index to output.
indexedArrayOf :: Parser a -> Parser (Int, a)
indexedArrayOf :: forall a. Parser a -> Parser (Int, a)
indexedArrayOf Parser a
valparse = forall a. (Int -> Parser a) -> Parser a
array' (\(!Int
key) -> (Int
key,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
valparse)


-- | Go through an object; if once is True, yield only first success, then ignore the rest
object' :: Bool -> (T.Text -> Parser a) -> Parser a
object' :: forall a. Bool -> (Text -> Parser a) -> Parser a
object' Bool
once Text -> Parser a
valparse = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
tp ->
  case TokenResult
tp of
    (PartialResult Element
ObjectBegin TokenResult
ntp) -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Bool -> TokenResult -> Element -> TokenResult -> ParseResult a
nextitem Bool
False) TokenResult
ntp
    (PartialResult Element
_ TokenResult
_) -> forall a. Parser a -> TokenResult -> ParseResult a
callParse forall a. Parser a
ignoreVal TokenResult
tp -- Run ignoreval parser on the same output we got
    (TokMoreData ByteString -> TokenResult
ntok) -> forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. Bool -> (Text -> Parser a) -> Parser a
object' Bool
once Text -> Parser a
valparse, ByteString -> TokenResult
ntok)
    TokenResult
TokFailed -> forall v. String -> ParseResult v
Failed String
"Array - token failed"
  where
    nextitem :: Bool -> TokenResult -> Element -> TokenResult -> ParseResult a
nextitem Bool
_ TokenResult
_ (ObjectEnd ByteString
ctx) TokenResult
ntok = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok
    nextitem Bool
yielded TokenResult
_ (JValue (AE.String Text
key)) TokenResult
ntok =
      Bool -> ParseResult a -> ParseResult a
objcontent Bool
yielded (forall a. Parser a -> TokenResult -> ParseResult a
callParse (Text -> Parser a
valparse Text
key) TokenResult
ntok)
    nextitem Bool
yielded TokenResult
_ (StringRaw ByteString
bs Bool
True) TokenResult
ntok = 
        Bool -> ParseResult a -> ParseResult a
objcontent Bool
yielded (forall a. Parser a -> TokenResult -> ParseResult a
callParse (Text -> Parser a
valparse (ByteString -> Text
unsafeDecodeASCII ByteString
bs)) TokenResult
ntok)
    nextitem Bool
yielded TokenResult
_ (StringRaw ByteString
bs Bool
False) TokenResult
ntok = 
      case ByteString -> Either UnicodeException Text
unescapeText ByteString
bs of
        Right Text
t -> Bool -> ParseResult a -> ParseResult a
objcontent Bool
yielded (forall a. Parser a -> TokenResult -> ParseResult a
callParse (Text -> Parser a
valparse Text
t) TokenResult
ntok)
        Left UnicodeException
e -> forall v. String -> ParseResult v
Failed (forall a. Show a => a -> String
show UnicodeException
e)
    nextitem Bool
yielded TokenResult
_ (StringContent ByteString
str) TokenResult
ntok =
      Bool -> ParseResult a -> ParseResult a
objcontent Bool
yielded forall a b. (a -> b) -> a -> b
$ forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData ([ByteString]
-> Int -> TokenResult -> Element -> TokenResult -> ParseResult a
getLongKey [ByteString
str] (ByteString -> Int
BS.length ByteString
str)) TokenResult
ntok
    nextitem Bool
_ TokenResult
_ Element
el TokenResult
_ = forall v. String -> ParseResult v
Failed forall a b. (a -> b) -> a -> b
$ String
"Object - unexpected item: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Element
el

    -- If we already yielded and should yield once, ignore the rest of the object
    objcontent :: Bool -> ParseResult a -> ParseResult a
objcontent Bool
yielded (Done ByteString
_ TokenResult
ntp)
      | Bool
once Bool -> Bool -> Bool
&& Bool
yielded = forall a. Parser a -> TokenResult -> ParseResult a
callParse (forall a. Int -> Parser a
ignoreVal' Int
1) TokenResult
ntp
      | Bool
otherwise = forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Bool -> TokenResult -> Element -> TokenResult -> ParseResult a
nextitem Bool
yielded) TokenResult
ntp -- Reset to next value
    objcontent Bool
yielded (MoreData (Parser TokenResult -> ParseResult a
np, ByteString -> TokenResult
ntok)) = forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (Bool -> ParseResult a -> ParseResult a
objcontent Bool
yieldedforall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult a
np), ByteString -> TokenResult
ntok)
    objcontent Bool
_ (Yield a
v ParseResult a
np) = forall v. v -> ParseResult v -> ParseResult v
Yield a
v (Bool -> ParseResult a -> ParseResult a
objcontent Bool
True ParseResult a
np)
    objcontent Bool
_ (Failed String
err) = forall v. String -> ParseResult v
Failed String
err

    getLongKey :: [ByteString]
-> Int -> TokenResult -> Element -> TokenResult -> ParseResult a
getLongKey [ByteString]
acc !Int
len TokenResult
_ Element
el TokenResult
ntok =
      case Element
el of
        Element
StringEnd
          | Right Text
key <- ByteString -> Either UnicodeException Text
unescapeText ([ByteString] -> ByteString
BS.concat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [ByteString]
acc) ->
              forall a. Parser a -> TokenResult -> ParseResult a
callParse (Text -> Parser a
valparse Text
key) TokenResult
ntok
          | Bool
otherwise -> forall v. String -> ParseResult v
Failed String
"Error decoding UTF8"
        StringContent ByteString
str
          | Int
len forall a. Ord a => a -> a -> Bool
> Int
objectKeyStringLimit -> forall a. Parser a -> TokenResult -> ParseResult a
callParse (forall a. Parser a -> Parser a
ignoreStrRestThen forall a. Parser a
ignoreVal) TokenResult
ntok
          | Bool
otherwise -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData ([ByteString]
-> Int -> TokenResult -> Element -> TokenResult -> ParseResult a
getLongKey (ByteString
strforall a. a -> [a] -> [a]
:[ByteString]
acc) (Int
len forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
str)) TokenResult
ntok
        Element
_ -> forall v. String -> ParseResult v
Failed String
"Object longstr - lexer failed."

-- | Helper function to deduplicate TokMoreData/FokFailed logic
moreData :: (TokenResult -> Element -> TokenResult -> ParseResult v) -> TokenResult -> ParseResult v
moreData :: forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData TokenResult -> Element -> TokenResult -> ParseResult v
parser TokenResult
tok =
  case TokenResult
tok of
    PartialResult Element
el TokenResult
ntok -> TokenResult -> Element -> TokenResult -> ParseResult v
parser TokenResult
tok Element
el TokenResult
ntok
    TokMoreData ByteString -> TokenResult
ntok -> forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData TokenResult -> Element -> TokenResult -> ParseResult v
parser), ByteString -> TokenResult
ntok)
    TokenResult
TokFailed -> forall v. String -> ParseResult v
Failed String
"More data - lexer failed."

-- | Match all key-value pairs of an object, return them as a tuple.
-- If the source object defines same key multiple times, all values
-- are matched.
objectItems :: Parser a -> Parser (T.Text, a)
objectItems :: forall a. Parser a -> Parser (Text, a)
objectItems Parser a
valparse = forall a. Bool -> (Text -> Parser a) -> Parser a
object' Bool
False forall a b. (a -> b) -> a -> b
$ \(!Text
key) -> (Text
key,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
valparse

-- | Match all key-value pairs of an object, return only values.
-- If the source object defines same key multiple times, all values
-- are matched. Keys are ignored.
objectValues :: Parser a -> Parser a
objectValues :: forall a. Parser a -> Parser a
objectValues Parser a
valparse = forall a. Bool -> (Text -> Parser a) -> Parser a
object' Bool
False (forall a b. a -> b -> a
const Parser a
valparse)

-- | Match all key-value pairs of an object, and parse the value based on the key.
-- If the source object defines same key multiple times, all values
-- are matched.
objectKeyValues :: (T.Text -> Parser a) -> Parser a
objectKeyValues :: forall a. (Text -> Parser a) -> Parser a
objectKeyValues = forall a. Bool -> (Text -> Parser a) -> Parser a
object' Bool
False

-- | Match only specific key of an object.
-- This function will return only the first matched value in an object even
-- if the source JSON defines the key multiple times (in violation of the specification).
objectWithKey :: T.Text -> Parser a -> Parser a
objectWithKey :: forall a. Text -> Parser a -> Parser a
objectWithKey Text
name Parser a
valparse = forall a. Bool -> (Text -> Parser a) -> Parser a
object' Bool
True Text -> Parser a
itemFn
  where
    itemFn :: Text -> Parser a
itemFn Text
key
      | Text
key forall a. Eq a => a -> a -> Bool
== Text
name = Parser a
valparse
      | Bool
otherwise = forall a. Parser a
ignoreVal

-- | Parses underlying values and generates a AE.Value
aeValue :: Parser AE.Value
aeValue :: Parser Value
aeValue = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData TokenResult -> Element -> TokenResult -> ParseResult Value
value'
  where
#if MIN_VERSION_aeson(2,0,0)
    tomap :: [(Text, v)] -> KeyMap v
tomap = forall v. [(Key, v)] -> KeyMap v
AEK.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Key
AEK.fromText)
#else
    tomap = HMap.fromList
#endif
    value' :: TokenResult -> Element -> TokenResult -> ParseResult Value
value' TokenResult
tok Element
el TokenResult
ntok =
      case Element
el of
        JValue Value
val -> forall v. v -> ParseResult v -> ParseResult v
Yield Value
val (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        JInteger CLong
val -> forall v. v -> ParseResult v -> ParseResult v
Yield (Scientific -> Value
AE.Number forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
val) (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        StringContent ByteString
_ -> forall a. Parser a -> TokenResult -> ParseResult a
callParse (Text -> Value
AE.String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int -> Parser Text
longString forall a. Maybe a
Nothing) TokenResult
tok
        StringRaw ByteString
bs Bool
True -> forall v. v -> ParseResult v -> ParseResult v
Yield (Text -> Value
AE.String (ByteString -> Text
unsafeDecodeASCII ByteString
bs)) (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        StringRaw ByteString
bs Bool
False -> case ByteString -> Either UnicodeException Text
unescapeText ByteString
bs of
              Right Text
t -> forall v. v -> ParseResult v -> ParseResult v
Yield (Text -> Value
AE.String Text
t) (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
              Left UnicodeException
e -> forall v. String -> ParseResult v
Failed (forall a. Show a => a -> String
show UnicodeException
e)
        Element
ArrayBegin -> Array -> Value
AE.Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
Vec.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> TokenResult -> ParseResult a
callParse (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. Parser a -> Parser a
arrayOf Parser Value
aeValue)) TokenResult
tok
        Element
ObjectBegin -> Object -> Value
AE.Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {v}. [(Text, v)] -> KeyMap v
tomap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> TokenResult -> ParseResult a
callParse (forall a. Parser a -> Parser [a]
manyReverse (forall a. Parser a -> Parser (Text, a)
objectItems Parser Value
aeValue)) TokenResult
tok
        Element
_ -> forall v. String -> ParseResult v
Failed (String
"aeValue - unexpected token: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Element
el)

-- | Identical to @fmap 'reverse' . 'many'@ but more efficient.
-- If you don't care about the order of the results but plan to fully evaluate the list,
-- this can be slightly more efficient than 'many' as it avoids the accumulating thunks.
manyReverse :: Parser a -> Parser [a]
manyReverse :: forall a. Parser a -> Parser [a]
manyReverse Parser a
f = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
ntok -> forall {a}. [a] -> ParseResult a -> ParseResult [a]
loop [] (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
f TokenResult
ntok)
  where
    loop :: [a] -> ParseResult a -> ParseResult [a]
loop [a]
acc (Done ByteString
ctx TokenResult
ntp) = forall v. v -> ParseResult v -> ParseResult v
Yield [a]
acc (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntp)
    loop [a]
acc (MoreData (Parser TokenResult -> ParseResult a
np, ByteString -> TokenResult
ntok)) = forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ([a] -> ParseResult a -> ParseResult [a]
loop [a]
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult a
np), ByteString -> TokenResult
ntok)
    loop [a]
acc (Yield a
v ParseResult a
np) = [a] -> ParseResult a -> ParseResult [a]
loop (a
v forall a. a -> [a] -> [a]
: [a]
acc) ParseResult a
np
    loop [a]
_ (Failed String
err) = forall v. String -> ParseResult v
Failed String
err

-- | Convert a strict aeson value (no object/array) to a value.
-- Non-matching type is ignored and not parsed (unlike 'value')
jvalue :: (AE.Value -> Maybe a) -> (CLong -> Maybe a) -> Parser a
jvalue :: forall a. (Value -> Maybe a) -> (CLong -> Maybe a) -> Parser a
jvalue Value -> Maybe a
convert CLong -> Maybe a
cvtint = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData TokenResult -> Element -> TokenResult -> ParseResult a
value')
  where
    value' :: TokenResult -> Element -> TokenResult -> ParseResult a
value' TokenResult
tok Element
el TokenResult
ntok =
      case Element
el of
        JValue Value
val
          | Just a
convValue <- Value -> Maybe a
convert Value
val  -> forall v. v -> ParseResult v -> ParseResult v
Yield a
convValue (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
          | Bool
otherwise -> forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok
        JInteger CLong
val
          | Just a
convValue <- CLong -> Maybe a
cvtint CLong
val -> forall v. v -> ParseResult v -> ParseResult v
Yield a
convValue (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
          | Bool
otherwise -> forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok
        Element
_ -> forall a. Parser a -> TokenResult -> ParseResult a
callParse forall a. Parser a
ignoreVal TokenResult
tok


longByteString :: Maybe Int -> Parser BS.ByteString
longByteString :: Maybe Int -> Parser ByteString
longByteString Maybe Int
mbounds = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (([ByteString] -> [ByteString])
-> Int
-> TokenResult
-> Element
-> TokenResult
-> ParseResult ByteString
handle forall a. a -> a
id Int
0)
  where
    handle :: ([ByteString] -> [ByteString])
-> Int
-> TokenResult
-> Element
-> TokenResult
-> ParseResult ByteString
handle [ByteString] -> [ByteString]
acc !Int
len TokenResult
tok Element
el TokenResult
ntok =
      case Element
el of
        JValue (AE.String Text
_) -> forall v. String -> ParseResult v
Failed String
"INTERNAL ERROR! - got decoded JValue instead of string"
        StringRaw ByteString
bs Bool
_ -> forall v. v -> ParseResult v -> ParseResult v
Yield ByteString
bs (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        StringContent ByteString
str
          | (Just Int
bounds) <- Maybe Int
mbounds, Int
len forall a. Ord a => a -> a -> Bool
> Int
bounds -- If the string exceeds bounds, discard it
                          -> forall a. Parser a -> TokenResult -> ParseResult a
callParse (forall a. Parser a -> Parser a
ignoreStrRestThen (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"")) TokenResult
ntok
          | Bool
otherwise     -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (([ByteString] -> [ByteString])
-> Int
-> TokenResult
-> Element
-> TokenResult
-> ParseResult ByteString
handle ([ByteString] -> [ByteString]
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
strforall a. a -> [a] -> [a]
:)) (Int
len forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
str)) TokenResult
ntok
        Element
StringEnd -> forall v. v -> ParseResult v -> ParseResult v
Yield ([ByteString] -> ByteString
BS.concat ([ByteString] -> [ByteString]
acc [])) (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        Element
_ ->  forall a. Parser a -> TokenResult -> ParseResult a
callParse forall a. Parser a
ignoreVal TokenResult
tok


-- | Parse raw bytestring value (json string expected), skip parsing otherwise.
-- The returned value is not unescaped.
byteString :: Parser BS.ByteString
byteString :: Parser ByteString
byteString = Maybe Int -> Parser ByteString
longByteString forall a. Maybe a
Nothing

-- | Stops parsing string after the limit is reached. The string will not be matched
-- if it exceeds the size. The size is the size of escaped string including escape
-- characters. 
-- The return value is not unescaped.
safeByteString :: Int -> Parser BS.ByteString
safeByteString :: Int -> Parser ByteString
safeByteString Int
limit = Maybe Int -> Parser ByteString
longByteString (forall a. a -> Maybe a
Just Int
limit)

-- | Match a possibly bounded string roughly limited by a limit
longString :: Maybe Int -> Parser T.Text
longString :: Maybe Int -> Parser Text
longString Maybe Int
mbounds = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (([ByteString] -> [ByteString])
-> Int -> TokenResult -> Element -> TokenResult -> ParseResult Text
handle forall a. a -> a
id Int
0)
  where
    handle :: ([ByteString] -> [ByteString])
-> Int -> TokenResult -> Element -> TokenResult -> ParseResult Text
handle [ByteString] -> [ByteString]
acc !Int
len TokenResult
tok Element
el TokenResult
ntok =
      case Element
el of
        JValue (AE.String Text
str) -> forall v. v -> ParseResult v -> ParseResult v
Yield Text
str (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        StringRaw ByteString
bs Bool
True -> forall v. v -> ParseResult v -> ParseResult v
Yield (ByteString -> Text
unsafeDecodeASCII ByteString
bs) (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        StringRaw ByteString
bs Bool
False -> 
          case ByteString -> Either UnicodeException Text
unescapeText ByteString
bs of
            Right Text
t -> forall v. v -> ParseResult v -> ParseResult v
Yield Text
t (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
            Left UnicodeException
e -> forall v. String -> ParseResult v
Failed (forall a. Show a => a -> String
show UnicodeException
e)
        StringContent ByteString
str
          | (Just Int
bounds) <- Maybe Int
mbounds, Int
len forall a. Ord a => a -> a -> Bool
> Int
bounds -- If the string exceeds bounds, discard it
                          -> forall a. Parser a -> TokenResult -> ParseResult a
callParse (forall a. Parser a -> Parser a
ignoreStrRestThen (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"")) TokenResult
ntok
          | Bool
otherwise     -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (([ByteString] -> [ByteString])
-> Int -> TokenResult -> Element -> TokenResult -> ParseResult Text
handle ([ByteString] -> [ByteString]
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
strforall a. a -> [a] -> [a]
:)) (Int
len forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
str)) TokenResult
ntok
        Element
StringEnd
          | Right Text
val <- ByteString -> Either UnicodeException Text
unescapeText ([ByteString] -> ByteString
BS.concat ([ByteString] -> [ByteString]
acc []))
                      -> forall v. v -> ParseResult v -> ParseResult v
Yield Text
val (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
          | Bool
otherwise -> forall v. String -> ParseResult v
Failed String
"Error decoding UTF8"
        Element
_ ->  forall a. Parser a -> TokenResult -> ParseResult a
callParse forall a. Parser a
ignoreVal TokenResult
tok

-- | Parse string value, skip parsing otherwise.
string :: Parser T.Text
string :: Parser Text
string = Maybe Int -> Parser Text
longString forall a. Maybe a
Nothing

-- | Stops parsing string after the limit is reached. The string will not be matched
-- if it exceeds the size. The size is the size of escaped string including escape
-- characters.
safeString :: Int -> Parser T.Text
safeString :: Int -> Parser Text
safeString Int
limit = Maybe Int -> Parser Text
longString (forall a. a -> Maybe a
Just Int
limit)

-- | Parse number, return in scientific format.
number :: Parser Scientific
number :: Parser Scientific
number = forall a. (Value -> Maybe a) -> (CLong -> Maybe a) -> Parser a
jvalue Value -> Maybe Scientific
cvt (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)
  where
    cvt :: Value -> Maybe Scientific
cvt (AE.Number Scientific
num) = forall a. a -> Maybe a
Just Scientific
num
    cvt Value
_ = forall a. Maybe a
Nothing

-- | Parse to bounded integer type (not 'Integer').
-- If you are using integer numbers, use this parser.
-- It skips the conversion JSON -> 'Scientific' -> 'Int' and uses an 'Int' directly.
integer :: forall i. (Integral i, Bounded i) => Parser i
integer :: forall i. (Integral i, Bounded i) => Parser i
integer = forall a. (Value -> Maybe a) -> (CLong -> Maybe a) -> Parser a
jvalue forall {i}. (Integral i, Bounded i) => Value -> Maybe i
cvt CLong -> Maybe i
clongToBounded
  where
    clmax :: Integer
clmax = forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: CLong)
    clmin :: Integer
clmin = forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: CLong)
    imax :: Integer
imax = forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: i)
    imin :: Integer
imin = forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: i)
    -- Int is generally CLong, so we get this
    clongIsSmaller :: Bool
clongIsSmaller = Integer
clmax forall a. Ord a => a -> a -> Bool
<= Integer
imax Bool -> Bool -> Bool
&& Integer
clmin forall a. Ord a => a -> a -> Bool
>= Integer
imin
    -- If partial, we have to convert to Integer to do the checking
    clongIsPartial :: Bool
clongIsPartial = Integer
clmax forall a. Ord a => a -> a -> Bool
< Integer
imax Bool -> Bool -> Bool
|| Integer
clmin forall a. Ord a => a -> a -> Bool
> Integer
imin

    inBounds :: a -> Bool
inBounds a
num
      | Bool
clongIsPartial = forall a. Integral a => a -> Integer
toInteger a
num forall a. Ord a => a -> a -> Bool
<= Integer
imax Bool -> Bool -> Bool
&& forall a. Integral a => a -> Integer
toInteger a
num forall a. Ord a => a -> a -> Bool
>= Integer
imin
      | Bool
otherwise = a
num forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: i) Bool -> Bool -> Bool
&& a
num forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: i)

    clongToBounded :: CLong -> Maybe i
    clongToBounded :: CLong -> Maybe i
clongToBounded CLong
num
      | Bool
clongIsSmaller Bool -> Bool -> Bool
|| forall {a}. Integral a => a -> Bool
inBounds CLong
num = forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
num)
      | Bool
otherwise = forall a. Maybe a
Nothing

    cvt :: Value -> Maybe i
cvt (AE.Number Scientific
num)
      | Scientific -> Bool
isInteger Scientific
num = forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
num
    cvt Value
_ = forall a. Maybe a
Nothing

-- | Parse to float/double.
real :: RealFloat a => Parser a
real :: forall a. RealFloat a => Parser a
real = forall a. (Value -> Maybe a) -> (CLong -> Maybe a) -> Parser a
jvalue forall {a}. RealFloat a => Value -> Maybe a
cvt (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)
  where
    cvt :: Value -> Maybe a
cvt (AE.Number Scientific
num) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
num
    cvt Value
_ = forall a. Maybe a
Nothing

-- | Parse bool, skip if the type is not bool.
bool :: Parser Bool
bool :: Parser Bool
bool = forall a. (Value -> Maybe a) -> (CLong -> Maybe a) -> Parser a
jvalue Value -> Maybe Bool
cvt (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
  where
    cvt :: Value -> Maybe Bool
cvt (AE.Bool Bool
b) = forall a. a -> Maybe a
Just Bool
b
    cvt Value
_ = forall a. Maybe a
Nothing

-- | Match a null value.
jNull :: Parser ()
jNull :: Parser ()
jNull = forall a. (Value -> Maybe a) -> (CLong -> Maybe a) -> Parser a
jvalue Value -> Maybe ()
cvt (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
  where
    cvt :: Value -> Maybe ()
cvt (Value
AE.Null) = forall a. a -> Maybe a
Just ()
    cvt Value
_ = forall a. Maybe a
Nothing

-- | Parses a field with a possible null value.
nullable :: Parser a -> Parser (Maybe a)
nullable :: forall a. Parser a -> Parser (Maybe a)
nullable Parser a
valparse = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData TokenResult -> Element -> TokenResult -> ParseResult (Maybe a)
value')
  where
    value' :: TokenResult -> Element -> TokenResult -> ParseResult (Maybe a)
value' TokenResult
_ (JValue Value
AE.Null) TokenResult
ntok = forall v. v -> ParseResult v -> ParseResult v
Yield forall a. Maybe a
Nothing (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
    value' TokenResult
tok Element
_ TokenResult
_ = forall a. Parser a -> TokenResult -> ParseResult a
callParse (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
valparse) TokenResult
tok

-- | Match values with a 'AE.Parser'.  Returns values for which the given parser succeeds.
valueWith :: (AE.Value -> AE.Parser a) -> Parser a
valueWith :: forall a. (Value -> Parser a) -> Parser a
valueWith Value -> Parser a
jparser = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
ntok -> ParseResult Value -> ParseResult a
loop (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser Value
aeValue TokenResult
ntok)
  where
    loop :: ParseResult Value -> ParseResult a
loop (Done ByteString
ctx TokenResult
ntp) = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntp
    loop (Failed String
err) = forall v. String -> ParseResult v
Failed String
err
    loop (MoreData (Parser TokenResult -> ParseResult Value
np, ByteString -> TokenResult
ntok)) = forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (ParseResult Value -> ParseResult a
loop forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult Value
np), ByteString -> TokenResult
ntok)
    loop (Yield Value
v ParseResult Value
np) =
      case forall a b. (a -> Parser b) -> a -> Result b
AE.parse Value -> Parser a
jparser Value
v of
        AE.Error String
_ -> ParseResult Value -> ParseResult a
loop ParseResult Value
np
        AE.Success a
res -> forall v. v -> ParseResult v -> ParseResult v
Yield a
res (ParseResult Value -> ParseResult a
loop ParseResult Value
np)

-- | Match 'AE.FromJSON' value. Equivalent to @'valueWith' 'AE.parseJSON'@.
--
-- >>> let json = "[{\"key1\": [1,2], \"key2\": [5,6]}]"
-- >>> parseByteString (arrayOf value) json :: [AE.Value]
-- [Object (fromList [("key2",Array [Number 5.0,Number 6.0]),("key1",Array [Number 1.0,Number 2.0])])]
value :: AE.FromJSON a => Parser a
value :: forall a. FromJSON a => Parser a
value = forall a. (Value -> Parser a) -> Parser a
valueWith forall a. FromJSON a => Value -> Parser a
AE.parseJSON

-- | Take maximum n matching items.
--
-- >>> parseByteString (takeI 3 $ arrayOf integer) "[1,2,3,4,5,6,7,8,9,0]" :: [Int]
-- [1,2,3]
takeI :: Int -> Parser a -> Parser a
takeI :: forall a. Int -> Parser a -> Parser a
takeI Int
num Parser a
valparse = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> forall {t} {v}.
(Eq t, Num t) =>
t -> ParseResult v -> ParseResult v
loop Int
num (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
valparse TokenResult
tok)
  where
    loop :: t -> ParseResult v -> ParseResult v
loop t
_ (Done ByteString
ctx TokenResult
ntp) = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntp
    loop t
_ (Failed String
err) = forall v. String -> ParseResult v
Failed String
err
    loop t
n (MoreData (Parser TokenResult -> ParseResult v
np, ByteString -> TokenResult
ntok)) = forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (t -> ParseResult v -> ParseResult v
loop t
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult v
np), ByteString -> TokenResult
ntok)
    loop t
0 (Yield v
_ ParseResult v
np) = t -> ParseResult v -> ParseResult v
loop t
0 ParseResult v
np
    loop t
n (Yield v
v ParseResult v
np) = forall v. v -> ParseResult v -> ParseResult v
Yield v
v (t -> ParseResult v -> ParseResult v
loop (t
nforall a. Num a => a -> a -> a
-t
1) ParseResult v
np)

-- | Skip rest of string + call next parser
ignoreStrRestThen :: Parser a -> Parser a
ignoreStrRestThen :: forall a. Parser a -> Parser a
ignoreStrRestThen Parser a
next = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData TokenResult -> Element -> TokenResult -> ParseResult a
handle
  where
    handle :: TokenResult -> Element -> TokenResult -> ParseResult a
handle TokenResult
_ Element
el TokenResult
ntok =
      case Element
el of
        StringContent ByteString
_ -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData TokenResult -> Element -> TokenResult -> ParseResult a
handle TokenResult
ntok
        Element
StringEnd -> forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
next TokenResult
ntok
        Element
_ -> forall v. String -> ParseResult v
Failed String
"Unexpected result in ignoreStrRestPlusOne"


-- | Skip value; cheat to avoid parsing and make it faster
ignoreVal :: Parser a
ignoreVal :: forall a. Parser a
ignoreVal = forall a. Int -> Parser a
ignoreVal' Int
0

ignoreVal' :: Int -> Parser a
ignoreVal' :: forall a. Int -> Parser a
ignoreVal' Int
stval = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok Int
stval)
  where
    handleLongString :: Int -> TokenResult -> Element -> TokenResult -> ParseResult v
handleLongString Int
level TokenResult
_ (StringContent ByteString
_) TokenResult
ntok = forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Int -> TokenResult -> Element -> TokenResult -> ParseResult v
handleLongString Int
level) TokenResult
ntok
    handleLongString Int
0 TokenResult
_ Element
StringEnd TokenResult
ntok = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok
    handleLongString Int
level TokenResult
_ Element
StringEnd TokenResult
ntok = forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok Int
level) TokenResult
ntok
    handleLongString Int
_ TokenResult
_ Element
el TokenResult
_ = forall v. String -> ParseResult v
Failed forall a b. (a -> b) -> a -> b
$ String
"Unexpected element in handleLongStr: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Element
el

    handleTok :: Int -> TokenResult -> Element -> TokenResult -> ParseResult a
    handleTok :: forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok Int
0 TokenResult
_ (JValue Value
_) TokenResult
ntok = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok
    handleTok Int
0 TokenResult
_ (StringRaw ByteString
_ Bool
_) TokenResult
ntok = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok
    handleTok Int
0 TokenResult
_ (JInteger CLong
_) TokenResult
ntok = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok
    handleTok Int
0 TokenResult
_ (ArrayEnd ByteString
_) TokenResult
_ = forall v. String -> ParseResult v
Failed String
"ArrayEnd in ignoreval on 0 level"
    handleTok Int
0 TokenResult
_ (ObjectEnd ByteString
_) TokenResult
_ = forall v. String -> ParseResult v
Failed String
"ObjectEnd in ignoreval on 0 level"
    handleTok Int
1 TokenResult
_ (ArrayEnd ByteString
ctx) TokenResult
ntok = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok
    handleTok Int
1 TokenResult
_ (ObjectEnd ByteString
ctx) TokenResult
ntok = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok
    handleTok Int
level TokenResult
_ Element
el TokenResult
ntok =
      case Element
el of
        JValue Value
_ -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok Int
level) TokenResult
ntok
        JInteger CLong
_ -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok Int
level) TokenResult
ntok
        StringContent ByteString
_ -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleLongString Int
level) TokenResult
ntok
        StringRaw ByteString
_ Bool
_ -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok Int
level) TokenResult
ntok
        ArrayEnd ByteString
_ -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok (Int
level forall a. Num a => a -> a -> a
- Int
1)) TokenResult
ntok
        ObjectEnd ByteString
_ -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok (Int
level forall a. Num a => a -> a -> a
- Int
1)) TokenResult
ntok
        Element
ArrayBegin -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok (Int
level forall a. Num a => a -> a -> a
+ Int
1)) TokenResult
ntok
        Element
ObjectBegin -> forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok (Int
level forall a. Num a => a -> a -> a
+ Int
1)) TokenResult
ntok
        Element
StringEnd -> forall v. String -> ParseResult v
Failed String
"Internal error - out of order StringEnd"

-- | Let only items matching a condition pass.
--
-- >>> parseByteString (filterI (>5) $ arrayOf integer) "[1,2,3,4,5,6,7,8,9,0]" :: [Int]
-- [6,7,8,9]
filterI :: (a -> Bool) -> Parser a -> Parser a
filterI :: forall a. (a -> Bool) -> Parser a -> Parser a
filterI a -> Bool
cond Parser a
valparse = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
ntok -> ParseResult a -> ParseResult a
loop (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
valparse TokenResult
ntok)
  where
    loop :: ParseResult a -> ParseResult a
loop (Done ByteString
ctx TokenResult
ntp) = forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntp
    loop (Failed String
err) = forall v. String -> ParseResult v
Failed String
err
    loop (MoreData (Parser TokenResult -> ParseResult a
np, ByteString -> TokenResult
ntok)) = forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (ParseResult a -> ParseResult a
loop forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult a
np), ByteString -> TokenResult
ntok)
    loop (Yield a
v ParseResult a
np)
      | a -> Bool
cond a
v = forall v. v -> ParseResult v -> ParseResult v
Yield a
v (ParseResult a -> ParseResult a
loop ParseResult a
np)
      | Bool
otherwise = ParseResult a -> ParseResult a
loop ParseResult a
np

-- | A back-door for lifting of possibly failing actions.
-- If an action fails with Left value, convert it into failure
-- of parsing
mapWithFailure :: (a -> Either String b) -> Parser a -> Parser b
mapWithFailure :: forall a b. (a -> Either String b) -> Parser a -> Parser b
mapWithFailure a -> Either String b
mapping =
  Parser a -> Parser b
updateParser
  where
    updateParser :: Parser a -> Parser b
updateParser (Parser TokenResult -> ParseResult a
run) = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ ParseResult a -> ParseResult b
updateParseResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult a
run
    updateParseResult :: ParseResult a -> ParseResult b
updateParseResult ParseResult a
x = case ParseResult a
x of
      MoreData (Parser a
parser, ByteString -> TokenResult
continuation) -> forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (Parser a -> Parser b
updateParser Parser a
parser, ByteString -> TokenResult
continuation)
      Failed String
message -> forall v. String -> ParseResult v
Failed String
message
      Done ByteString
a TokenResult
b -> forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
a TokenResult
b
      Yield a
val ParseResult a
parseResult -> case a -> Either String b
mapping a
val of
        Left String
message -> forall v. String -> ParseResult v
Failed String
message
        Right b
val' -> forall v. v -> ParseResult v -> ParseResult v
Yield b
val' (ParseResult a -> ParseResult b
updateParseResult ParseResult a
parseResult)

--- Convenience operators

-- | Synonym for 'objectWithKey'. Matches key in an object. The '.:' operators can be chained.
--
-- >>> let json = "{\"key1\": {\"nested-key\": 3}}"
-- >>> parseByteString ("key1" .: "nested-key" .: integer) json :: [Int]
-- [3]
(.:) :: T.Text -> Parser a -> Parser a
.: :: forall a. Text -> Parser a -> Parser a
(.:) = forall a. Text -> Parser a -> Parser a
objectWithKey
infixr 7 .:

-- | Returns 'Nothing' if value is null or does not exist or match. Otherwise returns 'Just' value.
--
-- > key .:? val = optional (key .: val)
(.:?) :: T.Text -> Parser a -> Parser (Maybe a)
Text
key .:? :: forall a. Text -> Parser a -> Parser (Maybe a)
.:? Parser a
val = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text
key forall a. Text -> Parser a -> Parser a
.: Parser a
val)
infixr 7 .:?

-- | Return default value if the parsers on the left hand didn't produce a result.
--
-- > p .| defval = p <|> pure defval
--
-- The operator works on complete left side, the following statements are equal:
--
-- > Record <$>  "key1" .: "nested-key" .: value .| defaultValue
-- > Record <$> (("key1" .: "nested-key" .: value) .| defaultValue)
(.|) :: Parser a -> a -> Parser a
Parser a
p .| :: forall a. Parser a -> a -> Parser a
.| a
defval = Parser a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
defval
infixl 6 .|


-- | Synonym for 'arrayWithIndexOf'. Matches n-th item in array.
--
-- >>> parseByteString (arrayOf (1 .! bool)) "[ [1,true,null], [2,false], [3]]" :: [Bool]
-- [True,False]
(.!) :: Int -> Parser a -> Parser a
.! :: forall a. Int -> Parser a -> Parser a
(.!) = forall a. Int -> Parser a -> Parser a
arrayWithIndexOf
infixr 7 .!

---

-- | Result of parsing. Contains continuations to continue parsing.
data ParseOutput a = ParseYield a (ParseOutput a) -- ^ Returns a value from a parser.
                    | ParseNeedData (BS.ByteString -> ParseOutput a) -- ^ Parser needs more data to continue parsing.
                    | ParseFailed String -- ^ Parsing failed, error is reported.
                    | ParseDone BS.ByteString -- ^ Parsing finished, unparsed data is returned.

-- | Run streaming parser with initial input.
runParser' :: Parser a -> BS.ByteString -> ParseOutput a
runParser' :: forall a. Parser a -> ByteString -> ParseOutput a
runParser' Parser a
parser ByteString
startdata = forall {a}. ParseResult a -> ParseOutput a
parse forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
parser (ByteString -> TokenResult
tokenParser ByteString
startdata)
  where
    parse :: ParseResult a -> ParseOutput a
parse (MoreData (Parser a
np, ByteString -> TokenResult
ntok)) = forall a. (ByteString -> ParseOutput a) -> ParseOutput a
ParseNeedData (ParseResult a -> ParseOutput a
parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
np forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString -> TokenResult
ntok)
    parse (Failed String
err) = forall a. String -> ParseOutput a
ParseFailed String
err
    parse (Yield a
v ParseResult a
np) = forall a. a -> ParseOutput a -> ParseOutput a
ParseYield a
v (ParseResult a -> ParseOutput a
parse ParseResult a
np)
    parse (Done ByteString
ctx TokenResult
_) = forall a. ByteString -> ParseOutput a
ParseDone ByteString
ctx

-- | Run streaming parser, immediately returns 'ParseNeedData'.
runParser :: Parser a -> ParseOutput a
runParser :: forall a. Parser a -> ParseOutput a
runParser Parser a
parser = forall a. Parser a -> ByteString -> ParseOutput a
runParser' Parser a
parser ByteString
BS.empty

-- | Parse a bytestring, generate lazy list of parsed values. If an error occurs, throws an exception.
--
-- >>> parseByteString (arrayOf integer) "[1,2,3,4]" :: [Int]
-- [1,2,3,4]
--
-- >>> parseByteString (arrayOf ("name" .: string)) "[{\"name\":\"KIWI\"}, {\"name\":\"BIRD\"}]"
-- ["KIWI","BIRD"]
parseByteString :: Parser a -> BS.ByteString -> [a]
parseByteString :: forall a. Parser a -> ByteString -> [a]
parseByteString Parser a
parser ByteString
startdata = forall {a}. ParseOutput a -> [a]
loop (forall a. Parser a -> ByteString -> ParseOutput a
runParser' Parser a
parser ByteString
startdata)
  where
    loop :: ParseOutput a -> [a]
loop (ParseNeedData ByteString -> ParseOutput a
_) = forall a. HasCallStack => String -> a
error String
"Not enough data."
    loop (ParseDone ByteString
_) = []
    loop (ParseFailed String
err) = forall a. HasCallStack => String -> a
error String
err
    loop (ParseYield a
v ParseOutput a
np) = a
v forall a. a -> [a] -> [a]
: ParseOutput a -> [a]
loop ParseOutput a
np

-- | Parse a lazy bytestring, generate lazy list of parsed values. If an error occurs, throws an exception.
parseLazyByteString :: Parser a -> BL.ByteString -> [a]
parseLazyByteString :: forall a. Parser a -> ByteString -> [a]
parseLazyByteString Parser a
parser ByteString
input = forall {a}. ByteString -> ParseOutput a -> [a]
loop ByteString
input (forall a. Parser a -> ParseOutput a
runParser Parser a
parser)
  where
    loop :: ByteString -> ParseOutput a -> [a]
loop ByteString
BL.Empty (ParseNeedData ByteString -> ParseOutput a
_) = forall a. HasCallStack => String -> a
error String
"Not enough data."
    loop (BL.Chunk ByteString
dta ByteString
rest) (ParseNeedData ByteString -> ParseOutput a
np) = ByteString -> ParseOutput a -> [a]
loop ByteString
rest (ByteString -> ParseOutput a
np ByteString
dta)
    loop ByteString
_ (ParseDone ByteString
_) = []
    loop ByteString
_ (ParseFailed String
err) = forall a. HasCallStack => String -> a
error String
err
    loop ByteString
rest (ParseYield a
v ParseOutput a
np) = a
v forall a. a -> [a] -> [a]
: ByteString -> ParseOutput a -> [a]
loop ByteString
rest ParseOutput a
np


-- | Deserialize a JSON value from lazy 'BL.ByteString'.
--
-- If this fails due to incomplete or invalid input, 'Nothing' is returned.
--
-- The input must consist solely of a JSON document, with no trailing data except for whitespace.
decode :: AE.FromJSON a => BL.ByteString -> Maybe a
decode :: forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bs =
  case forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs of
    Right a
val -> forall a. a -> Maybe a
Just a
val
    Left String
_ -> forall a. Maybe a
Nothing

-- | Like 'decode' but returns an error message when decoding fails.
eitherDecode :: AE.FromJSON a => BL.ByteString -> Either String a
eitherDecode :: forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs = forall {a}. ByteString -> ParseOutput a -> Either String a
loop ByteString
bs (forall a. Parser a -> ParseOutput a
runParser forall a. FromJSON a => Parser a
value)
  where
    loop :: ByteString -> ParseOutput a -> Either String a
loop ByteString
BL.Empty (ParseNeedData ByteString -> ParseOutput a
_) = forall a b. a -> Either a b
Left String
"Not enough data."
    loop (BL.Chunk ByteString
dta ByteString
rest) (ParseNeedData ByteString -> ParseOutput a
np) = ByteString -> ParseOutput a -> Either String a
loop ByteString
rest (ByteString -> ParseOutput a
np ByteString
dta)
    loop ByteString
_ (ParseDone ByteString
_) = forall a b. a -> Either a b
Left String
"Nothing parsed."
    loop ByteString
_ (ParseFailed String
err) = forall a b. a -> Either a b
Left String
err
    loop ByteString
rest (ParseYield a
v ParseOutput a
next) = forall {t} {a}. t -> ParseOutput a -> ByteString -> Either String t
checkExit a
v ParseOutput a
next ByteString
rest

    checkExit :: t -> ParseOutput a -> ByteString -> Either String t
checkExit t
v (ParseDone ByteString
srest) ByteString
rest
      | (Char -> Bool) -> ByteString -> Bool
BS.all Char -> Bool
isSpace ByteString
srest Bool -> Bool -> Bool
&& (Char -> Bool) -> ByteString -> Bool
BL.all Char -> Bool
isSpace ByteString
rest = forall a b. b -> Either a b
Right t
v
      | Bool
otherwise = forall a b. a -> Either a b
Left String
"Data followed by non-whitespace characters."
    checkExit t
_ (ParseYield a
_ ParseOutput a
_) ByteString
_ = forall a b. a -> Either a b
Left String
"Multiple value parses?"
    checkExit t
_ (ParseFailed String
err) ByteString
_ = forall a b. a -> Either a b
Left String
err
    checkExit t
_ (ParseNeedData ByteString -> ParseOutput a
_) ByteString
BL.Empty = forall a b. a -> Either a b
Left String
"Incomplete json structure."
    checkExit t
v (ParseNeedData ByteString -> ParseOutput a
cont) (BL.Chunk ByteString
dta ByteString
rest) = t -> ParseOutput a -> ByteString -> Either String t
checkExit t
v (ByteString -> ParseOutput a
cont ByteString
dta) ByteString
rest

-- | Like 'decode', but on strict 'BS.ByteString'
decodeStrict :: AE.FromJSON a => BS.ByteString -> Maybe a
decodeStrict :: forall a. FromJSON a => ByteString -> Maybe a
decodeStrict ByteString
bs =
  case forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict ByteString
bs of
    Right a
val -> forall a. a -> Maybe a
Just a
val
    Left String
_ -> forall a. Maybe a
Nothing

-- | Like 'eitherDecode', but on strict 'BS.ByteString'
eitherDecodeStrict :: AE.FromJSON a => BS.ByteString -> Either String a
eitherDecodeStrict :: forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict ByteString
bs =
    case forall a. Parser a -> ByteString -> ParseOutput a
runParser' forall a. FromJSON a => Parser a
value ByteString
bs of
      ParseYield a
next ParseOutput a
v -> forall {a} {a} {b}. IsString a => ParseOutput a -> b -> Either a b
checkExit ParseOutput a
v a
next
      ParseNeedData ByteString -> ParseOutput a
_ -> forall a b. a -> Either a b
Left String
"Incomplete json structure."
      ParseFailed String
err -> forall a b. a -> Either a b
Left String
err
      ParseDone ByteString
_ -> forall a b. a -> Either a b
Left String
"No data found."
  where
    checkExit :: ParseOutput a -> b -> Either a b
checkExit (ParseDone ByteString
rest) b
v
      | (Char -> Bool) -> ByteString -> Bool
BS.all Char -> Bool
isSpace ByteString
rest = forall a b. b -> Either a b
Right b
v
    checkExit ParseOutput a
_ b
_ = forall a b. a -> Either a b
Left a
"Data folowed by non-whitespace characters."

-- $use
--
-- >>> parseByteString value "[1,2,3]" :: [[Int]]
-- [[1,2,3]]
--
-- The 'value' parser matches any 'AE.FromJSON' value. The above command is essentially
-- identical to the aeson decode function; the parsing process can generate more
-- objects, therefore the results is [a].
--
-- Example of json-stream style parsing:
--
-- >>> parseByteString (arrayOf integer) "[1,2,3]" :: [Int]
-- [1,2,3]
--
-- Parsers can be combinated using  '<*>' and '<|>' operators. The parsers are
-- run in parallel and return combinations of the parsed values.
--
-- >>> let text = "[{\"name\": \"John\", \"age\": 20}, {\"age\": 30, \"name\": \"Frank\"} ]"
-- >>> let parser = arrayOf $ (,) <$> "name" .: string <*> "age"  .: integer
-- >>> parseByteString  parser text :: [(T.Text,Int)]
-- [("John",20),("Frank",30)]
--
-- When parsing larger values, it is advisable to use lazy ByteStrings. The parsing
-- is then more memory efficient as less lexical state
-- is needed to be held in memory for parallel parsers.
--
-- More examples are available on <https://github.com/ondrap/json-stream>.


-- $constant
-- Constant space decoding is possible if the grammar does not specify non-constant
-- operations. The non-constant operations are 'value', 'string', 'many' and in some instances
-- '<*>'.
--
-- The 'value' parser works by creating an aeson AST and passing it to the
-- 'parseJSON' method. The AST can consume a lot of memory before it is rejected
-- in 'parseJSON'. To achieve constant space the parsers 'safeString', 'number', 'integer',
-- 'real' and 'bool'
-- must be used; these parsers reject and do not parse data if it does not match the
-- type.
--
-- The object key length is limited to ~64K. Object records with longer key are ignored and unparsed.
--
-- Numbers are limited to 200.000 digits. Longer numbers will make the parsing fail.
--
-- The 'many' parser works by accumulating all matched values. Obviously, number
-- of such values influences the amount of used memory.
--
-- The '<*>' operator runs both parsers in parallel and when they are both done, it
-- produces combinations of the received values. It is constant-space as long as the
-- number of element produced by child parsers is limited by a constant. This can be achieved by using
-- '.!' and '.:' functions combined with constant space
-- parsers or limiting the number of returned elements with 'takeI'.
--
-- If the source object contains an object with multiple keys with a same name,
-- json-stream matches the key multiple times. The only exception
-- is 'objectWithKey' ('.:' and '.:?') that return at most one value for a given key.

-- $aeson
-- The parser uses internally "Data.Aeson" types, so that the FromJSON instances are
-- directly usable with the 'value' parser. It may be more convenient to parse the
-- outer structure with json-stream and the inner objects with aeson as long as constant-space
-- decoding is not required.
--
-- Json-stream defines the object-access operators '.:', '.:?'
-- but in a slightly different albeit more natural way. New operators are '.!' for
-- array access and '.|' to handle missing values.
--
-- >>> let test = "[{\"name\": \"test1\", \"value\": 1}, {\"name\": \"test2\", \"value\": null}, {\"name\": \"test3\"}]"
-- >>> let person = (,) <$> "name" .: string <*> "value" .: integer .| (-1)
-- >>> let people = arrayOf person
-- >>> parseByteString people test :: [(T.Text, Int)]
-- [("test1",1),("test2",-1),("test3",-1)]

-- $performance
-- The parser tries to do the least amount of work to get the job done, skipping over items that
-- are not required. General guidelines to get best performance:
--
-- Do not use the 'value' parser for the whole object if the object is big. Do not use json-stream
-- applicative parsing for creating objects if they have lots of records, unless you are skipping
-- large part of the structure. Every '<*>' causes parallel parsing, too many parallel parsers
-- kill performance.
--
-- > arrayOf value :: Parser MyStructure -- MyStructure with FromJSON instance
--
-- will probably behave better than
--
-- > arrayOf $ MyStructure <$> "field1" .: string <*> "field2" .: integer <*> .... <*> "field20" .: string
--
-- and also better (at least memory-wise) than
--
-- > value :: Parser [MyStructure]
--
-- unless the structure has hundreths of fields and you are parsing only a substructure.
--
-- The 'integer' parser was optimized in such
-- a way that the integer numbers skip the conversion to 'Scientific', resulting in a slightly
-- faster speed.
--
-- It is possible to use the '*>' operator to filter objects based on a condition, e.g.:
--
-- > arrayOf $ id <$> "error" .: number
-- >               *> "name" .: string
--
-- This will return all objects that contain attribute error with number content. The parser will
-- skip trying to decode the name attribute if error is not found.
--