{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ExistentialQuantification #-}
module Data.JsonStream.Parser (
Parser
, ParseOutput(..)
, runParser
, runParser'
, parseByteString
, parseLazyByteString
, decode
, eitherDecode
, decodeStrict
, eitherDecodeStrict
, value
, valueWith
, string
, byteString
, safeString
, number
, integer
, real
, bool
, jNull
, safeByteString
, (.:)
, (.:?)
, (.|)
, (.!)
, objectWithKey
, objectItems
, objectValues
, objectKeyValues
, arrayOf
, arrayWithIndexOf
, indexedArrayOf
, nullable
, objectOf
, Object
, filterI
, takeI
, mapWithFailure
, manyReverse
, foldI
, foldMapI
, unFoldI
, catMaybeI
, 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)
objectKeyStringLimit :: Int
objectKeyStringLimit :: Int
objectKeyStringLimit = Int
65536
data ParseResult v = MoreData (Parser v, BS.ByteString -> TokenResult)
| Failed String
| Done BS.ByteString TokenResult
| 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)
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)
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
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
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 <*>."
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 <|>"
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
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)
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
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)
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)
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
(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
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)
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)
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
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
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
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)
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
(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
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
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."
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."
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
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)
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
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
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)
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
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
-> 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
byteString :: Parser BS.ByteString
byteString :: Parser ByteString
byteString = Maybe Int -> Parser ByteString
longByteString Maybe Int
forall a. Maybe a
Nothing
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)
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
-> 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
string :: Parser T.Text
string :: Parser Text
string = Maybe Int -> Parser Text
longString Maybe Int
forall a. Maybe a
Nothing
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)
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
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)
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
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
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
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
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
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
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)
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
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)
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"
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"
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
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
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
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
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
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)
class OnObject o a where
(.:) :: T.Text -> Parser a -> o a
(.:?) :: T.Text -> Parser a -> o (Maybe a)
(.|) :: 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
(.!) :: 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 .!
data ParseOutput a = ParseYield a (ParseOutput a)
| ParseNeedData (BS.ByteString -> ParseOutput a)
| ParseFailed String
| ParseDone BS.ByteString
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
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
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
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
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
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
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
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
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."
data HValue = forall a. HValue a
data Object f = Object
(Map.Map T.Text (Parser HValue))
(Map.Map T.Text [HValue] -> [f])
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)
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) =
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
(<>)
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
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