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

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

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

    -- * Performance
    -- $performance

    -- * Constant space decoding
    -- $constant

    -- * Aeson compatibility
    -- $aeson

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

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

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

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

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

instance Functor ParseResult where
  fmap :: forall a b. (a -> b) -> ParseResult a -> ParseResult b
fmap a -> b
f (MoreData (Parser a
np, ByteString -> TokenResult
ntok)) = (Parser b, ByteString -> TokenResult) -> ParseResult b
forall v. (Parser v, ByteString -> TokenResult) -> ParseResult v
MoreData ((a -> b) -> Parser a -> Parser b
forall a b. (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 a b. (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 {
    forall a. Parser a -> TokenResult -> ParseResult a
callParse :: TokenResult -> ParseResult a
}

instance Functor Parser where
  fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f (Parser TokenResult -> ParseResult a
p) = (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 a b. (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 :: forall a. [a] -> ParseResult a -> ParseResult a
yieldResults [a]
values ParseResult a
end = (a -> ParseResult a -> ParseResult a)
-> ParseResult a -> [a] -> ParseResult a
forall a b. (a -> b -> b) -> b -> [a] -> b
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 :: forall a. 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"

  <*> :: forall a b. 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 {t} {v}.
([t -> v], [t])
-> ParseResult (t -> v) -> ParseResult t -> 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 :: ([t -> v], [t])
-> ParseResult (t -> v) -> ParseResult t -> ParseResult v
process ([], [t]
_) (Done ByteString
ctx TokenResult
ntok) ParseResult t
_ = ByteString -> TokenResult -> ParseResult v
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok -- Optimize, return immediately when first parser fails
      process ([t -> v]
lst1, [t]
lst2) (Yield t -> v
v ParseResult (t -> v)
np1) ParseResult t
p2 = ([t -> v], [t])
-> ParseResult (t -> v) -> ParseResult t -> ParseResult v
process (t -> v
v(t -> v) -> [t -> v] -> [t -> v]
forall a. a -> [a] -> [a]
:[t -> v]
lst1, [t]
lst2) ParseResult (t -> v)
np1 ParseResult t
p2
      process ([t -> v]
lst1, [t]
lst2) ParseResult (t -> v)
p1 (Yield t
v ParseResult t
np2) = ([t -> v], [t])
-> ParseResult (t -> v) -> ParseResult t -> ParseResult v
process ([t -> v]
lst1, t
vt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
lst2) ParseResult (t -> v)
p1 ParseResult t
np2
      process ([t -> v]
lst1, [t]
lst2) (Done ByteString
ctx TokenResult
ntok) (Done {}) =
        [v] -> ParseResult v -> ParseResult v
forall a. [a] -> ParseResult a -> ParseResult a
yieldResults [ t -> v
mx t
my | t -> v
mx <- [t -> v] -> [t -> v]
forall a. [a] -> [a]
reverse [t -> v]
lst1, t
my <- [t] -> [t]
forall a. [a] -> [a]
reverse [t]
lst2 ] (ByteString -> TokenResult -> ParseResult v
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok)
      process ([t -> v], [t])
lsts (MoreData (Parser (t -> v)
np1, ByteString -> TokenResult
ntok1)) (MoreData (Parser t
np2, ByteString -> TokenResult
_)) =
        (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 -> ([t -> v], [t])
-> ParseResult (t -> v) -> ParseResult t -> ParseResult v
process ([t -> v], [t])
lsts (Parser (t -> v) -> TokenResult -> ParseResult (t -> v)
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser (t -> v)
np1 TokenResult
tok) (Parser t -> TokenResult -> ParseResult t
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser t
np2 TokenResult
tok)), ByteString -> TokenResult
ntok1)
      process ([t -> v], [t])
_ (Failed String
err) ParseResult t
_ = String -> ParseResult v
forall v. String -> ParseResult v
Failed String
err
      process ([t -> v], [t])
_ ParseResult (t -> v)
_ (Failed String
err) = String -> ParseResult v
forall v. String -> ParseResult v
Failed String
err
      process ([t -> v], [t])
_ ParseResult (t -> v)
_ ParseResult t
_ = 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]
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 =
    (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 :: forall a. Parser a
empty = Parser a
forall a. Parser a
ignoreVal
  Parser a
m1 <|> :: forall a. 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 {a}.
[a] -> ParseResult a -> Maybe (ParseResult a) -> ParseResult a
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 :: [a] -> ParseResult a -> Maybe (ParseResult a) -> ParseResult a
process [a]
_ (Yield a
v ParseResult a
np1) Maybe (ParseResult a)
_ = a -> ParseResult a -> ParseResult a
forall v. v -> ParseResult v -> ParseResult v
Yield a
v ([a] -> ParseResult a -> Maybe (ParseResult a) -> ParseResult a
process [] ParseResult a
np1 Maybe (ParseResult a)
forall a. Maybe a
Nothing)
      -- First done with disabled second -> exit
      process [a]
_ (Done ByteString
ctx TokenResult
ntok) Maybe (ParseResult a)
Nothing = ByteString -> TokenResult -> ParseResult a
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok
      -- Both done but second not disabled -> yield items from the second
      process [a]
lst (Done ByteString
ctx TokenResult
ntok) (Just (Done {})) = [a] -> ParseResult a -> ParseResult a
forall a. [a] -> ParseResult a -> ParseResult a
yieldResults ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
lst) (ByteString -> TokenResult -> ParseResult a
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok)
      -- Second yield - remember data
      process [a]
lst ParseResult a
np1 (Just (Yield a
v ParseResult a
np2)) = [a] -> ParseResult a -> Maybe (ParseResult a) -> ParseResult a
process (a
va -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
lst) ParseResult a
np1 (ParseResult a -> Maybe (ParseResult a)
forall a. a -> Maybe a
Just ParseResult a
np2)
      -- Moredata processing
      process [a]
lst (MoreData (Parser a
np1, ByteString -> TokenResult
ntok)) Maybe (ParseResult a)
Nothing =
          (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 ((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
process [a]
lst (Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
np1 TokenResult
tok) Maybe (ParseResult a)
forall a. Maybe a
Nothing, ByteString -> TokenResult
ntok)
      process [a]
lst (MoreData (Parser a
np1, ByteString -> TokenResult
ntok)) (Just (MoreData (Parser a
np2, ByteString -> TokenResult
_))) =
          (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 ((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
process [a]
lst (Parser a -> TokenResult -> ParseResult a
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser a
np1 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
np2 TokenResult
tok), ByteString -> TokenResult
ntok)
      process [a]
_ (Failed String
err) Maybe (ParseResult a)
_ = String -> ParseResult a
forall v. String -> ParseResult v
Failed String
err
      process [a]
_ ParseResult a
_ (Just (Failed String
err)) = String -> ParseResult a
forall v. String -> ParseResult v
Failed String
err
      process [a]
_ ParseResult a
_ Maybe (ParseResult a)
_ = String -> ParseResult a
forall v. String -> ParseResult v
Failed String
"Unexpected error in parallel processing <|>"

  some :: forall a. 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 a. [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 a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
  many :: forall a. 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' :: forall a. (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 :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. 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' :: forall a. 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
"Object - 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 ByteString
_) 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 ByteString
_) 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
        StringEnd ByteString
_
          | 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/TokFailed logic
moreData :: (TokenResult -> Element -> TokenResult -> ParseResult v) -> TokenResult -> ParseResult v
moreData :: forall v.
(TokenResult -> Element -> TokenResult -> ParseResult v)
-> TokenResult -> ParseResult v
moreData TokenResult -> Element -> TokenResult -> ParseResult v
parser TokenResult
tok =
  case TokenResult
tok of
    PartialResult Element
el TokenResult
ntok -> TokenResult -> Element -> TokenResult -> ParseResult v
parser TokenResult
tok Element
el TokenResult
ntok
    TokMoreData ByteString -> TokenResult
ntok -> (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 :: forall a. 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 :: forall a. 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 :: forall a. (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 :: forall a. 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 a b c. (a -> b) -> (a, c) -> (b, c)
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 ByteString
ctx -> 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
ctx TokenResult
ntok)
        StringRaw ByteString
bs Bool
False ByteString
ctx -> 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
ctx 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 a. Parser a -> Parser [a]
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 :: forall a. 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 :: forall a. (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
ctx -> 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
ctx 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
        StringEnd ByteString
ctx -> 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
ctx 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 ByteString
ctx -> 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
ctx TokenResult
ntok)
        StringRaw ByteString
bs Bool
False ByteString
ctx -> 
          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
ctx 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
        StringEnd ByteString
ctx
          | 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
ctx 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 :: forall i. (Integral i, Bounded i) => 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 :: forall a. RealFloat a => 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 :: forall a. 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 :: forall a. (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 :: forall a. FromJSON a => 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 :: forall a. 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 {t} {v}.
(Eq t, Num t) =>
t -> 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 :: t -> ParseResult v -> ParseResult v
loop t
_ (Done ByteString
ctx TokenResult
ntp) = ByteString -> TokenResult -> ParseResult v
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntp
    loop t
_ (Failed String
err) = String -> ParseResult v
forall v. String -> ParseResult v
Failed String
err
    loop t
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 (t -> ParseResult v -> ParseResult v
loop t
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 t
0 (Yield v
_ ParseResult v
np) = t -> ParseResult v -> ParseResult v
loop t
0 ParseResult v
np
    loop t
n (Yield v
v ParseResult v
np) = v -> ParseResult v -> ParseResult v
forall v. v -> ParseResult v -> ParseResult v
Yield v
v (t -> ParseResult v -> ParseResult v
loop (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) ParseResult v
np)

-- | Skip rest of string + call next parser
ignoreStrRestThen :: Parser a -> Parser a
ignoreStrRestThen :: forall a. Parser a -> Parser a
ignoreStrRestThen Parser a
next = (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
        StringEnd ByteString
_ -> 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 :: forall a. Parser a
ignoreVal = Int -> Parser a
forall a. Int -> Parser a
ignoreVal' Int
0

ignoreVal' :: Int -> Parser a
ignoreVal' :: forall a. 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
_ (StringEnd ByteString
ctx) TokenResult
ntok = ByteString -> TokenResult -> ParseResult v
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntok
    handleLongString Int
level TokenResult
_ (StringEnd 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
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 :: forall a.
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
_ ByteString
ctx) TokenResult
ntok = ByteString -> TokenResult -> ParseResult a
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx 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{} -> (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
        StringEnd ByteString
_ -> 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 :: forall a. (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

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

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

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

-- | From a list of values generate single values
unFoldI :: Parser [a] -> Parser a
unFoldI :: forall a. Parser [a] -> Parser a
unFoldI Parser [a]
valparse = (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
forall {v}. ParseResult [v] -> ParseResult v
loop (Parser [a] -> TokenResult -> ParseResult [a]
forall a. Parser a -> TokenResult -> ParseResult a
callParse Parser [a]
valparse TokenResult
ntok)
  where
    loop :: ParseResult [v] -> ParseResult v
loop (Done ByteString
ctx TokenResult
ntp) = ByteString -> TokenResult -> ParseResult v
forall v. ByteString -> TokenResult -> ParseResult v
Done ByteString
ctx TokenResult
ntp
    loop (Failed String
err) = String -> ParseResult v
forall v. String -> ParseResult v
Failed String
err
    loop (MoreData (Parser TokenResult -> ParseResult [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 (ParseResult [v] -> ParseResult v
loop (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 (Yield (v
v:[v]
rest) ParseResult [v]
np) = v -> ParseResult v -> ParseResult v
forall v. v -> ParseResult v -> ParseResult v
Yield v
v (ParseResult [v] -> ParseResult v
loop ([v] -> ParseResult [v] -> ParseResult [v]
forall v. v -> ParseResult v -> ParseResult v
Yield [v]
rest ParseResult [v]
np))
    loop (Yield [] ParseResult [v]
np) = ParseResult [v] -> ParseResult v
loop ParseResult [v]
np

-- | A back-door for lifting of possibly failing actions.
-- If an action fails with Left value, convert it into failure
-- of parsing
mapWithFailure :: (a -> Either String b) -> Parser a -> Parser b
mapWithFailure :: forall a b. (a -> Either String b) -> Parser a -> Parser b
mapWithFailure a -> Either String b
mapping =
  Parser a -> Parser b
updateParser
  where
    updateParser :: Parser a -> Parser b
updateParser (Parser TokenResult -> ParseResult a
run) = (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

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

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

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

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

instance OnObject Parser a where
  .: :: Text -> Parser a -> Parser a
(.:) = Text -> Parser a -> Parser a
forall a. Text -> Parser a -> Parser a
objectWithKey
  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 (o :: * -> *) a. OnObject o a => Text -> Parser a -> o a
.: Parser a
val)
  Parser a
p .| :: Parser a -> a -> Parser a
.| a
defval = Parser a
p Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
defval

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

-- | Synonym for 'arrayWithIndexOf'. Matches n-th item in array.
--
-- >>> parseByteString (arrayOf (1 .! bool)) "[ [1,true,null], [2,false], [3]]" :: [Bool]
-- [True,False]
(.!) :: Int -> Parser a -> Parser a
.! :: forall a. Int -> Parser a -> Parser a
(.!) = 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.
                    -- Remaining data is not returned correctly if the parser parses directly numbers/booleans/nulls; JSON should be an array/object.


instance (Show a) => Show (ParseOutput a) where
  showsPrec :: Int -> ParseOutput a -> String -> String
showsPrec Int
d (ParseYield a
a ParseOutput a
next) = Bool -> (String -> String) -> String -> String
showParen Bool
True ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
showString String
"ParseYield " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
d a
a (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ParseOutput a -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
d ParseOutput a
next
  showsPrec Int
_ (ParseNeedData ByteString -> ParseOutput a
_) = String -> String -> String
showString String
"ParseNeedData"
  showsPrec Int
d (ParseFailed String
err) = Bool -> (String -> String) -> String -> String
showParen Bool
True ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
showString String
"ParseFailed " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
d String
err
  showsPrec Int
d (ParseDone ByteString
rest) = Bool -> (String -> String) -> String -> String
showParen Bool
True ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
showString String
"ParseDone " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
d ByteString
rest

-- | Run streaming parser with initial input.
runParser' :: Parser a -> BS.ByteString -> ParseOutput a
runParser' :: forall a. Parser a -> ByteString -> ParseOutput a
runParser' Parser a
parser ByteString
startdata = 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 :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. FromJSON a => 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 :: forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
bs = ByteString -> ParseOutput a -> Either String a
forall {a}. ByteString -> ParseOutput a -> Either String a
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 a -> Either String a
loop ByteString
BL.Empty (ParseNeedData ByteString -> ParseOutput a
_) = String -> Either String a
forall a b. a -> Either a b
Left String
"Not enough data."
    loop (BL.Chunk ByteString
dta ByteString
rest) (ParseNeedData ByteString -> ParseOutput a
np) = ByteString -> ParseOutput a -> Either String a
loop ByteString
rest (ByteString -> ParseOutput a
np ByteString
dta)
    loop ByteString
_ (ParseDone ByteString
_) = String -> Either String a
forall a b. a -> Either a b
Left String
"Nothing parsed."
    loop ByteString
_ (ParseFailed String
err) = String -> Either String a
forall a b. a -> Either a b
Left String
err
    loop ByteString
rest (ParseYield a
v ParseOutput a
next) = a -> ParseOutput a -> ByteString -> Either String a
forall {t} {a}. t -> ParseOutput a -> ByteString -> Either String t
checkExit a
v ParseOutput a
next ByteString
rest

    checkExit :: t -> ParseOutput a -> ByteString -> Either String t
checkExit t
v (ParseDone ByteString
srest) ByteString
rest
      | (Char -> Bool) -> ByteString -> Bool
BS.all Char -> Bool
isSpace ByteString
srest Bool -> Bool -> Bool
&& (Char -> Bool) -> ByteString -> Bool
BL.all Char -> Bool
isSpace ByteString
rest = 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 :: forall a. FromJSON a => 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 :: forall a. FromJSON a => 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."

--- High performance object parsing

-- Helper type into which we unsafeCoerce the data
data HValue = forall a. HValue a

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

-- | Helper function for some parser combining operators
joinObjectFieldWith ::([a] -> [b] -> [c]) -> Object a -> Object b -> Object c
joinObjectFieldWith :: forall a b c.
([a] -> [b] -> [c]) -> Object a -> Object b -> Object c
joinObjectFieldWith [a] -> [b] -> [c]
joinFunc (Object Map Text (Parser HValue)
amap Map Text [HValue] -> [a]
adata) (Object Map Text (Parser HValue)
bmap Map Text [HValue] -> [b]
bdata) =
  -- We MUST disallow duplicate field access as we do unsafeCoerce and that could lead to mixing types
  let dmap :: Map Text (Parser HValue)
dmap = (Text -> Parser HValue -> Parser HValue -> Parser HValue)
-> Map Text (Parser HValue)
-> Map Text (Parser HValue)
-> Map Text (Parser HValue)
forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWithKey (\Text
k Parser HValue
_ Parser HValue
_ -> String -> Parser HValue
forall a. HasCallStack => String -> a
error (String
"JStream Object - duplicate field access: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
k)) Map Text (Parser HValue)
amap Map Text (Parser HValue)
bmap
  in Map Text (Parser HValue)
dmap Map Text (Parser HValue) -> Object c -> Object c
forall a b. a -> b -> b
`seq` Map Text (Parser HValue) -> (Map Text [HValue] -> [c]) -> Object c
forall f.
Map Text (Parser HValue) -> (Map Text [HValue] -> [f]) -> Object f
Object Map Text (Parser HValue)
dmap (\Map Text [HValue]
inp -> [a] -> [b] -> [c]
joinFunc (Map Text [HValue] -> [a]
adata Map Text [HValue]
inp) (Map Text [HValue] -> [b]
bdata Map Text [HValue]
inp))

instance Applicative Object where
  pure :: forall a. a -> Object a
pure a
f = Map Text (Parser HValue) -> (Map Text [HValue] -> [a]) -> Object a
forall f.
Map Text (Parser HValue) -> (Map Text [HValue] -> [f]) -> Object f
Object Map Text (Parser HValue)
forall a. Monoid a => a
mempty ([a] -> Map Text [HValue] -> [a]
forall a b. a -> b -> a
const (a -> [a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
f))
  <*> :: forall a b. Object (a -> b) -> Object a -> Object b
(<*>) = ([a -> b] -> [a] -> [b]) -> Object (a -> b) -> Object a -> Object b
forall a b c.
([a] -> [b] -> [c]) -> Object a -> Object b -> Object c
joinObjectFieldWith (((a -> b) -> a -> b) -> [a -> b] -> [a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($))

instance Alternative Object where
  empty :: forall a. Object a
empty = Map Text (Parser HValue) -> (Map Text [HValue] -> [a]) -> Object a
forall f.
Map Text (Parser HValue) -> (Map Text [HValue] -> [f]) -> Object f
Object Map Text (Parser HValue)
forall a. Monoid a => a
mempty ([a] -> Map Text [HValue] -> [a]
forall a b. a -> b -> a
const [])
  <|> :: forall a. Object a -> Object a -> Object a
(<|>) = ([a] -> [a] -> [a]) -> Object a -> Object a -> Object a
forall a b c.
([a] -> [b] -> [c]) -> Object a -> Object b -> Object c
joinObjectFieldWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
dfunc
    where
      dfunc :: [a] -> [a] -> [a]
dfunc [] [a]
bdata = [a]
bdata
      dfunc [a]
adata [a]
_ = [a]
adata

instance Semigroup (Object a) where
  <> :: Object a -> Object a -> Object a
(<>) = ([a] -> [a] -> [a]) -> Object a -> Object a -> Object a
forall a b c.
([a] -> [b] -> [c]) -> Object a -> Object b -> Object c
joinObjectFieldWith [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
(<>)

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

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

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

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

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

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


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

-- $aeson
-- The parser uses internally "Data.Aeson" types, so that the FromJSON instances are
-- directly usable with the 'value' parser. It may be more convenient to parse the
-- outer structure with json-stream and the inner objects with aeson as long as constant-space
-- decoding is not required.
--
-- Json-stream defines the object-access operators '.:', '.:?'
-- but in a slightly different albeit more natural way. New operators are '.!' for
-- array access and '.|' to handle missing values.
--
-- >>> let test = "[{\"name\": \"test1\", \"value\": 1}, {\"name\": \"test2\", \"value\": null}, {\"name\": \"test3\"}]"
-- >>> let person = (,) <$> "name" .: string <*> "value" .: integer .| (-1)
-- >>> let people = arrayOf person
-- >>> parseByteString people test :: [(T.Text, Int)]
-- [("test1",1),("test2",-1),("test3",-1)]
--
-- The above code would run 3 parsers in parallel to get the appropriate results. 
-- You can use the 'objectOf' parser to get a similar result in a more performant way.
--
-- >>> let test = "[{\"name\": \"test1\", \"value\": 1}, {\"name\": \"test2\", \"value\": null}, {\"name\": \"test3\"}]"
-- >>> let person = objectOf $ (,) <$> "name" .: string <*> "value" .: integer .| (-1)
-- >>> let people = arrayOf person
-- >>> parseByteString people test :: [(T.Text, Int)]
-- [("test1",1),("test2",-1),("test3",-1)]
--
-- $performance
-- The parser tries to do the least amount of work to get the job done, skipping over items that
-- are not required. General guidelines to get best performance:
--
-- Do not use the 'value' parser for the whole object if the object is big.
-- Consider using the 'objectOf' parser to parse objects instead of direct applicative parsing
-- for creating objects if they have lots of records. Every '<*>' outside of direct 'objectOf' parser
-- causes parallel parsing. Too many parallel parsers kill performance.
--
-- > arrayOf $ objectOf $ MyStructure <$> "field1" .: string <*> "field2" .: integer <*> .... <*> "field20" .: string
--
-- will be the fastest and use the least memory. 
--
-- > arrayOf value :: Parser MyStructure -- MyStructure with FromJSON instance
--
-- will probably still behave better than
--
-- > arrayOf $ MyStructure <$> "field1" .: string <*> "field2" .: integer <*> .... <*> "field20" .: string
--
-- and also better (at least memory-wise) than
--
-- > value :: Parser [MyStructure]
--
-- unless the structure has hundreths of fields and you are parsing only a substructure.
--
-- The 'integer' parser was optimized in such
-- a way that the integer numbers skip the conversion to 'Scientific', resulting in a slightly
-- faster speed.
--
-- It is possible to use the '*>' operator to filter objects based on a condition, e.g.:
--
-- > arrayOf $ id <$> "error" .: number
-- >               *> "name" .: string
--
-- This will return all objects that contain attribute error with number content. The parser will
-- skip trying to decode the name attribute if error is not found.
--