json-syntax 0.1.2.0 → 0.2.0.0

raw patch · 4 files changed

+199/−71 lines, 4 filesdep +run-stdep ~array-chunksPVP ok

version bump matches the API change (PVP)

Dependencies added: run-st

Dependency ranges changed: array-chunks

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• json-syntax.cabal +3/−2
• src/Json.hs +174/−64
• test/Main.hs +14/−5

@@ -1,5 +1,13 @@ # Revision history for json-syntax +## 0.2.0.0 -- 2021-03-22++* Switch from `Chunks` to `SmallArray` in the `Object` and `Array` data+  constructors. This makes the library simpler to use but it a breaking+  change.+* Expose `emptyArray` and `emptyObject`.+* Add `object(9|10|11|12)` as convenience helpers for construction.+ ## 0.1.2.0 -- 2020-11-18  * Add infix pattern synonym for `Member`.

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: json-syntax-version: 0.1.2.0+version: 0.2.0.0 synopsis: High-performance JSON parser and encoder description:   This library parses JSON into a @Value@ type that is consistent with the@@ -29,13 +29,14 @@   exposed-modules: Json   build-depends:     , array-builder >=0.1 && <0.2-    , array-chunks >=0.1.2 && <0.2+    , array-chunks >=0.1.3 && <0.2     , base >=4.12 && <5     , bytebuild >=0.3.4 && <0.4     , byteslice >=0.1.3 && <0.3     , bytesmith >=0.3.2 && <0.4     , bytestring >=0.10.8 && <0.11     , primitive >=0.7 && <0.8+    , run-st >=0.1.1 && <0.2     , scientific-notation >=0.1.2 && <0.2     , text-short >=0.1.3 && <0.2   hs-source-dirs: src

