{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MultiWayIf               #-}
{-# LANGUAGE OverloadedStrings        #-}
{-# LANGUAGE RecordWildCards          #-}

module Data.JsonStream.CLexer (
    tokenParser
  , unescapeText
) where

#if !MIN_VERSION_bytestring(0,10,6)
import           Control.Applicative         ((<$>))
#endif

import           Control.Monad               (when)
import qualified Data.Aeson                  as AE
import qualified Data.ByteString             as BSW
import qualified Data.ByteString.Char8       as BS
import           Data.ByteString.Unsafe      (unsafeUseAsCString)
import           Data.Scientific             (Scientific, scientific)
import           Data.Text.Internal.Unsafe   (inlinePerformIO)
import           Foreign
import           Foreign.C.Types
import           System.IO.Unsafe            (unsafeDupablePerformIO)

import           Data.JsonStream.CLexType
import           Data.JsonStream.TokenParser (Element (..), TokenResult (..))
import           Data.JsonStream.Unescape (unescapeText)

-- | Limit for maximum size of a number; fail if larger number is found
-- this is needed to make this constant-space, otherwise we would eat
-- all memory just memoizing the number. The lexer fails if larger number
-- is encountered.
numberDigitLimit :: Int
numberDigitLimit :: Int
numberDigitLimit = Int
200000

newtype ResultPtr = ResultPtr { ResultPtr -> ForeignPtr ()
unresPtr :: ForeignPtr () }

-- | Header for the C routing for batch parsing
data Header = Header {
    Header -> CInt
hdrCurrentState :: !CInt
  , Header -> CInt
hdrStateData    :: !CInt
  , Header -> CInt
hdrStateSata2   :: !CInt

  , Header -> CInt
hdrPosition     :: !CInt
  , Header -> CInt
hdrLength       :: !CInt
  , Header -> CInt
hdrResultNum    :: !CInt
  , Header -> CInt
hdrResultLimit  :: !CInt
} deriving (Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show)

defHeader :: Header
defHeader :: Header
defHeader = CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Header
Header CInt
0 CInt
0 CInt
0 CInt
0 CInt
0 CInt
0 CInt
0

instance Storable Header where
  sizeOf :: Header -> Int
sizeOf Header
_ = Int
7 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: CInt)
  alignment :: Header -> Int
alignment Header
_ = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: CInt)
  peek :: Ptr Header -> IO Header
peek Ptr Header
ptr = do
    CInt
state <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr Int
0
    CInt
sdata1 <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr (forall a. Storable a => a -> Int
sizeOf CInt
state)
    CInt
sdata2 <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr (Int
2 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf CInt
state)
    CInt
position <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr (Int
3 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf CInt
state)
    CInt
slength <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr (Int
4 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf CInt
state)
    CInt
sresultnum <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr (Int
5 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf CInt
state)
    CInt
sresultlimit <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr (Int
6 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf CInt
state)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> Header
Header CInt
state CInt
sdata1  CInt
sdata2  CInt
position  CInt
slength CInt
sresultnum CInt
sresultlimit

  poke :: Ptr Header -> Header -> IO ()
poke Ptr Header
ptr (Header {CInt
hdrResultLimit :: CInt
hdrResultNum :: CInt
hdrLength :: CInt
hdrPosition :: CInt
hdrStateSata2 :: CInt
hdrStateData :: CInt
hdrCurrentState :: CInt
hdrResultLimit :: Header -> CInt
hdrResultNum :: Header -> CInt
hdrLength :: Header -> CInt
hdrPosition :: Header -> CInt
hdrStateSata2 :: Header -> CInt
hdrStateData :: Header -> CInt
hdrCurrentState :: Header -> CInt
..}) = do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr Int
0 CInt
hdrCurrentState
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr (Int
1 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf CInt
hdrCurrentState) CInt
hdrStateData
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr (Int
2 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf CInt
hdrCurrentState) CInt
hdrStateSata2
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr (Int
3 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf CInt
hdrCurrentState) CInt
hdrPosition
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr (Int
4 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf CInt
hdrCurrentState) CInt
hdrLength
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr (Int
5 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf CInt
hdrCurrentState) CInt
hdrResultNum
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr (Int
6 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf CInt
hdrCurrentState) CInt
hdrResultLimit

-- | Hardcoded result record size (see lexer.h)
resultRecSize :: Int
resultRecSize :: Int
resultRecSize = Int
4 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: CInt) forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: CLong)

