{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

-- |
-- 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 optionally 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
    -- * Fast structure parser
  , objectOf
  , Object
    -- * Parsing modifiers
  , filterI
  , takeI
  , mapWithFailure
  , manyReverse
  , foldI
  , foldMapI
  , unFoldI
  , catMaybeI
    -- * SAX-like parsers
  , arrayFound
  , objectFound
) where

import Control.Applicative ( Alternative(..), optional )
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 ( CLong )

import Data.JsonStream.CLexer ( unescapeText, tokenParser )
import Data.JsonStream.TokenParser ( TokenResult(..), Element(..) )
import Data.JsonStream.Unescape (unsafeDecodeASCII)
import qualified Data.Map.Strict as Map
import Unsafe.Coerce (unsafeCoerce)

-- | 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]
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 =
    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
"Object - 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/TokFailed 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

-- | Fold over values in stream
foldI :: (b -> a -> b) -> b -> Parser a -> Parser b
foldI :: forall b a. (b -> a -> b) -> b -> Parser a -> Parser b
foldI b -> a -> b
mfold b
start Parser a
f = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
ntok -> b -> ParseResult a -> ParseResult b
loop b
start (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
f TokenResult
ntok)
  where
    loop :: b -> ParseResult a -> ParseResult b
loop !b
acc (Done ByteString
ctx TokenResult
ntp) = forall v. v -> ParseResult v -> ParseResult v
Yield b
acc (forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntp)
    loop !b
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 (b -> ParseResult a -> ParseResult b
loop b
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult a
np), ByteString -> TokenResult
ntok)
    loop !b
acc (Yield a
v ParseResult a
np) = b -> ParseResult a -> ParseResult b
loop (b
acc b -> a -> b
`mfold` a
v) ParseResult a
np
    loop b
_ (Failed String
err) = forall v. String -> ParseResult v
Failed String
err

-- | Strict foldMap over values in stream
foldMapI :: Monoid m => (a -> m) -> Parser a -> Parser m
foldMapI :: forall m a. Monoid m => (a -> m) -> Parser a -> Parser m
foldMapI a -> m
f = forall b a. (b -> a -> b) -> b -> Parser a -> Parser b
foldI (\m
b a
a -> m
b forall a. Semigroup a => a -> a -> a
<> a -> m
f a
a) forall a. Monoid a => a
mempty

-- | Filter Nothing values out of a stream
catMaybeI :: Parser (Maybe a) -> Parser a
catMaybeI :: forall a. Parser (Maybe a) -> Parser a
catMaybeI Parser (Maybe a)
valparse = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
ntok -> forall {v}. ParseResult (Maybe v) -> ParseResult v
loop (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser (Maybe a)
valparse TokenResult
ntok)
  where
    loop :: ParseResult (Maybe v) -> ParseResult v
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 (Maybe v)
np, ByteString -> TokenResult
ntok)) = forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (ParseResult (Maybe v) -> ParseResult v
loop forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult (Maybe v)
np), ByteString -> TokenResult
ntok)
    loop (Yield (Just v
v) ParseResult (Maybe v)
np) = forall v. v -> ParseResult v -> ParseResult v
Yield v
v (ParseResult (Maybe v) -> ParseResult v
loop ParseResult (Maybe v)
np)
    loop (Yield Maybe v
Nothing ParseResult (Maybe v)
np) = ParseResult (Maybe v) -> ParseResult v
loop ParseResult (Maybe v)
np

-- | From a list of values generate single values
unFoldI :: Parser [a] -> Parser a
unFoldI :: forall a. Parser [a] -> Parser a
unFoldI Parser [a]
valparse = forall a. (TokenResult -> ParseResult a) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \TokenResult
ntok -> forall {v}. ParseResult [v] -> ParseResult v
loop (forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser [a]
valparse TokenResult
ntok)
  where
    loop :: ParseResult [v] -> ParseResult v
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 [v]
np, ByteString -> TokenResult
ntok)) = forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (ParseResult [v] -> ParseResult v
loop forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult [v]
np), ByteString -> TokenResult
ntok)
    loop (Yield (v
v:[v]
rest) ParseResult [v]
np) = forall v. v -> ParseResult v -> ParseResult v
Yield v
v (ParseResult [v] -> ParseResult v
loop (forall v. v -> ParseResult v -> ParseResult v
Yield [v]
rest ParseResult [v]
np))
    loop (Yield [] ParseResult [v]
np) = ParseResult [v] -> ParseResult v
loop ParseResult [v]
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

