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

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

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

    -- * Performance
    -- $performance

    -- * Constant space decoding
    -- $constant

    -- * Aeson compatibility
    -- $aeson

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

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

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

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

import           Data.JsonStream.CLexer
import           Data.JsonStream.TokenParser

-- | 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 :: (a -> b) -> ParseResult a -> ParseResult b
fmap a -> b
f (MoreData (Parser a
np, ByteString -> TokenResult
ntok)) = (Parser b, ByteString -> TokenResult) -> ParseResult b
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((a -> b) -> Parser a -> Parser b
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) = String -> ParseResult b
forall v. String -> ParseResult v
Failed String
err
  fmap a -> b
_ (Done ByteString
ctx TokenResult
tok) = ByteString -> TokenResult -> ParseResult b
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
tok
  fmap a -> b
f (Yield a
v ParseResult a
np) = b -> ParseResult b -> ParseResult b
forall v. v -> ParseResult v -> ParseResult v
Yield (a -> b
f a
v) ((a -> b) -> ParseResult a -> ParseResult b
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 {
    Parser a -> TokenResult -> ParseResult a
callParse :: TokenResult -> ParseResult a
}

instance Functor Parser where
  fmap :: (a -> b) -> Parser a -> Parser b
fmap a -> b
f (Parser TokenResult -> ParseResult a
p) = (TokenResult -> ParseResult b) -> Parser b
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult b) -> Parser b)
-> (TokenResult -> ParseResult b) -> Parser b
forall a b. (a -> b) -> a -> b
$ \TokenResult
d -> (a -> b) -> ParseResult a -> ParseResult b
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 :: [a] -> ParseResult a -> ParseResult a
yieldResults [a]
values ParseResult a
end = (a -> ParseResult a -> ParseResult a)
-> ParseResult a -> [a] -> ParseResult a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> ParseResult a -> ParseResult a
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 :: a -> Parser a
pure a
x = (TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult a) -> Parser a)
-> (TokenResult -> ParseResult a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> ParseResult Any -> ParseResult a
forall a. ParseResult a -> ParseResult a
process (Parser Any -> TokenResult -> ParseResult Any
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser Any
forall a. Parser a
ignoreVal TokenResult
tok)
    where
      process :: ParseResult a -> ParseResult a
process (Failed String
err) = String -> ParseResult a
forall v. String -> ParseResult v
Failed String
err
      process (Done ByteString
ctx TokenResult
tok) = a -> ParseResult a -> ParseResult a
forall v. v -> ParseResult v -> ParseResult v
Yield a
x (ByteString -> TokenResult -> ParseResult a
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
tok)
      process (MoreData (Parser a
np, ByteString -> TokenResult
ntok)) = (Parser a, ByteString -> TokenResult) -> ParseResult a
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (ParseResult a -> ParseResult a
process (ParseResult a -> ParseResult a)
-> (TokenResult -> ParseResult a) -> TokenResult -> ParseResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
np), ByteString -> TokenResult
ntok)
      process ParseResult a
_ = String -> ParseResult a
forall v. String -> ParseResult v
Failed String
"Internal error in pure, ignoreVal doesn't yield"

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


-- | '<>' will run both parsers in parallel yielding from both as the data comes
--
-- >>> :m +Data.Monoid
-- >>> let test = "[{\"key1\": [1,2], \"key2\": [5,6], \"key3\": [8,9]}]"
-- >>> let parser = arrayOf $ "key1" .: (arrayOf value) <> "key2" .: (arrayOf value)
-- >>> parseByteString parser test :: [Int]
-- [1,2,5,6]
#if MIN_VERSION_base(4,10,0)
instance Monoid (Parser a) where
  mempty :: Parser a
mempty = Parser a
forall a. Parser a
ignoreVal
  mappend :: Parser a -> Parser a -> Parser a
mappend = Parser a -> Parser a -> Parser a
forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup (Parser a) where
  <> :: Parser a -> Parser a -> Parser a
(<>) Parser a
m1 Parser a
m2 =
#else
instance Monoid (Parser a) where
  mempty = ignoreVal
  mappend m1 m2 =
#endif
    (TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult a) -> Parser a)
-> (TokenResult -> ParseResult a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> ParseResult a -> ParseResult a -> ParseResult a
forall v. ParseResult v -> ParseResult v -> ParseResult v
process (Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
m1 TokenResult
tok) (Parser a -> TokenResult -> ParseResult a
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 = v -> ParseResult v -> ParseResult v
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) = v -> ParseResult v -> ParseResult v
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 {} = ByteString -> TokenResult -> ParseResult v
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
_)) =
          (Parser v, ByteString -> TokenResult) -> ParseResult v
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((TokenResult -> ParseResult v) -> Parser v
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult v) -> Parser v)
-> (TokenResult -> ParseResult v) -> Parser v
forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> ParseResult v -> ParseResult v -> ParseResult v
process (Parser v -> TokenResult -> ParseResult v
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser v
np1 TokenResult
tok) (Parser v -> TokenResult -> ParseResult v
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser v
np2 TokenResult
tok), ByteString -> TokenResult
ntok)
      process (Failed String
err) ParseResult v
_ = String -> ParseResult v
forall v. String -> ParseResult v
Failed String
err
      process ParseResult v
_ (Failed String
err) = String -> ParseResult v
forall v. String -> ParseResult v
Failed String
err
      process ParseResult v
_ ParseResult v
_ = String -> 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 :: Parser a
empty = Parser a
forall a. Parser a
ignoreVal
  Parser a
