diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,12 @@ `small-bytearray-builder` is now just a compatibility shim to ease the migration process. +## 0.3.15.0 -- 2024-01-05 + +* Add `Data.Bytes.Builder.Unsafe.pasteUtf8TextJson#` for users who need + to perform JSON string encoding without using a builder. +* Add `Data.Bytes.Builder.textJsonString` when building with text 2.0+ + ## 0.3.14.0 -- 2023-07-20 * Add `runOntoLength`. diff --git a/bytebuild.cabal b/bytebuild.cabal --- a/bytebuild.cabal +++ b/bytebuild.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: bytebuild -version: 0.3.14.0 +version: 0.3.15.0 synopsis: Build byte arrays description: This is similar to the builder facilities provided by @@ -49,10 +49,10 @@ reexported-modules: Data.Bytes.Chunks build-depends: - , base >=4.12.0.0 && <4.19 + , base >=4.12.0.0 && <4.20 , byteslice >=0.2.6 && <0.3 - , bytestring >=0.10.8.2 && <0.12 - , haskell-src-meta >=0.8 + , bytestring >=0.10.8.2 && <0.13 + , haskell-src-meta >=0.8.13 , integer-logarithms >=1.0.3 && <1.1 , natural-arithmetic >=0.1 && <0.3 , primitive-offset >=0.2 && <0.3 @@ -68,10 +68,10 @@ if impl(ghc >= 8.10) hs-source-dirs: src-9.0 if flag(checked) - build-depends: primitive-checked >= 0.7 && <0.9 + build-depends: primitive-checked >= 0.7 && <0.10 hs-source-dirs: src-checked else - build-depends: primitive >= 0.7 && <0.9 + build-depends: primitive >= 0.7 && <0.10 hs-source-dirs: src-unchecked ghc-options: -Wall -O2 hs-source-dirs: src @@ -99,7 +99,7 @@ , quickcheck-classes >=0.6.4 , quickcheck-instances >=0.3.22 , text-short - , tasty >=1.2.3 && <1.5 + , tasty >=1.2.3 && <1.6 , tasty-hunit >=0.10.0.2 && <0.11 , tasty-quickcheck >=0.10.1 && <0.11 , text >=1.2 && <2.2 diff --git a/src/Data/Bytes/Builder.hs b/src/Data/Bytes/Builder.hs --- a/src/Data/Bytes/Builder.hs +++ b/src/Data/Bytes/Builder.hs @@ -32,6 +32,7 @@ , shortByteString #if MIN_VERSION_text(2,0,0) , textUtf8 + , textJsonString #endif , shortTextUtf8 , shortTextJsonString @@ -159,10 +160,10 @@ import Data.Bytes.Builder.Unsafe (commitsOntoChunks) import Data.Bytes.Builder.Unsafe (reverseCommitsOntoChunks) import Data.Bytes.Builder.Unsafe (stringUtf8,cstring,fromEffect) +import Data.Bytes.Builder.Unsafe (pasteUtf8TextJson#) import Data.Bytes.Chunks (Chunks(ChunksCons,ChunksNil)) import Data.Bytes.Types (Bytes(Bytes),MutableBytes(MutableBytes)) import Data.ByteString.Short.Internal (ShortByteString(SBS)) -import Data.Char (ord) import Data.Foldable (foldlM) import Data.Int (Int64,Int32,Int16,Int8) import Data.Primitive (ByteArray(..),MutableByteArray(..),PrimArray(..)) @@ -173,7 +174,7 @@ import Foreign.C.String (CStringLen) import GHC.ByteOrder (ByteOrder(BigEndian,LittleEndian),targetByteOrder) import GHC.Exts (MutableByteArray#,Addr#,(*#),oneShot) -import GHC.Exts (Int(I#),Char(C#),Int#,State#,ByteArray#,(>=#)) +import GHC.Exts (Int(I#),Int#,State#,ByteArray#,(>=#)) import GHC.Exts (RealWorld,(+#),(-#),(<#)) import GHC.Integer.Logarithms.Compat (integerLog2#) import GHC.IO (IO(IO),stToIO) @@ -795,38 +796,18 @@ -- byte sequence is UTF-8 encoded text. slicedUtf8TextJson :: ByteArray# -> Int# -> Int# -> Builder {-# noinline slicedUtf8TextJson #-} -slicedUtf8TextJson !src# !soff0# !slen0# = fromFunction reqLen $ \dst doff0 -> do - PM.writeByteArray dst doff0 (c2w '"') - let go !soff !slen !doff = if slen > 0 - then case indexChar8Array (ByteArray src#) soff of - '\\' -> write2 dst doff '\\' '\\' *> go (soff + 1) (slen - 1) (doff + 2) - '\"' -> write2 dst doff '\\' '\"' *> go (soff + 1) (slen - 1) (doff + 2) - c -> if c >= '\x20' - then PM.writeByteArray dst doff (c2w c) *> go (soff + 1) (slen - 1) (doff + 1) - else case c of - '\n' -> write2 dst doff '\\' 'n' *> go (soff + 1) (slen - 1) (doff + 2) - '\r' -> write2 dst doff '\\' 'r' *> go (soff + 1) (slen - 1) (doff + 2) - '\t' -> write2 dst doff '\\' 't' *> go (soff + 1) (slen - 1) (doff + 2) - _ -> do - write2 dst doff '\\' 'u' - doff' <- UnsafeBounded.pasteST - (Bounded.word16PaddedUpperHex (fromIntegral (c2w c))) - dst (doff + 2) - go (soff + 1) (slen - 1) doff' - else pure doff - doffRes <- go (I# soff0#) (I# slen0#) (doff0 + 1) - PM.writeByteArray dst doffRes (c2w '"') - pure (doffRes + 1) +slicedUtf8TextJson !src# !soff0# !slen0# = fromFunction# reqLen# + ( \dst# doff0# s0# -> pasteUtf8TextJson# src# soff0# slen0# dst# doff0# s0# ) where - slen0 = I# slen0# -- We multiply by 6 because, in the worst case, everything might be in the -- unprintable ASCII range. The plus 2 is for the quotes on the ends. - reqLen = (6 * slen0) + 2 + !reqLen# = (6# *# slen0# ) +# 2# -- | Constructor for 'Builder' that works on a function with lifted -- arguments instead of unlifted ones. This is just as unsafe as the -- actual constructor. fromFunction :: Int -> (forall s. MutableByteArray s -> Int -> ST s Int) -> Builder +{-# inline fromFunction #-} fromFunction (I# req) f = Builder $ \buf0 off0 len0 cs0 s0 -> let !(# s1, buf1, off1, len1, cs1 #) = case len0 >=# req of 1# -> (# s0, buf0, off0, len0, cs0 #) @@ -837,11 +818,17 @@ in case unST (f (MutableByteArray buf1) (I# off1)) s1 of (# s2, I# off2 #) -> (# s2, buf1, off2, len1 -# (off2 -# off1), cs1 #) --- Internal. Write two characters in the ASCII plane to a byte array. -write2 :: MutableByteArray s -> Int -> Char -> Char -> ST s () -write2 marr ix a b = do - PM.writeByteArray marr ix (c2w a) - PM.writeByteArray marr (ix + 1) (c2w b) +fromFunction# :: Int# -> (forall s. MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) ) -> Builder +{-# inline fromFunction# #-} +fromFunction# req f = Builder $ \buf0 off0 len0 cs0 s0 -> + let !(# s1, buf1, off1, len1, cs1 #) = case len0 >=# req of + 1# -> (# s0, buf0, off0, len0, cs0 #) + _ -> let !(I# lenX) = max 4080 (I# req) in + case Exts.newByteArray# lenX s0 of + (# sX, bufX #) -> + (# sX, bufX, 0#, lenX, Mutable buf0 off0 cs0 #) + in case f buf1 off1 s1 of + (# s2, off2 #) -> (# s2, buf1, off2, len1 -# (off2 -# off1), cs1 #) -- | Create a builder from text. The text will be UTF-8 encoded. shortTextUtf8 :: ShortText -> Builder @@ -864,11 +851,18 @@ -- * @\\_"_\/ ==\> "\\\\_\\"_\/"@ (escapes backslashes and quotes) -- * @hello\world ==> "hello\\u001Bworld"@ (where @\@ is code point 0x1B) shortTextJsonString :: ShortText -> Builder +{-# inline shortTextJsonString #-} shortTextJsonString a = let !(ByteArray ba) = shortTextToByteArray a !(I# len) = PM.sizeofByteArray (ByteArray ba) in slicedUtf8TextJson ba 0# len +#if MIN_VERSION_text(2,0,0) +textJsonString :: Text -> Builder +{-# inline textJsonString #-} +textJsonString (I.Text (A.ByteArray ba) (I# off) (I# len)) = slicedUtf8TextJson ba off len +#endif + -- | Encodes an unsigned 64-bit integer as decimal. -- This encoding never starts with a zero unless the -- argument was zero. @@ -1204,23 +1198,20 @@ shortTextToByteArray x = case TS.toShortByteString x of SBS a -> ByteArray a -indexChar8Array :: ByteArray -> Int -> Char -indexChar8Array (ByteArray b) (I# i) = C# (Exts.indexCharArray# b i) - -c2w :: Char -> Word8 -c2w = fromIntegral . ord - -- | Encode a signed machine-sized integer with LEB-128. This uses -- zig-zag encoding. intLEB128 :: Int -> Builder +{-# inline intLEB128 #-} intLEB128 = wordLEB128 . toZigzagNative -- | Encode a 32-bit signed integer with LEB-128. This uses zig-zag encoding. int32LEB128 :: Int32 -> Builder +{-# inline int32LEB128 #-} int32LEB128 = word32LEB128 . toZigzag32 -- | Encode a 64-bit signed integer with LEB-128. This uses zig-zag encoding. int64LEB128 :: Int64 -> Builder +{-# inline int64LEB128 #-} int64LEB128 = word64LEB128 . toZigzag64 -- | Encode a machine-sized word with LEB-128. diff --git a/src/Data/Bytes/Builder/Unsafe.hs b/src/Data/Bytes/Builder/Unsafe.hs --- a/src/Data/Bytes/Builder/Unsafe.hs +++ b/src/Data/Bytes/Builder/Unsafe.hs @@ -33,22 +33,25 @@ -- @Data.Bytes.Builder@ instead. , stringUtf8 , cstring + -- * Pasting with Preconditions + , pasteUtf8TextJson# ) where import Control.Monad.Primitive (primitive_) import Data.Bytes.Chunks (Chunks(ChunksCons)) import Data.Bytes.Types (Bytes(Bytes)) +import Data.Char (ord) import Data.Primitive (MutableByteArray(..),ByteArray(..)) +import Data.Word (Word8) import Foreign.C.String (CString) import GHC.Base (unpackCString#,unpackCStringUtf8#) -import GHC.Exts ((-#),(+#),(>#),(>=#)) +import GHC.Exts ((-#),(+#),(>#),(>=#),Char(C#)) import GHC.Exts (Addr#,ByteArray#,MutableByteArray#,Int(I#),Ptr(Ptr)) import GHC.Exts (RealWorld,IsString,Int#,State#) -import GHC.ST (ST(ST)) import GHC.IO (stToIO) +import GHC.ST (ST(ST)) import qualified Compat as C - import qualified Data.Bytes.Builder.Bounded as Bounded import qualified Data.Bytes.Builder.Bounded.Unsafe as UnsafeBounded import qualified Data.Primitive as PM @@ -311,3 +314,65 @@ case Exts.sameMutableByteArray# target buf of 1# -> n +# len _ -> commitDistance target (n +# len) cs + +-- | Encode (UTF-8 encoded) text as a JSON string, wrapping it in double quotes. +-- This escapes all characters with code points below @0x20@. +-- +-- * Precondition: The slice of the byte argument is UTF-8 encoded text. +-- * Precondition: There is enough space in the buffer for the result +-- to be written to. A simple way to ensure enough space is to allocate +-- @6N + 2@ bytes, where N is the length of the argument. However, the +-- caller may use clever heuristics to find a lower upper bound. +-- * Result: The next offset in the destination buffer +pasteUtf8TextJson# :: + ByteArray# -- ^ source + -> Int# -- ^ source offset + -> Int# -- ^ source length + -> MutableByteArray# s -- ^ destination buffer + -> Int# -- ^ offset into destination buffer + -> State# s -- ^ state token + -> (# State# s, Int# #) -- returns next destination offset +{-# noinline pasteUtf8TextJson# #-} +pasteUtf8TextJson# src# soff0# slen0# dst# doff0# s0# = + let ST f = do + let dst = MutableByteArray dst# + let doff0 = I# doff0# + PM.writeByteArray dst doff0 (c2w '"') + let go !soff !slen !doff = if slen > 0 + then case indexChar8Array (ByteArray src#) soff of + '\\' -> write2 dst doff '\\' '\\' *> go (soff + 1) (slen - 1) (doff + 2) + '\"' -> write2 dst doff '\\' '\"' *> go (soff + 1) (slen - 1) (doff + 2) + c -> if c >= '\x20' + then PM.writeByteArray dst doff (c2w c) *> go (soff + 1) (slen - 1) (doff + 1) + else case c of + '\n' -> write2 dst doff '\\' 'n' *> go (soff + 1) (slen - 1) (doff + 2) + '\r' -> write2 dst doff '\\' 'r' *> go (soff + 1) (slen - 1) (doff + 2) + '\t' -> write2 dst doff '\\' 't' *> go (soff + 1) (slen - 1) (doff + 2) + '\b' -> write2 dst doff '\\' 'b' *> go (soff + 1) (slen - 1) (doff + 2) + '\f' -> write2 dst doff '\\' 'f' *> go (soff + 1) (slen - 1) (doff + 2) + _ -> do + write2 dst doff '\\' 'u' + doff' <- UnsafeBounded.pasteST + (Bounded.word16PaddedUpperHex (fromIntegral (c2w c))) + dst (doff + 2) + go (soff + 1) (slen - 1) doff' + else pure doff + doffRes <- go (I# soff0#) (I# slen0#) (doff0 + 1) + PM.writeByteArray dst doffRes (c2w '"') + pure (doffRes + 1) + !(# !s1, I# dstFinal #) = f s0# + in (# s1, dstFinal #) + +c2w :: Char -> Word8 +{-# inline c2w #-} +c2w = fromIntegral . ord + +-- Internal. Write two characters in the ASCII plane to a byte array. +write2 :: MutableByteArray s -> Int -> Char -> Char -> ST s () +write2 marr ix a b = do + PM.writeByteArray marr ix (c2w a) + PM.writeByteArray marr (ix + 1) (c2w b) + +indexChar8Array :: ByteArray -> Int -> Char +{-# inline indexChar8Array #-} +indexChar8Array (ByteArray b) (I# i) = C# (Exts.indexCharArray# b i)