json-stream 0.3.2.2 → 0.3.2.3

raw patch · 6 files changed

+231/−164 lines, 6 filesdep +QuickCheckdep +quickcheck-unicodePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, quickcheck-unicode

API changes (from Hackage documentation)

Files

• Data/JsonStream/CLexer.hs +5/−32
• Data/JsonStream/Parser.hs +4/−6
• Data/JsonStream/Unescape.hs +51/−0
• c_lib/unescape_string.c +159/−122
• changelog.md +3/−0
• json-stream.cabal +9/−4

@@ -7,7 +7,6 @@ module Data.JsonStream.CLexer (     tokenParser   , unescapeText-  , mapLeft ) where  import           Control.Applicative         ((<$>))@@ -15,20 +14,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           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,-                                              unsafePerformIO)+import           System.IO.Unsafe            (unsafeDupablePerformIO)  import           Data.JsonStream.CLexType import           Data.JsonStream.TokenParser (Element (..), TokenResult (..))+import           Data.JsonStream.Unescape  -- | 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@@ -120,29 +116,6 @@   , 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@@ -239,9 +212,9 @@                   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+                case unescapeText textSection of                   Right ctext -> PartialResult (JValue (AE.String ctext)) next-                  Left _ -> TokFailed+                  _ -> TokFailed              | otherwise -> PartialResult (StringContent textSection) -- Final part of partial strings                             (PartialResult StringEnd next)         | resType == resStringPartial ->@@ -267,4 +240,4 @@ tokenParser :: BS.ByteString -> TokenResult tokenParser dta = getNextResult (TempData dta newhdr False [])   where-    newhdr = defHeader{hdrLength=fromIntegral (BS.length dta), hdrResultLimit=(estResultLimit dta)}+    newhdr = defHeader{hdrLength=fromIntegral (BS.length dta), hdrResultLimit=estResultLimit dta}

