small-bytearray-builder 0.3.0.0 → 0.3.1.0

raw patch · 8 files changed

+263/−46 lines, 8 filesdep +quickcheck-classesdep +wide-wordPVP ok

version bump matches the API change (PVP)

Dependencies added: quickcheck-classes, wide-word

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• small-bytearray-builder.cabal +7/−4
• src/Data/ByteArray/Builder.hs +105/−29
• src/Data/ByteArray/Builder/Bounded.hs +11/−2
• src/Data/ByteArray/Builder/Bounded/Unsafe.hs +3/−3
• src/Data/ByteArray/Builder/Unsafe.hs +54/−5
• src/Data/Bytes/Chunks.hs +32/−2
• test/Main.hs +42/−1

@@ -1,5 +1,14 @@ # Revision history for small-bytearray-builder +## 0.3.1.0 -- 2019-11-20++* Add big-endian and little-endian parsers for `Word128`. This includes+  both the single and multiple element variants.+* Export `reverseCommitsOntoChunks` from the `Unsafe` module.+* Add `Semigroup` and `Monoid` instances for `Chunks`.+* Add `consLengthLE32`.+* Add `fromEffect` to the unsafe interface.+ ## 0.3.0.0 -- 2019-10-17  * Breaking change: Change the internal implementation of `Builder`. This

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: small-bytearray-builder-version: 0.3.0.0+version: 0.3.1.0 synopsis: Serialize to a small byte arrays description:   This is similar to the builder facilities provided by@@ -43,12 +43,13 @@     Data.ByteArray.Builder.Bounded.Unsafe   build-depends:     , base >=4.12.0.0 && <5-    , byteslice >=0.1 && <0.2+    , byteslice >=0.1 && <0.3+    , bytestring >=0.10.8.2 && <0.11+    , natural-arithmetic >=0.1 && <0.2     , primitive-offset >=0.2 && <0.3     , run-st >=0.1 && <0.2-    , bytestring >=0.10.8.2 && <0.11     , text-short >=0.1.3 && <0.2-    , natural-arithmetic >=0.1 && <0.2+    , wide-word >=0.1.0.9 && <0.2   if flag(checked)     build-depends: primitive-checked >= 0.7 && <0.8   else@@ -73,12 +74,14 @@     , bytestring     , natural-arithmetic     , primitive+    , quickcheck-classes >=0.6.4     , small-bytearray-builder     , tasty >=1.2.3 && <1.3     , tasty-hunit >=0.10.0.2 && <0.11     , tasty-quickcheck >=0.10.1 && <0.11     , text >=1.2 && <1.3     , vector+    , wide-word >=0.1.0.9 && <0.2  benchmark bench   type: exitcode-stdio-1.0