m1 <|> :: Parser a -> Parser a -> Parser a
<|> Parser a
m2 = (TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult a) -> Parser a)
-> (TokenResult -> ParseResult a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> [a] -> ParseResult a -> Maybe (ParseResult a) -> ParseResult a
forall v.
[v] -> ParseResult v -> Maybe (ParseResult v) -> ParseResult v
process [] (Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
m1 TokenResult
tok) (ParseResult a -> Maybe (ParseResult a)
forall a. a -> Maybe a
Just (ParseResult a -> Maybe (ParseResult a))
-> ParseResult a -> Maybe (ParseResult a)
forall a b. (a -> b) -> a -> b
$ Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
m2 TokenResult
tok)
    where
      -- First returned item -> disable second parser
      process :: [v] -> ParseResult v -> Maybe (ParseResult v) -> ParseResult v
process [v]
_ (Yield v
v ParseResult v
np1) Maybe (ParseResult v)
_ = v -> ParseResult v -> ParseResult v
forall v. v -> ParseResult v -> ParseResult v
Yield v
v ([v] -> ParseResult v -> Maybe (ParseResult v) -> ParseResult v
process [] ParseResult v
np1 Maybe (ParseResult v)
forall a. Maybe a
Nothing)
      -- First done with disabled second -> exit
      process [v]
_ (Done ByteString
ctx TokenResult
ntok) Maybe (ParseResult v)
Nothing = ByteString -> TokenResult -> ParseResult v
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok
      -- Both done but second not disabled -> yield items from the second
      process [v]
lst (Done ByteString
ctx TokenResult
ntok) (Just (Done {})) = [v] -> ParseResult v -> ParseResult v
forall a. [a] -> ParseResult a -> ParseResult a
yieldResults ([v] -> [v]
forall a. [a] -> [a]
reverse [v]
lst) (ByteString -> TokenResult -> ParseResult v
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok)
      -- Second yield - remember data
      process [v]
lst ParseResult v
np1 (Just (Yield v
v ParseResult v
np2)) = [v] -> ParseResult v -> Maybe (ParseResult v) -> ParseResult v
process (v
vv -> [v] -> [v]
forall a. a -> [a] -> [a]
:[v]
lst) ParseResult v
np1 (ParseResult v -> Maybe (ParseResult v)
forall a. a -> Maybe a
Just ParseResult v
np2)
      -- Moredata processing
      process [v]
lst (MoreData (Parser v
np1, ByteString -> TokenResult
ntok)) Maybe (ParseResult v)
Nothing =
          (Parser v, ByteString -> TokenResult) -> ParseResult v
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((TokenResult -> ParseResult v) -> Parser v
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult v) -> Parser v)
-> (TokenResult -> ParseResult v) -> Parser v
forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> [v] -> ParseResult v -> Maybe (ParseResult v) -> ParseResult v
process [v]
lst (Parser v -> TokenResult -> ParseResult v
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser v
np1 TokenResult
tok) Maybe (ParseResult v)
forall a. Maybe a
Nothing, ByteString -> TokenResult
ntok)
      process [v]
lst (MoreData (Parser v
np1, ByteString -> TokenResult
ntok)) (Just (MoreData (Parser v
np2, ByteString -> TokenResult
_))) =
          (Parser v, ByteString -> TokenResult) -> ParseResult v
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((TokenResult -> ParseResult v) -> Parser v
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult v) -> Parser v)
-> (TokenResult -> ParseResult v) -> Parser v
forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> [v] -> ParseResult v -> Maybe (ParseResult v) -> ParseResult v
process [v]
lst (Parser v -> TokenResult -> ParseResult v
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser v
np1 TokenResult
tok) (ParseResult v -> Maybe (ParseResult v)
forall a. a -> Maybe a
Just (ParseResult v -> Maybe (ParseResult v))
-> ParseResult v -> Maybe (ParseResult v)
forall a b. (a -> b) -> a -> b
$ Parser v -> TokenResult -> ParseResult v
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser v
np2 TokenResult
tok), ByteString -> TokenResult
ntok)
      process [v]
_ (Failed String
err) Maybe (ParseResult v)
_ = String -> ParseResult v
forall v. String -> ParseResult v
Failed String
err
      process [v]
_ ParseResult v
_ (Just (Failed String
err)) = String -> ParseResult v
forall v. String -> ParseResult v
Failed String
err
      process [v]
_ ParseResult v
_ Maybe (ParseResult v)
_ = String -> ParseResult v
forall v. String -> ParseResult v
Failed String
"Unexpected error in parallel processing <|>"

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

