small-bytearray-builder 0.3.1.0 → 0.3.2.0

raw patch · 7 files changed

+378/−189 lines, 7 filesdep +primitive-unlifteddep ~byteslicePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: primitive-unlifted

Dependency ranges changed: byteslice

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• small-bytearray-builder.cabal +8/−5
• src/Data/ByteArray/Builder.hs +169/−51
• src/Data/ByteArray/Builder/Bounded.hs +59/−3
• src/Data/ByteArray/Builder/Unsafe.hs +67/−1
• src/Data/Bytes/Chunks.hs +0/−106
• test/Main.hs +64/−23

@@ -1,5 +1,16 @@ # Revision history for small-bytearray-builder +## 0.3.2.0 -- 2020-01-20++* Add `putMany`, which allows pasting into the same mutable byte+  array over and over.+* Add `consLength`.+* Add `putManyConsLength`, useful for chunked HTTP encoding.+* Add `runOnto`+* Add `Data.Bytes.Chunks.length`+* Add `wordPaddedDec2` and `wordPaddedDec9`.+* Add `word8PaddedLowerHex`.+ ## 0.3.1.0 -- 2019-11-20  * Add big-endian and little-endian parsers for `Word128`. This includes

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: small-bytearray-builder-version: 0.3.1.0+version: 0.3.2.0 synopsis: Serialize to a small byte arrays description:   This is similar to the builder facilities provided by@@ -19,8 +19,8 @@   of the next chunk. This strategy for building is suitable for most   CSVs and several line protocols (carbon, InfluxDB, etc.).   -homepage: https://github.com/andrewthad/small-bytearray-builder-bug-reports: https://github.com/andrewthad/small-bytearray-builder/issues+homepage: https://github.com/byteverse/small-bytearray-builder+bug-reports: https://github.com/byteverse/small-bytearray-builder/issues license: BSD-3-Clause license-file: LICENSE author: Andrew Martin@@ -36,17 +36,19 @@  library   exposed-modules:-    Data.Bytes.Chunks     Data.ByteArray.Builder     Data.ByteArray.Builder.Unsafe     Data.ByteArray.Builder.Bounded     Data.ByteArray.Builder.Bounded.Unsafe+  reexported-modules:+    Data.Bytes.Chunks   build-depends:     , base >=4.12.0.0 && <5-    , byteslice >=0.1 && <0.3+    , byteslice >=0.2 && <0.3     , bytestring >=0.10.8.2 && <0.11     , natural-arithmetic >=0.1 && <0.2     , primitive-offset >=0.2 && <0.3+    , primitive-unlifted >=0.1.2 && <0.2     , run-st >=0.1 && <0.2     , text-short >=0.1.3 && <0.2     , wide-word >=0.1.0.9 && <0.2@@ -74,6 +76,7 @@     , bytestring     , natural-arithmetic     , primitive+    , primitive-unlifted >=0.1.2     , quickcheck-classes >=0.6.4     , small-bytearray-builder     , tasty >=1.2.3 && <1.3