class OnObject o a where
  -- | Synonym for 'objectWithKey'. The '.:' operators can be chained.
  --
  -- >>> let json = "{\"key1\": {\"nested-key\": 3}}"
  -- >>> parseByteString ("key1" .: "nested-key" .: integer) json :: [Int]
  -- > [3]
  --
  -- It works both as a standalone parser and as a part of 'objectOf' parser
  --
  -- >>> let test = "[{\"name\": \"test1\", \"value\": 1}, {\"name\": \"test2\", \"value\": null}, {\"name\": \"test3\"}]"
  -- >>> let person = objectOf $ (,) <$> "name" .: string <*> "value" .: integer .| (-1)
  -- >>> let people = arrayOf person
  -- >>> parseByteString people test :: [(T.Text, Int)]
  -- [("test1",1),("test2",-1),("test3",-1)]

  (.:) :: T.Text -> Parser a -> o a
  -- | Returns 'Nothing' if value is null or does not exist or match. Otherwise returns 'Just' value.
  --
  -- > key .:? val = optional (key .: val)
  --
  -- It could be similarly used in the 'objectOf' parser
  (.:?) :: T.Text -> Parser a -> o (Maybe a)

  -- | 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)
  (.|) :: o a -> a -> o a

infixr 7 .:
infixr 7 .:?
infixl 6 .|

instance OnObject Parser a where
  .: :: Text -> Parser a -> Parser a
(.:) = forall a. Text -> Parser a -> Parser a
objectWithKey
  Text
key .:? :: Text -> Parser a -> Parser (Maybe a)
.:? Parser a
val = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text
key forall (o :: * -> *) a. OnObject o a => Text -> Parser a -> o a
.: Parser a
val)
  Parser a
p .| :: 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

instance OnObject Object a where
  .: :: Text -> Parser a -> Object a
(.:) = forall a. Text -> Parser a -> Object a
fastObjectWithKey
  .:? :: Text -> Parser a -> Object (Maybe a)
(.:?) = forall a. Text -> Parser a -> Object (Maybe a)
fastObjectWithKeyMaybe
  (Object Map Text (Parser ())
pmap Map Text [()] -> [a]
out) .| :: Object a -> a -> Object a
.| a
defval = forall f.
Map Text (Parser ()) -> (Map Text [()] -> [f]) -> Object f
Object Map Text (Parser ())
pmap Map Text [()] -> [a]
altFunc
    where
      altFunc :: Map Text [()] -> [a]
altFunc Map Text [()]
dmap = case Map Text [()] -> [a]
out Map Text [()]
dmap of
        [] -> [a
defval]
        [a]
res -> [a]
res

-- | 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."

--- High performance object parsing

-- | Representation for applicative JSON one-pass object parsing
data Object f = Object 
  (Map.Map T.Text (Parser ())) -- ^ Field parsers
  (Map.Map T.Text [()] -> [f]) -- ^ How to generate results from already parsed fields
  deriving (forall a b. a -> Object b -> Object a
forall a b. (a -> b) -> Object a -> Object b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Object b -> Object a
$c<$ :: forall a b. a -> Object b -> Object a
fmap :: forall a b. (a -> b) -> Object a -> Object b
$cfmap :: forall a b. (a -> b) -> Object a -> Object b
Functor)

-- We use unsafeCoerce to convert to () and back; we guarantee that there exists only
-- one key to the map and so the original Parser will get the right type of value.
-- This allows to drop the Typeable constraint, but the code better be OK here.

instance Applicative Object where
  pure :: forall a. a -> Object a
pure a
f = forall f.
Map Text (Parser ()) -> (Map Text [()] -> [f]) -> Object f
Object forall a. Monoid a => a
mempty (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
f))
  (Object Map Text (Parser ())
amap Map Text [()] -> [a -> b]
adata) <*> :: forall a b. Object (a -> b) -> Object a -> Object b
<*> (Object Map Text (Parser ())
bmap Map Text [()] -> [a]
bdata) =
      let dmap :: Map Text (Parser ())
