{-# 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
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt)
  alignment :: Header -> Int
alignment Header
_ = CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt)
  peek :: Ptr Header -> IO Header
peek Ptr Header
ptr = do
    CInt
state <- Ptr Header -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr Int
0
    CInt
sdata1 <- Ptr Header -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr (CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
state)
    CInt
sdata2 <- Ptr Header -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
state)
    CInt
position <- Ptr Header -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
state)
    CInt
slength <- Ptr Header -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
state)
    CInt
sresultnum <- Ptr Header -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr (Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
state)
    CInt
sresultlimit <- Ptr Header -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Header
ptr (Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
state)
    Header -> IO Header
forall (m :: * -> *) a. Monad m => a -> m a
return (Header -> IO Header) -> Header -> IO Header
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
    Ptr Header -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr Int
0 CInt
hdrCurrentState
    Ptr Header -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
hdrCurrentState) CInt
hdrStateData
    Ptr Header -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
hdrCurrentState) CInt
hdrStateSata2
    Ptr Header -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
hdrCurrentState) CInt
hdrPosition
    Ptr Header -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
hdrCurrentState) CInt
hdrLength
    Ptr Header -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr (Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
hdrCurrentState) CInt
hdrResultNum
    Ptr Header -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Header
ptr (Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CLong -> Int
forall a. Storable a => a -> Int
sizeOf (CLong
forall a. HasCallStack => a
undefined :: CLong)

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

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

peekResultType :: Int -> ResultPtr -> LexResultType
peekResultType :: Int -> ResultPtr -> LexResultType
peekResultType Int
n ResultPtr
fptr = IO LexResultType -> LexResultType
forall a. IO a -> a
inlinePerformIO (IO LexResultType -> LexResultType)
-> IO LexResultType -> LexResultType
forall a b. (a -> b) -> a -> b
$ -- !! Using inlinePerformIO should be safe - we are just reading bytes from memory
  ForeignPtr () -> (Ptr () -> IO LexResultType) -> IO LexResultType
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (ResultPtr -> ForeignPtr ()
unresPtr ResultPtr
fptr) ((Ptr () -> IO LexResultType) -> IO LexResultType)
-> (Ptr () -> IO LexResultType) -> IO LexResultType
forall a b. (a -> b) -> a -> b
$ \Ptr ()
ptr ->
    CInt -> LexResultType
LexResultType (CInt -> LexResultType) -> IO CInt -> IO LexResultType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr () -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
ptr (Int
resultRecSize Int -> Int -> Int
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 = IO (CInt, Header, Int, ResultPtr) -> (CInt, Header, Int, ResultPtr)
forall a. IO a -> a
unsafeDupablePerformIO (IO (CInt, Header, Int, ResultPtr)
 -> (CInt, Header, Int, ResultPtr))
-> IO (CInt, Header, Int, ResultPtr)
-> (CInt, Header, Int, ResultPtr)
forall a b. (a -> b) -> a -> b
$ -- Using Dupable PerformIO should be safe - at the worst is is executed twice
  (Ptr Header -> IO (CInt, Header, Int, ResultPtr))
-> IO (CInt, Header, Int, ResultPtr)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Header -> IO (CInt, Header, Int, ResultPtr))
 -> IO (CInt, Header, Int, ResultPtr))
-> (Ptr Header -> IO (CInt, Header, Int, ResultPtr))
-> IO (CInt, Header, Int, ResultPtr)
forall a b. (a -> b) -> a -> b
$ \Ptr Header
hdrptr -> do
    Ptr Header -> Header -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Header
hdrptr (Header
hdr{hdrResultNum :: CInt
hdrResultNum=CInt
0, hdrLength :: CInt
hdrLength=Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs})

    CString
bsptr <- ByteString -> (CString -> IO CString) -> IO CString
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString ByteString
bs CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return
    ForeignPtr ()
resptr <- Int -> IO (ForeignPtr ())
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Header -> CInt
hdrResultLimit Header
hdr) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
resultRecSize)
    CInt
res <- ForeignPtr () -> (Ptr () -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
resptr ((Ptr () -> IO CInt) -> IO CInt) -> (Ptr () -> IO CInt) -> IO CInt
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 <- Ptr Header -> IO Header
forall a. Storable a => Ptr a -> IO a
peek Ptr Header
hdrptr
    let !rescount :: Int
rescount = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Header -> CInt
hdrResultNum Header
hdrres)
    (CInt, Header, Int, ResultPtr) -> IO (CInt, Header, Int, ResultPtr)
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 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
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) = ByteString -> (Int, ByteString)
forall a. Num a => ByteString -> (a, ByteString)
parseSign ByteString
tnumber :: (Int, BS.ByteString)
      ((Integer
num, Int
numdigits), ByteString
r2) = ByteString -> ((Integer, Int), ByteString)
forall a b. (Num a, Num b) => ByteString -> ((a, b), ByteString)
parseDecimal ByteString
r1 :: ((Integer, Int), BS.ByteString)
      ((Integer
frac, Int
frdigits), ByteString
r3) = ByteString -> ((Integer, Int), ByteString)
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
    Bool -> Maybe () -> Maybe ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
numdigits Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
rest)) Maybe ()
forall a. Maybe a
Nothing
    let dpart :: Integer