@@ -13,6 +13,9 @@   , fromBounded     -- * Evaluation   , run+  , runOnto+  , putMany+  , putManyConsLength     -- * Materialized Byte Sequences   , bytes   , copy@@ -88,6 +91,7 @@   , int32ArrayLE   , int16ArrayLE     -- ** Prefixing with Length+  , consLength   , consLength32LE   , consLength32BE   , consLength64BE@@ -98,15 +102,20 @@   , flush   ) where +import Control.Exception (SomeException,toException) import Control.Monad.ST (ST,runST)+import Control.Monad.IO.Class (MonadIO,liftIO) import Data.ByteArray.Builder.Unsafe (Builder(Builder))+import Data.ByteArray.Builder.Unsafe (BuilderState(BuilderState),pasteIO) import Data.ByteArray.Builder.Unsafe (Commits(Initial,Mutable,Immutable)) import Data.ByteArray.Builder.Unsafe (reverseCommitsOntoChunks) import Data.ByteArray.Builder.Unsafe (stringUtf8,cstring)+import Data.ByteArray.Builder.Unsafe (addCommitsLength,copyReverseCommits) import Data.ByteString.Short.Internal (ShortByteString(SBS)) import Data.Bytes.Chunks (Chunks(ChunksNil))-import Data.Bytes.Types (Bytes(Bytes))+import Data.Bytes.Types (Bytes(Bytes),MutableBytes(MutableBytes)) import Data.Char (ord)+import Data.Foldable (foldlM) import Data.Int (Int64,Int32,Int16,Int8) import Data.Primitive (ByteArray(..),MutableByteArray(..),PrimArray(..)) import Data.Text.Short (ShortText)@@ -114,7 +123,8 @@ import Data.Word (Word64,Word32,Word16,Word8) import GHC.ByteOrder (ByteOrder(BigEndian,LittleEndian),targetByteOrder) import GHC.Exts (Int(I#),Char(C#),Int#,State#,ByteArray#,(>=#))-import GHC.Exts (MutableByteArray#,(+#),(-#),(<#))+import GHC.Exts (RealWorld,MutableByteArray#,(+#),(-#),(<#))+import GHC.IO (IO(IO),stToIO) import GHC.ST (ST(ST))  import qualified Arithmetic.Nat as Nat@@ -130,13 +140,129 @@      Int -- ^ Size of initial chunk (use 4080 if uncertain)   -> Builder -- ^ Builder   -> Chunks-run hint@(I# hint# ) (Builder f) = runST $ do+run !hint bldr = runOnto hint bldr ChunksNil++-- | Run a builder. The resulting chunks are consed onto the+-- beginning of an existing sequence of chunks.+runOnto ::+     Int -- ^ Size of initial chunk (use 4080 if uncertain)+  -> Builder -- ^ Builder+  -> Chunks+  -> Chunks+runOnto hint@(I# hint# ) (Builder f) cs0 = runST $ do   MutableByteArray buf0 <- PM.newByteArray hint   cs <- ST $ \s0 -> case f buf0 0# hint# Initial s0 of     (# s1, bufX, offX, _, csX #) ->       (# s1, Mutable bufX offX csX #)-  reverseCommitsOntoChunks ChunksNil cs+  reverseCommitsOntoChunks cs0 cs +-- | Run a builder against lots of elements. This fills the same+-- underlying buffer over and over again. Do not let the argument to+-- the callback escape from the callback (i.e. do not write it to an+-- @IORef@). Also, do not @unsafeFreezeByteArray@ any of the mutable+-- byte arrays in the callback. The intent is that the callback will+-- write the buffer out.+putMany :: Foldable f+  => Int -- ^ Size of shared chunk (use 8176 if uncertain)+  -> (a -> Builder) -- ^ Value builder+  -> f a -- ^ Collection of values+  -> (MutableBytes RealWorld -> IO b) -- ^ Consume chunks.+  -> IO ()+{-# inline putMany #-}+putMany hint0 g xs cb = do+  MutableByteArray buf0 <- PM.newByteArray hint+  BuilderState bufZ offZ _ cmtsZ <- foldlM+    (\st0 a -> do+      st1@(BuilderState buf off _ cmts) <- pasteIO (g a) st0+      case cmts of+        Initial -> if I# off < threshold+          then pure st1+          else do+            _ <- cb (MutableBytes (MutableByteArray buf) 0 (I# off))+            pure (BuilderState buf0 0# hint# Initial)+        _ -> do+          let total = addCommitsLength (I# off) cmts+              doff0 = total - I# off+          large <- PM.newByteArray total+          stToIO (PM.copyMutableByteArray large doff0 (MutableByteArray buf) 0 (I# off))+          r <- stToIO (copyReverseCommits large doff0 cmts)+          case r of+            0 -> do+              _ <- cb (MutableBytes large 0 total)+              pure (BuilderState buf0 0# hint# Initial)+            _ -> IO (\s0 -> Exts.raiseIO# putManyError s0)+    ) (BuilderState buf0 0# hint# Initial) xs+  _ <- case cmtsZ of+    Initial -> cb (MutableBytes (MutableByteArray bufZ) 0 (I# offZ))+    _ -> IO (\s0 -> Exts.raiseIO# putManyError s0)+  pure ()+  where+  !hint@(I# hint#) = max hint0 8+  !threshold = div (hint * 3) 4++putManyError :: SomeException+{-# noinline putManyError #-}+putManyError = toException+  (userError "small-bytearray-builder: putMany implementation error")++-- | Variant of 'putMany' that prefixes each pushed array of chunks+-- with the number of bytes that the chunks in each batch required.+-- (This excludes the bytes required to encode the length itself.)+-- This is useful for chunked HTTP encoding.+putManyConsLength :: (Foldable f, MonadIO m)+  => Arithmetic.Nat n -- ^ Number of bytes used by the serialization of the length+  -> (Int -> Bounded.Builder n) -- ^ Length serialization function+  -> Int -- ^ Size of shared chunk (use 8176 if uncertain)+  -> (a -> Builder) -- ^ Value builder+  -> f a -- ^ Collection of values+  -> (MutableBytes RealWorld -> m b) -- ^ Consume chunks.+  -> m ()+{-# inline putManyConsLength #-}+putManyConsLength n buildSize hint g xs cb = do+  let !(I# n# ) = Nat.demote n+  let !(I# actual# ) = max hint (I# n# )+  let !threshold = div (I# actual# * 3) 4+  MutableByteArray buf0 <- liftIO (PM.newByteArray (I# actual# ))+  BuilderState bufZ offZ _ cmtsZ <- foldlM+    (\st0 a -> do+      st1@(BuilderState buf off _ cmts) <- liftIO (pasteIO (g a) st0)+      case cmts of+        Initial -> if I# off < threshold+          then pure st1+          else do+            let !dist = off -# n#+            _ <- liftIO $ stToIO $ UnsafeBounded.pasteST+              (buildSize (fromIntegral (I# dist)))+              (MutableByteArray buf0) 0+            _ <- cb (MutableBytes (MutableByteArray buf) 0 (I# off))+            pure (BuilderState buf0 n# (actual# -# n# ) Initial)+        _ -> do+          let !dist = commitDistance1 buf0 n# buf off cmts+          _ <- liftIO $ stToIO $ UnsafeBounded.pasteST+            (buildSize (fromIntegral (I# dist)))+            (MutableByteArray buf0) 0+          let total = addCommitsLength (I# off) cmts+              doff0 = total - I# off+          large <- liftIO (PM.newByteArray total)+          liftIO (stToIO (PM.copyMutableByteArray large doff0 (MutableByteArray buf) 0 (I# off)))+          r <- liftIO (stToIO (copyReverseCommits large doff0 cmts))+          case r of+            0 -> do+              _ <- cb (MutableBytes large 0 total)+              pure (BuilderState buf0 n# (actual# -# n# ) Initial)+            _ -> liftIO (IO (\s0 -> Exts.raiseIO# putManyError s0))+    ) (BuilderState buf0 n# (actual# -# n# ) Initial) xs+  _ <- case cmtsZ of+    Initial -> do+      let !distZ = offZ -# n#+      _ <- liftIO $ stToIO $ UnsafeBounded.pasteST+        (buildSize (fromIntegral (I# distZ)))+        (MutableByteArray buf0)+        0+      cb (MutableBytes (MutableByteArray bufZ) 0 (I# offZ))+    _ -> liftIO (IO (\s0 -> Exts.raiseIO# putManyError s0))+  pure ()+ -- | Convert a bounded builder to an unbounded one. If the size -- is a constant, use @Arithmetic.Nat.constant@ as the first argument -- to let GHC conjure up this value for you.@@ -603,7 +729,7 @@ ascii :: Char -> Builder ascii c = fromBoundedOne (Bounded.ascii c) --- | Encode an UTF8 char. This only uses as much space as is required.+-- | Encode a UTF-8 char. This only uses as much space as is required. char :: Char -> Builder char c = fromBounded Nat.constant (Bounded.char c) @@ -684,33 +810,44 @@ word8 :: Word8 -> Builder word8 w = fromBoundedOne (Bounded.word8 w) --- | Variant of 'consLength32BE' the encodes the length in--- a little-endian fashion.-consLength32LE :: Builder -> Builder-consLength32LE (Builder f) = Builder $ \buf0 off0 len0 cs0 s0 ->-  let !(# s1, buf1, off1, len1, cs1 #) = case len0 >=# 4# of+-- | Prefix a builder with the number of bytes that it requires.+consLength ::+     Arithmetic.Nat n -- ^ Number of bytes used by the serialization of the length+  -> (Int -> Bounded.Builder n) -- ^ Length serialization function+  -> Builder -- ^ Builder whose length is measured+  -> Builder+{-# inline consLength #-}+consLength !n buildSize (Builder f) = Builder $ \buf0 off0 len0 cs0 s0 ->+  -- There is actually a little bit of unsoundness here. If the number of+  -- bytes required to encode the length is greater than 4080, this will+  -- write outside the array, leading to a crash.+  let !(I# lenSz) = Nat.demote n+      !(# s1, buf1, off1, len1, cs1 #) = case len0 >=# lenSz of         1# -> (# s0, buf0, off0, len0, cs0 #)         _ -> case Exts.newByteArray# 4080# s0 of           (# sX, bufX #) ->             (# sX, bufX, 0#, 4080#, Mutable buf0 off0 cs0 #)-   in case f buf1 (off1 +# 4# ) (len1 -# 4# ) cs1 s1 of+   in case f buf1 (off1 +# lenSz) (len1 -# lenSz) cs1 s1 of         (# s2, buf2, off2, len2, cs2 #) ->-          let !dist = case Exts.sameMutableByteArray# buf1 buf2 of-                1# -> off2 -# off1-                _ -> commitDistance buf1 off2 cs2 -# off1+          let !dist = commitDistance1 buf1 (off1 +# lenSz) buf2 off2 cs2               ST g = UnsafeBounded.pasteST-                (Bounded.word32LE (fromIntegral (I# (dist -# 4# ))))+                (buildSize (fromIntegral (I# dist)))                 (MutableByteArray buf1)                 (I# off1)            in case g s2 of                 (# s3, _ #) -> (# s3, buf2, off2, len2, cs2 #) +-- | Variant of 'consLength32BE' the encodes the length in+-- a little-endian fashion.+consLength32LE :: Builder -> Builder+consLength32LE = consLength Nat.constant (\x -> Bounded.word32LE (fromIntegral x))+ -- | Prefix a builder with its size in bytes. This size is -- presented as a big-endian 32-bit word. The need to prefix -- a builder with its length shows up a numbers of wire protocols -- including those of PostgreSQL and Apache Kafka. Note the -- equivalence:--- +-- -- > forall (n :: Int) (x :: Builder). -- >   let sz = sizeofByteArray (run n (consLength32BE x)) -- >   consLength32BE x === word32BE (fromIntegral sz) <> x@@ -718,45 +855,26 @@ -- However, using 'consLength32BE' is much more efficient here -- since it only materializes the 'ByteArray' once. consLength32BE :: Builder -> Builder-consLength32BE (Builder f) = Builder $ \buf0 off0 len0 cs0 s0 ->-  let !(# s1, buf1, off1, len1, cs1 #) = case len0 >=# 4# of-        1# -> (# s0, buf0, off0, len0, cs0 #)-        _ -> case Exts.newByteArray# 4080# s0 of-          (# sX, bufX #) ->-            (# sX, bufX, 0#, 4080#, Mutable buf0 off0 cs0 #)-   in case f buf1 (off1 +# 4# ) (len1 -# 4# ) cs1 s1 of-        (# s2, buf2, off2, len2, cs2 #) ->-          let !dist = case Exts.sameMutableByteArray# buf1 buf2 of-                1# -> off2 -# off1-                _ -> commitDistance buf1 off2 cs2 -# off1-              ST g = UnsafeBounded.pasteST-                (Bounded.word32BE (fromIntegral (I# (dist -# 4# ))))-                (MutableByteArray buf1)-                (I# off1)-           in case g s2 of-                (# s3, _ #) -> (# s3, buf2, off2, len2, cs2 #)-+consLength32BE = consLength Nat.constant (\x -> Bounded.word32BE (fromIntegral x))  -- | Prefix a builder with its size in bytes. This size is -- presented as a big-endian 64-bit word. See 'consLength32BE'. consLength64BE :: Builder -> Builder-consLength64BE (Builder f) = Builder $ \buf0 off0 len0 cs0 s0 ->-  let !(# s1, buf1, off1, len1, cs1 #) = case len0 >=# 8# of-        1# -> (# s0, buf0, off0, len0, cs0 #)-        _ -> case Exts.newByteArray# 4080# s0 of-          (# sX, bufX #) ->-            (# sX, bufX, 0#, 4080#, Mutable buf0 off0 cs0 #)-   in case f buf1 (off1 +# 8# ) (len1 -# 8# ) cs1 s1 of-        (# s2, buf2, off2, len2, cs2 #) ->-          let !dist = case Exts.sameMutableByteArray# buf1 buf2 of-                1# -> off2 -# off1-                _ -> commitDistance buf1 off2 cs2 -# off1-              ST g = UnsafeBounded.pasteST-                (Bounded.word64BE (fromIntegral (I# (dist -# 8# ))))-                (MutableByteArray buf1)-                (I# off1)-           in case g s2 of-                (# s3, _ #) -> (# s3, buf2, off2, len2, cs2 #)+consLength64BE = consLength Nat.constant (\x -> Bounded.word64BE (fromIntegral x))++-- Internal. This is like commitDistance, but you get to supply a+-- head of the commit list that has not yet been committed.+commitDistance1 ::+     MutableByteArray# s -- target+  -> Int# -- offset into target+  -> MutableByteArray# s -- head of array+  -> Int# -- offset into head of array+  -> Commits s+  -> Int#+commitDistance1 target offTarget buf0 offBuf cs =+  case Exts.sameMutableByteArray# target buf0 of+    1# -> offBuf -# offTarget+    _ -> commitDistance target offBuf cs -# offTarget  commitDistance :: MutableByteArray# s -> Int# -> Commits s -> Int# commitDistance _ !_ Initial = error "chunkDistance: chunk not found"

@@ -47,10 +47,14 @@   , word16LowerHex   , word16UpperHex     -- ** 8-bit+  , word8PaddedLowerHex   , word8PaddedUpperHex   , word8LowerHex   , ascii   , char+    -- ** Native+  , wordPaddedDec2+  , wordPaddedDec9     -- ** Machine-Readable     -- *** One   , word8@@ -380,6 +384,12 @@ word8PaddedUpperHex :: Word8 -> Builder 2 word8PaddedUpperHex (W8# w) = word8PaddedUpperHex# w +-- | Requires exactly 2 bytes. Encodes a 8-bit unsigned integer as+-- hexadecimal, zero-padding the encoding to 2 digits. This uses+-- lowercase for the alphabetical digits.+word8PaddedLowerHex :: Word8 -> Builder 2+word8PaddedLowerHex (W8# w) = word8PaddedLowerHex# w+ -- TODO: Is it actually worth unrolling this loop. I suspect that it -- might not be. Benchmark this. word64PaddedUpperHex# :: Word# -> Builder 16@@ -522,6 +532,47 @@   where   w = W# w# +-- | Encode a number less than 100 as a decimal number, zero-padding it to+-- two digits. For example: 0 is encoded as @00@, 5 is encoded as @05@, and+-- 73 is encoded as @73@.+--+-- Precondition: Argument must be less than 100. Failure to satisfy this+-- precondition will not result in a segfault, but the resulting bytes are+-- undefined. The implemention uses a heuristic for division that is inaccurate+-- for large numbers.+wordPaddedDec2 :: Word -> Builder 2+wordPaddedDec2 !w = Unsafe.construct $ \arr off -> do+  let d1 = approxDiv10 w+      d2 = w - (10 * d1)+  writeByteArray arr off (unsafeWordToWord8 (d1 + 48))+  writeByteArray arr (off + 1) (unsafeWordToWord8 (d2 + 48))+  pure (off + 2)++-- | Encode a number less than 1e9 as a decimal number, zero-padding it to+-- nine digits. For example: 0 is encoded as @000000000@ and 5 is encoded as+-- @000000005@.+--+-- Precondition: Argument must be less than 1e9. Failure to satisfy this+-- precondition will not result in a segfault, but the resulting bytes are+-- undefined. The implemention uses a heuristic for division that is inaccurate+-- for large numbers.+wordPaddedDec9 :: Word -> Builder 9+wordPaddedDec9 !w = Unsafe.construct $ \arr off -> do+  putRem10+    (putRem10 $ putRem10 $ putRem10 $ putRem10 $ putRem10 $+     putRem10 $ putRem10 $ putRem10+     (\_ _ _ -> pure ())+    ) arr (off + 8) w+  pure (off + 9)++putRem10 :: (MutableByteArray s -> Int -> Word -> ST s a) -> MutableByteArray s -> Int -> Word -> ST s a+{-# inline putRem10 #-}+putRem10 andThen arr off dividend = do+  let quotient = approxDiv10 dividend+      remainder = dividend - (10 * quotient)+  writeByteArray arr off (unsafeWordToWord8 (remainder + 48))+  andThen arr (off - 1) quotient+ -- | Encode an ASCII character. -- Precondition: Input must be an ASCII character. This is not checked. ascii :: Char -> Builder 1@@ -561,9 +612,6 @@     codepoint :: Word     codepoint = fromIntegral (ord c) -    unsafeWordToWord8 :: Word -> Word8-    unsafeWordToWord8 (W# w) = W8# w-     -- precondition: codepoint is less than 0x800     byteTwoOne :: Word -> Word     byteTwoOne w = unsafeShiftR w 6 .|. 0b11000000@@ -807,3 +855,11 @@ -- result anyway. Hmm... logBase10 :: Double -> Double logBase10 d = log d / 2.30258509299++-- Based on C code from https://stackoverflow.com/a/5558614+-- For numbers less than 1073741829, this gives a correct answer.+approxDiv10 :: Word -> Word+approxDiv10 !n = unsafeShiftR (0x1999999A * n) 32++unsafeWordToWord8 :: Word -> Word8+unsafeWordToWord8 (W# w) = W8# w

@@ -9,11 +9,17 @@ module Data.ByteArray.Builder.Unsafe   ( -- * Types     Builder(..)+  , BuilderState(..)   , Commits(..)+    -- * Execution+  , pasteST+  , pasteIO     -- * Construction   , fromEffect     -- * Finalization   , reverseCommitsOntoChunks+  , copyReverseCommits+  , addCommitsLength     -- * Safe Functions     -- | These functions are actually completely safe, but they are defined     -- here because they are used by typeclass instances. Import them from@@ -30,8 +36,9 @@ import GHC.Base (unpackCString#,unpackCStringUtf8#) import GHC.Exts ((-#),(+#),(>#),(>=#)) import GHC.Exts (Addr#,ByteArray#,MutableByteArray#,Int(I#),Ptr(Ptr))-import GHC.Exts (IsString,Int#,State#)+import GHC.Exts (RealWorld,IsString,Int#,State#) import GHC.ST (ST(ST))+import GHC.IO (stToIO)  import qualified Data.ByteArray.Builder.Bounded as Bounded import qualified Data.ByteArray.Builder.Bounded.Unsafe as UnsafeBounded@@ -50,6 +57,27 @@       (# State# s, MutableByteArray# s, Int#, Int#, Commits s #) -- all the same things     ) +data BuilderState s = BuilderState+  (MutableByteArray# s) -- buffer we are currently writing to+  Int# -- offset into the current buffer+  Int# -- number of bytes remaining in the current buffer+  !(Commits s) -- buffers and immutable byte slices that are already committed++-- | Run a builder, performing an in-place update on the state.+-- The @BuilderState@ argument must not be reused after being passed+-- to this function. That is, its use must be affine.+pasteST :: Builder -> BuilderState s -> ST s (BuilderState s)+{-# inline pasteST #-}+pasteST (Builder f) (BuilderState buf off len cmts) = ST $ \s0 ->+  case f buf off len cmts s0 of+    (# s1, buf1, off1, len1, cmts1 #) ->+      (# s1, BuilderState buf1 off1 len1 cmts1 #)++-- | Variant of 'pasteST' that runs in 'IO'.+pasteIO :: Builder -> BuilderState RealWorld -> IO (BuilderState RealWorld)+{-# inline pasteIO #-}+pasteIO b st = stToIO (pasteST b st)+ instance IsString Builder where   {-# inline fromString #-}   fromString = stringUtf8@@ -76,6 +104,13 @@       !(Commits s)   | Initial +-- | Add the total number of bytes in the commits to first+-- argument.+addCommitsLength :: Int -> Commits s -> Int+addCommitsLength !acc Initial = acc+addCommitsLength !acc (Immutable _ _ x cs) = addCommitsLength (acc + I# x) cs+addCommitsLength !acc (Mutable _ x cs) = addCommitsLength (acc + I# x) cs+ -- | Cons the chunks from a list of @Commits@ onto an initial -- @Chunks@ list (this argument is often @ChunksNil@). This reverses -- the order of the chunks, which is desirable since builders assemble@@ -93,6 +128,37 @@     shrinkMutableByteArray (MutableByteArray buf) (I# len)     arr <- PM.unsafeFreezeByteArray (MutableByteArray buf)     reverseCommitsOntoChunks (ChunksCons (Bytes arr 0 (I# len)) xs) cs++-- | Copy the contents of the chunks into a mutable array, reversing+-- the order of the chunks.+-- Precondition: The destination must have enough space to house the+-- contents. This is not checked.+copyReverseCommits ::+     MutableByteArray s -- ^ Destination+  -> Int -- ^ Destination range successor+  -> Commits s -- ^ Source+  -> ST s Int+{-# inline copyReverseCommits #-}+copyReverseCommits (MutableByteArray dst) (I# off) cs = ST+  (\s0 -> case copyReverseCommits# dst off cs s0 of+    (# s1, nextOff #) -> (# s1, I# nextOff #)+  )++copyReverseCommits# ::+     MutableByteArray# s+  -> Int#+  -> Commits s+  -> State# s+  -> (# State# s, Int# #)+copyReverseCommits# _ off Initial s0 = (# s0, off #)+copyReverseCommits# marr prevOff (Mutable arr sz cs) s0 =+  let !off = prevOff -# sz in+  case Exts.copyMutableByteArray# arr 0# marr off sz s0 of+    s1 -> copyReverseCommits# marr off cs s1+copyReverseCommits# marr prevOff (Immutable arr soff sz cs) s0 =+  let !off = prevOff -# sz in+  case Exts.copyByteArray# arr soff marr off sz s0 of+    s1 -> copyReverseCommits# marr off cs s1  -- | Create a builder from a cons-list of 'Char'. These -- are be UTF-8 encoded.

@@ -1,106 +0,0 @@-{-# language BangPatterns #-}-{-# language DerivingStrategies #-}-{-# language TypeFamilies #-}-{-# language MagicHash #-}-{-# language UnboxedTuples #-}-{-# language NamedFieldPuns #-}--module Data.Bytes.Chunks-  ( Chunks(..)-  , concat-  , reverse-  , reverseOnto-  ) where--import Prelude hiding (length,concat,reverse)--import GHC.ST (ST(..))-import Data.Bytes.Types (Bytes(..))-import Data.Primitive (ByteArray(..),MutableByteArray(..))-import GHC.Exts (ByteArray#,MutableByteArray#)-import GHC.Exts (Int#,State#,Int(I#),(+#))-import Control.Monad.ST.Run (runByteArrayST)--import qualified GHC.Exts as Exts-import qualified Data.Primitive as PM--data Chunks-  = ChunksCons {-# UNPACK #-} !Bytes !Chunks-  | ChunksNil-  deriving stock (Show)--instance Semigroup Chunks where-  ChunksNil <> a = a-  cs@(ChunksCons _ _) <> ChunksNil = cs-  as@(ChunksCons _ _) <> bs@(ChunksCons _ _) =-    reverseOnto bs (reverse as)--instance Monoid Chunks where-  mempty = ChunksNil--instance Eq Chunks where-  -- TODO: There is a more efficient way to do this, but-  -- it is tedious.-  a == b = concat a == concat b--concat :: Chunks -> ByteArray-concat x = ByteArray (concat# x)--concat# :: Chunks -> ByteArray#-{-# noinline concat# #-}-concat# ChunksNil = case mempty of {ByteArray x -> x}-concat# (ChunksCons (Bytes{array=c,offset=coff,length=szc}) cs) = case cs of-  ChunksNil -> case c of {ByteArray x -> x}-  ChunksCons (Bytes{array=d,offset=doff,length=szd}) ds ->-    unBa $ runByteArrayST $ do-      let szboth = szc + szd-          len = chunksLengthGo szboth ds-      dst <- PM.newByteArray len-      PM.copyByteArray dst 0 c coff szc-      PM.copyByteArray dst szc d doff szd-      _ <- copy dst szboth ds-      PM.unsafeFreezeByteArray dst--chunksLengthGo :: Int -> Chunks -> Int-chunksLengthGo !n ChunksNil = n-chunksLengthGo !n (ChunksCons (Bytes{length}) cs) =-  chunksLengthGo (n + length) cs---- | Copy the contents of the chunks into a mutable array.--- Precondition: The destination must have enough space to--- house the contents. This is not checked.-copy ::-     MutableByteArray s -- ^ Destination-  -> Int -- ^ Destination offset-  -> Chunks -- ^ Source-  -> ST s Int -- ^ Returns the next index into the destination after the payload-{-# inline copy #-}-copy (MutableByteArray dst) (I# off) cs = ST-  (\s0 -> case copy# dst off cs s0 of-    (# s1, nextOff #) -> (# s1, I# nextOff #)-  )--copy# :: MutableByteArray# s -> Int# -> Chunks -> State# s -> (# State# s, Int# #)-copy# _ off ChunksNil s0 = (# s0, off #)-copy# marr off (ChunksCons (Bytes{array,offset,length}) cs) s0 =-  case Exts.copyByteArray# (unBa array) (unI offset) marr off (unI length) s0 of-    s1 -> copy# marr (off +# unI length) cs s1----- | Reverse chunks but not the bytes within each chunk.-reverse :: Chunks -> Chunks-reverse = reverseOnto ChunksNil---- | Variant of 'reverse' that allows the caller to provide--- an initial list of chunks that the reversed chunks will--- be pushed onto.-reverseOnto :: Chunks -> Chunks -> Chunks-reverseOnto !x ChunksNil = x-reverseOnto !x (ChunksCons y ys) =-  reverseOnto (ChunksCons y x) ys--unI :: Int -> Int#-unI (I# i) = i--unBa :: ByteArray -> ByteArray#-unBa (ByteArray x) = x

@@ -8,13 +8,12 @@ import Control.Applicative (liftA2) import Control.Monad.ST (runST) import Data.ByteArray.Builder-import Data.Bytes.Types (Bytes(Bytes))-import Data.Bytes.Chunks (Chunks(ChunksNil,ChunksCons))+import Data.Bytes.Types (MutableBytes(MutableBytes)) import Data.Primitive (PrimArray) import Data.Word import Data.Char (ord,chr)+import Data.IORef (IORef,newIORef,readIORef,writeIORef) import Data.Primitive (ByteArray)-import Data.Proxy (Proxy(..)) import Data.WideWord (Word128(Word128)) import Test.Tasty (defaultMain,testGroup,TestTree) import Test.QuickCheck ((===),Arbitrary)@@ -22,6 +21,7 @@ import Test.Tasty.HUnit ((@=?))  import qualified Arithmetic.Nat as Nat+import qualified Data.ByteArray.Builder.Bounded as Bounded import qualified Data.ByteString as ByteString import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy.Char8 as LB@@ -31,7 +31,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified GHC.Exts as Exts-import qualified Test.QuickCheck.Classes as QCC import qualified Test.Tasty.HUnit as THU import qualified Test.Tasty.QuickCheck as TQC @@ -62,6 +61,18 @@         runConcat 1 (word64PaddedUpperHex w)         ===         pack (showWord64PaddedUpperHex w)+    , TQC.testProperty "word16PaddedLowerHex" $ \w ->+        runConcat 1 (word16PaddedLowerHex w)+        ===+        pack (showWord16PaddedLowerHex w)+    , TQC.testProperty "wordPaddedDec2" $ TQC.forAll (TQC.choose (0,99)) $ \w ->+        Bounded.run Nat.two (Bounded.wordPaddedDec2 w)+        ===+        pack (zeroPadL 2 (show w))+    , TQC.testProperty "wordPaddedDec9" $ TQC.forAll (TQC.choose (0,999999999)) $ \w ->+        Bounded.run Nat.constant (Bounded.wordPaddedDec9 w)+        ===+        pack (zeroPadL 9 (show w))     , TQC.testProperty "word8Dec" $ \w ->         runConcat 1 (word8Dec w)         ===@@ -192,27 +203,46 @@         ===         pack (showWord64PaddedUpperHex x <> showWord64PaddedUpperHex y)     ]-  , testGroup "Chunks"-    [ lawsToTest (QCC.eqLaws (Proxy :: Proxy Chunks))-    , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy Chunks))-    , lawsToTest (QCC.monoidLaws (Proxy :: Proxy Chunks))+  , testGroup "putMany"+    [ THU.testCase "A" $ do+        ref <- newIORef []+        let txt = "hello_world_are_you_listening" :: [Char]+        putMany 7 ascii txt (bytesOntoRef ref)+        res <- readIORef ref+        id $+          [ map c2w "hello_"+          , map c2w "world_"+          , map c2w "are_yo"+          , map c2w "u_list"+          , map c2w "ening"+          ] @=? map Exts.toList (Exts.toList res)     ]+  , testGroup "putManyConsLength"+    [ THU.testCase "A" $ do+        ref <- newIORef []+        let txt = "hello_world_are_you_listening" :: [Char]+        putManyConsLength Nat.constant+          (\n -> Bounded.word16BE (fromIntegral n))+          16 ascii txt (bytesOntoRef ref)+        res <- readIORef ref+        id $+          [ 0x00 : 0x0A : map c2w "hello_worl"+          , 0x00 : 0x0A : map c2w "d_are_you_"+          , 0x00 : 0x09 : map c2w "listening"+          ] @=? map Exts.toList (Exts.toList res)+    ]   ] -instance Arbitrary Chunks where-  arbitrary = do-    xs :: [[Word8]] <- TQC.arbitrary-    let ys = map-          (\x -> Exts.fromList ([255] ++ x ++ [255]))-          xs-        zs = foldr-          (\b cs ->-            ChunksCons (Bytes b 1 (PM.sizeofByteArray b - 2)) cs-          ) ChunksNil ys-    pure zs--lawsToTest :: QCC.Laws -> TestTree-lawsToTest (QCC.Laws name pairs) = testGroup name (map (uncurry TQC.testProperty) pairs)+bytesOntoRef ::+     IORef [PM.ByteArray]+  -> MutableBytes Exts.RealWorld+  -> IO ()+bytesOntoRef !ref (MutableBytes buf off len) = do+  rs <- readIORef ref+  dst <- PM.newByteArray len+  PM.copyMutableByteArray dst 0 buf off len+  dst' <- PM.unsafeFreezeByteArray dst+  writeIORef ref (rs ++ [dst'])  replicateByte :: Int -> Word8 -> ByteArray replicateByte n w = runST $ do@@ -229,8 +259,19 @@ showWord64PaddedUpperHex :: Word64 -> String showWord64PaddedUpperHex = printf "%016X"  +showWord16PaddedLowerHex :: Word16 -> String+showWord16PaddedLowerHex = printf "%04x" + runConcat :: Int -> Builder -> ByteArray-runConcat n = Chunks.concat . run n+runConcat n = Chunks.concatU . run n +c2w :: Char -> Word8+c2w = fromIntegral . ord+ instance Arbitrary Word128 where   arbitrary = liftA2 Word128 TQC.arbitrary TQC.arbitrary++zeroPadL :: Int -> String -> String+zeroPadL n s+  | length s < n = replicate (n - length s) '0' ++ s+  | otherwise = s