@@ -21,6 +21,9 @@   , encode     -- * Infix Synonyms    , pattern (:->)+    -- * Constants+  , emptyArray+  , emptyObject     -- * Construction   , object1   , object2@@ -30,23 +33,26 @@   , object6   , object7   , object8+  , object9+  , object10+  , object11+  , object12   ) where  import Prelude hiding (Bool(True,False))  import Control.Exception (Exception) import Control.Monad.ST (ST)+import Control.Monad.ST.Run (runSmallArrayST) import Data.Bits ((.&.),(.|.),unsafeShiftR) import Data.Builder.ST (Builder) import Data.Bytes.Parser (Parser) import Data.Bytes.Types (Bytes(..)) import Data.Char (ord)-import Data.Chunks (Chunks(ChunksNil,ChunksCons)) import Data.Number.Scientific (Scientific)-import Data.Primitive (ByteArray,MutableByteArray)+import Data.Primitive (ByteArray,MutableByteArray,SmallArray) import Data.Text.Short (ShortText)-import GHC.Exts (SmallArray#,Char(C#),Int(I#),gtWord#,ltWord#,word2Int#,chr#)-import GHC.Exts (sizeofSmallArray#,indexSmallArray#)+import GHC.Exts (Char(C#),Int(I#),gtWord#,ltWord#,word2Int#,chr#) import GHC.Word (Word8(W8#),Word16(W16#))  import qualified Prelude@@ -78,8 +84,8 @@ --   there are functions in @Data.Chunks@ that efficently perform other --   operations. data Value-  = Object !(Chunks Member)-  | Array !(Chunks Value)+  = Object !(SmallArray Member)+  | Array !(SmallArray Value)   | String {-# UNPACK #-} !ShortText   | Number {-# UNPACK #-} !Scientific   | Null@@ -118,15 +124,18 @@   , value :: !Value   } deriving stock (Eq,Show) -emptyArrayValue :: Value-{-# noinline emptyArrayValue #-}-emptyArrayValue = Array ChunksNil+-- | An array with no elements (i.e. @[]@)+emptyArray :: Value+{-# noinline emptyArray #-}+emptyArray = Array mempty -emptyObjectValue :: Value-{-# noinline emptyObjectValue #-}-emptyObjectValue = Object ChunksNil+-- | An object with no members (i.e. @{}@)+emptyObject :: Value+{-# noinline emptyObject #-}+emptyObject = Object mempty  isSpace :: Word8 -> Prelude.Bool+{-# inline isSpace #-} isSpace w =      w == c2w ' '   || w == c2w '\t'@@ -150,36 +159,28 @@   Null -> BLDR.ascii4 'n' 'u' 'l' 'l'   String s -> BLDR.shortTextJsonString s   Number n -> SCI.builderUtf8 n-  Array ys -> case unconsNonempty ys of-    (# (# #) | #) -> BLDR.ascii2 '[' ']'-    (# | (# x, xs #) #) ->-      BLDR.ascii '['-      <>-      encode (case indexSmallArray# x 0# of {(# z #) -> z})-      <>-      foldrTail-        ( \v b -> BLDR.ascii ',' <> encode v <> b-        )-        ( foldr-          ( \v b -> BLDR.ascii ',' <> encode v <> b-          ) (BLDR.ascii ']') xs-        )-        (PM.SmallArray x)-  Object ys -> case unconsNonempty ys of-    (# (# #) | #) -> BLDR.ascii2 '{' '}'-    (# | (# x,xs #) #) ->-      BLDR.ascii '{'-      <>-      encodeMember (case indexSmallArray# x 0# of {(# z #) -> z})-      <>-      foldrTail-        ( \mbr b -> BLDR.ascii ',' <> encodeMember mbr <> b-        )-        ( foldr-          ( \mbr b -> BLDR.ascii ',' <> encodeMember mbr <> b-          ) (BLDR.ascii '}') xs-        )-        (PM.SmallArray x)+  Array ys -> case PM.sizeofSmallArray ys of+    0 -> BLDR.ascii2 '[' ']'+    _ ->+      let !(# z #) = PM.indexSmallArray## ys 0+       in BLDR.ascii '['+          <>+          encode z+          <>+          foldrTail+            ( \v b -> BLDR.ascii ',' <> encode v <> b+            ) (BLDR.ascii ']') ys+  Object ys -> case PM.sizeofSmallArray ys of+    0 -> BLDR.ascii2 '{' '}'+    _ ->+      let !(# z #) = PM.indexSmallArray## ys 0+       in BLDR.ascii '{'+          <>+          encodeMember z+          <>+          foldrTail+            ( \v b -> BLDR.ascii ',' <> encodeMember v <> b+            ) (BLDR.ascii '}') ys  encodeMember :: Member -> BLDR.Builder encodeMember Member{key,value} =@@ -198,15 +199,6 @@     | (# x #) <- PM.indexSmallArray## ary i     = f x (go (i+1)) --- Get the first non-empty SmallArray from the Chunks.-unconsNonempty :: Chunks a -> (# (# #) | (# SmallArray# a, Chunks a #) #)-{-# inline unconsNonempty #-}-unconsNonempty = go where-  go ChunksNil = (# (# #) | #)-  go (ChunksCons (PM.SmallArray x) xs) = case sizeofSmallArray# x of-    0# -> go xs-    _ -> (# | (# x, xs #) #)- -- Precondition: skip over all space before calling this. -- It will not skip leading space for you. It does parser :: Char -> Parser SyntaxException s Value@@ -234,10 +226,11 @@   _ -> P.fail InvalidLeader  objectTrailedByBrace :: Parser SyntaxException s Value+{-# inline objectTrailedByBrace #-} objectTrailedByBrace = do   P.skipWhile isSpace   Latin.any IncompleteObject >>= \case-    '}' -> pure emptyObjectValue+    '}' -> pure emptyObject     '"' -> do       start <- Unsafe.cursor       !theKey <- string id start@@ -268,7 +261,8 @@       P.effect (B.push mbr b) >>= objectStep     '}' -> do       !r <- P.effect (B.freeze b)-      pure (Object r)+      let !arr = Chunks.concat r+      pure (Object arr)     _ -> P.fail ExpectedCommaOrRightBracket  -- This eats all the space at the front of the input. There@@ -280,10 +274,11 @@ -- -- This parser handles everything after the LBRACKET character. arrayTrailedByBracket :: Parser SyntaxException s Value+{-# inline arrayTrailedByBracket #-} arrayTrailedByBracket = do   P.skipWhile isSpace   Latin.any IncompleteArray >>= \case-    ']' -> pure emptyArrayValue+    ']' -> pure emptyArray     c -> do       !b0 <- P.effect B.new       val <- parser c@@ -308,7 +303,8 @@       P.effect (B.push val b) >>= arrayStep     ']' -> do       !r <- P.effect (B.freeze b)-      pure (Array r)+      let !arr = Chunks.concat r+      pure (Array arr)     _ -> P.fail ExpectedCommaOrRightBracket  c2w :: Char -> Word8@@ -434,39 +430,153 @@ -- | Construct a JSON object with one member. object1 :: Member -> Value {-# inline object1 #-}-object1 a = Object (Chunks.singleton a)+object1 a = Object $ runSmallArrayST $ do+  dst <- PM.newSmallArray 1 a+  PM.unsafeFreezeSmallArray dst  -- | Construct a JSON object with two members. object2 :: Member -> Member -> Value {-# inline object2 #-}-object2 a b = Object (Chunks.doubleton a b)+object2 a b = Object $ runSmallArrayST $ do+  dst <- PM.newSmallArray 2 a+  PM.writeSmallArray dst 1 b+  PM.unsafeFreezeSmallArray dst  -- | Construct a JSON object with three members. object3 :: Member -> Member -> Member -> Value {-# inline object3 #-}-object3 a b c = Object (Chunks.tripleton a b c)+object3 a b c = Object $ runSmallArrayST $ do+  dst <- PM.newSmallArray 3 a+  PM.writeSmallArray dst 1 b+  PM.writeSmallArray dst 2 c+  PM.unsafeFreezeSmallArray dst  -- | Construct a JSON object with four members. object4 :: Member -> Member -> Member -> Member -> Value {-# inline object4 #-}-object4 a b c d = Object (Chunks.quadrupleton a b c d)+object4 a b c d = Object $ runSmallArrayST $ do+  dst <- PM.newSmallArray 4 a+  PM.writeSmallArray dst 1 b+  PM.writeSmallArray dst 2 c+  PM.writeSmallArray dst 3 d+  PM.unsafeFreezeSmallArray dst  -- | Construct a JSON object with five members. object5 :: Member -> Member -> Member -> Member -> Member -> Value {-# inline object5 #-}-object5 a b c d e = Object (Chunks.quintupleton a b c d e)+object5 a b c d e = Object $ runSmallArrayST $ do+  dst <- PM.newSmallArray 5 a+  PM.writeSmallArray dst 1 b+  PM.writeSmallArray dst 2 c+  PM.writeSmallArray dst 3 d+  PM.writeSmallArray dst 4 e+  PM.unsafeFreezeSmallArray dst  -- | Construct a JSON object with six members. object6 :: Member -> Member -> Member -> Member -> Member -> Member -> Value {-# inline object6 #-}-object6 a b c d e f = Object (Chunks.sextupleton a b c d e f)+object6 a b c d e f = Object $ runSmallArrayST $ do+  dst <- PM.newSmallArray 6 a+  PM.writeSmallArray dst 1 b+  PM.writeSmallArray dst 2 c+  PM.writeSmallArray dst 3 d+  PM.writeSmallArray dst 4 e+  PM.writeSmallArray dst 5 f+  PM.unsafeFreezeSmallArray dst  -- | Construct a JSON object with seven members. object7 :: Member -> Member -> Member -> Member -> Member -> Member -> Member -> Value {-# inline object7 #-}-object7 a b c d e f g = Object (Chunks.septupleton a b c d e f g)+object7 a b c d e f g = Object $ runSmallArrayST $ do+  dst <- PM.newSmallArray 7 a+  PM.writeSmallArray dst 1 b+  PM.writeSmallArray dst 2 c+  PM.writeSmallArray dst 3 d+  PM.writeSmallArray dst 4 e+  PM.writeSmallArray dst 5 f+  PM.writeSmallArray dst 6 g+  PM.unsafeFreezeSmallArray dst --- | Construct a JSON object with eight members.+-- | Construct a JSON object with nine members. object8 :: Member -> Member -> Member -> Member -> Member -> Member -> Member -> Member -> Value {-# inline object8 #-}-object8 a b c d e f g h = Object (Chunks.octupleton a b c d e f g h)+object8 a b c d e f g h = Object $ runSmallArrayST $ do+  dst <- PM.newSmallArray 8 a+  PM.writeSmallArray dst 1 b+  PM.writeSmallArray dst 2 c+  PM.writeSmallArray dst 3 d+  PM.writeSmallArray dst 4 e+  PM.writeSmallArray dst 5 f+  PM.writeSmallArray dst 6 g+  PM.writeSmallArray dst 7 h+  PM.unsafeFreezeSmallArray dst++-- | Construct a JSON object with nine members.+object9 :: Member -> Member -> Member -> Member -> Member -> Member -> Member -> Member -> Member+        -> Value+{-# inline object9 #-}+object9 a b c d e f g h i = Object $ runSmallArrayST $ do+  dst <- PM.newSmallArray 9 a+  PM.writeSmallArray dst 1 b+  PM.writeSmallArray dst 2 c+  PM.writeSmallArray dst 3 d+  PM.writeSmallArray dst 4 e+  PM.writeSmallArray dst 5 f+  PM.writeSmallArray dst 6 g+  PM.writeSmallArray dst 7 h+  PM.writeSmallArray dst 8 i+  PM.unsafeFreezeSmallArray dst++-- | Construct a JSON object with ten members.+object10 :: Member -> Member -> Member -> Member -> Member -> Member -> Member -> Member +         -> Member -> Member -> Value+{-# inline object10 #-}+object10 a b c d e f g h i j = Object $ runSmallArrayST $ do+  dst <- PM.newSmallArray 10 a+  PM.writeSmallArray dst 1 b+  PM.writeSmallArray dst 2 c+  PM.writeSmallArray dst 3 d+  PM.writeSmallArray dst 4 e+  PM.writeSmallArray dst 5 f+  PM.writeSmallArray dst 6 g+  PM.writeSmallArray dst 7 h+  PM.writeSmallArray dst 8 i+  PM.writeSmallArray dst 9 j+  PM.unsafeFreezeSmallArray dst++-- | Construct a JSON object with eleven members.+object11 :: Member -> Member -> Member -> Member -> Member -> Member -> Member -> Member+         -> Member -> Member -> Member -> Value+{-# inline object11 #-}+object11 a b c d e f g h i j k = Object $ runSmallArrayST $ do+  dst <- PM.newSmallArray 11 a+  PM.writeSmallArray dst 1 b+  PM.writeSmallArray dst 2 c+  PM.writeSmallArray dst 3 d+  PM.writeSmallArray dst 4 e+  PM.writeSmallArray dst 5 f+  PM.writeSmallArray dst 6 g+  PM.writeSmallArray dst 7 h+  PM.writeSmallArray dst 8 i+  PM.writeSmallArray dst 9 j+  PM.writeSmallArray dst 10 k+  PM.unsafeFreezeSmallArray dst++-- | Construct a JSON object with eleven members.+object12 :: Member -> Member -> Member -> Member -> Member -> Member -> Member -> Member+         -> Member -> Member -> Member -> Member -> Value+{-# inline object12 #-}+object12 a b c d e f g h i j k l = Object $ runSmallArrayST $ do+  dst <- PM.newSmallArray 12 a+  PM.writeSmallArray dst 1 b+  PM.writeSmallArray dst 2 c+  PM.writeSmallArray dst 3 d+  PM.writeSmallArray dst 4 e+  PM.writeSmallArray dst 5 f+  PM.writeSmallArray dst 6 g+  PM.writeSmallArray dst 7 h+  PM.writeSmallArray dst 8 i+  PM.writeSmallArray dst 9 j+  PM.writeSmallArray dst 10 k+  PM.writeSmallArray dst 11 l+  PM.unsafeFreezeSmallArray dst

@@ -4,6 +4,7 @@ import Control.Monad (when) import Data.ByteString.Short.Internal (ShortByteString(SBS)) import Data.Bytes (Bytes)+import Data.Chunks (Chunks(ChunksCons,ChunksNil)) import Data.Primitive (ByteArray(ByteArray)) import Data.Scientific (Scientific,scientific) import Data.Text.Short (ShortText)@@ -33,15 +34,15 @@       @=?       J.decode (Bytes.fromAsciiString "{}")   , THU.testCase "B" $-      Right (J.Object (Exts.fromList [Exts.fromList [J.Member "foo" J.True]]))+      Right (J.Object (Exts.fromList [J.Member "foo" J.True]))       @=?       J.decode (Bytes.fromAsciiString "{\"foo\" : true}")   , THU.testCase "C" $-      Right (J.Array (Exts.fromList [Exts.fromList [J.String "bar"]]))+      Right (J.Array (Exts.fromList [J.String "bar"]))       @=?       J.decode (Bytes.fromAsciiString "[\"bar\"]")   , THU.testCase "D" $-      Right (J.Object (Exts.fromList [Exts.fromList [J.Member "foo" J.True, J.Member "bar" J.False]]))+      Right (J.Object (Exts.fromList [J.Member "foo" J.True, J.Member "bar" J.False]))       @=?       J.decode (Bytes.fromAsciiString "{\"foo\" : true, \"bar\": false }")   , THU.testCase "E" $@@ -49,11 +50,11 @@       @=?       J.decode (shortTextToBytes "\"Smile: 😂\"")   , THU.testCase "F" $-      Right (J.Array (Exts.fromList [Exts.fromList [ J.Object mempty, J.Object mempty, J.Null ]]))+      Right (J.Array (Exts.fromList [ J.Object mempty, J.Object mempty, J.Null ]))       @=?       J.decode (shortTextToBytes " [ {} , { } , null ] ")   , THU.testCase "G" $ case J.decode (shortTextToBytes " [ 55e2 , 1 ] ") of-      Right (J.Array xs) -> case Exts.toList (Chunks.concat xs) of+      Right (J.Array xs) -> case Exts.toList xs of         [J.Number a, J.Number b] -> do           SCI.toWord32 a @=? Just 5500           SCI.toWord32 b @=? Just 1@@ -62,6 +63,14 @@   , THU.testCase "H" $ case J.decode (shortTextToBytes " [] x") of       Left _ -> pure ()       Right _ -> fail "this was not supposed parse"+  , THU.testCase "I" $+      BChunks.concat (Builder.run 1 (J.encode (J.Array mempty)))+      @=?+      Bytes.fromLatinString "[]"+  , THU.testCase "J" $+      BChunks.concat (Builder.run 1 (J.encode (J.Array mempty)))+      @=?+      Bytes.fromLatinString "[]"   , THU.testCase "Twitter100" $       case J.decode (Bytes.fromByteArray encodedTwitter100) of         Left _ -> fail "nope"