peekResultField :: Int -> Int -> ResultPtr -> Int
peekResultField :: Int -> Int -> ResultPtr -> Int
peekResultField Int
n Int
fieldno ResultPtr
fptr = forall a. IO a -> a
inlinePerformIO forall a b. (a -> b) -> a -> b
$ -- !! Using inlinePerformIO should be safe - we are just reading bytes from memory
  forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (ResultPtr -> ForeignPtr ()
unresPtr ResultPtr
fptr) forall a b. (a -> b) -> a -> b
$ \Ptr ()
ptr ->
    forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
ptr (Int
resultRecSize forall a. Num a => a -> a -> a
* Int
n forall a. Num a => a -> a -> a
+ Int
fieldno forall a. Num a => a -> a -> a
* Int
isize) :: IO CInt)
  where
    isize :: Int
isize = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: CInt)

peekResultAddData :: Int -> ResultPtr -> CLong
peekResultAddData :: Int -> ResultPtr -> CLong
peekResultAddData Int
n ResultPtr
fptr = forall a. IO a -> a
inlinePerformIO forall a b. (a -> b) -> a -> b
$ -- !! Using inlinePerformIO should be safe - we are just reading bytes from memory
  forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (ResultPtr -> ForeignPtr ()
unresPtr ResultPtr
fptr) forall a b. (a -> b) -> a -> b
$ \Ptr ()
ptr ->
    forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
ptr (Int
resultRecSize forall a. Num a => a -> a -> a
* Int
n forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
* Int
isize) :: IO CLong)
  where
    isize :: Int
isize = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: CInt)

peekResultType :: Int -> ResultPtr -> LexResultType
peekResultType :: Int -> ResultPtr -> LexResultType
peekResultType Int
n ResultPtr
fptr = forall a. IO a -> a
inlinePerformIO forall a b. (a -> b) -> a -> b
$ -- !! Using inlinePerformIO should be safe - we are just reading bytes from memory
  forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (ResultPtr -> ForeignPtr ()
unresPtr ResultPtr
fptr) forall a b. (a -> b) -> a -> b
$ \Ptr ()
ptr ->
    CInt -> LexResultType
LexResultType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
ptr (Int
resultRecSize forall a. Num a => a -> a -> a
* Int
n)

foreign import ccall unsafe "lex_json" lexJson :: Ptr CChar -> Ptr Header -> Ptr () -> IO CInt

-- Call the C lexer. Returns (Error code, Header, (result_count, result_count, ResultPointer))
callLex :: BS.ByteString -> Header -> (CInt, Header, Int, ResultPtr)
callLex :: ByteString -> Header -> (CInt, Header, Int, ResultPtr)
callLex ByteString
bs Header
hdr = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ -- Using Dupable PerformIO should be safe - at the worst is is executed twice
  forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Header
hdrptr -> do
    forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Header
hdrptr (Header
hdr{hdrResultNum :: CInt
hdrResultNum=CInt
0, hdrLength :: CInt
hdrLength=forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs})

    CString
bsptr <- forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString ByteString
bs forall (m :: * -> *) a. Monad m => a -> m a
return
    ForeignPtr ()
resptr <- forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Header -> CInt
hdrResultLimit Header
hdr) forall a. Num a => a -> a -> a
* Int
resultRecSize)
    CInt
res <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
resptr forall a b. (a -> b) -> a -> b
$ \Ptr ()
resptr' ->
      CString -> Ptr Header -> Ptr () -> IO CInt
lexJson CString
bsptr Ptr Header
hdrptr Ptr ()
resptr'

    Header
hdrres <- forall a. Storable a => Ptr a -> IO a
peek Ptr Header
hdrptr
    let !rescount :: Int
rescount = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Header -> CInt
hdrResultNum Header
hdrres)
    forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