array' :: (Int -> Parser a) -> Parser a
array' :: (Int -> Parser a) -> Parser a
array' Int -> Parser a
valparse = (TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult a) -> Parser a)
-> (TokenResult -> ParseResult a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \TokenResult
tp ->
  case TokenResult
tp of
    (PartialResult Element
ArrayBegin TokenResult
ntp) -> (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
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
_) -> Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
forall a. Parser a
ignoreVal TokenResult
tp -- Run ignoreval parser on the same output we got
    (TokMoreData ByteString -> TokenResult
ntok) -> (Parser a, ByteString -> TokenResult) -> ParseResult a
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((Int -> Parser a) -> Parser a
forall a. (Int -> Parser a) -> Parser a
array' Int -> Parser a
valparse, ByteString -> TokenResult
ntok)
    (TokenResult
TokFailed) -> String -> ParseResult a
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 = ByteString -> TokenResult -> ParseResult a
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 (Parser a -> TokenResult -> ParseResult a
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) = (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Int -> TokenResult -> Element -> TokenResult -> ParseResult a
nextitem (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) TokenResult
ntp
    arrcontent !Int
i (MoreData (Parser TokenResult -> ParseResult a
np, ByteString -> TokenResult
ntp)) = (Parser a, ByteString -> TokenResult) -> ParseResult a
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (Int -> ParseResult a -> ParseResult a
arrcontent Int
i (ParseResult a -> ParseResult a)
-> (TokenResult -> ParseResult a) -> TokenResult -> ParseResult a
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) = a -> ParseResult a -> ParseResult a
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) = String -> ParseResult a
forall v. String -> ParseResult v
Failed String
err

-- | Match all items of an array.
arrayOf :: Parser a -> Parser a
arrayOf :: Parser a -> Parser a
arrayOf Parser a
valparse = (Int -> Parser a) -> Parser a
forall a. (Int -> Parser a) -> Parser a
array' (Parser a -> Int -> Parser a
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 :: Element -> a -> a -> Parser a -> Parser a
elemFound Element
elsearch a
start a
end Parser a
parser = (TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult a) -> Parser a)
-> (TokenResult -> ParseResult a) -> Parser a
forall a b. (a -> b) -> a -> b
$ (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData TokenResult -> Element -> TokenResult -> ParseResult a
forall p. TokenResult -> Element -> p -> ParseResult a
handle
  where
    handle :: TokenResult -> Element -> p -> ParseResult a
handle TokenResult
tok Element
el p
_
      | Element
el Element -> Element -> Bool
forall a. Eq a => a -> a -> Bool
== Element
elsearch = a -> ParseResult a -> ParseResult a
forall v. v -> ParseResult v -> ParseResult v
Yield a
start (ParseResult a -> ParseResult a
parseAndAppend (Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
parser TokenResult
tok))
    handle TokenResult
tok Element
_ p
_ = Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
forall a. Parser a
ignoreVal TokenResult
tok

    parseAndAppend :: ParseResult a -> ParseResult a
parseAndAppend (Failed String
err) = String -> ParseResult a
forall v. String -> ParseResult v
Failed String
err
    parseAndAppend (Yield a
v ParseResult a
np) = a -> ParseResult a -> ParseResult a
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)) = (Parser a, ByteString -> TokenResult) -> ParseResult a
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (ParseResult a -> ParseResult a
parseAndAppend (ParseResult a -> ParseResult a)
-> (TokenResult -> ParseResult a) -> TokenResult -> ParseResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult a
np), ByteString -> TokenResult
ntp)
    parseAndAppend (Done ByteString
ctx TokenResult
ntp) = a -> ParseResult a -> ParseResult a
forall v. v -> ParseResult v -> ParseResult v
Yield a
end (ByteString -> TokenResult -> ParseResult a
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 :: a -> a -> Parser a -> Parser a
objectFound = Element -> a -> a -> Parser a -> Parser a
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 :: a -> a -> Parser a -> Parser a
arrayFound = Element -> a -> a -> Parser a -> Parser a
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 :: Int -> Parser a -> Parser a
arrayWithIndexOf Int
idx Parser a
valparse = (Int -> Parser a) -> Parser a
forall a. (Int -> Parser a) -> Parser a
array' Int -> Parser a
itemFn
  where
    itemFn :: Int -> Parser a
itemFn Int
aidx
      | Int
aidx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
idx = Parser a
valparse
      | Bool
otherwise = Parser a
forall a. Parser a
ignoreVal

-- | Match all items of an array, add index to output.
indexedArrayOf :: Parser a -> Parser (Int, a)
indexedArrayOf :: Parser a -> Parser (Int, a)
indexedArrayOf Parser a
valparse = (Int -> Parser (Int, a)) -> Parser (Int, a)
forall a. (Int -> Parser a) -> Parser a
array' (\(!Int
key) -> (Int
key,) (a -> (Int, a)) -> Parser a -> Parser (Int, a)
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' :: Bool -> (Text -> Parser a) -> Parser a
object' Bool
once Text -> Parser a
valparse = (TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult a) -> Parser a)
-> (TokenResult -> ParseResult a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \TokenResult
tp ->
  case TokenResult
tp of
    (PartialResult Element
ObjectBegin TokenResult
ntp) -> (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
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
_) -> Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
forall a. Parser a
ignoreVal TokenResult
tp -- Run ignoreval parser on the same output we got
    (TokMoreData ByteString -> TokenResult
ntok) -> (Parser a, ByteString -> TokenResult) -> ParseResult a
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData (Bool -> (Text -> Parser a) -> Parser a
forall a. Bool -> (Text -> Parser a) -> Parser a
object' Bool
once Text -> Parser a
valparse, ByteString -> TokenResult
ntok)
    TokenResult
TokFailed -> String -> ParseResult a
forall v. String -> ParseResult v
Failed String
"Array - token failed"
  where
    nextitem :: Bool -> TokenResult -> Element -> TokenResult -> ParseResult a
nextitem Bool
_ TokenResult
_ (ObjectEnd ByteString
ctx) TokenResult
ntok = ByteString -> TokenResult -> ParseResult a
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 (Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse (Text -> Parser a
valparse Text
key) TokenResult
ntok)
    nextitem Bool
yielded TokenResult
_ (StringRaw ByteString
bs) TokenResult
ntok = 
      case ByteString -> Either UnicodeException Text
unescapeText ByteString
bs of
        Right Text
t -> Bool -> ParseResult a -> ParseResult a
objcontent Bool
yielded (Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse (Text -> Parser a
valparse Text
t) TokenResult
ntok)
        Left UnicodeException
e -> String -> ParseResult a
forall v. String -> ParseResult v
Failed (UnicodeException -> String
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 (ParseResult a -> ParseResult a) -> ParseResult a -> ParseResult a
forall a b. (a -> b) -> a -> b
$ (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
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
_ = String -> ParseResult a
forall v. String -> ParseResult v
Failed (String -> ParseResult a) -> String -> ParseResult a
forall a b. (a -> b) -> a -> b
$ String
"Object - unexpected item: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Element -> String
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 = Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse (Int -> Parser a
forall a. Int -> Parser a
ignoreVal' Int
1) TokenResult
ntp
      | Bool
otherwise = (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
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)) = (Parser a, ByteString -> TokenResult) -> ParseResult a
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (Bool -> ParseResult a -> ParseResult a
objcontent Bool
yielded(ParseResult a -> ParseResult a)
-> (TokenResult -> ParseResult a) -> TokenResult -> ParseResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult a
np), ByteString -> TokenResult
ntok)
    objcontent Bool
_ (Yield a
v ParseResult a
np) = a -> ParseResult a -> ParseResult a
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) = String -> ParseResult a
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 ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc) ->
              Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse (Text -> Parser a
valparse Text
key) TokenResult
ntok
          | Bool
otherwise -> String -> ParseResult a
forall v. String -> ParseResult v
Failed String
"Error decoding UTF8"
        StringContent ByteString
str
          | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
objectKeyStringLimit -> Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse (Parser a -> Parser a
forall a. Parser a -> Parser a
ignoreStrRestThen Parser a
forall a. Parser a
ignoreVal) TokenResult
ntok
          | Bool
