json-syntax 0.1.0.0 → 0.1.1.0
raw patch · 5 files changed
+93/−11 lines, 5 filesdep +bytebuilddep −small-bytearray-builderdep ~scientific-notationPVP ok
version bump matches the API change (PVP)
Dependencies added: bytebuild
Dependencies removed: small-bytearray-builder
Dependency ranges changed: scientific-notation
API changes (from Hackage documentation)
+ Json: encode :: Value -> Builder
Files
- CHANGELOG.md +4/−0
- common/Twitter100.hs +1/−0
- json-syntax.cabal +10/−9
- src/Json.hs +69/−1
- test/Main.hs +9/−1
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for json-syntax +## 0.1.1.0 -- 2020-05-01++* Add `encode`.+ ## 0.1.0.0 -- 2020-01-20 * Initial release.
common/Twitter100.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} module Twitter100 ( encodedTwitter100
json-syntax.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: json-syntax-version: 0.1.0.0-synopsis: High-performance JSON parser+version: 0.1.1.0+synopsis: High-performance JSON parser and encoder description: This library parses JSON into a @Value@ type that is consistent with the ABNF described in [RFC 7159](https://tools.ietf.org/html/rfc7159). The@@ -14,8 +14,8 @@ and typeclasses are outside the scope of this library. If anyone writes a library that offers users these conveniences open a issue so that the @json-syntax@ documentation can point users to it.-homepage: https://github.com/andrewthad/json-syntax-bug-reports: https://github.com/andrewthad/json-syntax/issues+homepage: https://github.com/byteverse/json-syntax+bug-reports: https://github.com/byteverse/json-syntax/issues license: BSD-3-Clause license-file: LICENSE author: Andrew Martin@@ -31,12 +31,13 @@ , array-builder >=0.1 && <0.2 , array-chunks >=0.1.1 && <0.2 , base >=4.12 && <5- , bytesmith >=0.3.2 && <0.4+ , bytebuild >=0.3.4 && <0.4 , byteslice >=0.1.3 && <0.3- , scientific-notation >=0.1.1 && <0.2- , text-short >=0.1.3 && <0.2- , primitive >=0.7 && <0.8+ , bytesmith >=0.3.2 && <0.4 , bytestring >=0.10.8 && <0.11+ , primitive >=0.7 && <0.8+ , scientific-notation >=0.1.2 && <0.2+ , text-short >=0.1.3 && <0.2 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall -O2@@ -60,7 +61,7 @@ , primitive , scientific , scientific-notation >=0.1.1- , small-bytearray-builder+ , bytebuild , tasty >=1.2.3 && <1.3 , tasty-hunit >=0.10.0.2 && <0.11 , text >=1.2
src/Json.hs view
@@ -5,7 +5,9 @@ {-# language DeriveAnyClass #-} {-# language LambdaCase #-} {-# language MagicHash #-}+{-# language NamedFieldPuns #-} {-# language TypeApplications #-}+{-# language UnboxedTuples #-} module Json ( -- * Types@@ -14,6 +16,7 @@ , SyntaxException(..) -- * Functions , decode+ , encode ) where import Prelude hiding (Bool(True,False))@@ -25,7 +28,7 @@ import Data.Bytes.Parser (Parser) import Data.Bytes.Types (Bytes(..)) import Data.Char (ord)-import Data.Chunks (Chunks(ChunksNil))+import Data.Chunks (Chunks(ChunksNil,ChunksCons)) import Data.Number.Scientific (Scientific) import Data.Primitive (ByteArray,MutableByteArray) import Data.Text.Short (ShortText)@@ -34,6 +37,7 @@ import qualified Prelude import qualified Data.Builder.ST as B+import qualified Data.Bytes.Builder as BLDR import qualified Data.Bytes.Parser as P import qualified Data.Text.Short.Unsafe as TS import qualified Data.Number.Scientific as SCI@@ -122,6 +126,70 @@ P.skipWhile isSpace P.endOfInput UnexpectedLeftovers pure result++encode :: Value -> BLDR.Builder+encode = \case+ True -> BLDR.ascii4 't' 'r' 'u' 'e'+ False -> BLDR.ascii5 'f' 'a' 'l' 's' 'e'+ Null -> BLDR.ascii4 'n' 'u' 'l' 'l'+ String s -> BLDR.shortTextJsonString s+ Number n -> SCI.builderUtf8 n+ Array ys -> case unconsNonempty ys of+ Nothing -> BLDR.ascii2 '[' ']'+ Just (x,xs) ->+ BLDR.ascii '['+ <>+ encode (PM.indexSmallArray x 0)+ <>+ foldrTail+ ( \v b -> BLDR.ascii ',' <> encode v <> b+ )+ ( foldr+ ( \v b -> BLDR.ascii ',' <> encode v <> b+ ) (BLDR.ascii ']') xs+ )+ x+ Object ys -> case unconsNonempty ys of+ Nothing -> BLDR.ascii2 '{' '}'+ Just (x,xs) ->+ BLDR.ascii '{'+ <>+ encodeMember (PM.indexSmallArray x 0)+ <>+ foldrTail+ ( \mbr b -> BLDR.ascii ',' <> encodeMember mbr <> b+ )+ ( foldr+ ( \mbr b -> BLDR.ascii ',' <> encodeMember mbr <> b+ ) (BLDR.ascii '}') xs+ )+ x++encodeMember :: Member -> BLDR.Builder+encodeMember Member{key,value} =+ BLDR.shortTextJsonString key+ <>+ BLDR.ascii ':'+ <>+ encode value++foldrTail :: (a -> b -> b) -> b -> PM.SmallArray a -> b+{-# inline foldrTail #-}+foldrTail f z !ary = go 1 where+ !sz = PM.sizeofSmallArray ary+ go i+ | i == sz = z+ | (# x #) <- PM.indexSmallArray## ary i+ = f x (go (i+1))++-- Get the first non-empty SmallArray from the Chunks.+unconsNonempty :: Chunks a -> Maybe (PM.SmallArray a, Chunks a)+{-# inline unconsNonempty #-}+unconsNonempty = go where+ go ChunksNil = Nothing+ go (ChunksCons x xs) = case PM.sizeofSmallArray x of+ 0 -> go xs+ _ -> Just (x,xs) -- Precondition: skip over all space before calling this. -- It will not skip leading space for you. It does
test/Main.hs view
@@ -1,6 +1,7 @@ {-# language LambdaCase #-} {-# language OverloadedStrings #-} +import Control.Monad (when) import Data.ByteString.Short.Internal (ShortByteString(SBS)) import Data.Bytes (Bytes) import Data.Primitive (ByteArray(ByteArray))@@ -12,6 +13,8 @@ import qualified Data.Aeson as AE import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Builder as Builder+import qualified Data.Bytes.Chunks as BChunks import qualified Data.Chunks as Chunks import qualified Data.HashMap.Strict as HM import qualified Data.Number.Scientific as SCI@@ -65,7 +68,12 @@ Right j -> case AE.decodeStrict byteStringTwitter100 of Nothing -> fail "aeson is messed up" Just ae -> ae @=? toAesonValue j- + , THU.testCase "Twitter100-roundtrip" $+ case J.decode (Bytes.fromByteArray encodedTwitter100) of+ Left _ -> fail "nope, Twitter100 test will be failing too"+ Right j -> case J.decode (BChunks.concat (Builder.run 1 (J.encode j))) of+ Left _ -> fail "encode did not produce a document that could be decoded"+ Right j' -> when (j /= j') (fail "document was not the same after roundtrip") ] toBadSci :: SCI.Scientific -> Scientific