diff --git a/Data/JsonStream/CLexType.hsc b/Data/JsonStream/CLexType.hsc --- a/Data/JsonStream/CLexType.hsc +++ b/Data/JsonStream/CLexType.hsc @@ -8,9 +8,6 @@ #include "lexer.h" -resultLimit :: Int -resultLimit = #const RESULT_COUNT - #{enum LexResultType, LexResultType , resNumber = RES_NUMBER , resString = RES_STRING diff --git a/Data/JsonStream/CLexer.hs b/Data/JsonStream/CLexer.hs --- a/Data/JsonStream/CLexer.hs +++ b/Data/JsonStream/CLexer.hs @@ -43,10 +43,14 @@ , hdrPosition :: !CInt , hdrLength :: !CInt , hdrResultNum :: !CInt + , hdrResultLimit :: !CInt } deriving (Show) +defHeader :: Header +defHeader = Header 0 0 0 0 0 0 0 + instance Storable Header where - sizeOf _ = 7 * sizeOf (undefined :: CInt) + sizeOf _ = 8 * sizeOf (undefined :: CInt) alignment _ = sizeOf (undefined :: CInt) peek ptr = do state <- peekByteOff ptr 0 @@ -55,8 +59,8 @@ position <- peekByteOff ptr (3 * sizeOf state) slength <- peekByteOff ptr (4 * sizeOf state) sresultnum <- peekByteOff ptr (5 * sizeOf state) - return $ Header state sdata1 sdata2 position slength sresultnum - -- return $ Header state sdata1 sdata2 position slength sresultnum + sresultlimit <- peekByteOff ptr (6 * sizeOf state) + return $ Header state sdata1 sdata2 position slength sresultnum sresultlimit poke ptr (Header {..}) = do pokeByteOff ptr 0 hdrCurrentState @@ -65,6 +69,7 @@ pokeByteOff ptr (3 * sizeOf hdrCurrentState) hdrPosition pokeByteOff ptr (4 * sizeOf hdrCurrentState) hdrLength pokeByteOff ptr (5 * sizeOf hdrCurrentState) hdrResultNum + pokeByteOff ptr (6 * sizeOf hdrCurrentState) hdrResultLimit peekResultField :: Int -> Int -> ResultPtr -> Int peekResultField n fieldno fptr = inlinePerformIO $ -- !! Using inlinePerformIO should be safe - we are just reading bytes from memory @@ -91,7 +96,7 @@ poke hdrptr (hdr{hdrResultNum=0, hdrLength=fromIntegral $ BS.length bs}) bsptr <- unsafeUseAsCString bs return - resptr <- mallocForeignPtrBytes (resultLimit * sizeOf (undefined :: CInt) * 4) + resptr <- mallocForeignPtrBytes (fromIntegral (hdrResultLimit hdr) * sizeOf (undefined :: CInt) * 4) res <- withForeignPtr resptr $ \resptr' -> lexJson bsptr hdrptr resptr' @@ -212,18 +217,22 @@ PartialResult (StringContent (encodeUtf8 $ T.singleton $ toEnum resAddData)) next -- -- Partial string, not the end | resType == resStringPartial -> - if resLength == 0 + if resLength == -1 then PartialResult (StringContent (BSW.singleton $ fromIntegral resAddData)) next -- \n\r.. else PartialResult (StringContent textSection) next -- normal string section | otherwise -> error "Unsupported" +-- | Estimate number of elements in a chunk +estResultLimit :: BS.ByteString -> CInt +estResultLimit dta = fromIntegral $ 1 + BS.length dta `div` 5 + getNextResult :: TempData -> TokenResult getNextResult tmp@(TempData {..}) | tmpError = TokFailed | hdrPosition tmpHeader < hdrLength tmpHeader = parseResults tmp (callLex tmpBuffer tmpHeader) | otherwise = TokMoreData newdata where - newdata dta = parseResults newtmp (callLex dta newhdr) + newdata dta = parseResults newtmp (callLex dta newhdr{hdrResultLimit=estResultLimit dta}) where newtmp = tmp{tmpBuffer=dta} newhdr = tmpHeader{hdrPosition=0, hdrLength=fromIntegral $ BS.length dta} @@ -232,4 +241,4 @@ tokenParser :: BS.ByteString -> TokenResult tokenParser dta = getNextResult (TempData dta newhdr False []) where - newhdr = Header 0 0 0 0 (fromIntegral $ BS.length dta) 0 + newhdr = defHeader{hdrLength=fromIntegral (BS.length dta), hdrResultLimit=(estResultLimit dta)} diff --git a/Data/JsonStream/Parser.hs b/Data/JsonStream/Parser.hs --- a/Data/JsonStream/Parser.hs +++ b/Data/JsonStream/Parser.hs @@ -82,7 +82,6 @@ import Data.Text.Lazy.Encoding (decodeUtf8') import qualified Data.Vector as Vec -import Data.Bits (clearBit, setBit) import Data.JsonStream.CLexer (tokenParser) import Data.JsonStream.TokenParser @@ -249,7 +248,7 @@ nextitem yielded _ (JValue (AE.String key)) ntok = objcontent yielded (callParse (valparse key) ntok) nextitem yielded _ (StringContent str) ntok = objcontent yielded $ moreData (getLongKey [str] (BS.length str)) ntok - nextitem _ _ _ _ = Failed "Object - unexpected item" + nextitem _ _ el _ = Failed $ "Object - unexpected item: " ++ show el -- If we already yielded and should yield once, ignore the rest of the object objcontent yielded (Done _ ntp) @@ -460,6 +459,11 @@ ignoreVal' :: Int -> Parser a ignoreVal' stval = Parser $ moreData (handleTok stval) where + handleLongString level _ (StringContent _) ntok = moreData (handleLongString level) ntok + handleLongString 0 _ StringEnd ntok = Done "" ntok + handleLongString level _ StringEnd ntok = moreData (handleTok level) ntok + handleLongString _ _ el _ = Failed $ "Unexpected element in handleLongStr: " ++ (show el) + handleTok :: Int -> TokenResult -> Element -> TokenResult -> ParseResult a handleTok 0 _ (JValue _) ntok = Done "" ntok handleTok 0 _ (JInteger _) ntok = Done "" ntok @@ -471,12 +475,12 @@ case el of JValue _ -> moreData (handleTok level) ntok JInteger _ -> moreData (handleTok level) ntok - StringContent _ -> moreData (handleTok (setBit level 30)) ntok - StringEnd -> moreData (handleTok (clearBit level 30)) ntok -- The 30s bit indicates that we are in string + StringContent _ -> moreData (handleLongString level) ntok ArrayEnd _ -> moreData (handleTok (level - 1)) ntok ObjectEnd _ -> moreData (handleTok (level - 1)) ntok ArrayBegin -> moreData (handleTok (level + 1)) ntok ObjectBegin -> moreData (handleTok (level + 1)) ntok + StringEnd -> Failed "Internal error - out of order StringEnd" -- | Gather matches and return them as list. -- diff --git a/c_lib/lexer.c b/c_lib/lexer.c --- a/c_lib/lexer.c +++ b/c_lib/lexer.c @@ -179,7 +179,8 @@ int handle_string(const char *input, struct lexer *lexer) { int startposition = lexer->position; - for (char ch=input[lexer->position]; lexer->position < lexer->length && safechar(ch); ch = input[++lexer->position]) + char ch; + for (ch=input[lexer->position]; lexer->position < lexer->length && safechar(ch); ch = input[++lexer->position]) ; struct lexer_result *res = &lexer->result[lexer->result_num]; @@ -189,8 +190,7 @@ // Emit partial string res->restype = RES_STRING_PARTIAL; res->adddata = 0; - if (res->length != 0) // Do not add new result, if length == 0 - lexer->result_num++; + lexer->result_num++; // If we stopped because of backslash, change state, move one forward if (lexer->position < lexer->length) { @@ -250,7 +250,7 @@ res->restype = RES_STRING_PARTIAL; res->startpos = lexer->position; - res->length = 0; + res->length = -1; // Special value indicating that this is special character res->adddata = ch; lexer->result_num++; @@ -293,7 +293,7 @@ &&state_string_uni }; #define DISPATCH() { \ - if (!(lexer->position < lexer->length && lexer->result_num < RESULT_COUNT && res == 0)) \ + if (!(lexer->position < lexer->length && lexer->result_num < lexer->result_limit && res == 0)) \ return res; \ goto *dispatch_table[lexer->current_state];\ } diff --git a/c_lib/lexer.h b/c_lib/lexer.h --- a/c_lib/lexer.h +++ b/c_lib/lexer.h @@ -17,8 +17,6 @@ #define RES_STRING_UNI 11 #define RES_NUMBER_SMALL 12 -#define RESULT_COUNT 6000 - enum states { STATE_BASE = 0, STATE_STRING, @@ -47,6 +45,7 @@ int length; int result_num; + int result_limit; struct lexer_result *result; }; diff --git a/json-stream.cabal b/json-stream.cabal --- a/json-stream.cabal +++ b/json-stream.cabal @@ -1,5 +1,5 @@ name: json-stream -version: 0.3.0.1 +version: 0.3.0.2 synopsis: Incremental applicative JSON parser description: Easy to use JSON parser fully supporting incremental parsing. Parsing grammar in applicative form. @@ -20,6 +20,7 @@ category: Text, JSON build-type: Simple cabal-version: >=1.10 +extra-source-files: c_lib/lexer.h source-repository head type: git diff --git a/test/ParserSpec.hs b/test/ParserSpec.hs --- a/test/ParserSpec.hs +++ b/test/ParserSpec.hs @@ -14,6 +14,7 @@ import Data.JsonStream.Parser import Data.JsonStream.TokenParser +import Data.JsonStream.CLexer -- During the tests the single quotes are replaced with double quotes in the strings as -- otherwise it would be unreadable in haskell @@ -247,7 +248,39 @@ res = parse parser test1 :: [[Int]] res `shouldBe` [] - -- it "Parses correctly empty objects:" $ do + it "Parses correctly runs ignore parser on array:" $ do + let test1 = "[{\"name\":\"x\",\"key\":20}]" + onechar = BL.fromChunks $ map BS.singleton $ BS.unpack test1 + parser = arrayOf $ "key" .: integer + res = parseLazyByteString parser onechar :: [Int] + res `shouldBe` [20] + + it "Parses correctly runs ignore parser on array:" $ do + let test1 = "[\"abc\",123,\"def\"]" + onechar = BL.fromChunks $ map BS.singleton $ BS.unpack test1 + parser = arrayOf integer + res = parseLazyByteString parser onechar :: [Int] + res `shouldBe` [123] + + it "Parses correctly handles empty strings when sliced:" $ do + let test1 = "[\"\", \"\", true]" + onechar = BL.fromChunks $ map BS.singleton $ BS.unpack test1 + parser = arrayOf bool + res = parseByteString parser test1 :: [Bool] + res `shouldBe` [True] + + +-- testLexer (start:rest) = iter rest (tokenParser start) +-- where +-- iter [] (TokMoreData cont) = print "done" +-- iter (dta:rest) (TokMoreData cont) = do +-- print "more-data" +-- iter rest (cont dta) +-- iter dta (PartialResult el cont) = do +-- print el +-- iter dta cont +-- iter _ TokFailed = print "tok failed" + aeCompare :: Spec