diff --git a/Data/JsonStream/CLexType.hsc b/Data/JsonStream/CLexType.hsc --- a/Data/JsonStream/CLexType.hsc +++ b/Data/JsonStream/CLexType.hsc @@ -21,7 +21,6 @@ , resCloseBracket = RES_CLOSE_BRACKET , resStringPartial = RES_STRING_PARTIAL - , resStringUni = RES_STRING_UNI , resNumberPartial = RES_NUMBER_PARTIAL , resNumberSmall = RES_NUMBER_SMALL } diff --git a/Data/JsonStream/CLexer.hs b/Data/JsonStream/CLexer.hs --- a/Data/JsonStream/CLexer.hs +++ b/Data/JsonStream/CLexer.hs @@ -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 diff --git a/Data/JsonStream/Parser.hs b/Data/JsonStream/Parser.hs --- a/Data/JsonStream/Parser.hs +++ b/Data/JsonStream/Parser.hs @@ -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 diff --git a/c_lib/lexer.c b/c_lib/lexer.c --- a/c_lib/lexer.c +++ b/c_lib/lexer.c @@ -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; diff --git a/c_lib/lexer.h b/c_lib/lexer.h --- a/c_lib/lexer.h +++ b/c_lib/lexer.h @@ -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 { diff --git a/c_lib/unescape_string.c b/c_lib/unescape_string.c new file mode 100644 --- /dev/null +++ b/c_lib/unescape_string.c @@ -0,0 +1,132 @@ +/** + * Copied from https://github.com/agrafix/highjson project. + */ + +#include + +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; +} diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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 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.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 diff --git a/test/ParserSpec.hs b/test/ParserSpec.hs --- a/test/ParserSpec.hs +++ b/test/ParserSpec.hs @@ -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