res, Header
hdrres, Int
rescount, ForeignPtr () -> ResultPtr
ResultPtr ForeignPtr ()
resptr)

{-# INLINE substr #-}
substr :: Int -> Int -> BS.ByteString -> BS.ByteString
substr :: Int -> Int -> ByteString -> ByteString
substr Int
start Int
len = Int -> ByteString -> ByteString
BS.take Int
len forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop Int
start

data TempData = TempData {
    TempData -> ByteString
tmpBuffer  :: BS.ByteString
  , TempData -> Header
tmpHeader  :: Header
  , TempData -> Bool
tmpError   :: Bool
  , TempData -> [ByteString]
tmpNumbers :: [BS.ByteString]
}

-- | Parse number from bytestring to Scientific using JSON syntax rules
parseNumber :: BS.ByteString -> Maybe Scientific
parseNumber :: ByteString -> Maybe Scientific
parseNumber ByteString
tnumber = do
    let
      (Int
csign, ByteString
r1) = forall {a}. Num a => ByteString -> (a, ByteString)
parseSign ByteString
tnumber :: (Int, BS.ByteString)
      ((Integer
num, Int
numdigits), ByteString
r2) = forall {a} {b}.
(Num a, Num b) =>
ByteString -> ((a, b), ByteString)
parseDecimal ByteString
r1 :: ((Integer, Int), BS.ByteString)
      ((Integer
frac, Int
frdigits), ByteString
r3) = forall {a} {b}.
(Num a, Num b) =>
ByteString -> ((a, b), ByteString)
parseFract ByteString
r2 :: ((Integer, Int), BS.ByteString)
      (Int
texp, ByteString
rest) = ByteString -> (Int, ByteString)
parseE ByteString
r3
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
numdigits forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
rest)) forall a. Maybe a
Nothing
    let dpart :: Integer
dpart = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
csign forall a. Num a => a -> a -> a
* (Integer
num forall a. Num a => a -> a -> a
* (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
frdigits) forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
frac) :: Integer
        e :: Int
e = Int
texp forall a. Num a => a -> a -> a
- Int
frdigits
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
scientific Integer
dpart Int
e
  where
    parseFract :: ByteString -> ((a, b), ByteString)
parseFract ByteString
txt
      | ByteString -> Bool
BS.null ByteString
txt = ((a
0, b
0), ByteString
txt)
      | ByteString -> Char
BS.head ByteString
txt forall a. Eq a => a -> a -> Bool
== Char
'.' = forall {a} {b}.
(Num a, Num b) =>
ByteString -> ((a, b), ByteString)
parseDecimal (HasCallStack => ByteString -> ByteString
BS.tail ByteString
txt)
      | Bool
otherwise = ((a
0,b
0), ByteString
txt)

    parseE :: ByteString -> (Int, ByteString)
parseE ByteString
txt
      | ByteString -> Bool
BS.null ByteString
txt = (Int
0, ByteString
txt)
      | Char
firstc forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
firstc forall a. Eq a => a -> a -> Bool
== Char
'E' =
              let (Int
sign, ByteString
rest) = forall {a}. Num a => ByteString -> (a, ByteString)
parseSign (HasCallStack => ByteString -> ByteString
BS.tail ByteString
txt)
                  ((Int
dnum, Int
_), ByteString
trest) = forall {a} {b}.
(Num a, Num b) =>
ByteString -> ((a, b), ByteString)
parseDecimal ByteString
rest :: ((Int, Int), BS.ByteString)
              in (Int
dnum forall a. Num a => a -> a -> a
* Int
sign, ByteString
trest)
      | Bool
otherwise = (Int
0, ByteString
txt)
      where
        firstc :: Char
firstc = ByteString -> Char
BS.head ByteString
txt

    parseSign :: ByteString -> (a, ByteString)
parseSign ByteString
txt
      | ByteString -> Bool
BS.null ByteString
txt = (a
1, ByteString
txt)
      | ByteString -> Char