otherwise -> (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData ([ByteString]
-> Int -> TokenResult -> Element -> TokenResult -> ParseResult a
getLongKey (ByteString
strByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
str)) TokenResult
ntok
        Element
_ -> String -> ParseResult a
forall v. String -> ParseResult v
Failed String
"Object longstr - lexer failed."

-- | Helper function to deduplicate TokMoreData/FokFailed logic
moreData :: (TokenResult -> Element -> TokenResult -> ParseResult v) -> TokenResult -> ParseResult v
moreData :: (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 -> (Parser v, ByteString -> TokenResult) -> ParseResult v
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((TokenResult -> ParseResult v) -> Parser v
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData TokenResult -> Element -> TokenResult -> ParseResult v
parser), ByteString -> TokenResult
ntok)
    TokenResult
TokFailed -> String -> ParseResult v
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 :: Parser a -> Parser (Text, a)
objectItems Parser a
valparse = Bool -> (Text -> Parser (Text, a)) -> Parser (Text, a)
forall a. Bool -> (Text -> Parser a) -> Parser a
object' Bool
False ((Text -> Parser (Text, a)) -> Parser (Text, a))
-> (Text -> Parser (Text, a)) -> Parser (Text, a)
forall a b. (a -> b) -> a -> b
$ \(!Text
key) -> (Text
key,) (a -> (Text, a)) -> Parser a -> Parser (Text, a)
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 :: Parser a -> Parser a
objectValues Parser a
valparse = Bool -> (Text -> Parser a) -> Parser a
forall a. Bool -> (Text -> Parser a) -> Parser a
object' Bool
False (Parser a -> Text -> Parser a
forall a b. a -> b -> a
const Parser a
valparse)

-- | 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 :: Text -> Parser a -> Parser a
objectWithKey Text
name Parser a
valparse = Bool -> (Text -> Parser a) -> Parser a
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name = Parser a
valparse
      | Bool
otherwise = Parser a
forall a. Parser a
ignoreVal

-- | Parses underlying values and generates a AE.Value
aeValue :: Parser AE.Value
aeValue :: Parser Value
aeValue = (TokenResult -> ParseResult Value) -> Parser Value
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult Value) -> Parser Value)
-> (TokenResult -> ParseResult Value) -> Parser Value
forall a b. (a -> b) -> a -> b
$ (TokenResult -> Element -> TokenResult -> ParseResult Value)
-> TokenResult -> ParseResult Value
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 = [(Key, v)] -> KeyMap v
forall v. [(Key, v)] -> KeyMap v
AEK.fromList ([(Key, v)] -> KeyMap v)
-> ([(Text, v)] -> [(Key, v)]) -> [(Text, v)] -> KeyMap v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, v) -> (Key, v)) -> [(Text, v)] -> [(Key, v)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Key) -> (Text, v) -> (Key, v)
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 -> Value -> ParseResult Value -> ParseResult Value
forall v. v -> ParseResult v -> ParseResult v
Yield Value
val (ByteString -> TokenResult -> ParseResult Value
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        JInteger CLong
val -> Value -> ParseResult Value -> ParseResult Value
forall v. v -> ParseResult v -> ParseResult v
Yield (Scientific -> Value
AE.Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ CLong -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
val) (ByteString -> TokenResult -> ParseResult Value
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        StringContent ByteString
_ -> Parser Value -> TokenResult -> ParseResult Value
forall a. Parser a -> TokenResult -> ParseResult a
callParse (Text -> Value
AE.String (Text -> Value) -> Parser Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int -> Parser Text
longString Maybe Int
forall a. Maybe a
Nothing) TokenResult
tok
        StringRaw ByteString
bs -> case ByteString -> Either UnicodeException Text
unescapeText ByteString
bs of
              Right Text
t -> Value -> ParseResult Value -> ParseResult Value
forall v. v -> ParseResult v -> ParseResult v
Yield (Text -> Value
AE.String Text
t) (ByteString -> TokenResult -> ParseResult Value
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
              Left UnicodeException
e -> String -> ParseResult Value
forall v. String -> ParseResult v
Failed (UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e)
        Element
ArrayBegin -> Array -> Value
AE.Array (Array -> Value) -> ([Value] -> Array) -> [Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
Vec.fromList ([Value] -> Value) -> ParseResult [Value] -> ParseResult Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [Value] -> TokenResult -> ParseResult [Value]
forall a. Parser a -> TokenResult -> ParseResult a
callParse (Parser Value -> Parser [Value]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Value -> Parser Value
forall a. Parser a -> Parser a
arrayOf Parser Value
aeValue)) TokenResult
tok
        Element
ObjectBegin -> Object -> Value
AE.Object (Object -> Value)
-> ([(Text, Value)] -> Object) -> [(Text, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Object
forall v. [(Text, v)] -> KeyMap v
tomap ([(Text, Value)] -> Value)
-> ParseResult [(Text, Value)] -> ParseResult Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [(Text, Value)]
-> TokenResult -> ParseResult [(Text, Value)]
forall a. Parser a -> TokenResult -> ParseResult a
callParse (Parser (Text, Value) -> Parser [(Text, Value)]
forall a. Parser a -> Parser [a]
manyReverse (Parser Value -> Parser (Text, Value)
forall a. Parser a -> Parser (Text, a)
objectItems Parser Value
aeValue)) TokenResult
tok
        Element
_ -> String -> ParseResult Value
forall v. String -> ParseResult v
Failed (String
"aeValue - unexpected token: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Element -> String
forall a. Show a => a -> String
show Element
el)

-- | Optimized function for aeson objects - evades reversing the objects
manyReverse :: Parser a -> Parser [a]
manyReverse :: Parser a -> Parser [a]
manyReverse Parser a
f = (TokenResult -> ParseResult [a]) -> Parser [a]
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult [a]) -> Parser [a])
-> (TokenResult -> ParseResult [a]) -> Parser [a]
forall a b. (a -> b) -> a -> b
$ \TokenResult
ntok -> [a] -> ParseResult a -> ParseResult [a]
forall a. [a] -> ParseResult a -> ParseResult [a]
loop [] (Parser a -> TokenResult -> ParseResult a
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) = [a] -> ParseResult [a] -> ParseResult [a]
forall v. v -> ParseResult v -> ParseResult v
Yield [a]
acc (ByteString -> TokenResult -> ParseResult [a]
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntp)
    loop [a]
acc (MoreData (Parser TokenResult -> ParseResult a
np, ByteString -> TokenResult
ntok)) = (Parser [a], ByteString -> TokenResult) -> ParseResult [a]
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((TokenResult -> ParseResult [a]) -> Parser [a]
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ([a] -> ParseResult a -> ParseResult [a]
loop [a]
acc (ParseResult a -> ParseResult [a])
-> (TokenResult -> ParseResult a) -> TokenResult -> ParseResult [a]
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 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc) ParseResult a
np
    loop [a]
_ (Failed String
err) = String -> ParseResult [a]
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 :: (Value -> Maybe a) -> (CLong -> Maybe a) -> Parser a
jvalue Value -> Maybe a
convert CLong -> Maybe a
cvtint = (TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
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  -> a -> ParseResult a -> ParseResult a
forall v. v -> ParseResult v -> ParseResult v
Yield a
convValue (ByteString -> TokenResult -> ParseResult a
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
          | Bool
otherwise -> ByteString -> TokenResult -> ParseResult a
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok
        JInteger CLong
val
          | Just a
convValue <- CLong -> Maybe a
cvtint CLong
val -> a -> ParseResult a -> ParseResult a
forall v. v -> ParseResult v -> ParseResult v
Yield a
convValue (ByteString -> TokenResult -> ParseResult a
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
          | Bool
otherwise -> ByteString -> TokenResult -> ParseResult a
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok
        Element
_ -> Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
forall a. Parser a
ignoreVal TokenResult
tok


longByteString :: Maybe Int -> Parser BS.ByteString
longByteString :: Maybe Int -> Parser ByteString
longByteString Maybe Int
mbounds = (TokenResult -> ParseResult ByteString) -> Parser ByteString
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult ByteString) -> Parser ByteString)
-> (TokenResult -> ParseResult ByteString) -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ (TokenResult -> Element -> TokenResult -> ParseResult ByteString)
-> TokenResult -> ParseResult ByteString
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (([ByteString] -> [ByteString])
-> Int
-> TokenResult
-> Element
-> TokenResult
-> ParseResult ByteString
handle [ByteString] -> [ByteString]
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
_) -> String -> ParseResult ByteString
forall v. String -> ParseResult v
Failed String
"INTERNAL ERROR! - got decoded JValue instead of string"
        StringRaw ByteString
bs -> ByteString -> ParseResult ByteString -> ParseResult ByteString
forall v. v -> ParseResult v -> ParseResult v
Yield ByteString
bs (ByteString -> TokenResult -> ParseResult ByteString
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        StringContent ByteString
str
          | (Just Int
bounds) <- Maybe Int
mbounds, Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
bounds -- If the string exceeds bounds, discard it
                          -> Parser ByteString -> TokenResult -> ParseResult ByteString
forall a. Parser a -> TokenResult -> ParseResult a
callParse (Parser ByteString -> Parser ByteString
forall a. Parser a -> Parser a
ignoreStrRestThen ((TokenResult -> ParseResult ByteString) -> Parser ByteString
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult ByteString) -> Parser ByteString)
-> (TokenResult -> ParseResult ByteString) -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> TokenResult -> ParseResult ByteString
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"")) TokenResult
ntok
          | Bool
otherwise     -> (TokenResult -> Element -> TokenResult -> ParseResult ByteString)
-> TokenResult -> ParseResult ByteString
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (([ByteString] -> [ByteString])
-> Int
-> TokenResult
-> Element
-> TokenResult
-> ParseResult ByteString
handle ([ByteString] -> [ByteString]
acc ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
strByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
str)) TokenResult
ntok
        Element
StringEnd -> ByteString -> ParseResult ByteString -> ParseResult ByteString
forall v. v -> ParseResult v -> ParseResult v
Yield ([ByteString] -> ByteString
BS.concat ([ByteString] -> [ByteString]
acc [])) (ByteString -> TokenResult -> ParseResult ByteString
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        Element
_ ->  Parser ByteString -> TokenResult -> ParseResult ByteString
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser ByteString
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 Maybe Int
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 (Int -> Maybe Int
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 = (TokenResult -> ParseResult Text) -> Parser Text
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult Text) -> Parser Text)
-> (TokenResult -> ParseResult Text) -> Parser Text
forall a b. (a -> b) -> a -> b
$ (TokenResult -> Element -> TokenResult -> ParseResult Text)
-> TokenResult -> ParseResult Text
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (([ByteString] -> [ByteString])
-> Int -> TokenResult -> Element -> TokenResult -> ParseResult Text
handle [ByteString] -> [ByteString]
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) -> Text -> ParseResult Text -> ParseResult Text
forall v. v -> ParseResult v -> ParseResult v
Yield Text
str (ByteString -> TokenResult -> ParseResult Text
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        StringRaw ByteString
bs -> 
          case ByteString -> Either UnicodeException Text
unescapeText ByteString
bs of
            Right Text
t -> Text -> ParseResult Text -> ParseResult Text
forall v. v -> ParseResult v -> ParseResult v
Yield Text
t (ByteString -> TokenResult -> ParseResult Text
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
            Left UnicodeException
e -> String -> ParseResult Text
forall v. String -> ParseResult v
Failed (UnicodeException -> String
forall a. Show a => a -> String
show UnicodeException
e)
        StringContent ByteString
str
          | (Just Int
bounds) <- Maybe Int
mbounds, Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
bounds -- If the string exceeds bounds, discard it
                          -> Parser Text -> TokenResult -> ParseResult Text
forall a. Parser a -> TokenResult -> ParseResult a
callParse (Parser Text -> Parser Text
forall a. Parser a -> Parser a
ignoreStrRestThen ((TokenResult -> ParseResult Text) -> Parser Text
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult Text) -> Parser Text)
-> (TokenResult -> ParseResult Text) -> Parser Text
forall a b. (a -> b) -> a -> b
$ ByteString -> TokenResult -> ParseResult Text
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"")) TokenResult
ntok
          | Bool
otherwise     -> (TokenResult -> Element -> TokenResult -> ParseResult Text)
-> TokenResult -> ParseResult Text
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (([ByteString] -> [ByteString])
-> Int -> TokenResult -> Element -> TokenResult -> ParseResult Text
handle ([ByteString] -> [ByteString]
acc ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
strByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)) (Int
len Int -> Int -> Int
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 []))
                      -> Text -> ParseResult Text -> ParseResult Text
forall v. v -> ParseResult v -> ParseResult v
Yield Text
val (ByteString -> TokenResult -> ParseResult Text
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
          | Bool
otherwise -> String -> ParseResult Text
forall v. String -> ParseResult v
Failed String
"Error decoding UTF8"
        Element
_ ->  Parser Text -> TokenResult -> ParseResult Text
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser Text
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 Maybe Int
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 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
limit)

-- | Parse number, return in scientific format.
number :: Parser Scientific
number :: Parser Scientific
number = (Value -> Maybe Scientific)
-> (CLong -> Maybe Scientific) -> Parser Scientific
forall a. (Value -> Maybe a) -> (CLong -> Maybe a) -> Parser a
jvalue Value -> Maybe Scientific
cvt (Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just (Scientific -> Maybe Scientific)
-> (CLong -> Scientific) -> CLong -> Maybe Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
  where
    cvt :: Value -> Maybe Scientific
cvt (AE.Number Scientific
num) = Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just Scientific
num
    cvt Value
_ = Maybe Scientific
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 :: Parser i
integer = (Value -> Maybe i) -> (CLong -> Maybe i) -> Parser i
forall a. (Value -> Maybe a) -> (CLong -> Maybe a) -> Parser a
jvalue Value -> Maybe i
forall i. (Integral i, Bounded i) => Value -> Maybe i
cvt CLong -> Maybe i
clongToBounded
  where
    clmax :: Integer
clmax = CLong -> Integer
forall a. Integral a => a -> Integer
toInteger (CLong
forall a. Bounded a => a
maxBound :: CLong)
    clmin :: Integer
clmin = CLong -> Integer
forall a. Integral a => a -> Integer
toInteger (CLong
forall a. Bounded a => a
minBound :: CLong)
    imax :: Integer
imax = i -> Integer
forall a. Integral a => a -> Integer
toInteger (i
forall a. Bounded a => a
maxBound :: i)
    imin :: Integer
imin = i -> Integer
forall a. Integral a => a -> Integer
toInteger (i
forall a. Bounded a => a
minBound :: i)
    -- Int is generally CLong, so we get this
    clongIsSmaller :: Bool
clongIsSmaller = Integer
clmax Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
imax Bool -> Bool -> Bool
&& Integer
clmin Integer -> Integer -> Bool
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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
imax Bool -> Bool -> Bool
|| Integer
clmin Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
imin

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

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

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

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

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

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

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

-- | Match 'FromJSON' value. Calls parseJSON on the parsed value.
--
-- >>> 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 :: Parser a
value = (TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult a) -> Parser a)
-> (TokenResult -> ParseResult a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \TokenResult
ntok -> ParseResult Value -> ParseResult a
forall v. FromJSON v => ParseResult Value -> ParseResult v
loop (Parser Value -> TokenResult -> ParseResult Value
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser Value
aeValue TokenResult
ntok)
  where
    loop :: ParseResult Value -> ParseResult v
loop (Done ByteString
ctx TokenResult
ntp) = ByteString -> TokenResult -> ParseResult v
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntp
    loop (Failed String
err) = String -> ParseResult v
forall v. String -> ParseResult v
Failed String
err
    loop (MoreData (Parser TokenResult -> ParseResult Value
np, ByteString -> TokenResult
ntok)) = (Parser v, ByteString -> TokenResult) -> ParseResult v
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((TokenResult -> ParseResult v) -> Parser v
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (ParseResult Value -> ParseResult v
loop (ParseResult Value -> ParseResult v)
-> (TokenResult -> ParseResult Value)
-> TokenResult
-> ParseResult v
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 Value -> Result v
forall a. FromJSON a => Value -> Result a
AE.fromJSON Value
v of
        AE.Error String
_ -> ParseResult Value -> ParseResult v
loop ParseResult Value
np
        AE.Success v
res -> v -> ParseResult v -> ParseResult v
forall v. v -> ParseResult v -> ParseResult v
Yield v
res (ParseResult Value -> ParseResult v
loop ParseResult Value
np)

-- | 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 :: Int -> Parser a -> Parser a
takeI Int
num Parser a
valparse = (TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult a) -> Parser a)
-> (TokenResult -> ParseResult a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \TokenResult
tok -> Int -> ParseResult a -> ParseResult a
forall a v. (Eq a, Num a) => a -> ParseResult v -> ParseResult v
loop Int
num (Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
valparse TokenResult
tok)
  where
    loop :: a -> ParseResult v -> ParseResult v
loop a
_ (Done ByteString
ctx TokenResult
ntp) = ByteString -> TokenResult -> ParseResult v
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntp
    loop a
_ (Failed String
err) = String -> ParseResult v
forall v. String -> ParseResult v
Failed String
err
    loop a
n (MoreData (Parser TokenResult -> ParseResult v
np, ByteString -> TokenResult
ntok)) = (Parser v, ByteString -> TokenResult) -> ParseResult v
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((TokenResult -> ParseResult v) -> Parser v
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (a -> ParseResult v -> ParseResult v
loop a
n (ParseResult v -> ParseResult v)
-> (TokenResult -> ParseResult v) -> TokenResult -> ParseResult v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenResult -> ParseResult v
np), ByteString -> TokenResult
ntok)
    loop a
0 (Yield v
_ ParseResult v
np) = a -> ParseResult v -> ParseResult v
loop a
0 ParseResult v
np
    loop a
n (Yield v
v ParseResult v
np) = v -> ParseResult v -> ParseResult v
forall v. v -> ParseResult v -> ParseResult v
Yield v
v (a -> ParseResult v -> ParseResult v
loop (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) ParseResult v
np)

-- | Skip rest of string + call next parser
ignoreStrRestThen :: Parser a -> Parser a
ignoreStrRestThen :: Parser a -> Parser a
ignoreStrRestThen Parser a
next = (TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult a) -> Parser a)
-> (TokenResult -> ParseResult a) -> Parser a
forall a b. (a -> b) -> a -> b
$ (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
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
_ -> (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData TokenResult -> Element -> TokenResult -> ParseResult a
handle TokenResult
ntok
        Element
StringEnd -> Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
next TokenResult
ntok
        Element
_ -> String -> ParseResult a
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 :: Parser a
ignoreVal = Int -> Parser a
forall a. Int -> Parser a
ignoreVal' Int
0

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

    handleTok :: Int -> TokenResult -> Element -> TokenResult -> ParseResult a
    handleTok :: Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok Int
0 TokenResult
_ (JValue Value
_) TokenResult
ntok = ByteString -> TokenResult -> ParseResult a
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok
    handleTok Int
0 TokenResult
_ (StringRaw ByteString
_) TokenResult
ntok = ByteString -> TokenResult -> ParseResult a
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok
    handleTok Int
0 TokenResult
_ (JInteger CLong
_) TokenResult
ntok = ByteString -> TokenResult -> ParseResult a
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok
    handleTok Int
0 TokenResult
_ (ArrayEnd ByteString
_) TokenResult
_ = String -> ParseResult a
forall v. String -> ParseResult v
Failed String
"ArrayEnd in ignoreval on 0 level"
    handleTok Int
0 TokenResult
_ (ObjectEnd ByteString
_) TokenResult
_ = String -> ParseResult a
forall v. String -> ParseResult v
Failed String
"ObjectEnd in ignoreval on 0 level"
    handleTok Int
1 TokenResult
_ (ArrayEnd ByteString
ctx) TokenResult
ntok = ByteString -> TokenResult -> ParseResult a
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok
    handleTok Int
1 TokenResult
_ (ObjectEnd ByteString
ctx) TokenResult
ntok = ByteString -> TokenResult -> ParseResult a
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
_ -> (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Int -> TokenResult -> Element -> TokenResult -> ParseResult a
forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok Int
level) TokenResult
ntok
        JInteger CLong
_ -> (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Int -> TokenResult -> Element -> TokenResult -> ParseResult a
forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok Int
level) TokenResult
ntok
        StringContent ByteString
_ -> (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Int -> TokenResult -> Element -> TokenResult -> ParseResult a
forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleLongString Int
level) TokenResult
ntok
        StringRaw ByteString
_ -> (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Int -> TokenResult -> Element -> TokenResult -> ParseResult a
forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok Int
level) TokenResult
ntok
        ArrayEnd ByteString
_ -> (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Int -> TokenResult -> Element -> TokenResult -> ParseResult a
forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) TokenResult
ntok
        ObjectEnd ByteString
_ -> (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Int -> TokenResult -> Element -> TokenResult -> ParseResult a
forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) TokenResult
ntok
        Element
ArrayBegin -> (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Int -> TokenResult -> Element -> TokenResult -> ParseResult a
forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) TokenResult
ntok
        Element
ObjectBegin -> (TokenResult -> Element -> TokenResult -> ParseResult a)
-> TokenResult -> ParseResult a
forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData (Int -> TokenResult -> Element -> TokenResult -> ParseResult a
forall a.
Int -> TokenResult -> Element -> TokenResult -> ParseResult a
handleTok (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) TokenResult
ntok
        Element
StringEnd -> String -> ParseResult a
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 :: (a -> Bool) -> Parser a -> Parser a
filterI a -> Bool
cond Parser a
valparse = (TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser ((TokenResult -> ParseResult a) -> Parser a)
-> (TokenResult -> ParseResult a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \TokenResult
ntok -> ParseResult a -> ParseResult a
loop (Parser a -> TokenResult -> ParseResult a
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) = ByteString -> TokenResult -> ParseResult a
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntp
    loop (Failed String
err) = String -> ParseResult a
forall v. String -> ParseResult v
Failed String
err
    loop (MoreData (Parser TokenResult -> ParseResult a
np, ByteString -> TokenResult
ntok)) = (Parser a, ByteString -> TokenResult) -> ParseResult a
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((TokenResult -> ParseResult a) -> Parser a
forall a. (TokenResult -> ParseResult a) -> Parser a
Parser (ParseResult a -> ParseResult a
loop (ParseResult a -> ParseResult a)
-> (TokenResult -> ParseResult a) -> TokenResult -> ParseResult a
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 = a -> ParseResult a -> ParseResult a
forall v. v -> ParseResult v -> ParseResult v
Yield a
v (ParseResult a -> ParseResult a
loop ParseResult a
np)
      | Bool
otherwise = ParseResult a -> ParseResult a
loop ParseResult a
np

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

--- Convenience operators

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

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

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


-- | Synonym for 'arrayWithIndexOf'. Matches n-th item in array.
--
-- >>> parseByteString (arrayOf (1 .! bool)) "[ [1,true,null], [2,false], [3]]" :: [Bool]
-- [True,False]
(.!) :: Int -> Parser a -> Parser a
.! :: Int -> Parser a -> Parser 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' :: Parser a -> ByteString -> ParseOutput a
runParser' Parser a
parser ByteString
startdata = ParseResult a -> ParseOutput a
forall a. ParseResult a -> ParseOutput a
parse (ParseResult a -> ParseOutput a) -> ParseResult a -> ParseOutput a
forall a b. (a -> b) -> a -> b
$ Parser a -> TokenResult -> ParseResult a
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)) = (ByteString -> ParseOutput a) -> ParseOutput a
forall a. (ByteString -> ParseOutput a) -> ParseOutput a
ParseNeedData (ParseResult a -> ParseOutput a
parse (ParseResult a -> ParseOutput a)
-> (ByteString -> ParseResult a) -> ByteString -> ParseOutput a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
np (TokenResult -> ParseResult a)
-> (ByteString -> TokenResult) -> ByteString -> ParseResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ByteString -> TokenResult
ntok)
    parse (Failed String
err) = String -> ParseOutput a
forall a. String -> ParseOutput a
ParseFailed String
err
    parse (Yield a
v ParseResult a
np) = a -> ParseOutput a -> ParseOutput a
forall a. a -> ParseOutput a -> ParseOutput a
ParseYield a
v (ParseResult a -> ParseOutput a
parse ParseResult a
np)
    parse (Done ByteString
ctx TokenResult
_) = ByteString -> ParseOutput a
forall a. ByteString -> ParseOutput a
ParseDone ByteString
ctx

-- | Run streaming parser, immediately returns 'ParseNeedData'.
runParser :: Parser a -> ParseOutput a
runParser :: Parser a -> ParseOutput a
runParser Parser a
parser = Parser a -> ByteString -> ParseOutput a
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 :: Parser a -> ByteString -> [a]
parseByteString Parser a
parser ByteString
startdata = ParseOutput a -> [a]
forall a. ParseOutput a -> [a]
loop (Parser a -> ByteString -> ParseOutput a
forall a. Parser a -> ByteString -> ParseOutput a
runParser' Parser a
parser ByteString
startdata)
  where
    loop :: ParseOutput a -> [a]
loop (ParseNeedData ByteString -> ParseOutput a
_) = String -> [a]
forall a. HasCallStack => String -> a
error String
"Not enough data."
    loop (ParseDone ByteString
_) = []
    loop (ParseFailed String
err) = String -> [a]
forall a. HasCallStack => String -> a
error String
err
    loop (ParseYield a
v ParseOutput a
np) = a
v a -> [a] -> [a]
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 :: Parser a -> ByteString -> [a]
parseLazyByteString Parser a
parser ByteString
input = ByteString -> ParseOutput a -> [a]
forall a. ByteString -> ParseOutput a -> [a]
loop ByteString
input (Parser a -> ParseOutput a
forall a. Parser a -> ParseOutput a
runParser Parser a
parser)
  where
    loop :: ByteString -> ParseOutput a -> [a]
loop ByteString
BL.Empty (ParseNeedData ByteString -> ParseOutput a
_) = String -> [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) = String -> [a]
forall a. HasCallStack => String -> a
error String
err
    loop ByteString
rest (ParseYield a
v ParseOutput a
np) = a
v a -> [a] -> [a]
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 :: ByteString -> Maybe a
decode ByteString
bs =
  case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs of
    Right a
val -> a -> Maybe a
forall a. a -> Maybe a
Just a
val
    Left String
_ -> Maybe a
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 :: ByteString -> Either String a
eitherDecode ByteString
bs = ByteString -> ParseOutput a -> Either String a
forall b. ByteString -> ParseOutput b -> Either String b
loop ByteString
bs (Parser a -> ParseOutput a
forall a. Parser a -> ParseOutput a
runParser Parser a
forall a. FromJSON a => Parser a
value)
  where
    loop :: ByteString -> ParseOutput b -> Either String b
loop ByteString
BL.Empty (ParseNeedData ByteString -> ParseOutput b
_) = String -> Either String b
forall a b. a -> Either a b
Left String
"Not enough data."
    loop (BL.Chunk ByteString
dta ByteString
rest) (ParseNeedData ByteString -> ParseOutput b
np) = ByteString -> ParseOutput b -> Either String b
loop ByteString
rest (ByteString -> ParseOutput b
np ByteString
dta)
    loop ByteString
_ (ParseDone ByteString
_) = String -> Either String b
forall a b. a -> Either a b
Left String
"Nothing parsed."
    loop ByteString
_ (ParseFailed String
err) = String -> Either String b
forall a b. a -> Either a b
Left String
err
    loop ByteString
rest (ParseYield b
v ParseOutput b
next) = b -> ParseOutput b -> ByteString -> Either String b
forall t a. t -> ParseOutput a -> ByteString -> Either String t
checkExit b
v ParseOutput b
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 = t -> Either String t
forall a b. b -> Either a b
Right t
v
      | Bool
otherwise = String -> Either String t
forall a b. a -> Either a b
Left String
"Data followed by non-whitespace characters."
    checkExit t
_ (ParseYield a
_ ParseOutput a
_) ByteString
_ = String -> Either String t
forall a b. a -> Either a b
Left String
"Multiple value parses?"
    checkExit t
_ (ParseFailed String
err) ByteString
_ = String -> Either String t
forall a b. a -> Either a b
Left String
err
    checkExit t
_ (ParseNeedData ByteString -> ParseOutput a
_) ByteString
BL.Empty = String -> Either String t
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 :: ByteString -> Maybe a
decodeStrict ByteString
bs =
  case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict ByteString
bs of
    Right a
val -> a -> Maybe a
forall a. a -> Maybe a
Just a
val
    Left String
_ -> Maybe a
forall a. Maybe a
Nothing

-- | Like 'eitherDecode', but on strict 'BS.ByteString'
eitherDecodeStrict :: AE.FromJSON a => BS.ByteString -> Either String a
eitherDecodeStrict :: ByteString -> Either String a
eitherDecodeStrict ByteString
bs =
    case Parser a -> ByteString -> ParseOutput a
forall a. Parser a -> ByteString -> ParseOutput a
runParser' Parser a
forall a. FromJSON a => Parser a
value ByteString
bs of
      ParseYield a
next ParseOutput a
v -> ParseOutput a -> a -> Either String a
forall a a b. IsString a => ParseOutput a -> b -> Either a b
checkExit ParseOutput a
v a
next
      ParseNeedData ByteString -> ParseOutput a
_ -> String -> Either String a
forall a b. a -> Either a b
Left String
"Incomplete json structure."
      ParseFailed String
err -> String -> Either String a
forall a b. a -> Either a b
Left String
err
      ParseDone ByteString
_ -> String -> Either String a
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 = b -> Either a b
forall a b. b -> Either a b
Right b
v
    checkExit ParseOutput a
_ b
_ = a -> Either a b
forall a b. a -> Either a b
Left a
"Data folowed by non-whitespace characters."

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


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

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

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