@@ -54,6 +54,7 @@     -- *** One   , word8     -- **** Big Endian+  , word128BE   , word64BE   , word32BE   , word16BE@@ -61,6 +62,7 @@   , int32BE   , int16BE     -- **** Little Endian+  , word128LE   , word64LE   , word32LE   , word16LE@@ -73,6 +75,7 @@   , word16ArrayBE   , word32ArrayBE   , word64ArrayBE+  , word128ArrayBE   , int64ArrayBE   , int32ArrayBE   , int16ArrayBE@@ -80,10 +83,12 @@   , word16ArrayLE   , word32ArrayLE   , word64ArrayLE+  , word128ArrayLE   , int64ArrayLE   , int32ArrayLE   , int16ArrayLE     -- ** Prefixing with Length+  , consLength32LE   , consLength32BE   , consLength64BE     -- * Encode Floating-Point Types@@ -93,31 +98,32 @@   , flush   ) where -import Control.Monad.Primitive (primitive_) import Control.Monad.ST (ST,runST) import Data.ByteArray.Builder.Unsafe (Builder(Builder)) import Data.ByteArray.Builder.Unsafe (Commits(Initial,Mutable,Immutable))+import Data.ByteArray.Builder.Unsafe (reverseCommitsOntoChunks) import Data.ByteArray.Builder.Unsafe (stringUtf8,cstring) import Data.ByteString.Short.Internal (ShortByteString(SBS))+import Data.Bytes.Chunks (Chunks(ChunksNil)) import Data.Bytes.Types (Bytes(Bytes)) import Data.Char (ord) import Data.Int (Int64,Int32,Int16,Int8) import Data.Primitive (ByteArray(..),MutableByteArray(..),PrimArray(..)) import Data.Text.Short (ShortText)+import Data.WideWord (Word128) 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.ST (ST(ST))-import Data.Bytes.Chunks (Chunks(..))-import GHC.ByteOrder (ByteOrder(BigEndian,LittleEndian),targetByteOrder)  import qualified Arithmetic.Nat as Nat import qualified Arithmetic.Types as Arithmetic-import qualified GHC.Exts as Exts-import qualified Data.Text.Short as TS-import qualified Data.Primitive as PM import qualified Data.ByteArray.Builder.Bounded as Bounded import qualified Data.ByteArray.Builder.Bounded.Unsafe as UnsafeBounded+import qualified Data.Primitive as PM+import qualified Data.Text.Short as TS+import qualified GHC.Exts as Exts  -- | Run a builder. run ::@@ -129,21 +135,7 @@   cs <- ST $ \s0 -> case f buf0 0# hint# Initial s0 of     (# s1, bufX, offX, _, csX #) ->       (# s1, Mutable bufX offX csX #)-  commitsOntoChunks ChunksNil cs---- Internal. This freezes all the mutable byte arrays in-place,--- so be careful. It also reverses the chunks since everything--- is backwards.-commitsOntoChunks :: Chunks -> Commits s -> ST s Chunks-commitsOntoChunks !xs Initial = pure xs-commitsOntoChunks !xs (Immutable arr off len cs) =-  commitsOntoChunks (ChunksCons (Bytes (ByteArray arr) (I# off) (I# len)) xs) cs-commitsOntoChunks !xs (Mutable buf len cs) = case len of-  0# -> commitsOntoChunks xs cs-  _ -> do-    shrinkMutableByteArray (MutableByteArray buf) (I# len)-    arr <- PM.unsafeFreezeByteArray (MutableByteArray buf)-    commitsOntoChunks (ChunksCons (Bytes arr 0 (I# len)) xs) cs+  reverseCommitsOntoChunks ChunksNil cs  -- | Convert a bounded builder to an unbounded one. If the size -- is a constant, use @Arithmetic.Nat.constant@ as the first argument@@ -262,6 +254,16 @@ int16ArrayBE :: PrimArray Int16 -> Int -> Int -> Builder int16ArrayBE (PrimArray x) = word16ArrayBE (PrimArray x) +word128ArrayLE :: PrimArray Word128 -> Int -> Int -> Builder+word128ArrayLE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of+  LittleEndian -> bytes (Bytes (ByteArray arr) (soff0 * 16) (slen0 * 16))+  BigEndian -> word128ArraySwap src soff0 slen0++word128ArrayBE :: PrimArray Word128 -> Int -> Int -> Builder+word128ArrayBE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of+  BigEndian -> bytes (Bytes (ByteArray arr) (soff0 * 16) (slen0 * 16))+  LittleEndian -> word128ArraySwap src soff0 slen0+ word64ArrayLE :: PrimArray Word64 -> Int -> Int -> Builder word64ArrayLE src@(PrimArray arr) soff0 slen0 = case targetByteOrder of   LittleEndian -> bytes (Bytes (ByteArray arr) (soff0 * 8) (slen0 * 8))@@ -350,13 +352,60 @@       go (soff + 8) send dst (doff + 8)     else pure doff +word128ArraySwap :: PrimArray Word128 -> Int -> Int -> Builder+word128ArraySwap src soff0 slen0 =+  fromFunction (slen0 * 16) (go (soff0 * 16) ((soff0 + slen0) * 16))+  where+  -- TODO: Perhaps we could put byteswapping functions to use+  -- rather than indexing tons of Word8s. This could be done+  -- both here and in the other swap functions. There are a+  -- decent number of tests for these array-swapping functions,+  -- which makes changing this less scary.+  go :: Int -> Int -> MutableByteArray s -> Int -> ST s Int+  go !soff !send !dst !doff = if soff < send+    then do+      let v0 = PM.indexPrimArray (asWord8s src) soff+          v1 = PM.indexPrimArray (asWord8s src) (soff + 1)+          v2 = PM.indexPrimArray (asWord8s src) (soff + 2)+          v3 = PM.indexPrimArray (asWord8s src) (soff + 3)+          v4 = PM.indexPrimArray (asWord8s src) (soff + 4)+          v5 = PM.indexPrimArray (asWord8s src) (soff + 5)+          v6 = PM.indexPrimArray (asWord8s src) (soff + 6)+          v7 = PM.indexPrimArray (asWord8s src) (soff + 7)+          v8 = PM.indexPrimArray (asWord8s src) (soff + 8)+          v9 = PM.indexPrimArray (asWord8s src) (soff + 9)+          v10 = PM.indexPrimArray (asWord8s src) (soff + 10)+          v11 = PM.indexPrimArray (asWord8s src) (soff + 11)+          v12 = PM.indexPrimArray (asWord8s src) (soff + 12)+          v13 = PM.indexPrimArray (asWord8s src) (soff + 13)+          v14 = PM.indexPrimArray (asWord8s src) (soff + 14)+          v15 = PM.indexPrimArray (asWord8s src) (soff + 15)+      PM.writeByteArray dst doff v15+      PM.writeByteArray dst (doff + 1) v14+      PM.writeByteArray dst (doff + 2) v13+      PM.writeByteArray dst (doff + 3) v12+      PM.writeByteArray dst (doff + 4) v11+      PM.writeByteArray dst (doff + 5) v10+      PM.writeByteArray dst (doff + 6) v9+      PM.writeByteArray dst (doff + 7) v8+      PM.writeByteArray dst (doff + 8) v7+      PM.writeByteArray dst (doff + 9) v6+      PM.writeByteArray dst (doff + 10) v5+      PM.writeByteArray dst (doff + 11) v4+      PM.writeByteArray dst (doff + 12) v3+      PM.writeByteArray dst (doff + 13) v2+      PM.writeByteArray dst (doff + 14) v1+      PM.writeByteArray dst (doff + 15) v0+      go (soff + 16) send dst (doff + 16)+    else pure doff+ asWord8s :: PrimArray a -> PrimArray Word8 asWord8s (PrimArray x) = PrimArray x  -- Internal function. Precondition, the referenced slice of the -- byte sequence is UTF-8 encoded text. slicedUtf8TextJson :: ByteArray# -> Int# -> Int# -> Builder-{-# inline slicedUtf8TextJson #-}+{-# noinline slicedUtf8TextJson #-} slicedUtf8TextJson !src# !soff0# !slen0# = fromFunction reqLen $ \dst doff0 -> do   PM.writeByteArray dst doff0 (c2w '"')   let go !soff !slen !doff = if slen > 0@@ -412,9 +461,9 @@ -- and JSON special characters will be escaped. Additionally, the -- result is surrounded by double quotes. For example: ----- * @foo ==> "foo"@--- * @\_"_/ ==> "\\_\"_/"@--- * @hello<ESC>world ==> "hello\u001Bworld"@ (where <LF> is code point 0x1B)+-- * @foo ==\> "foo"@ (no escape sequences)+-- * @\\_"_\/ ==\> "\\\\_\\"_\/"@ (escapes backslashes and quotes)+-- * @hello\<ESC\>world ==> "hello\\u001Bworld"@ (where @\<ESC\>@ is code point 0x1B) shortTextJsonString :: ShortText -> Builder shortTextJsonString a =   let !(ByteArray ba) = shortTextToByteArray a@@ -561,10 +610,6 @@ unST :: ST s a -> State# s -> (# State# s, a #) unST (ST f) = f -shrinkMutableByteArray :: MutableByteArray s -> Int -> ST s ()-shrinkMutableByteArray (MutableByteArray arr) (I# sz) =-  primitive_ (Exts.shrinkMutableByteArray# arr sz)- -- | Requires exactly 8 bytes. Dump the octets of a 64-bit -- signed integer in a little-endian fashion. int64LE :: Int64 -> Builder@@ -595,6 +640,11 @@ int16BE :: Int16 -> Builder int16BE w = fromBounded Nat.constant (Bounded.int16BE w) +-- | Requires exactly 16 bytes. Dump the octets of a 128-bit+-- word in a little-endian fashion.+word128LE :: Word128 -> Builder+word128LE w = fromBounded Nat.constant (Bounded.word128LE w)+ -- | Requires exactly 8 bytes. Dump the octets of a 64-bit -- word in a little-endian fashion. word64LE :: Word64 -> Builder@@ -615,6 +665,11 @@ word64BE :: Word64 -> Builder word64BE w = fromBounded Nat.constant (Bounded.word64BE w) +-- | Requires exactly 16 bytes. Dump the octets of a 128-bit+-- word in a big-endian fashion.+word128BE :: Word128 -> Builder+word128BE w = fromBounded Nat.constant (Bounded.word128BE w)+ -- | Requires exactly 4 bytes. Dump the octets of a 32-bit -- word in a big-endian fashion. word32BE :: Word32 -> Builder@@ -628,6 +683,27 @@ -- | Requires exactly 1 byte. 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+        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.word32LE (fromIntegral (I# (dist -# 4# ))))+                (MutableByteArray buf1)+                (I# off1)+           in case g s2 of+                (# s3, _ #) -> (# s3, buf2, off2, len2, cs2 #)  -- | Prefix a builder with its size in bytes. This size is -- presented as a big-endian 32-bit word. The need to prefix

