add laws tests for Chunks

small-bytearray-builder.cabal

@@ -74,6 +74,7 @@ test-suite test
     , 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

src/Data/Bytes/Chunks.hs

@@ -27,6 +27,7 @@ import qualified Data.Primitive as PM
 data Chunks
   = ChunksCons {-# UNPACK #-} !Bytes !Chunks
   | ChunksNil
+  deriving stock (Show)
 
 instance Semigroup Chunks where
   ChunksNil <> a = a
@@ -37,6 +38,11 @@ instance Semigroup Chunks where
 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)
 

test/Main.hs

@@ -8,10 +8,13 @@
 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 ((===),Arbitrary)
@@ -28,6 +31,7 @@ import qualified Data.Primitive as PM
 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
 
@@ -188,7 +192,27 @@ tests = testGroup "Tests"
         ===
         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