dmap = forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWithKey (\Text
k Parser ()
_ Parser ()
_ -> forall a. HasCallStack => String -> a
error (String
"JStream Object - duplicate field access: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
k)) Map Text (Parser ())
amap Map Text (Parser ())
bmap
      in Map Text (Parser ())
dmap seq :: forall a b. a -> b -> b
`seq` forall f.
Map Text (Parser ()) -> (Map Text [()] -> [f]) -> Object f
Object Map Text (Parser ())
dmap Map Text [()] -> [b]
dfunc
    where
      dfunc :: Map Text [()] -> [b]
dfunc Map Text [()]
dmap = forall a b. (a -> b) -> a -> b
($) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text [()] -> [a -> b]
adata Map Text [()]
dmap forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Text [()] -> [a]
bdata Map Text [()]
dmap

instance Alternative Object where
  empty :: forall a. Object a
empty = forall f.
Map Text (Parser ()) -> (Map Text [()] -> [f]) -> Object f
Object forall a. Monoid a => a
mempty (forall a b. a -> b -> a
const [])
  (Object Map Text (Parser ())
amap Map Text [()] -> [a]
adata) <|> :: forall a. Object a -> Object a -> Object a
<|> (Object Map Text (Parser ())
bmap Map Text [()] -> [a]
bdata) =
      let dmap :: Map Text (Parser ())
dmap = forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWithKey (\Text
k Parser ()
_ Parser ()
_ -> forall a. HasCallStack => String -> a
error (String
"JStream Object - duplicate field access: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
k)) Map Text (Parser ())
amap Map Text (Parser ())
bmap
      in Map Text (Parser ())
dmap seq :: forall a b. a -> b -> b
`seq` forall f.
Map Text (Parser ()) -> (Map Text [()] -> [f]) -> Object f
Object Map Text (Parser ())
dmap Map Text [()] -> [a]
dfunc
    where
      -- Return second one if first one generates nothing
      dfunc :: Map Text [()] -> [a]
dfunc Map Text [()]
dmap =
        case Map Text [()] -> [a]
adata Map Text [()]
dmap of
          [] -> Map Text [()] -> [a]
bdata Map Text [()]
dmap
          [a]
lst -> [a]
lst

instance Semigroup (Object a) where
  (Object Map Text (Parser ())
amap Map Text [()] -> [a]
adata) <> :: Object a -> Object a -> Object a
<> (Object Map Text (Parser ())
bmap Map Text [()] -> [a]
bdata) =
      let dmap :: Map Text (Parser ())
dmap = forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWithKey (\Text
k Parser ()
_ Parser ()
_ -> forall a. HasCallStack => String -> a
error (String
"JStream Object - duplicate field access: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
k)) Map Text (Parser ())
amap Map Text (Parser ())
bmap
      in Map Text (Parser ())
dmap seq :: forall a b. a -> b -> b
`seq` forall f.
Map Text (Parser ()) -> (Map Text [()] -> [f]) -> Object f
Object Map Text (Parser ())
dmap Map Text [()] -> [a]
dfunc
    where
      -- Return second one if first one generates nothing
      dfunc :: Map Text [()] -> [a]
dfunc Map Text [()]
dmap = Map Text [()] -> [a]
adata Map Text [()]
dmap forall a. Semigroup a => a -> a -> a
<> Map Text [()] -> [a]
bdata Map Text [()]
dmap

-- | Similar to 'objectWithKey', generates a field-accessor in JSON object
fastObjectWithKey :: forall a. T.Text -> Parser a -> Object a
fastObjectWithKey :: forall a. Text -> Parser a -> Object a
fastObjectWithKey Text
tname Parser a
parser = forall f.
Map Text (Parser ()) -> (Map Text [()] -> [f]) -> Object f
Object (forall k a. k -> a -> Map k a
Map.singleton Text
tname forall a. Parser a
parseObj) forall {a}. Map Text a -> [a]
mkObj
  where
    mkObj :: Map Text a -> [a]
mkObj Map Text a
dmap = case forall a b. a -> b
unsafeCoerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
tname Map Text a
dmap of
      Just ([a]
vals :: [a]) -> forall a. [a] -> [a]
reverse [a]
vals
      Maybe [a]
Nothing -> []
    parseObj :: Parser b