BS.head ByteString
txt forall a. Eq a => a -> a -> Bool
== Char
'+' = (a
1, HasCallStack => ByteString -> ByteString
BS.tail ByteString
txt)
      | ByteString -> Char
BS.head ByteString
txt forall a. Eq a => a -> a -> Bool
== Char
'-' = (-a
1, HasCallStack => ByteString -> ByteString
BS.tail ByteString
txt)
      | Bool
otherwise = (a
1, ByteString
txt)

    parseDecimal :: ByteString -> ((a, b), ByteString)
parseDecimal ByteString
txt
      | ByteString -> Bool
BS.null ByteString
txt = ((a
0, b
0), ByteString
txt)
      | Bool
otherwise = forall {a} {b}.
(Num a, Num b) =>
ByteString -> (a, b) -> ((a, b), ByteString)
parseNum ByteString
txt (a
0,b
0)

    parseNum :: ByteString -> (a, b) -> ((a, b), ByteString)
parseNum ByteString
txt (!a
start, !b
digits)
      | ByteString -> Bool
BS.null ByteString
txt = ((a
start, b
digits), ByteString
txt)
      | Word8
dchr forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
dchr forall a. Ord a => a -> a -> Bool
<= Word8
57 = ByteString -> (a, b) -> ((a, b), ByteString)
parseNum (HasCallStack => ByteString -> ByteString
BS.tail ByteString
txt) (a
start forall a. Num a => a -> a -> a
* a
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
dchr forall a. Num a => a -> a -> a
- Word8
48), b
digits forall a. Num a => a -> a -> a
+ b
1)
      | Bool
otherwise = ((a
start, b
digits), ByteString
txt)
      where
        dchr :: Word8
dchr = HasCallStack => ByteString -> Word8
BSW.head ByteString
txt

-- | Parse particular result
parseResults :: TempData -> (CInt, Header, Int, ResultPtr) -> TokenResult
parseResults :: TempData -> (CInt, Header, Int, ResultPtr) -> TokenResult
parseResults TempData{tmpNumbers :: TempData -> [ByteString]
tmpNumbers=[ByteString]
tmpNumbers, tmpBuffer :: TempData -> ByteString
tmpBuffer=ByteString
bs} (CInt
err, Header
hdr, Int
rescount, ResultPtr
resptr) = Int -> TokenResult
parse Int
0
  where
    newtemp :: [ByteString] -> TempData
newtemp = ByteString -> Header -> Bool -> [ByteString] -> TempData
TempData ByteString
bs Header
hdr (CInt
err forall a. Eq a => a -> a -> Bool
/= CInt
0)
    -- We iterate the items from CNT to 1, 1 is the last element, CNT is the first
    parse :: Int -> TokenResult
parse Int
n
      | Int
n forall a. Ord a => a -> a -> Bool
>= Int
rescount = TempData -> TokenResult
getNextResult ([ByteString] -> TempData
newtemp [ByteString]
tmpNumbers)
      | Bool
otherwise =
      let resType :: LexResultType
resType = Int -> ResultPtr -> LexResultType
peekResultType Int
n ResultPtr
resptr
          resStartPos :: Int
resStartPos = Int -> Int -> ResultPtr -> Int
peekResultField Int
n Int
1 ResultPtr
resptr
          resLength :: Int
resLength = Int -> Int -> ResultPtr -> Int
peekResultField Int
n Int
2 ResultPtr
resptr
          resAddData :: CLong
resAddData = Int -> ResultPtr -> CLong
peekResultAddData Int
n ResultPtr
resptr
          next :: TokenResult
next = Int -> TokenResult
parse (Int
n forall a. Num a => a -> a -> a
+ Int
1)
          context :: ByteString
context = Int -> ByteString -> ByteString
BS.drop (Int
resStartPos forall a. Num a => a -> a -> a
+ Int
resLength) ByteString
bs
          textSection :: ByteString
textSection = Int -> Int -> ByteString -> ByteString
substr Int
resStartPos Int
resLength ByteString
bs
      in case () of
       ()
_| LexResultType
resType forall a. Eq a => a -> a -> Bool
== LexResultType
resNumberPartial ->
            if | CLong
