json-stream 0.3.0.1 → 0.3.0.2
raw patch · 7 files changed
+66/−23 lines, 7 files
Files
- Data/JsonStream/CLexType.hsc +0/−3
- Data/JsonStream/CLexer.hs +16/−7
- Data/JsonStream/Parser.hs +8/−4
- c_lib/lexer.c +5/−5
- c_lib/lexer.h +1/−2
- json-stream.cabal +2/−1
- test/ParserSpec.hs +34/−1
Data/JsonStream/CLexType.hsc view
@@ -8,9 +8,6 @@ #include "lexer.h" -resultLimit :: Int-resultLimit = #const RESULT_COUNT- #{enum LexResultType, LexResultType , resNumber = RES_NUMBER , resString = RES_STRING
Data/JsonStream/CLexer.hs view
@@ -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)}
Data/JsonStream/Parser.hs view
@@ -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. --
c_lib/lexer.c view
@@ -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];\ }
c_lib/lexer.h view
@@ -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; };
json-stream.cabal view
@@ -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
test/ParserSpec.hs view
@@ -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