hedgehog-classes 0.2.4.1 → 0.2.5
raw patch · 7 files changed
+530/−9 lines, 7 filesdep +vectordep ~aesondep ~pretty-showPVP ok
version bump matches the API change (PVP)
Dependencies added: vector
Dependency ranges changed: aeson, pretty-show
API changes (from Hackage documentation)
+ Hedgehog.Classes: muvectorLaws :: (Eq a, Unbox a, Show a) => Gen a -> Laws
Files
- CHANGELOG.md +5/−0
- README.md +1/−1
- hedgehog-classes.cabal +19/−6
- src/Hedgehog/Classes.hs +6/−2
- src/Hedgehog/Classes/MVector.hs +472/−0
- test/Spec.hs +2/−0
- test/Spec/MVector.hs +25/−0
CHANGELOG.md view
@@ -3,6 +3,11 @@ `hedgehog-classes` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +0.2.5+=====+* Add MUVector laws+* Update upper bounds on dependencies+ 0.2.4.1 ======= * Fix error introduced by change of hedgehog's
README.md view
@@ -132,7 +132,7 @@ To use this library to export your own `Laws` functions which you wish to distribute, add it to the library stanza of your cabal file. [hackage]: http://hackage.haskell.org/package/hedgehog-classes- [hackage-shield]: https://img.shields.io/badge/hackage-v0.1.1.0-blue.svg+ [hackage-shield]: https://img.shields.io/badge/hackage-v0.2.4.1-blue.svg ## Improvements
hedgehog-classes.cabal view
@@ -2,7 +2,7 @@ name: hedgehog-classes version:- 0.2.4.1+ 0.2.5 synopsis: Hedgehog will eat your typeclass bugs description:@@ -84,6 +84,14 @@ default: True manual: True +flag vector+ description:+ You can disable the use of the `vector` package using `-f-vector`.+ .+ This may be useful for accelerating builds in sandboxes for expert users.+ default: True+ manual: True+ library hs-source-dirs: src@@ -126,6 +134,7 @@ Hedgehog.Classes.MonadPlus Hedgehog.Classes.MonadZip Hedgehog.Classes.Monoid+ Hedgehog.Classes.MVector Hedgehog.Classes.Ord Hedgehog.Classes.Prim Hedgehog.Classes.Semigroup@@ -135,7 +144,7 @@ Hedgehog.Classes.Storable Hedgehog.Classes.Traversable build-depends:- , base >= 4.12 && < 4.14+ , base >= 4.12 && < 4.15 , binary >= 0.8 && < 0.9 , containers >= 0.5 && < 0.7 , hedgehog >= 1 && < 1.1@@ -148,7 +157,7 @@ default-language: Haskell2010 if flag(aeson)- build-depends: aeson >= 0.9 && < 1.5+ build-depends: aeson >= 0.9 && < 1.6 cpp-options: -DHAVE_AESON -- if flag(semigroupoids) -- build-depends: semigroupoids >= 0.5.3.0 && < 0.6.0.0@@ -159,9 +168,9 @@ if flag(comonad) build-depends: comonad >= 5.0 && < 5.1 cpp-options: -DHAVE_COMONAD--- if flag(vector)--- build-depends: vector >= 0.12.0.0 && < 0.13.0.0--- cpp-options: -DHAVE_VECTOR+ if flag(vector)+ build-depends: vector >= 0.12 && < 0.13+ cpp-options: -DHAVE_VECTOR if flag(primitive) build-depends: primitive >= 0.6.4 && < 0.8 cpp-options: -DHAVE_PRIMITIVE@@ -195,6 +204,7 @@ Spec.Json Spec.Monad Spec.Monoid+ Spec.MVector Spec.Ord Spec.Prim Spec.Semigroup@@ -214,3 +224,6 @@ -Wall default-language: Haskell2010+ if flag(vector)+ build-depends: vector+ cpp-options: -DHAVE_VECTOR
src/Hedgehog/Classes.hs view
@@ -45,7 +45,9 @@ , showLaws , showReadLaws , storableLaws-+#if HAVE_VECTOR+ , muvectorLaws+#endif -- ** Unary type constructors , alternativeLaws , applicativeLaws@@ -114,6 +116,9 @@ import Hedgehog.Classes.MonadPlus (monadPlusLaws) import Hedgehog.Classes.MonadZip (monadZipLaws) import Hedgehog.Classes.Monoid (monoidLaws, commutativeMonoidLaws)+#if HAVE_VECTOR+import Hedgehog.Classes.MVector (muvectorLaws)+#endif import Hedgehog.Classes.Ord (ordLaws) #if HAVE_PRIMITIVE import Hedgehog.Classes.Prim (primLaws)@@ -126,4 +131,3 @@ import Hedgehog.Classes.ShowRead (showReadLaws) import Hedgehog.Classes.Storable (storableLaws) import Hedgehog.Classes.Traversable (traversableLaws)-
+ src/Hedgehog/Classes/MVector.hs view
@@ -0,0 +1,472 @@+-- |+-- Module: Hedgehog.Classes.MVector+-- Copyright: (c) 2019-2020 Andrew Lelechenko+-- Licence: BSD3+--++{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}++#if !HAVE_VECTOR++module Hedgehog.Classes.MVector () where++#else++module Hedgehog.Classes.MVector+ ( muvectorLaws+ ) where++import Control.Monad (when)+import Control.Monad.ST+import qualified Data.Vector.Generic.Mutable as MU (basicInitialize)+import qualified Data.Vector.Unboxed.Mutable as MU++import Hedgehog+import Hedgehog.Classes.Common+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++-- | Test that a 'Vector.Unboxed.MVector' instance obey several laws.+muvectorLaws :: (Eq a, MU.Unbox a, Show a) => Gen a -> Laws+muvectorLaws gen = Laws "Vector.Unboxed.MVector"+ [ ("New-Length", newLength gen)+ , ("Replicate-Length", replicateLength gen)+ , ("Slice-Length", sliceLength gen)+ , ("Grow-Length", growLength gen)++ , ("Write-Read", writeRead gen)+ , ("Set-Read", setRead gen)+ , ("Sliced-Set-Read", slicedSetRead gen)+ , ("Replicate-Read", replicateRead gen)++ , ("Slice-Overlaps", sliceOverlaps gen)+ , ("Slice-Copy", sliceCopy gen)+ , ("Slice-Move", sliceMove gen)++ , ("Write-Copy-Read", writeCopyRead gen)+ , ("Write-Move-Read", writeMoveRead gen)+ , ("Write-Grow-Read", writeGrowRead gen)+ , ("Sliced-Write-Copy-Read", slicedWriteCopyRead gen)+ , ("Sliced-Write-Move-Read", slicedWriteMoveRead gen)+ , ("Sliced-Write-Grow-Read", slicedWriteGrowRead gen)++ , ("Write-InitializeAround-Read", writeInitializeAroundRead gen)+ , ("Write-ClearAround-Read", writeClearAroundRead gen)+ , ("Write-SetAround-Read", writeSetAroundRead gen)+ , ("Write-WriteAround-Read", writeWriteAroundRead gen)+ , ("Write-CopyAround-Read", writeCopyAroundRead gen)+ , ("Write-MoveAround-Read", writeMoveAroundRead gen)++ , ("Write-InitializeBetween-Read", writeInitializeBetweenRead gen)+ , ("Write-ClearBetween-Read", writeClearBetweenRead gen)+ , ("Write-SetBetween-Read", writeSetBetweenRead gen)+ , ("Write-CopyBetween-Read", writeCopyBetweenRead gen)+ , ("Write-MoveBetween-Read", writeMoveBetweenRead gen)+ ]++genNonNegative :: Gen Int+genNonNegative = Gen.integral (Range.linear 0 1000)++genPositive :: Gen Int+genPositive = Gen.integral (Range.linear 1 1000)++-------------------------------------------------------------------------------+-- Length++newLength :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+newLength _ = property $ do+ len <- forAll genNonNegative+ (=== len) (runST $ MU.length <$> (MU.new len :: ST s (MU.MVector s a)))++replicateLength :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+replicateLength gen = property $ do+ a <- forAll gen+ len <- forAll genNonNegative+ (=== len) (runST $ MU.length <$> MU.replicate len a)++sliceLength :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+sliceLength _ = property $ do+ ix <- forAll genNonNegative+ subLen <- forAll genNonNegative+ excess <- forAll genPositive+ (=== subLen) (runST $ MU.length . MU.slice ix subLen <$> (MU.new (ix + subLen + excess) :: ST s (MU.MVector s a)))++growLength :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+growLength _ = property $ do+ len <- forAll genPositive+ by <- forAll genPositive+ (=== len + by) $ runST $ do+ arr <- MU.new len :: ST s (MU.MVector s a)+ MU.length <$> MU.grow arr by++-------------------------------------------------------------------------------+-- Read++writeRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ (=== a) $ runST $ do+ arr <- MU.new (ix + excess)+ MU.write arr ix a+ MU.read arr ix++setRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+setRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ (=== a) $ runST $ do+ arr <- MU.new (ix + excess)+ MU.set arr a+ MU.read arr ix++slicedSetRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+slicedSetRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ before <- forAll genNonNegative+ after <- forAll genNonNegative+ (=== a) $ runST $ do+ arr <- newSlice before after (ix + excess)+ MU.set arr a+ MU.read arr ix++replicateRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+replicateRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ (=== a) $ runST $ do+ arr <- MU.replicate (ix + excess) a+ MU.read arr ix++-------------------------------------------------------------------------------+-- Overlaps++sliceOverlaps :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+sliceOverlaps _ = property $ do+ i <- forAll genNonNegative+ ij <- forAll genNonNegative+ jk <- forAll genNonNegative+ kl <- forAll genNonNegative+ lm <- forAll genNonNegative+ let j = i + ij+ k = j + jk+ l = k + kl+ m = l + lm+ runST $ do+ arr <- MU.new (m + 1) :: ST s (MU.MVector s a)+ let slice1 = MU.slice i (k - i + 1) arr+ slice2 = MU.slice j (l - j + 1) arr+ pure $ assert $ MU.overlaps slice1 slice2++sliceCopy :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+sliceCopy gen = property $ do+ a <- forAll gen+ i <- forAll genNonNegative+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ ij <- forAll genNonNegative+ jk <- forAll genNonNegative+ let j = i + ix + excess + ij+ k = j + ix + excess + jk+ runST $ do+ arr <- MU.new k :: ST s (MU.MVector s a)+ let src = MU.slice i (ix + excess) arr+ dst = MU.slice j (ix + excess) arr+ if MU.overlaps src dst then pure success else do+ MU.write src ix a+ MU.copy dst src+ valSrc <- MU.read src ix+ valDst <- MU.read dst ix+ pure $ (valSrc, valDst) === (a, a)++sliceMove :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+sliceMove gen = property $ do+ a <- forAll gen+ i <- forAll genNonNegative+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ ij <- forAll genNonNegative+ jk <- forAll genNonNegative+ let j = i + ix + excess + ij+ k = j + ix + excess + jk+ (=== a) $ runST $ do+ arr <- MU.new k :: ST s (MU.MVector s a)+ let src = MU.slice i (ix + excess) arr+ dst = MU.slice j (ix + excess) arr+ MU.write src ix a+ MU.move dst src+ MU.read dst ix++-------------------------------------------------------------------------------+-- Write + copy/move/grow++writeCopyRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeCopyRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ (=== a) $ runST $ do+ src <- MU.new (ix + excess)+ MU.write src ix a+ dst <- MU.new (ix + excess)+ MU.copy dst src+ MU.clear src+ MU.read dst ix++writeMoveRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeMoveRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ (=== a) $ runST $ do+ src <- MU.new (ix + excess)+ MU.write src ix a+ dst <- MU.new (ix + excess)+ MU.move dst src+ MU.clear src+ MU.read dst ix++writeGrowRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeGrowRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ by <- forAll genPositive+ (=== a) $ runST $ do+ src <- MU.new (ix + excess)+ MU.write src ix a+ dst <- MU.grow src by+ MU.clear src+ MU.read dst ix++slicedWriteCopyRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+slicedWriteCopyRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ beforeSrc <- forAll genNonNegative+ afterSrc <- forAll genNonNegative+ beforeDst <- forAll genNonNegative+ afterDst <- forAll genNonNegative+ (=== a) $ runST $ do+ src <- newSlice beforeSrc afterSrc (ix + excess)+ MU.write src ix a+ dst <- newSlice beforeDst afterDst (ix + excess)+ MU.copy dst src+ MU.clear src+ MU.read dst ix++slicedWriteMoveRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+slicedWriteMoveRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ beforeSrc <- forAll genNonNegative+ afterSrc <- forAll genNonNegative+ beforeDst <- forAll genNonNegative+ afterDst <- forAll genNonNegative+ (=== a) $ runST $ do+ src <- newSlice beforeSrc afterSrc (ix + excess)+ MU.write src ix a+ dst <- newSlice beforeDst afterDst (ix + excess)+ MU.move dst src+ MU.clear src+ MU.read dst ix++slicedWriteGrowRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+slicedWriteGrowRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ by <- forAll genPositive+ beforeSrc <- forAll genNonNegative+ afterSrc <- forAll genNonNegative+ (=== a) $ runST $ do+ src <- newSlice beforeSrc afterSrc (ix + excess)+ MU.write src ix a+ dst <- MU.grow src by+ MU.clear src+ MU.read dst ix++-------------------------------------------------------------------------------+-- Write + overwrite around++writeInitializeAroundRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeInitializeAroundRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ (=== a) $ runST $ do+ arr <- MU.new (ix + excess)+ MU.write arr ix a+ when (ix > 0) $+ MU.basicInitialize (MU.slice 0 ix arr)+ when (excess > 1) $+ MU.basicInitialize (MU.slice (ix + 1) (excess - 1) arr)+ MU.read arr ix++writeClearAroundRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeClearAroundRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ (=== a) $ runST $ do+ arr <- MU.new (ix + excess)+ MU.write arr ix a+ when (ix > 0) $+ MU.clear (MU.slice 0 ix arr)+ when (excess > 1) $+ MU.clear (MU.slice (ix + 1) (excess - 1) arr)+ MU.read arr ix++writeSetAroundRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeSetAroundRead gen = property $ do+ a <- forAll gen+ b <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ (=== a) $ runST $ do+ arr <- MU.new (ix + excess)+ MU.write arr ix a+ when (ix > 0) $+ MU.set (MU.slice 0 ix arr) b+ when (excess > 1) $+ MU.set (MU.slice (ix + 1) (excess - 1) arr) b+ MU.read arr ix++writeWriteAroundRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeWriteAroundRead gen = property $ do+ a <- forAll gen+ b <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ (=== a) $ runST $ do+ arr <- MU.new (ix + excess)+ MU.write arr ix a+ when (ix > 0) $+ MU.write arr (ix - 1) b+ when (excess > 1) $+ MU.write arr (ix + 1) b+ MU.read arr ix++writeCopyAroundRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeCopyAroundRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ (=== a) $ runST $ do+ src <- MU.new (ix + excess)+ dst <- MU.new (ix + excess)+ MU.write dst ix a+ when (ix > 0) $+ MU.copy (MU.slice 0 ix dst) (MU.slice 0 ix src)+ when (excess > 1) $+ MU.copy (MU.slice (ix + 1) (excess - 1) dst) (MU.slice (ix + 1) (excess - 1) src)+ MU.read dst ix++writeMoveAroundRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeMoveAroundRead gen = property $ do+ a <- forAll gen+ ix <- forAll genNonNegative+ excess <- forAll genPositive+ (=== a) $ runST $ do+ src <- MU.new (ix + excess)+ dst <- MU.new (ix + excess)+ MU.write dst ix a+ when (ix > 0) $+ MU.move (MU.slice 0 ix dst) (MU.slice 0 ix src)+ when (excess > 1) $+ MU.move (MU.slice (ix + 1) (excess - 1) dst) (MU.slice (ix + 1) (excess - 1) src)+ MU.read dst ix++-------------------------------------------------------------------------------+-- Two writes + overwrite in between++writeInitializeBetweenRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeInitializeBetweenRead gen = property $ do+ a <- forAll gen+ b <- forAll gen+ ix <- forAll genNonNegative+ dix <- forAll genPositive+ excess <- forAll genPositive+ (=== (a, b)) $ runST $ do+ arr <- MU.new (ix + dix + excess)+ MU.write arr ix a+ MU.write arr (ix + dix) b+ MU.basicInitialize (MU.slice (ix + 1) (dix - 1) arr)+ (,) <$> MU.read arr ix <*> MU.read arr (ix + dix)++writeClearBetweenRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeClearBetweenRead gen = property $ do+ a <- forAll gen+ b <- forAll gen+ ix <- forAll genNonNegative+ dix <- forAll genPositive+ excess <- forAll genPositive+ (=== (a, b)) $ runST $ do+ arr <- MU.new (ix + dix + excess)+ MU.write arr ix a+ MU.write arr (ix + dix) b+ MU.clear (MU.slice (ix + 1) (dix - 1) arr)+ (,) <$> MU.read arr ix <*> MU.read arr (ix + dix)++writeSetBetweenRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeSetBetweenRead gen = property $ do+ a <- forAll gen+ b <- forAll gen+ c <- forAll gen+ ix <- forAll genNonNegative+ dix <- forAll genPositive+ excess <- forAll genPositive+ (=== (a, b)) $ runST $ do+ arr <- MU.new (ix + dix + excess)+ MU.write arr ix a+ MU.write arr (ix + dix) b+ MU.set (MU.slice (ix + 1) (dix - 1) arr) c+ (,) <$> MU.read arr ix <*> MU.read arr (ix + dix)++writeCopyBetweenRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeCopyBetweenRead gen = property $ do+ a <- forAll gen+ b <- forAll gen+ ix <- forAll genNonNegative+ dix <- forAll genPositive+ excess <- forAll genPositive+ (=== (a, b)) $ runST $ do+ src <- MU.new (ix + dix + excess)+ dst <- MU.new (ix + dix + excess)+ MU.write dst ix a+ MU.write dst (ix + dix) b+ MU.copy (MU.slice (ix + 1) (dix - 1) dst) (MU.slice (ix + 1) (dix - 1) src)+ (,) <$> MU.read dst ix <*> MU.read dst (ix + dix)++writeMoveBetweenRead :: forall a. (Eq a, MU.Unbox a, Show a) => Gen a -> Property+writeMoveBetweenRead gen = property $ do+ a <- forAll gen+ b <- forAll gen+ ix <- forAll genNonNegative+ dix <- forAll genPositive+ excess <- forAll genPositive+ (=== (a, b)) $ runST $ do+ src <- MU.new (ix + dix + excess)+ dst <- MU.new (ix + dix + excess)+ MU.write dst ix a+ MU.write dst (ix + dix) b+ MU.move (MU.slice (ix + 1) (dix - 1) dst) (MU.slice (ix + 1) (dix - 1) src)+ (,) <$> MU.read dst ix <*> MU.read dst (ix + dix)++-------------------------------------------------------------------------------+-- Utils++newSlice :: MU.Unbox a => Int -> Int -> Int -> ST s (MU.MVector s a)+newSlice before after len = do+ arr <- MU.new (before + len + after)+ pure $ MU.slice before len arr++#endif
test/Spec.hs view
@@ -23,6 +23,7 @@ import Spec.Json import Spec.Monad import Spec.Monoid+import Spec.MVector import Spec.Ord import Spec.Prim import Spec.Semigroup@@ -59,6 +60,7 @@ ++ testShow ++ testShowRead ++ testStorable+ ++ testMUVector allUnaryLaws :: [(String, [Laws])] allUnaryLaws = testAlternative
+ test/Spec/MVector.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE CPP #-}++#if !HAVE_VECTOR++module Spec.MVector (testMUVector) where++testMUVector :: [a]+testMUVector = []++#else++module Spec.MVector (testMUVector) where++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Hedgehog.Classes (Laws, muvectorLaws)++testMUVector :: [(String, [Laws])]+testMUVector =+ [ ("Word8", [muvectorLaws (Gen.word8 Range.constantBounded)])+ , ("(Int, Word)", [muvectorLaws ((,) <$> Gen.int Range.constantBounded <*> Gen.word Range.constantBounded)])+ ]++#endif