resAddData forall a. Eq a => a -> a -> Bool
== CLong
0 -> TempData -> TokenResult
getNextResult ([ByteString] -> TempData
newtemp [ByteString
textSection]) -- First part of number
               | forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Int
BS.length [ByteString]
tmpNumbers) forall a. Ord a => a -> a -> Bool
> Int
numberDigitLimit ->  TokenResult
TokFailed -- Number too long
               | Bool
otherwise -> TempData -> TokenResult
getNextResult ([ByteString] -> TempData
newtemp (ByteString
textSectionforall a. a -> [a] -> [a]
:[ByteString]
tmpNumbers)) -- Middle part of number
        | LexResultType
resType forall a. Eq a => a -> a -> Bool
== LexResultType
resTrue -> Element -> TokenResult -> TokenResult
PartialResult (Value -> Element
JValue (Bool -> Value
AE.Bool Bool
True)) TokenResult
next
        | LexResultType
resType forall a. Eq a => a -> a -> Bool
== LexResultType
resFalse -> Element -> TokenResult -> TokenResult
PartialResult (Value -> Element
JValue (Bool -> Value
AE.Bool Bool
False)) TokenResult
next
        | LexResultType
resType forall a. Eq a => a -> a -> Bool
== LexResultType
resNull -> Element -> TokenResult -> TokenResult
PartialResult (Value -> Element
JValue Value
AE.Null) TokenResult
next
        | LexResultType
resType forall a. Eq a => a -> a -> Bool
== LexResultType
resOpenBrace -> Element -> TokenResult -> TokenResult
PartialResult Element
ObjectBegin TokenResult
next
        | LexResultType
resType forall a. Eq a => a -> a -> Bool
== LexResultType
resOpenBracket -> Element -> TokenResult -> TokenResult
PartialResult Element
ArrayBegin TokenResult
next
        -- ObjectEnd and ArrayEnd need pointer to data that wasn't parsed
        | LexResultType
resType forall a. Eq a => a -> a -> Bool
== LexResultType
resCloseBrace -> Element -> TokenResult -> TokenResult
PartialResult (ByteString -> Element
ObjectEnd ByteString
context) TokenResult
next
        | LexResultType
resType forall a. Eq a => a -> a -> Bool
== LexResultType
resCloseBracket -> Element -> TokenResult -> TokenResult
PartialResult (ByteString -> Element
ArrayEnd ByteString
context) TokenResult
next
        -- Number optimized - integer
        | LexResultType
resType forall a. Eq a => a -> a -> Bool
== LexResultType
resNumberSmall ->
            if | Int
resLength forall a. Eq a => a -> a -> Bool
== Int
0 ->  Element -> TokenResult -> TokenResult
PartialResult (CLong -> Element
JInteger CLong
resAddData) TokenResult
next
               | Bool
otherwise -> Element -> TokenResult -> TokenResult
PartialResult
                               (Value -> Element
JValue (Scientific -> Value
AE.Number forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
scientific (forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
resAddData) ((-Int
1) forall a. Num a => a -> a -> a
* Int
resLength)))
                               TokenResult
next
        -- Number optimized - floating
        | LexResultType
resType forall a. Eq a => a -> a -> Bool
== LexResultType
resNumber ->
            if | CLong
resAddData forall a. Eq a => a -> a -> Bool
== CLong
0 -> -- Single one-part number
                    case ByteString -> Maybe Scientific
parseNumber ByteString
textSection of
                      Just Scientific
num -> Element -> TokenResult -> TokenResult
PartialResult (Value -> Element
JValue (Scientific -> Value
AE.Number Scientific
num)) TokenResult
next
                      Maybe Scientific
Nothing -> TokenResult
TokFailed
               | Bool
otherwise ->  -- Concatenate number from partial parts
                     case ByteString -> Maybe Scientific
parseNumber ([ByteString] -> ByteString
BS.concat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse (ByteString
textSectionforall a. a -> [a] -> [a]
:[ByteString]
tmpNumbers)) of
                       Just Scientific
num -> Element -> TokenResult -> TokenResult
PartialResult (Value -> Element
JValue (Scientific -> Value
AE.Number Scientific
num)) TokenResult
next
                       Maybe Scientific