parseObj = forall a b. a -> b
unsafeCoerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
parser

fastObjectWithKeyMaybe :: forall a. T.Text -> Parser a -> Object (Maybe a)
fastObjectWithKeyMaybe :: forall a. Text -> Parser a -> Object (Maybe a)
fastObjectWithKeyMaybe Text
tname Parser a
parser = forall f.
Map Text (Parser ()) -> (Map Text [()] -> [f]) -> Object f
Object (forall k a. k -> a -> Map k a
Map.singleton Text
tname forall a. Parser a
parseObj) forall {a}. Map Text a -> [Maybe a]
mkObj
  where
    mkObj :: Map Text a -> [Maybe a]
mkObj Map Text a
dmap = case forall a b. a -> b
unsafeCoerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
tname Map Text a
dmap of
      Just ([a]
vals :: [a]) -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> [a]
reverse [a]
vals
      Maybe [a]
Nothing -> [forall a. Maybe a
Nothing]
    parseObj :: Parser b
parseObj = forall a b. a -> b
unsafeCoerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
parser

-- | Parser for faster object parsing
--
-- The whole object is parsed in a single run. Use the '.:' combinator to
-- access the fields; you may not access the same field more than once. If you
-- try to access the same field, an 'error' is called.
--
-- The operators '.:', '.:?', '<|>' and '<>' are supported and will produce
-- the same results as if used directly with parallel parsing.
objectOf :: forall f. Object f -> Parser f
objectOf :: forall f. Object f -> Parser f
objectOf (Object Map Text (Parser ())
pmap Map Text [()] -> [f]
odata) =
  forall a. Parser [a] -> Parser a
unFoldI forall a b. (a -> b) -> a -> b
$ Map Text [()] -> [f]
odata forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Text, ()) -> Parser (Map Text [()])
foldResults (forall a. Bool -> (Text -> Parser a) -> Parser a
object' Bool
False Text -> Parser (Text, ())
parseKey)
  where
    foldResults :: Parser (T.Text, ()) -> Parser (Map.Map T.Text [()])
    foldResults :: Parser (Text, ()) -> Parser (Map Text [()])
foldResults = forall b a. (b -> a -> b) -> b -> Parser a -> Parser b
foldI (\Map Text [()]
bmap (Text
k,()
v) -> forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (forall {a}. a -> Maybe [a] -> Maybe [a]
addVal ()
v) Text
k Map Text [()]
bmap) forall a. Monoid a => a
mempty
      where
        addVal :: a -> Maybe [a] -> Maybe [a]
addVal a
v Maybe [a]
Nothing = forall a. a -> Maybe a
Just [a
v]
        addVal a
v (Just [a]
old) = forall a. a -> Maybe a
Just (a
vforall a. a -> [a] -> [a]
:[a]
old)

    parseKey :: T.Text -> Parser (T.Text, ())
    parseKey :: Text -> Parser (Text, ())
parseKey Text
key = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
key Map Text (Parser ())
pmap of
      Maybe (Parser ())
Nothing -> forall a. Parser a
ignoreVal
      Just Parser ()
p -> (Text
key,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ()
p

-- $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', 'objectOf', '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'.
--
-- Running many parallel parsers (e.g. when parsing objects with a lot of fields) will slow
-- things done. Use the 'objectOf'.
--
-- 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)]
--
-- The above code would run 3 parsers in parallel to get the appropriate results. 
-- You can use the 'objectOf' parser to get a similar result in a more performant way.
--
-- >>> let test = "[{\"name\": \"test1\", \"value\": 1}, {\"name\": \"test2\", \"value\": null}, {\"name\": \"test3\"}]"
-- >>> let person = objectOf $ (,) <$> "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.
-- Consider using the 'objectOf' parser to parse objects instead of direct applicative parsing
-- for creating objects if they have lots of records. Every '<*>' outside of direct 'objectOf' parser
-- causes parallel parsing. Too many parallel parsers kill performance.
--
-- > arrayOf $ objectOf $ MyStructure <$> "field1" .: string <*> "field2" .: integer <*> .... <*> "field20" .: string
--
-- will be the fastest and use the least memory. 
--
-- > arrayOf value :: Parser MyStructure -- MyStructure with FromJSON instance
--
-- will probably still 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.
--