@@ -55,6 +55,7 @@     -- *** One   , word8     -- **** Big Endian+  , word128BE   , word64BE   , word32BE   , word16BE@@ -62,6 +63,7 @@   , int32BE   , int16BE     -- **** Little Endian+  , word128LE   , word64LE   , word32LE   , word16LE@@ -81,15 +83,16 @@ import Data.Char (ord) import Data.Primitive import Data.Primitive.ByteArray.Offset (MutableByteArrayOffset(..))+import Data.WideWord (Word128(Word128)) import GHC.Exts import GHC.Int (Int64(I64#),Int32(I32#),Int16(I16#),Int8(I8#)) import GHC.ST (ST(ST)) import GHC.TypeLits (type (+)) import GHC.Word (Word8(W8#),Word16(W16#),Word32(W32#),Word64(W64#)) -import qualified Arithmetic.Types as Arithmetic-import qualified Arithmetic.Nat as Nat import qualified Arithmetic.Lte as Lte+import qualified Arithmetic.Nat as Nat+import qualified Arithmetic.Types as Arithmetic import qualified Data.ByteArray.Builder.Bounded.Unsafe as Unsafe import qualified Data.Primitive as PM @@ -608,6 +611,12 @@  int16LE :: Int16 -> Builder 2 int16LE (I16# i) = word16LE (W16# (int2Word# i))++word128LE :: Word128 -> Builder 16+word128LE (Word128 hi lo) = append (word64LE lo) (word64LE hi)++word128BE :: Word128 -> Builder 16+word128BE (Word128 hi lo) = append (word64BE hi) (word64BE lo)  -- | Requires exactly 8 bytes. Dump the octets of a 64-bit -- word in a little-endian fashion.

@@ -16,12 +16,12 @@   , pasteIO   ) where -import GHC.TypeLits (Nat) import Data.Kind (Type)+import Data.Primitive (MutableByteArray(..))+import GHC.Exts (Int(I#),RealWorld,Int#,State#,MutableByteArray#) import GHC.IO (stToIO) import GHC.ST (ST(ST))-import GHC.Exts (Int(I#),RealWorld,Int#,State#,MutableByteArray#)-import Data.Primitive (MutableByteArray(..))+import GHC.TypeLits (Nat)  -- | A builder parameterized by the maximum number of bytes it uses -- when executed.

@@ -10,6 +10,10 @@   ( -- * Types     Builder(..)   , Commits(..)+    -- * Construction+  , fromEffect+    -- * Finalization+  , reverseCommitsOntoChunks     -- * Safe Functions     -- | These functions are actually completely safe, but they are defined     -- here because they are used by typeclass instances. Import them from@@ -18,17 +22,21 @@   , cstring   ) where -import Data.Primitive (MutableByteArray(MutableByteArray),ByteArray)+import Control.Monad.Primitive (primitive_)+import Data.Bytes.Chunks (Chunks(ChunksCons))+import Data.Bytes.Types (Bytes(Bytes))+import Data.Primitive (MutableByteArray(..),ByteArray(..)) import Foreign.C.String (CString)-import GHC.Exts ((-#),(+#),(>#))+import GHC.Base (unpackCString#,unpackCStringUtf8#)+import GHC.Exts ((-#),(+#),(>#),(>=#)) import GHC.Exts (Addr#,ByteArray#,MutableByteArray#,Int(I#),Ptr(Ptr))-import GHC.Exts (IsString,Int#,State#,MutableByteArray#)+import GHC.Exts (IsString,Int#,State#) import GHC.ST (ST(ST))-import GHC.Base (unpackCString#,unpackCStringUtf8#) -import qualified GHC.Exts as Exts import qualified Data.ByteArray.Builder.Bounded as Bounded import qualified Data.ByteArray.Builder.Bounded.Unsafe as UnsafeBounded+import qualified Data.Primitive as PM+import qualified GHC.Exts as Exts  -- | An unmaterialized sequence of bytes that may be pasted -- into a mutable byte array.@@ -68,6 +76,24 @@       !(Commits s)   | Initial +-- | 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+-- @Commits@ with the chunks backwards. This performs an in-place shrink+-- and freezes on any mutable byte arrays it encounters. Consequently,+-- these must not be reused.+reverseCommitsOntoChunks :: Chunks -> Commits s -> ST s Chunks+reverseCommitsOntoChunks !xs Initial = pure xs+reverseCommitsOntoChunks !xs (Immutable arr off len cs) =+  reverseCommitsOntoChunks (ChunksCons (Bytes (ByteArray arr) (I# off) (I# len)) xs) cs+reverseCommitsOntoChunks !xs (Mutable buf len cs) = case len of+  -- Skip over empty byte arrays.+  0# -> reverseCommitsOntoChunks xs cs+  _ -> do+    shrinkMutableByteArray (MutableByteArray buf) (I# len)+    arr <- PM.unsafeFreezeByteArray (MutableByteArray buf)+    reverseCommitsOntoChunks (ChunksCons (Bytes arr 0 (I# len)) xs) cs+ -- | Create a builder from a cons-list of 'Char'. These -- are be UTF-8 encoded. stringUtf8 :: String -> Builder@@ -95,6 +121,8 @@ -- We have to have a rule for both unpackCString# and unpackCStringUtf8# -- since GHC uses a different function based on whether or not non-ASCII -- codepoints are used in the string.+-- TODO: The UTF-8 variant of this rule is unsound because GHC actually+-- used Modified UTF-8. {-# RULES "Builder stringUtf8/cstring" forall s a b c d e.   goString (unpackCString# s) a b c d e = goCString s a b c d e@@ -116,5 +144,26 @@     _ -> case Exts.writeWord8Array# buf0 off0 w s0 of       s1 -> goCString (Exts.plusAddr# addr 1# ) buf0 (off0 +# 1# ) (len0 -# 1# ) cs0 s1 +fromEffect ::+     Int -- ^ Maximum number of bytes the paste function needs+  -> (forall s. MutableByteArray s -> Int -> ST s Int)+     -- ^ Paste function. Takes a byte array and an offset and returns+     -- the new offset and having pasted into the buffer.+  -> Builder+{-# inline fromEffect #-}+fromEffect (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 #)+        _ -> 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 unST (f (MutableByteArray buf1) (I# off1)) s1 of+        (# s2, I# off2 #) -> (# s2, buf1, off2, len1 -# (off2 -# off1), cs1 #)+ unST :: ST s a -> State# s -> (# State# s, a #) unST (ST f) = f++shrinkMutableByteArray :: MutableByteArray s -> Int -> ST s ()+shrinkMutableByteArray (MutableByteArray arr) (I# sz) =+  primitive_ (Exts.shrinkMutableByteArray# arr sz)

@@ -8,15 +8,17 @@ module Data.Bytes.Chunks   ( Chunks(..)   , concat+  , reverse+  , reverseOnto   ) where -import Prelude hiding (length,concat)+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 (IsList,Int#,State#,Int(I#),(+#),(-#))+import GHC.Exts (Int#,State#,Int(I#),(+#)) import Control.Monad.ST.Run (runByteArrayST)  import qualified GHC.Exts as Exts@@ -25,7 +27,22 @@ 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) @@ -68,6 +85,19 @@ 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

@@ -3,14 +3,21 @@ {-# language TypeApplications #-} {-# language OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}++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.Primitive (PrimArray) import Data.Word import Data.Char (ord,chr) import Data.Primitive (ByteArray)+import Data.Proxy (Proxy(..))+import Data.WideWord (Word128(Word128)) import Test.Tasty (defaultMain,testGroup,TestTree)-import Test.QuickCheck ((===))+import Test.QuickCheck ((===),Arbitrary) import Text.Printf (printf) import Test.Tasty.HUnit ((@=?)) @@ -24,6 +31,7 @@ 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 @@ -164,6 +172,16 @@          in runConcat 1 (foldMap word64BE xs)             ===             runConcat 1 (word64ArrayBE ys 0 (Prelude.length xs))+    , TQC.testProperty "word128ArrayLE" $ \(xs :: [Word128]) ->+        let ys = Exts.fromList xs :: PrimArray Word128+         in runConcat 1 (foldMap word128LE xs)+            ===+            runConcat 1 (word128ArrayLE ys 0 (Prelude.length xs))+    , TQC.testProperty "word128ArrayBE" $ \(xs :: [Word128]) ->+        let ys = Exts.fromList xs :: PrimArray Word128+         in runConcat 1 (foldMap word128BE xs)+            ===+            runConcat 1 (word128ArrayBE ys 0 (Prelude.length xs))     ]   , testGroup "alternate"     [ TQC.testProperty "HexWord64" $ \x y ->@@ -174,8 +192,28 @@         ===         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))+    ]   ] +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)+ replicateByte :: Int -> Word8 -> ByteArray replicateByte n w = runST $ do   m <- PM.newByteArray n@@ -193,3 +231,6 @@  runConcat :: Int -> Builder -> ByteArray runConcat n = Chunks.concat . run n++instance Arbitrary Word128 where+  arbitrary = liftA2 Word128 TQC.arbitrary TQC.arbitrary