dpart = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
csign Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
num Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
frdigits) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
frac) :: Integer
        e :: Int
e = Int
texp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
frdigits
    Scientific -> Maybe Scientific
forall (m :: * -> *) a. Monad m => a -> m a
return (Scientific -> Maybe Scientific) -> Scientific -> Maybe Scientific
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' = ByteString -> ((a, b), ByteString)
forall a b. (Num a, Num b) => ByteString -> ((a, b), ByteString)
parseDecimal (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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
firstc Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'E' =
              let (Int
sign, ByteString
rest) = ByteString -> (Int, ByteString)
forall a. Num a => ByteString -> (a, ByteString)
parseSign (ByteString -> ByteString
BS.tail ByteString
txt)
                  ((Int
dnum, Int
_), ByteString
trest) = ByteString -> ((Int, Int), ByteString)
forall a b. (Num a, Num b) => ByteString -> ((a, b), ByteString)
parseDecimal ByteString
rest :: ((Int, Int), BS.ByteString)
              in (Int
dnum Int -> Int -> Int
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' = (a
1, ByteString -> ByteString
BS.tail ByteString
txt)
      | ByteString -> Char
BS.head ByteString
txt Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' = (-a
1, 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 = ByteString -> (a, b) -> ((a, b), ByteString)
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
dchr Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57 = ByteString -> (a, b) -> ((a, b), ByteString)
parseNum (ByteString -> ByteString
BS.tail ByteString
txt) (a
start a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
dchr Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48), b
digits b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)
      | Bool
otherwise = ((a
start, b
digits), ByteString
txt)
      where
        dchr :: Word8
dchr = 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 CInt -> CInt -> Bool
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 Int -> Int -> Bool
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          context :: ByteString
context = Int -> ByteString -> ByteString
BS.drop (Int
resStartPos Int -> Int -> Int
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 LexResultType -> LexResultType -> Bool
forall a. Eq a => a -> a -> Bool
== LexResultType
resNumberPartial ->
            if | CLong
resAddData CLong -> CLong -> Bool
forall a. Eq a => a -> a -> Bool
== CLong
0 -> TempData -> TokenResult
getNextResult ([ByteString] -> TempData
newtemp [ByteString
textSection]) -- First part of number
               | [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Int
BS.length [ByteString]
tmpNumbers) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
numberDigitLimit ->  TokenResult
TokFailed -- Number too long
               | Bool
otherwise -> TempData -> TokenResult
getNextResult ([ByteString] -> TempData
newtemp (ByteString
textSectionByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
tmpNumbers)) -- Middle part of number
        | LexResultType
resType LexResultType -> LexResultType -> Bool
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 LexResultType -> LexResultType -> Bool
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 LexResultType -> LexResultType -> Bool
forall a. Eq a => a -> a -> Bool
== LexResultType
resNull -> Element -> TokenResult -> TokenResult
PartialResult (Value -> Element
JValue Value
AE.Null) TokenResult
next
        | LexResultType
resType LexResultType -> LexResultType -> Bool
forall a. Eq a => a -> a -> Bool
== LexResultType
resOpenBrace -> Element -> TokenResult -> TokenResult
PartialResult Element
ObjectBegin TokenResult
next
        | LexResultType
resType LexResultType -> LexResultType -> Bool
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 LexResultType -> LexResultType -> Bool
forall a. Eq a => a -> a -> Bool
== LexResultType
resCloseBrace -> Element -> TokenResult -> TokenResult
PartialResult (ByteString -> Element
ObjectEnd ByteString
context) TokenResult
next
        | LexResultType
resType LexResultType -> LexResultType -> Bool
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 LexResultType -> LexResultType -> Bool
forall a. Eq a => a -> a -> Bool
== LexResultType
resNumberSmall ->
            if | Int
resLength Int -> Int -> Bool
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 (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Scientific
scientific (CLong -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
resAddData) ((-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
resLength)))
                               TokenResult
next
        -- Number optimized - floating
        | LexResultType
resType LexResultType -> LexResultType -> Bool
forall a. Eq a => a -> a -> Bool
== LexResultType
resNumber ->
            if | CLong
resAddData CLong -> CLong -> Bool
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 ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse (ByteString
textSectionByteString -> [ByteString] -> [ByteString]
forall 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 LexResultType -> LexResultType -> Bool
forall a. Eq a => a -> a -> Bool
== LexResultType
resString ->
          if | CLong
resAddData CLong -> CLong -> Bool
forall a. Eq a => a -> a -> Bool
== -CLong
1 Bool -> Bool -> Bool
|| CLong
resAddData CLong -> CLong -> Bool
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 CLong -> CLong -> Bool
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 LexResultType -> LexResultType -> Bool
forall a. Eq a => a -> a -> Bool
== LexResultType
resStringPartial ->
              Element -> TokenResult -> TokenResult
PartialResult (ByteString -> Element
StringContent ByteString
textSection) TokenResult
next -- string section
        | Bool
otherwise -> String -> TokenResult
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 = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int
20 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
dta Int -> Int -> Int
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 CInt -> CInt -> Bool
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=Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
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=Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
dta), hdrResultLimit :: CInt
hdrResultLimit=ByteString -> CInt
estResultLimit ByteString
dta}