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

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

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

    -- * Performance
    -- $performance

    -- * Constant space decoding
    -- $constant

    -- * Aeson compatibility
    -- $aeson

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

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

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

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

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

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

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


instance Functor ParseResult where
  fmap :: (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 Bool
True) 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 (ByteString -> Text
unsafeDecodeASCII ByteString
bs)) TokenResult
ntok)
    nextitem Bool
yielded TokenResult
_ (StringRaw ByteString
bs Bool
False) TokenResult
ntok = 
      case ByteString -> Either UnicodeException Text
unescapeText ByteString
bs of
        Right Text
t -> Bool -> ParseResult a -> ParseResult a
objcontent Bool
yielded (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 all key-value pairs of an object, and parse the value based on the key.
-- If the source object defines same key multiple times, all values
-- are matched.
objectKeyValues :: (T.Text -> Parser a) -> Parser a
objectKeyValues :: (Text -> Parser a) -> Parser a
objectKeyValues = Bool -> (Text -> Parser a) -> Parser a
forall a. Bool -> (Text -> Parser a) -> Parser a
object' Bool
False

-- | Match only specific key of an object.
-- This function will return only the first matched value in an object even
-- if the source JSON defines the key multiple times (in violation of the specification).
objectWithKey :: T.Text -> Parser a -> Parser a
objectWithKey :: 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 Bool
True -> Value -> ParseResult Value -> ParseResult Value
forall v. v -> ParseResult v -> ParseResult v
Yield (Text -> Value
AE.String (ByteString -> Text
unsafeDecodeASCII ByteString
bs)) (ByteString -> TokenResult -> ParseResult Value
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        StringRaw ByteString
bs Bool
False -> case ByteString -> Either UnicodeException Text
unescapeText ByteString
bs of
              Right Text
t -> 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)

-- | Identical to @fmap 'reverse' . 'many'@ but more efficient.
-- If you don't care about the order of the results but plan to fully evaluate the list,
-- this can be slightly more efficient than 'many' as it avoids the accumulating thunks.
manyReverse :: Parser a -> Parser [a]
manyReverse :: 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 Bool
_ -> 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 Bool
True -> Text -> ParseResult Text -> ParseResult Text
forall v. v -> ParseResult v -> ParseResult v
Yield (ByteString -> Text
unsafeDecodeASCII ByteString
bs) (ByteString -> TokenResult -> ParseResult Text
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
"" TokenResult
ntok)
        StringRaw ByteString
bs Bool
False -> 
          case ByteString -> Either UnicodeException Text
unescapeText ByteString
bs of
            Right Text
t -> 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 values with a 'AE.Parser'.  Returns values for which the given parser succeeds.
valueWith :: (AE.Value -> AE.Parser a) -> Parser a
valueWith :: (Value -> Parser a) -> Parser a
valueWith Value -> Parser a
jparser = (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
loop (Parser Value -> TokenResult -> ParseResult Value
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser Value
aeValue TokenResult
ntok)
  where
    loop :: ParseResult Value -> ParseResult a
loop (Done ByteString
ctx TokenResult
ntp) = 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 Value
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 Value -> ParseResult a
loop (ParseResult Value -> ParseResult a)
-> (TokenResult -> ParseResult Value)
-> TokenResult
-> ParseResult a
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 -> Parser a) -> Value -> Result a
forall a b. (a -> Parser b) -> a -> Result b
AE.parse Value -> Parser a
jparser Value
v of
        AE.Error String
_ -> ParseResult Value -> ParseResult a
loop ParseResult Value
np
        AE.Success a
res -> a -> ParseResult a -> ParseResult a
forall v. v -> ParseResult v -> ParseResult v
Yield a
res (ParseResult Value -> ParseResult a
loop ParseResult Value
np)

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

-- | Take maximum n matching items.
--
-- >>> parseByteString (takeI 3 $ arrayOf integer) "[1,2,3,4,5,6,7,8,9,0]" :: [Int]
-- [1,2,3]
takeI :: Int -> Parser a -> Parser a
takeI :: 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
_ Bool
_) 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
_ Bool
_ -> (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.
--