@@ -81,13 +81,11 @@ import           Data.Scientific             (Scientific, isInteger,                                               toBoundedInteger, toRealFloat) import qualified Data.Text                   as T-import           Data.Text.Encoding          (decodeUtf8') import qualified Data.Vector                 as Vec  import           Data.JsonStream.CLexer import           Data.JsonStream.TokenParser - -- | Limit for the size of an object key objectKeyStringLimit :: Int objectKeyStringLimit = 65536@@ -291,7 +289,7 @@     getLongKey acc !len _ el ntok =       case el of         StringEnd-          | Right key <- unescapeText (BS.concat $ reverse acc) >>= (mapLeft show . decodeUtf8') ->+          | Right key <- unescapeText (BS.concat $ reverse acc) ->               callParse (valparse key) ntok           | otherwise -> Failed "Error decoding UTF8"         StringContent str@@ -360,7 +358,7 @@  -- | Match a possibly bounded string roughly limited by a limit longString :: Maybe Int -> Parser T.Text-longString mbounds = Parser $ moreData (handle [] 0)+longString mbounds = Parser $ moreData (handle (BS.empty :) 0)   where     handle acc !len tok el ntok =       case el of@@ -368,9 +366,9 @@         StringContent str           | (Just bounds) <- mbounds, len > bounds -- If the string exceeds bounds, discard it                           -> callParse (ignoreStrRestThen (Parser $ Done "")) ntok-          | otherwise     -> moreData (handle (str:acc) (len + BS.length str)) ntok+          | otherwise     -> moreData (handle (acc . (str:)) (len + BS.length str)) ntok         StringEnd-          | Right val <- unescapeText (BS.concat $ reverse acc) >>= (mapLeft show . decodeUtf8')+          | Right val <- unescapeText (BS.concat (acc []))                       -> Yield val (Done "" ntok)           | otherwise -> Failed "Error decoding UTF8"         _ ->  callParse ignoreVal tok

@@ -0,0 +1,51 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash                #-}+{-# LANGUAGE UnliftedFFITypes         #-}++module Data.JsonStream.Unescape (+  unescapeText+) where++import           Control.Exception          (evaluate, throw, try)+import           Control.Monad.ST.Unsafe    (unsafeIOToST, unsafeSTToIO)+import           Data.ByteString            as B+import           Data.ByteString.Internal   as B hiding (c2w)+import qualified Data.Text.Array            as A+import           Data.Text.Encoding.Error   (UnicodeException (..))+import           Data.Text.Internal         (Text (..))+import           Data.Text.Internal.Private (runText)+import           Data.Text.Unsafe           (unsafeDupablePerformIO)+import           Data.Word                  (Word8)+import           Foreign.C.Types            (CInt (..), CSize (..))+import           Foreign.ForeignPtr         (withForeignPtr)+import           Foreign.Marshal.Utils      (with)+import           Foreign.Ptr                (Ptr, plusPtr)+import           Foreign.Storable           (peek)+import           GHC.Base                   (MutableByteArray#)++foreign import ccall unsafe "_js_decode_string" c_js_decode+    :: MutableByteArray# s -> Ptr CSize+    -> Ptr Word8 -> Ptr Word8 -> IO CInt++unescapeText' :: ByteString -> Text+unescapeText' (PS fp off len) = runText $ \done -> do+  let go dest = withForeignPtr fp $ \ptr ->+        with (0::CSize) $ \destOffPtr -> do+          let end = ptr `plusPtr` (off + len)+              loop curPtr = do+                res <- c_js_decode (A.maBA dest) destOffPtr curPtr end+                case res of+                  0 -> do+                    n <- peek destOffPtr+                    unsafeSTToIO (done dest (fromIntegral n))+                  _ ->+                    throw (DecodeError desc Nothing)+          loop (ptr `plusPtr` off)+  (unsafeIOToST . go) =<< A.new len+ where+  desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"+{-# INLINE unescapeText' #-}++unescapeText :: ByteString -> Either UnicodeException Text+unescapeText = unsafeDupablePerformIO . try . evaluate . unescapeText'+{-# INLINE unescapeText #-}

@@ -1,132 +1,169 @@-/**-  * Copied from https://github.com/agrafix/highjson project.-  */+#include <string.h>+#include <stdio.h>+#include <stdint.h> -#include <stdlib.h> -void bs_json_unescape(const unsigned long length, int *error, char *bsIn, char *bsOut);+#define UTF8_ACCEPT 0+#define UTF8_REJECT 12 -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;-    }+static const uint8_t utf8d[] = {+  // The first part of the table maps bytes to character classes that+  // to reduce the size of the transition table and create bitmasks.+   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,+   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,+   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,+   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,+   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,  9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,+   7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,+   8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2,  2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,+  10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8,++  // The second part is a transition table that maps a combination+  // of a state of the automaton and a character class to a state.+   0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,+  12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,+  12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,+  12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,+  12,36,12,12,12,12,12,12,12,12,12,12,+};++static uint32_t inline decode(uint32_t* state, uint32_t* codep, uint32_t byte) {+  uint32_t type = utf8d[byte];++  *codep = (*state != UTF8_ACCEPT) ?+    (byte & 0x3fu) | (*codep << 6) :+    (0xff >> type) & (byte);++  *state = utf8d[256 + *state + type];+  return *state; } -#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); \-    }+static int inline ishexnum(uint32_t c)+{+  return (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F');+} -void bs_json_unescape(const unsigned long length, int *error, char *bsIn, char *bsOut)+static uint32_t inline decode_hex(uint32_t c) {-    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;+  if (c >= '0' && c <= '9')+    return c - '0';+  else if (c >= 'a' && c <= 'f')+    return c - 'a' + 10;+  else if (c >= 'A' && c <= 'F')+    return c - 'A' + 10;+  return 0; // Should not happen+}++static int inline isLowSurrogate(uint16_t c)+{+  return c >= 0xDC00 && c <= 0xDFFF;+}++static int inline isHighSurrogate(uint16_t c)+{+  return c >= 0xD800 && c <= 0xDBFF;+}++// Decode, return non-zero value on error+int+_js_decode_string(uint16_t *const dest, size_t *destoff,+                  const uint8_t *s, const uint8_t *const srcend)+{+  uint16_t *d = dest + *destoff;+  uint32_t state = 0;+  uint32_t codepoint;++  int surrogate = 0;+  uint16_t unidata;++  // Optimized version of dispatch when just an ASCII char is expected+  #define DISPATCH_ASCII(label) {\+    if (s >= srcend) {\+      return -1;\+    }\+    codepoint = *s++;\+    goto label;\+  }++  standard:+    // Test end of stream+    while (s < srcend) {+        if (*s <= 127)+          codepoint = *s++;+        else if (decode(&state, &codepoint, *s++) != UTF8_ACCEPT) {+          if (state == UTF8_REJECT)+            return -1;+          continue;         }++        if (codepoint == '\\')+          DISPATCH_ASCII(backslash)+        else if (codepoint <= 0xffff)+          *d++ = (uint16_t) codepoint;+        else {+          *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10));+          *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF));+        }     }-    *bsOut = '\0';-    *error = 0;+    *destoff = d - dest;+    // Exit point+    return (state != UTF8_ACCEPT);+  backslash:+    switch (codepoint) {+      case '"':+      case '\\':+      case '/':+        *d++ = (uint16_t) codepoint;+        goto standard;+        break;+      case 'b': *d++ = '\b';goto standard;+      case 'f': *d++ = '\f';goto standard;+      case 'n': *d++ = '\n';goto standard;+      case 'r': *d++ = '\r';goto standard;+      case 't': *d++ = '\t';goto standard;+      case 'u': DISPATCH_ASCII(unicode1);;break;+      default:+        return -1;+    }+  unicode1:+    if (!ishexnum(codepoint))+      return -1;+    unidata = decode_hex(codepoint) << 12;+    DISPATCH_ASCII(unicode2);+  unicode2:+    if (!ishexnum(codepoint))+      return -1;+    unidata |= decode_hex(codepoint) << 8;+    DISPATCH_ASCII(unicode3);+  unicode3:+    if (!ishexnum(codepoint))+      return -1;+    unidata |= decode_hex(codepoint) << 4;+    DISPATCH_ASCII(unicode4);+  unicode4:+    if (!ishexnum(codepoint))+      return -1;+    unidata |= decode_hex(codepoint);+    *d++ = (uint16_t) unidata;++    if (surrogate) {+      if (!isLowSurrogate(unidata))+        return -1;+      surrogate = 0;+    } else {+      if (isHighSurrogate(unidata)) {+        surrogate = 1;+        DISPATCH_ASCII(surrogate1);+      } else if (isLowSurrogate(unidata))+        return -1;+    }+    goto standard;+  surrogate1:+    if (codepoint != '\\')+      return -1;+    DISPATCH_ASCII(surrogate2)+  surrogate2:+    if (codepoint != 'u')+      return -1;+    DISPATCH_ASCII(unicode1) }

@@ -1,3 +1,6 @@+# 0.3.2.3+- Completely rewritten text unescapes based on text decodeUtf8; fixes some surprising crashes, speed improvements.+ # 0.3.2.0 - Changed string parsing; parsing of escaped strings is now very fast - Removed bytestring parser

@@ -1,5 +1,5 @@ name:                json-stream-version:             0.3.2.2+version:             0.3.2.3 synopsis:            Incremental applicative JSON parser description:         Easy to use JSON parser fully supporting incremental parsing.                      Parsing grammar in applicative form.@@ -29,7 +29,8 @@  library   exposed-modules:     Data.JsonStream.Parser-  other-modules:       Data.JsonStream.TokenParser, Data.JsonStream.CLexType, Data.JsonStream.CLexer+  other-modules:       Data.JsonStream.TokenParser, Data.JsonStream.CLexType, Data.JsonStream.CLexer,+                       Data.JsonStream.Unescape   c-sources:           c_lib/lexer.c, c_lib/unescape_string.c   includes:            c_lib/lexer.h   include-dirs:        c_lib@@ -40,12 +41,15 @@                        , vector                        , unordered-containers                        , scientific+   default-language:    Haskell2010   test-suite spec   main-is:             Spec.hs-  other-modules:       Data.JsonStream.CLexType, ParserSpec+  other-modules:         Data.JsonStream.CLexType+                       , Data.JsonStream.Unescape+                       , ParserSpec   c-sources:           c_lib/lexer.c, c_lib/unescape_string.c   include-dirs:        c_lib   includes:            c_lib/lexer.h@@ -62,7 +66,8 @@                        , hspec                        , scientific                        , directory-+                       , QuickCheck+                       , quickcheck-unicode  -- executable spdtest --   main-is: spdtest.hs