json-stream 0.3.1.0 → 0.3.2.0
raw patch · 9 files changed
+251/−158 lines, 9 filesdep +directorydep ~aesonPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: directory
Dependency ranges changed: aeson
API changes (from Hackage documentation)
- Data.JsonStream.Parser: bytestring :: Parser ByteString
Files
- Data/JsonStream/CLexType.hsc +0/−1
- Data/JsonStream/CLexer.hs +39/−13
- Data/JsonStream/Parser.hs +11/−25
- c_lib/lexer.c +35/−103
- c_lib/lexer.h +1/−4
- c_lib/unescape_string.c +132/−0
- changelog.md +4/−0
- json-stream.cabal +8/−4
- test/ParserSpec.hs +21/−8
Data/JsonStream/CLexType.hsc view
@@ -21,7 +21,6 @@ , resCloseBracket = RES_CLOSE_BRACKET , resStringPartial = RES_STRING_PARTIAL- , resStringUni = RES_STRING_UNI , resNumberPartial = RES_NUMBER_PARTIAL , resNumberSmall = RES_NUMBER_SMALL }
Data/JsonStream/CLexer.hs view
@@ -5,7 +5,9 @@ {-# LANGUAGE RecordWildCards #-} module Data.JsonStream.CLexer (- tokenParser+ tokenParser+ , unescapeText+ , mapLeft ) where import Control.Applicative ((<$>))@@ -13,14 +15,17 @@ import qualified Data.Aeson as AE import qualified Data.ByteString as BSW import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Internal as BS import Data.ByteString.Unsafe (unsafeUseAsCString)+import qualified Data.ByteString.Unsafe as BS import Data.Scientific (Scientific, scientific)-import qualified Data.Text as T-import Data.Text.Encoding (decodeUtf8', encodeUtf8)+import Data.Text.Encoding (decodeUtf8') import Data.Text.Internal.Unsafe (inlinePerformIO) import Foreign+import Foreign.C.String import Foreign.C.Types-import System.IO.Unsafe (unsafeDupablePerformIO)+import System.IO.Unsafe (unsafeDupablePerformIO,+ unsafePerformIO) import Data.JsonStream.CLexType import Data.JsonStream.TokenParser (Element (..), TokenResult (..))@@ -115,6 +120,29 @@ , tmpNumbers :: [BS.ByteString] } +foreign import ccall unsafe "bs_json_unescape" bs_json_unescape :: CULong -> Ptr CInt -> CString -> CString -> IO ()++unescapeText :: BS.ByteString -> Either String BS.ByteString+unescapeText bs =+ unsafePerformIO $+ do let len = BS.length bs+ outBsPtr <- BS.mallocByteString len+ (outBs, errCode) <-+ withForeignPtr outBsPtr $ \ptr ->+ alloca $ \errCode ->+ BS.unsafeUseAsCString bs $ \inBs ->+ do bs_json_unescape (fromIntegral len) errCode inBs ptr+ code <- peek errCode+ bs' <- BS.unsafePackCString ptr+ return (bs', code)+ return $ if errCode /= 0+ then Left ("Invalid escape sequence. ErrNo=" ++ show errCode)+ else Right outBs++mapLeft :: (a -> b) -> Either a c -> Either b c+mapLeft _ (Right v) = Right v+mapLeft f (Left v) = Left (f v)+ -- | Parse number from bytestring to Scientific using JSON syntax rules parseNumber :: BS.ByteString -> Maybe Scientific parseNumber tnumber = do@@ -206,20 +234,18 @@ Just num -> PartialResult (JValue (AE.Number num)) next Nothing -> TokFailed | resType == resString ->- if | resAddData == 0 -> -- One-part string- case decodeUtf8' textSection of+ if | resAddData == -1 -> -- One-part string without escaped characters+ case decodeUtf8' textSection of Right ctext -> PartialResult (JValue (AE.String ctext)) next Left _ -> TokFailed+ | resAddData == 0 -> -- One-part string with escaped characters+ case unescapeText textSection >>= (mapLeft show . decodeUtf8') of+ Right ctext -> PartialResult (JValue (AE.String ctext)) next+ Left _ -> TokFailed | otherwise -> PartialResult (StringContent textSection) -- Final part of partial strings (PartialResult StringEnd next)- -- -- Unicode- | resType == resStringUni ->- PartialResult (StringContent (encodeUtf8 $ T.singleton $ toEnum resAddData)) next- -- -- Partial string, not the end | resType == resStringPartial ->- if resLength == -1- then PartialResult (StringContent (BSW.singleton $ fromIntegral resAddData)) next -- \n\r..- else PartialResult (StringContent textSection) next -- normal string section+ PartialResult (StringContent textSection) next -- string section | otherwise -> error "Unsupported" -- | Estimate number of elements in a chunk
Data/JsonStream/Parser.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards #-} {-# LANGUAGE TupleSections #-} -- |@@ -42,7 +43,6 @@ -- * FromJSON parser , value , string- , bytestring -- * Constant space parsers , safeString , number@@ -81,12 +81,10 @@ import Data.Scientific (Scientific, isInteger, toBoundedInteger, toRealFloat) import qualified Data.Text as T-import Data.Text.Encoding (encodeUtf8)-import qualified Data.Text.Lazy as TL-import Data.Text.Lazy.Encoding (decodeUtf8')+import Data.Text.Encoding (decodeUtf8') import qualified Data.Vector as Vec -import Data.JsonStream.CLexer (tokenParser)+import Data.JsonStream.CLexer import Data.JsonStream.TokenParser @@ -293,8 +291,8 @@ getLongKey acc !len _ el ntok = case el of StringEnd- | Right key <- decodeUtf8' (BL.fromChunks $ reverse acc) ->- callParse (valparse $ T.concat $ TL.toChunks key) ntok+ | Right key <- unescapeText (BS.concat $ reverse acc) >>= (mapLeft show . decodeUtf8') ->+ callParse (valparse key) ntok | otherwise -> Failed "Error decoding UTF8" StringContent str | len > objectKeyStringLimit -> callParse (ignoreStrRestThen ignoreVal) ntok@@ -372,30 +370,18 @@ -> callParse (ignoreStrRestThen (Parser $ Done "")) ntok | otherwise -> moreData (handle (str:acc) (len + BS.length str)) ntok StringEnd- | Right val <- decodeUtf8' (BL.fromChunks $ reverse acc)- -> Yield (T.concat $ TL.toChunks val) (Done "" ntok)+ | Right val <- unescapeText (BS.concat $ reverse acc) >>= (mapLeft show . decodeUtf8')+ -> Yield val (Done "" ntok) | otherwise -> Failed "Error decoding UTF8" _ -> callParse ignoreVal tok --- | Match string as a ByteString without decoding the data from UTF8 (strings larger than input chunk,--- small get always decoded).-bytestring :: Parser BL.ByteString-bytestring = Parser $ moreData (handle [])- where- handle acc tok el ntok =- case el of- JValue (AE.String str) -> Yield (BL.fromChunks [encodeUtf8 str]) (Done "" ntok)- StringContent str -> moreData (handle (str:acc)) ntok- StringEnd -> Yield (BL.fromChunks $ reverse acc) (Done "" ntok)- _ -> callParse ignoreVal tok-- -- | Parse string value, skip parsing otherwise. string :: Parser T.Text string = longString Nothing -- | Stops parsing string after the limit is reached. The string will not be matched--- if it exceeds the size.+-- if it exceeds the size. The size is the size of escaped string including escape+-- characters. safeString :: Int -> Parser T.Text safeString limit = longString (Just limit) @@ -555,9 +541,9 @@ MoreData (parser, continuation) -> MoreData (updateParser parser, continuation) Failed message -> Failed message Done a b -> Done a b- Yield value parseResult -> case mapping value of+ Yield val parseResult -> case mapping val of Left message -> Failed message- Right value' -> Yield value' (updateParseResult parseResult)+ Right val' -> Yield val' (updateParseResult parseResult) --- Convenience operators
c_lib/lexer.c view
@@ -63,7 +63,11 @@ case '}': add_simple_res(RES_CLOSE_BRACE, lexer, 1, result); lexer->position++;break; case '[': add_simple_res(RES_OPEN_BRACKET, lexer, 1, result); lexer->position++;break; case ']': add_simple_res(RES_CLOSE_BRACKET, lexer, 1, result); lexer->position++;break;- case '"': lexer->current_state = STATE_STRING; lexer->state_data = 0; lexer->position++;return LEX_OK;+ case '"': lexer->current_state = STATE_STRING;+ lexer->state_data = 0;+ lexer->state_data_2 = 0;+ lexer->position++;+ return LEX_OK; case 't': lexer->current_state = STATE_TRUE; lexer->state_data = 1; lexer->position++;return LEX_OK; case 'f': lexer->current_state = STATE_FALSE; lexer->state_data = 1; lexer->position++;return LEX_OK; case 'n': lexer->current_state = STATE_NULL; lexer->state_data = 1; lexer->position++;return LEX_OK;@@ -172,116 +176,51 @@ return LEX_OK; } -static inline int safechar(char x) {- return (x != '"' && x != '\\');-}--/* Handle beginning of a string, the '"' is already stripped */+/* Handle beginning of a string, the '"' is already stripped+ *+ * state_data: 1 - this is string continuation+ * state_data_2: 1 - we have just skipped the backslash+ */ int handle_string(const char *input, struct lexer *lexer, struct lexer_result *result) { int startposition = lexer->position; char ch;- for (ch=input[lexer->position]; lexer->position < lexer->length && safechar(ch); ch = input[++lexer->position])- ;+ int hasspecialchar = 0; + for (ch=input[lexer->position]; lexer->position < lexer->length; ch = input[++lexer->position])+ if (lexer->state_data_2)+ lexer->state_data_2 = 0;+ else if (ch == '\\') {+ lexer->state_data_2 = 1;+ hasspecialchar = 1;+ } else if (ch == '"')+ break;+ struct lexer_result *res = &result[lexer->result_num]; res->startpos = startposition; res->length = lexer->position - startposition;- if (lexer->position == lexer->length || input[lexer->position] == '\\') {- // Emit partial string- res->restype = RES_STRING_PARTIAL;- res->adddata = 0;- lexer->result_num++;-- // If we stopped because of backslash, change state, move one forward- if (lexer->position < lexer->length) {- lexer->current_state = STATE_STRING_SPECCHAR;- lexer->state_data = 0;- lexer->position++;- } else- lexer->state_data = 1;- return LEX_OK;- } else if (input[lexer->position] == '"') {+ if (lexer->position < lexer->length && input[lexer->position] == '"') { res->restype = RES_STRING;- res->adddata = lexer->state_data;+ if (lexer->state_data)+ res->adddata = 1; // Indicate that we are final portion of the string+ else if (hasspecialchar)+ res->adddata = 0; // Indicate that the string contains escaped characters+ else+ res->adddata = -1; // Indicate that the stirng is clean UTF-8 (optimization) lexer->result_num++; lexer->current_state = STATE_BASE; lexer->position++; // Skip the final '"' return LEX_OK;- }- // Internal error, shouldn't get here- return LEX_ERROR;-}--/* Handle \uxxxx syntax */-static int handle_string_uni(const char *input, struct lexer *lexer, struct lexer_result *result)-{- char chr = input[lexer->position];- lexer->state_data_2 *= 16;- if (chr >= 'a' && chr <='f')- lexer->state_data_2 += 10 + (chr - 'a');- else if (chr >= 'A' && chr <= 'F')- lexer->state_data_2 += 10 + (chr - 'A');- else if (chr >= '0' && chr <= '9')- lexer->state_data_2 += chr - '0';- else- return LEX_ERROR;- lexer->state_data += 1;- lexer->position += 1;- if (lexer->state_data == 4) {- // Emit the result- struct lexer_result *res = &result[lexer->result_num];- res->startpos = lexer->position;- res->length = 0;- res->restype = RES_STRING_UNI;- res->adddata = lexer->state_data_2;+ } else {+ // Emit partial string+ res->restype = RES_STRING_PARTIAL;+ res->adddata = 0; lexer->result_num++; - lexer->current_state = STATE_STRING;- lexer->state_data = 1; // Set that we are in partial string, see handle_string- }- return LEX_OK;-}--// Add a character to result, move position forward, change state back to string-static inline void emitchar(char ch, struct lexer *lexer, struct lexer_result *result)-{- struct lexer_result *res = &result[lexer->result_num];-- res->restype = RES_STRING_PARTIAL;- res->startpos = lexer->position;- res->length = -1; // Special value indicating that this is special character- res->adddata = ch;-- lexer->result_num++;- lexer->position++;- lexer->current_state = STATE_STRING;- lexer->state_data = 1; // Set the string is in partial data-}--int handle_specchar(const char *input, struct lexer *lexer, struct lexer_result *result)-{- char chr = input[lexer->position];- switch (chr) {- case '"': emitchar('"', lexer, result);break;- case '\\':emitchar('\\', lexer, result);break;- case '/':emitchar('/', lexer, result);break;- case 'b':emitchar('\b', lexer, result);break;- case 'f':emitchar('\f', lexer, result);break;- case 'n':emitchar('\n', lexer, result);break;- case 'r':emitchar('\r', lexer, result);break;- case 't':emitchar('\t', lexer, result);break;- case 'u':- lexer->current_state = STATE_STRING_UNI;- lexer->state_data = 0;- lexer->state_data_2 = 0;- lexer->position++;- break;- default:- return LEX_ERROR;- }- return LEX_OK;+ lexer->state_data = 1;+ return LEX_OK;+ } } int lex_json(const char *input, struct lexer *lexer, struct lexer_result *result)@@ -289,8 +228,7 @@ int res = LEX_OK; static void* dispatch_table[] = { &&state_base, &&state_string, &&state_number, &&state_true,- &&state_false, &&state_null, &&state_string_specchar,- &&state_string_uni+ &&state_false, &&state_null }; #define DISPATCH() { \ if (!(lexer->position < lexer->length && lexer->result_num < lexer->result_limit && res == 0)) \@@ -316,12 +254,6 @@ DISPATCH(); state_null: res = handle_ident(input, lexer, "null", RES_NULL, result);- DISPATCH();- state_string_specchar:- res = handle_specchar(input, lexer, result);- DISPATCH();- state_string_uni:- res = handle_string_uni(input, lexer, result); DISPATCH(); return res;
c_lib/lexer.h view
@@ -14,7 +14,6 @@ #define RES_STRING_PARTIAL 9 /* Add-data: 0 - first part, 1 - other parts */ #define RES_NUMBER_PARTIAL 10 /* Add-data: 0 - first part, 1 - other parts */-#define RES_STRING_UNI 11 #define RES_NUMBER_SMALL 12 enum states {@@ -23,9 +22,7 @@ STATE_NUMBER, STATE_TRUE, STATE_FALSE,- STATE_NULL,- STATE_STRING_SPECCHAR,- STATE_STRING_UNI+ STATE_NULL }; struct lexer_result {
+ c_lib/unescape_string.c view
@@ -0,0 +1,132 @@+/**+ * Copied from https://github.com/agrafix/highjson project.+ */++#include <stdlib.h>++void bs_json_unescape(const unsigned long length, int *error, char *bsIn, char *bsOut);++inline void private_parse_hex(const char a, const char b, const char c, const char d, int *number, short *error) {+ const char hex[5] = { a, b, c, d, '\0' };+ char *internalError;+ *number = (int)strtol(hex, &internalError, 16);+ if (*internalError != '\0') {+ *error = 1;+ } else {+ *error = 0;+ }+}++#define UTF8_CHAR(N, OUT) \+ if (N < 0x80) { \+ OUT = (char)N; \+ } else if (N < 0x800) { \+ OUT = (char)((N >> 6) | 0xc0); \+ OUT = (char)((N & 0x3F) | 0x80); \+ } else if (N < 0xffff) { \+ OUT = (char)((N >> 12) | 0xe0); \+ OUT = (char)(((N >> 6) & 0x3f) | 0x80); \+ OUT = (char)((N & 0x3f) | 0x80); \+ } else { \+ OUT = (char)((N >> 18) | 0xF0); \+ OUT = (char)(((N >> 12) & 0x3F) | 0x80); \+ OUT = (char)(((N >> 6) & 0x3F) | 0x80); \+ OUT = (char)((N & 0x3f) | 0x80); \+ }++void bs_json_unescape(const unsigned long length, int *error, char *bsIn, char *bsOut)+{+ register unsigned long ptr = 0;+ while (ptr < length) {+ const char ch = *bsIn++;+ ptr++;+ if (ch == '\\') {+ if (ptr >= length) {+ *error = 1;+ return;+ }+ const char nextCh = *bsIn++;+ ptr++;+ switch (nextCh) {+ case '\\':+ *bsOut++ = '\\';+ break;+ case '"':+ *bsOut++ = '"';+ break;+ case '/':+ *bsOut++ = '/';+ break;+ case 'b':+ *bsOut++ = '\b';+ break;+ case 'f':+ *bsOut++ = '\f';+ break;+ case 'n':+ *bsOut++ = '\n';+ break;+ case 'r':+ *bsOut++ = '\r';+ break;+ case 't':+ *bsOut++ = '\t';+ break;+ case 'u':+ if (ptr+3 >= length) {+ *error = 3;+ return;+ }+ ptr += 4;+ int number = 0;+ short hexError = 0;+ const char a = *bsIn++; const char b = *bsIn++; const char c = *bsIn++; const char d = *bsIn++;+ private_parse_hex(a, b, c, d, &number, &hexError);+ if (hexError == 1) {+ *error = 4;+ return;+ }+ if (number < 0xd800 || number > 0xdfff) {+ UTF8_CHAR(number, *bsOut++);+ } else if (number <= 0xdbff) {+ if (ptr+5 >= length) {+ *error = 5;+ return;+ }+ ptr += 6;+ if (*bsIn++ != '\\') {+ *error = 6;+ return;+ }+ if (*bsIn++ != 'u') {+ *error = 7;+ return;+ }+ int numberB = 0;+ short hexErrorB = 0;+ const char ai = *bsIn++; const char bi = *bsIn++; const char ci = *bsIn++; const char di = *bsIn++;+ private_parse_hex(ai, bi, ci, di, &numberB, &hexErrorB);+ if (hexErrorB == 1) {+ *error = 8;+ return;+ }+ if (numberB >= 0xdc00 && numberB <= 0xdfff) {+ const int r = ((number - 0xdc00) << 10) + (numberB - 0xdc00) + 0x10000;+ UTF8_CHAR(r, *bsOut++);+ } else {+ *error = 9;+ return;+ }+ }+ break;+ default:+ *error = 2;+ return;+ }+ } else {+ *bsOut++ = ch;+ }+ }+ *bsOut = '\0';+ *error = 0;+}
changelog.md view
@@ -1,3 +1,7 @@+# 0.3.2.0+- Changed string parsing; parsing of escaped strings is now very vast+- Removed bytestring parser+ # 0.3.0.4 - Fixed bug in safestring - Fixed test so it doesn't depend on versions of other packages
json-stream.cabal view
@@ -1,5 +1,5 @@ name: json-stream-version: 0.3.1.0+version: 0.3.2.0 synopsis: Incremental applicative JSON parser description: Easy to use JSON parser fully supporting incremental parsing. Parsing grammar in applicative form.@@ -30,27 +30,29 @@ library exposed-modules: Data.JsonStream.Parser other-modules: Data.JsonStream.TokenParser, Data.JsonStream.CLexType, Data.JsonStream.CLexer- c-sources: c_lib/lexer.c+ c-sources: c_lib/lexer.c, c_lib/unescape_string.c includes: c_lib/lexer.h include-dirs: c_lib build-depends: base >=4.7 && <4.9 , bytestring , text- , aeson+ , aeson >= 0.7 , vector , unordered-containers , scientific default-language: Haskell2010 + test-suite spec main-is: Spec.hs other-modules: Data.JsonStream.CLexType, ParserSpec- c-sources: c_lib/lexer.c+ c-sources: c_lib/lexer.c, c_lib/unescape_string.c include-dirs: c_lib includes: c_lib/lexer.h type: exitcode-stdio-1.0 hs-source-dirs: test, . default-language: Haskell2010+ ghc-options: -Wall build-depends: base >=4.7 && <4.9 , bytestring , text@@ -59,6 +61,8 @@ , unordered-containers , hspec , scientific+ , directory+ -- executable spdtest -- main-is: spdtest.hs
test/ParserSpec.hs view
@@ -8,15 +8,13 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T-import Data.Text.Encoding (encodeUtf8) import Control.Monad (forM_) import Data.Text.Encoding (encodeUtf8) import qualified Data.Vector as Vec import qualified Data.HashMap.Strict as HMap+import System.Directory (getDirectoryContents) 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@@ -27,7 +25,7 @@ squotes '\'' = '"' squotes x = x -+parse :: Parser a -> BS.ByteString -> [a] parse parser text = parseByteString parser (todquotes text) testRemaining :: Parser a -> BS.ByteString -> BS.ByteString@@ -301,8 +299,6 @@ -- iter dta cont -- iter _ TokFailed = print "tok failed" -- aeCompare :: Spec aeCompare = describe "Compare parsing of strings aeason vs json-stream" $ do let values = [@@ -326,11 +322,28 @@ , " { \"a\" : true } " , "{ \"v\":1.7976931348623157E308} " ]+ forM_ values $ \test -> it ("Parses " ++ show test ++ " the same as aeson") $ do let resStream = head $ parseByteString value test :: AE.Value let Just resAeson = AE.decode (BL.fromChunks [test]) resStream `shouldBe` resAeson +readBenchFiles :: FilePath -> IO [BS.ByteString]+readBenchFiles dirname =+ getDirectoryContents dirname >>= return . (filter isJson) >>= mapM readFile'+ where+ readFile' fname = BS.readFile (dirname ++ "/" ++ fname)+ isJson fname = take 5 (reverse fname) == "nosj."++aeCompareBench :: Spec+aeCompareBench = describe "Compare benchmark jsons" $+ it "JSONs from benchamark directory are the same" $ do+ values <- readBenchFiles "benchmarks/json-data"+ forM_ values $ \test -> do+ let resStream = head $ parseByteString value test :: AE.Value+ let Just resAeson = AE.decode (BL.fromChunks [test])+ resStream `shouldBe` resAeson+ spec :: Spec spec = do specBase@@ -339,7 +352,7 @@ specControl errTests aeCompare+ aeCompareBench main :: IO ()-main = do- hspec spec+main = hspec spec