Nothing -> TokenResult
TokFailed
        | LexResultType
resType forall a. Eq a => a -> a -> Bool
== LexResultType
resString ->
          if | CLong
resAddData forall a. Eq a => a -> a -> Bool
== -CLong
1 Bool -> Bool -> Bool
|| CLong
resAddData forall a. Eq a => a -> a -> Bool
== CLong
0 -> -- One-part string without escaped characters; with escaped
                Element -> TokenResult -> TokenResult
PartialResult (ByteString -> Bool -> Element
StringRaw ByteString
textSection (CLong
resAddData forall a. Eq a => a -> a -> Bool
== -CLong
1)) TokenResult
next
             | Bool
otherwise -> Element -> TokenResult -> TokenResult
PartialResult (ByteString -> Element
StringContent ByteString
textSection) -- Final part of partial strings
                            (Element -> TokenResult -> TokenResult
PartialResult Element
StringEnd TokenResult
next)
        | LexResultType
resType forall a. Eq a => a -> a -> Bool
== LexResultType
resStringPartial ->
              Element -> TokenResult -> TokenResult
PartialResult (ByteString -> Element
StringContent ByteString
textSection) TokenResult
next -- string section
        | Bool
otherwise -> forall a. HasCallStack => String -> a
error String
"Unsupported"

-- | Estimate number of elements in a chunk
estResultLimit :: BS.ByteString -> CInt
estResultLimit :: ByteString -> CInt
estResultLimit ByteString
dta = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
20 forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
dta forall a. Integral a => a -> a -> a
`quot` Int
5

getNextResult :: TempData -> TokenResult
getNextResult :: TempData -> TokenResult
getNextResult tmp :: TempData
tmp@TempData{Bool
[ByteString]
ByteString
Header
tmpNumbers :: [ByteString]
tmpError :: Bool
tmpHeader :: Header
tmpBuffer :: ByteString
tmpNumbers :: TempData -> [ByteString]
tmpError :: TempData -> Bool
tmpHeader :: TempData -> Header
tmpBuffer :: TempData -> ByteString
..}
  | Bool
tmpError = TokenResult
TokFailed
  | Header -> CInt
hdrPosition Header
tmpHeader forall a. Ord a => a -> a -> Bool
< Header -> CInt
hdrLength Header
tmpHeader = TempData -> (CInt, Header, Int, ResultPtr) -> TokenResult
parseResults TempData
tmp (ByteString -> Header -> (CInt, Header, Int, ResultPtr)
callLex ByteString
tmpBuffer Header
tmpHeader)
  | Bool
otherwise = (ByteString -> TokenResult) -> TokenResult
TokMoreData ByteString -> TokenResult
newdata
  where
    newdata :: ByteString -> TokenResult
newdata ByteString
dta = TempData -> (CInt, Header, Int, ResultPtr) -> TokenResult
parseResults TempData
newtmp (ByteString -> Header -> (CInt, Header, Int, ResultPtr)
callLex ByteString
dta Header
newhdr{hdrResultLimit :: CInt
hdrResultLimit=ByteString -> CInt
estResultLimit ByteString
dta})
      where
        newtmp :: TempData
newtmp = TempData
tmp{tmpBuffer :: ByteString
tmpBuffer=ByteString
dta}
        newhdr :: Header
newhdr = Header
tmpHeader{hdrPosition :: CInt
hdrPosition=CInt
0, hdrLength :: CInt
hdrLength=forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
dta}


tokenParser :: BS.ByteString -> TokenResult
tokenParser :: ByteString -> TokenResult
tokenParser ByteString
dta = TempData -> TokenResult
getNextResult (ByteString -> Header -> Bool -> [ByteString] -> TempData
TempData ByteString
dta Header
newhdr Bool
False [])
  where
    newhdr :: Header
newhdr = Header
defHeader{hdrLength :: CInt
hdrLength=forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
dta), hdrResultLimit :: CInt
hdrResultLimit=ByteString -> CInt
estResultLimit ByteString
dta}