diff --git a/small-bytearray-builder.cabal b/small-bytearray-builder.cabal index 0eb64e0..00fc255 100644 --- a/small-bytearray-builder.cabal +++ b/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 diff --git a/src/Data/Bytes/Chunks.hs b/src/Data/Bytes/Chunks.hs index 64f3bb7..836a05a 100644 --- a/src/Data/Bytes/Chunks.hs +++ b/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) diff --git a/test/Main.hs b/test/Main.hs index 012f292..0c23bb8 100644 --- a/test/Main.hs +++ b/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,8 +192,28 @@ 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 m <- PM.newByteArray n