packages feed

hedgehog-classes 0.2.1 → 0.2.2

raw patch · 18 files changed

+385/−82 lines, 18 filesdep ~semiringsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: semirings

API changes (from Hackage documentation)

Files

CHANGELOG.md view
@@ -3,11 +3,18 @@ `hedgehog-classes` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +0.2.2+=====+* fix problem in storable set-get that caused attempt to index into+  0-element malloc'd array+* Test suite now tests almost all laws sans arrow/category (thanks @ag-eitilt!)+* Correct tcName of `MonadPlus`. Was `Monad`, now it's `MonadPlus`.+ 0.2.1 ===== * fix problem where ordLaws failed for everything. there was   some messed up logic used to check that transitivity held.-  Thanks @ocharles for reporting this.+  Thanks very much to @ocharles for reporting this.  0.2.0.1 =======@@ -15,7 +22,6 @@  0.2 ===- * switch to hedgehog-1.0 * add `binaryLaws` * relax cabal-version to 2.2
hedgehog-classes.cabal view
@@ -2,7 +2,7 @@ name:   hedgehog-classes version:-  0.2.1+  0.2.2 synopsis:   Hedgehog will eat your typeclass bugs description:@@ -164,14 +164,11 @@ --                       Spec.Ix                        Spec.Json                        Spec.Monad-                       Spec.MonadIO-                       Spec.MonadPlus-                       Spec.MonadZip                        Spec.Monoid                        Spec.Ord                        Spec.Semigroup+                       Spec.Semiring                        Spec.Show-                       Spec.ShowRead                        Spec.Storable                        Spec.Traversable
src/Hedgehog/Classes/MonadPlus.hs view
@@ -20,7 +20,7 @@   ( MonadPlus f   , forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)   ) => (forall x. Gen x -> Gen (f x)) -> Laws-monadPlusLaws gen = Laws "Monad"+monadPlusLaws gen = Laws "MonadPlus"   [ ("Left Identity", monadPlusLeftIdentity gen)   , ("Right Identity", monadPlusRightIdentity gen)   , ("Associativity", monadPlusAssociativity gen)@@ -50,7 +50,7 @@               , "mzero = " ++ showMZero               ]         }-  heqCtx1 lhs rhs ctx  +  heqCtx1 lhs rhs ctx  monadPlusRightIdentity :: forall f. MonadPlusProp f monadPlusRightIdentity fgen = property $ do@@ -68,8 +68,8 @@               , "x = " ++ showX               , "mzero = " ++ showMZero               ]-        } -  heqCtx1 lhs rhs ctx  +        }+  heqCtx1 lhs rhs ctx  monadPlusAssociativity :: forall f. MonadPlusProp f monadPlusAssociativity fgen = property $ do@@ -91,7 +91,7 @@               , "c = " ++ showC               ]         }-  heqCtx1 lhs rhs ctx +  heqCtx1 lhs rhs ctx  monadPlusLeftZero :: forall f. MonadPlusProp f monadPlusLeftZero _ = property $ do@@ -128,7 +128,7 @@               , "v = " ++ showV               , "mzero = " ++ showMZero               ]-        } -  heqCtx1 lhs rhs ctx   +        }+  heqCtx1 lhs rhs ctx
src/Hedgehog/Classes/Storable.hs view
@@ -103,7 +103,7 @@ storableSetGet :: forall a. (Eq a, Show a, Storable a) => Gen a -> Property storableSetGet gen = property $ do   a <- forAll gen-  len <- forAll $ Gen.int (Range.linear 0 20)+  len <- forAll $ Gen.int (Range.linear 1 20)   ix <- forAll $ Gen.int (Range.linear 0 (len - 1))   unsafePerformIO $ do     ptr <- genArray gen len
test/Spec.hs view
@@ -21,14 +21,11 @@ --import Spec.Ix import Spec.Json import Spec.Monad-import Spec.MonadIO-import Spec.MonadPlus-import Spec.MonadZip import Spec.Monoid import Spec.Ord import Spec.Semigroup+import Spec.Semiring import Spec.Show-import Spec.ShowRead import Spec.Storable import Spec.Traversable @@ -53,6 +50,9 @@   ++ testExponentialSemigroup   ++ testIdempotentSemigroup   ++ testRectangularBandSemigroup+  ++ testSemiring+  ++ testRing+  ++ testStar   ++ testShow   ++ testShowRead   ++ testStorable
test/Spec/Bifoldable.hs view
@@ -15,18 +15,20 @@  testBifoldableFunctor :: [(String, [Laws])] testBifoldableFunctor =-  [ ("Either", lawsEither)-  , ("Const", lawsConst)+  [ ("Either", functorLawsEither)+  , ("Const", functorLawsConst)   ] -lawsEither :: [Laws]-lawsEither = [bifoldableLaws either]--lawsConst :: [Laws]+lawsConst, functorLawsConst :: [Laws] lawsConst = [bifoldableLaws const]+functorLawsConst = [bifoldableFunctorLaws const]  const :: MonadGen m => m a -> m b -> m (Const a b) const genA _genB = fmap Const genA++lawsEither, functorLawsEither :: [Laws]+lawsEither = [bifoldableLaws either]+functorLawsEither = [bifoldableFunctorLaws either]  either :: MonadGen m => m e -> m a -> m (Either e a) either genE genA =
test/Spec/Enum.hs view
@@ -3,11 +3,17 @@ import Hedgehog import Hedgehog.Classes +import Data.Int (Int64)+import Data.Word (Word64) import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range+import Numeric.Natural (Natural)  testEnum :: [(String, [Laws])]-testEnum = []+testEnum =+  [ ("Integer", listInteger)+  , ("Natural", listNatural)+  ]  testBoundedEnum :: [(String, [Laws])] testBoundedEnum =@@ -58,3 +64,12 @@ listWord16 = [boundedEnumLaws (ranged Gen.word16)] listWord32 = [boundedEnumLaws (ranged Gen.word32)] listWord64 = [boundedEnumLaws (ranged Gen.word64)]++listInteger, listNatural :: [Laws]+listInteger = [enumLaws (Gen.integral $ Range.constantFrom+    (0 :: Integer)+    (2 * fromIntegral (minBound :: Int64))+    (2 * fromIntegral (maxBound :: Int64)))]+listNatural = [enumLaws (Gen.integral $ Range.constant+    (0 :: Natural)+    (2 * fromIntegral (maxBound :: Word64)))]
test/Spec/Monad.hs view
@@ -1,6 +1,18 @@-module Spec.Monad (testMonad) where+{-# language+        DerivingStrategies+      , GeneralizedNewtypeDeriving+  #-} -import Data.Functor.Compose (Compose(..))+module Spec.Monad+  ( testMonad+  , testMonadIO+  , testMonadPlus+  , testMonadZip+  ) where++import Control.Applicative (Alternative(..), liftA2)+import Control.Monad.IO.Class (MonadIO(..))+ import Data.Functor.Identity (Identity(..))  import Hedgehog@@ -9,21 +21,48 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range +import System.IO.Unsafe (unsafePerformIO)+ import Prelude hiding (either)  testMonad :: [(String, [Laws])] testMonad =   [ ("[]", lawsList)-  , ("Maybe", lawsMaybe)   , ("Either e", lawsEither)+  , ("Identity", lawsIdentity)+  , ("IO", lawsIO)+  , ("Maybe", lawsMaybe)   ] -lawsList :: [Laws]-lawsList = [monadLaws (Gen.list (Range.linear 0 6))]+{-+testMonadFix :: [(String, [Laws])]+testMonadFix =+  [ ("[]", fixLawsList)+  , ("Either e", fixLawsEither)+  , ("Identity", fixLawsIdentity)+  , ("IO", fixLawsIO)+  , ("Maybe", fixLawsMaybe)+  ]+-} -lawsMaybe :: [Laws]-lawsMaybe = [monadLaws Gen.maybe]+testMonadIO :: [(String, [Laws])]+testMonadIO =+  [ ("IO", ioLawsIO)+  ] +testMonadPlus :: [(String, [Laws])]+testMonadPlus =+  [ ("[]", plusLawsList)+  , ("Maybe", plusLawsMaybe)+  ]++testMonadZip :: [(String, [Laws])]+testMonadZip =+  [ ("[]", zipLawsList)+  , ("Identity", zipLawsIdentity)+  , ("Maybe", zipLawsMaybe)+  ]+ lawsEither :: [Laws] lawsEither = [monadLaws eitherInteger] @@ -37,3 +76,43 @@         (2, Left <$> genE)       , (1 + fromIntegral n, Right <$> genA)       ]++lawsIdentity, zipLawsIdentity :: [Laws]+lawsIdentity = [monadLaws identity]+zipLawsIdentity = [monadZipLaws identity]++identity :: MonadGen m => m a -> m (Identity a)+identity = fmap Identity++lawsList, plusLawsList, zipLawsList :: [Laws]+lawsList = [monadLaws list]+plusLawsList = [monadPlusLaws list]+zipLawsList = [monadZipLaws list]++list :: MonadGen m => m a -> m [a]+list = Gen.list $ Range.linear 0 6++lawsMaybe, plusLawsMaybe, zipLawsMaybe :: [Laws]+lawsMaybe = [monadLaws Gen.maybe]+plusLawsMaybe = [monadPlusLaws Gen.maybe]+zipLawsMaybe = [monadZipLaws Gen.maybe]++lawsIO, ioLawsIO :: [Laws]+lawsIO = [monadLaws io]+ioLawsIO = [monadIOLaws io]++newtype TestIO a = TestIO (IO a)+  deriving newtype (Functor, Applicative, Monad, Alternative)++-- | Unsafe!+instance Eq a => Eq (TestIO a) where+  TestIO a == TestIO b = unsafePerformIO $ liftA2 (==) a b+  {-# noinline (==) #-}+-- | Unsafe!+instance Show a => Show (TestIO a) where+  showsPrec d (TestIO a) = unsafePerformIO $ fmap (showsPrec d) a+instance MonadIO TestIO where+  liftIO = TestIO++io :: MonadGen m => m a -> m (TestIO a)+io = fmap pure
− test/Spec/MonadIO.hs 
@@ -1,6 +0,0 @@-module Spec.MonadIO (testMonadIO) where--import Hedgehog.Classes--testMonadIO :: [(String, [Laws])]-testMonadIO = []
− test/Spec/MonadPlus.hs 
@@ -1,6 +0,0 @@-module Spec.MonadPlus (testMonadPlus) where--import Hedgehog.Classes--testMonadPlus :: [(String, [Laws])]-testMonadPlus = []
− test/Spec/MonadZip.hs 
@@ -1,6 +0,0 @@-module Spec.MonadZip (testMonadZip) where--import Hedgehog.Classes--testMonadZip :: [(String, [Laws])]-testMonadZip = []
test/Spec/Monoid.hs view
@@ -18,29 +18,37 @@  testCommutativeMonoid :: [(String, [Laws])] testCommutativeMonoid =-  [ ("Sum Integer", lawsSum)-  , ("Product Integer", lawsProduct)-  , ("Maybe Integer", lawsMaybe)+  [ ("Sum Integer", commutativeLawsSum)+  , ("Product Integer", commutativeLawsProduct)+  , ("Maybe Integer", commutativeLawsMaybe)   ] -lawsSum, lawsProduct, lawsMaybe, lawsAp :: [Laws]--lawsSum = [monoidLaws genSum]-lawsProduct = [monoidLaws genProduct]-lawsMaybe = [monoidLaws genMaybe]-lawsAp = [monoidLaws genAp]- genInteger :: Gen Integer genInteger = Gen.integral (Range.linear (-3) 20) +lawsSum, commutativeLawsSum :: [Laws]+lawsSum = [monoidLaws genSum]+commutativeLawsSum = [commutativeMonoidLaws genSum]+ genSum :: Gen (Sum Integer) genSum = fmap coerce genInteger +lawsProduct, commutativeLawsProduct :: [Laws]+lawsProduct = [monoidLaws genProduct]+commutativeLawsProduct = [commutativeMonoidLaws genProduct]+ genProduct :: Gen (Product Integer) genProduct = fmap coerce genInteger +lawsMaybe, commutativeLawsMaybe :: [Laws]+lawsMaybe = [monoidLaws genMaybe]+commutativeLawsMaybe = [commutativeMonoidLaws genMaybe]+ genMaybe :: Gen (Maybe (Sum Integer)) genMaybe = Gen.maybe genSum++lawsAp :: [Laws]+lawsAp = [monoidLaws genAp]  genAp :: Gen (Ap Maybe (Sum Integer)) genAp = fmap coerce genMaybe
test/Spec/Semigroup.hs view
@@ -9,27 +9,54 @@ import Hedgehog.Classes  import Data.Monoid (Sum(..))+import Data.Semigroup (Last(..)) import Hedgehog (Gen) import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range  testSemigroup :: [(String, [Laws])]-testSemigroup = [("Maybe", listMaybe)]--listMaybe :: [Laws]-listMaybe = map ($ genMaybe) [semigroupLaws, commutativeSemigroupLaws]--genMaybe :: Gen (Maybe (Sum Int))-genMaybe = Gen.maybe (fmap Sum $ Gen.int Range.constantBounded)+testSemigroup =+  [ ("Last", lawsLast)+  , ("Maybe", lawsMaybe)+  ]  testCommutativeSemigroup :: [(String, [Laws])]-testCommutativeSemigroup = []+testCommutativeSemigroup =+  [ ("Maybe", commutativeLawsMaybe)+  ]  testExponentialSemigroup :: [(String, [Laws])]-testExponentialSemigroup = []+testExponentialSemigroup =+  [ ("Last", exponentialLawsLast)+  , ("Maybe", exponentialLawsMaybe)+  ]  testIdempotentSemigroup :: [(String, [Laws])]-testIdempotentSemigroup = []+testIdempotentSemigroup =+  [ ("Last", idempotentLawsLast)+  ]  testRectangularBandSemigroup :: [(String, [Laws])]-testRectangularBandSemigroup = []+testRectangularBandSemigroup =+  [ ("Last", rectangularBandLawsLast)+  ]++genInteger :: Gen Integer+genInteger = Gen.integral (Range.linear (-3) 20)++lawsLast, exponentialLawsLast, idempotentLawsLast, rectangularBandLawsLast :: [Laws]+lawsLast = [semigroupLaws genLast]+exponentialLawsLast = [exponentialSemigroupLaws genLast]+idempotentLawsLast = [idempotentSemigroupLaws genLast]+rectangularBandLawsLast = [rectangularBandSemigroupLaws genLast]++genLast :: Gen (Last Integer)+genLast = Last <$> genInteger++lawsMaybe, commutativeLawsMaybe, exponentialLawsMaybe :: [Laws]+lawsMaybe = [semigroupLaws genMaybe]+commutativeLawsMaybe = [commutativeSemigroupLaws genMaybe]+exponentialLawsMaybe = [exponentialSemigroupLaws genMaybe]++genMaybe :: Gen (Maybe (Sum Integer))+genMaybe = Gen.maybe (Sum <$> genInteger)
+ test/Spec/Semiring.hs view
@@ -0,0 +1,79 @@+module Spec.Semiring+  ( testSemiring+  , testRing+  , testStar+  ) where++import Hedgehog.Classes++import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++testSemiring :: [(String, [Laws])]+testSemiring =+  [ ("Bool", lawsBool)+  , ("Int", lawsInt)+  , ("Int8", lawsInt8)+  , ("Int16", lawsInt16)+  , ("Int32", lawsInt32)+  , ("Int64", lawsInt64)+  , ("Word", lawsWord)+  , ("Word8", lawsWord8)+  , ("Word16", lawsWord16)+  , ("Word32", lawsWord32)+  , ("Word64", lawsWord64)+  ]++testRing :: [(String, [Laws])]+testRing =+  [ ("Int", ringLawsInt)+  , ("Int8", ringLawsInt8)+  , ("Int16", ringLawsInt16)+  , ("Int32", ringLawsInt32)+  , ("Int64", ringLawsInt64)+  , ("Word", ringLawsWord)+  , ("Word8", ringLawsWord8)+  , ("Word16", ringLawsWord16)+  , ("Word32", ringLawsWord32)+  , ("Word64", ringLawsWord64)+  ]++testStar :: [(String, [Laws])]+testStar =+  [ ("Bool", starLawsBool)+  ]++ranged :: (Bounded a, Num a) => (Range.Range a -> b) -> b+ranged f = f Range.constantBounded++lawsBool, starLawsBool :: [Laws]+lawsBool = [semiringLaws Gen.bool]+starLawsBool = [starLaws Gen.bool]++lawsInt, lawsInt8, lawsInt16, lawsInt32, lawsInt64 :: [Laws]+lawsInt = [semiringLaws (ranged Gen.int)]+lawsInt8 = [semiringLaws (ranged Gen.int8)]+lawsInt16 = [semiringLaws (ranged Gen.int16)]+lawsInt32 = [semiringLaws (ranged Gen.int32)]+lawsInt64 = [semiringLaws (ranged Gen.int64)]++lawsWord, lawsWord8, lawsWord16, lawsWord32, lawsWord64 :: [Laws]+lawsWord = [semiringLaws (ranged Gen.word)]+lawsWord8 = [semiringLaws (ranged Gen.word8)]+lawsWord16 = [semiringLaws (ranged Gen.word16)]+lawsWord32 = [semiringLaws (ranged Gen.word32)]+lawsWord64 = [semiringLaws (ranged Gen.word64)]++ringLawsInt, ringLawsInt8, ringLawsInt16, ringLawsInt32, ringLawsInt64 :: [Laws]+ringLawsInt = [ringLaws (ranged Gen.int)]+ringLawsInt8 = [ringLaws (ranged Gen.int8)]+ringLawsInt16 = [ringLaws (ranged Gen.int16)]+ringLawsInt32 = [ringLaws (ranged Gen.int32)]+ringLawsInt64 = [ringLaws (ranged Gen.int64)]++ringLawsWord, ringLawsWord8, ringLawsWord16, ringLawsWord32, ringLawsWord64 :: [Laws]+ringLawsWord = [ringLaws (ranged Gen.word)]+ringLawsWord8 = [ringLaws (ranged Gen.word8)]+ringLawsWord16 = [ringLaws (ranged Gen.word16)]+ringLawsWord32 = [ringLaws (ranged Gen.word32)]+ringLawsWord64 = [ringLaws (ranged Gen.word64)]
test/Spec/Show.hs view
@@ -1,6 +1,81 @@-module Spec.Show (testShow) where+module Spec.Show+  ( testShow+  , testShowRead+  ) where +import Hedgehog import Hedgehog.Classes +import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+ testShow :: [(String, [Laws])]-testShow = []+testShow =+  [ ("E", lawsE)+  , ("Int", lawsInt)+  , ("Int8", lawsInt8)+  , ("Int16", lawsInt16)+  , ("Int32", lawsInt32)+  , ("Int64", lawsInt64)+  , ("Word", lawsWord)+  , ("Word8", lawsWord8)+  , ("Word16", lawsWord16)+  , ("Word32", lawsWord32)+  , ("Word64", lawsWord64) +  ]++testShowRead :: [(String, [Laws])]+testShowRead =+  [ ("E", readLawsE)+  , ("Int", readLawsInt)+  , ("Int8", readLawsInt8)+  , ("Int16", readLawsInt16)+  , ("Int32", readLawsInt32)+  , ("Int64", readLawsInt64)+  , ("Word", readLawsWord)+  , ("Word8", readLawsWord8)+  , ("Word16", readLawsWord16)+  , ("Word32", readLawsWord32)+  , ("Word64", readLawsWord64) +  ]++lawsE, readLawsE :: [Laws]+lawsE = [showLaws genE]+readLawsE = [showReadLaws genE]++data E = E1 | E2 | E3 | E4 | E5 | E6 | E7 | E8+  deriving (Eq, Show, Read, Enum, Bounded)++genE :: Gen E+genE = Gen.enumBounded++ranged :: (Bounded a, Num a) => (Range.Range a -> b) -> b+ranged f = f (Range.constantBounded)++lawsInt, lawsInt8, lawsInt16, lawsInt32, lawsInt64 :: [Laws]+lawsInt = [showLaws (ranged Gen.int)]+lawsInt8 = [showLaws (ranged Gen.int8)]+lawsInt16 = [showLaws (ranged Gen.int16)]+lawsInt32 = [showLaws (ranged Gen.int32)]+lawsInt64 = [showLaws (ranged Gen.int64)]++lawsWord, lawsWord8, lawsWord16, lawsWord32, lawsWord64 :: [Laws]+lawsWord = [showLaws (ranged Gen.word)]+lawsWord8 = [showLaws (ranged Gen.word8)]+lawsWord16 = [showLaws (ranged Gen.word16)]+lawsWord32 = [showLaws (ranged Gen.word32)]+lawsWord64 = [showLaws (ranged Gen.word64)]++readLawsInt, readLawsInt8, readLawsInt16, readLawsInt32, readLawsInt64 :: [Laws]+readLawsInt = [showReadLaws (ranged Gen.int)]+readLawsInt8 = [showReadLaws (ranged Gen.int8)]+readLawsInt16 = [showReadLaws (ranged Gen.int16)]+readLawsInt32 = [showReadLaws (ranged Gen.int32)]+readLawsInt64 = [showReadLaws (ranged Gen.int64)]++readLawsWord, readLawsWord8, readLawsWord16, readLawsWord32, readLawsWord64 :: [Laws]+readLawsWord = [showReadLaws (ranged Gen.word)]+readLawsWord8 = [showReadLaws (ranged Gen.word8)]+readLawsWord16 = [showReadLaws (ranged Gen.word16)]+readLawsWord32 = [showReadLaws (ranged Gen.word32)]+readLawsWord64 = [showReadLaws (ranged Gen.word64)]
− test/Spec/ShowRead.hs 
@@ -1,6 +0,0 @@-module Spec.ShowRead (testShowRead) where--import Hedgehog.Classes--testShowRead :: [(String, [Laws])]-testShowRead = []
test/Spec/Storable.hs view
@@ -2,5 +2,36 @@  import Hedgehog.Classes +import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+ testStorable :: [(String, [Laws])]-testStorable = []+testStorable =+  [ ("Int", lawsInt)+  , ("Int8", lawsInt8)+  , ("Int16", lawsInt16)+  , ("Int32", lawsInt32)+  , ("Int64", lawsInt64)+  , ("Word", lawsWord)+  , ("Word8", lawsWord8)+  , ("Word16", lawsWord16)+  , ("Word32", lawsWord32)+  , ("Word64", lawsWord64)+  ]++ranged :: (Bounded a, Num a) => (Range.Range a -> b) -> b+ranged f = f (Range.constantBounded)++lawsInt, lawsInt8, lawsInt16, lawsInt32, lawsInt64 :: [Laws]+lawsInt = [storableLaws (ranged Gen.int)]+lawsInt8 = [storableLaws (ranged Gen.int8)]+lawsInt16 = [storableLaws (ranged Gen.int16)]+lawsInt32 = [storableLaws (ranged Gen.int32)]+lawsInt64 = [storableLaws (ranged Gen.int64)]++lawsWord, lawsWord8, lawsWord16, lawsWord32, lawsWord64 :: [Laws]+lawsWord = [storableLaws (ranged Gen.word)]+lawsWord8 = [storableLaws (ranged Gen.word8)]+lawsWord16 = [storableLaws (ranged Gen.word16)]+lawsWord32 = [storableLaws (ranged Gen.word32)]+lawsWord64 = [storableLaws (ranged Gen.word64)]
test/Spec/Traversable.hs view
@@ -2,5 +2,13 @@  import Hedgehog.Classes +import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+ testTraversable :: [(String, [Laws])]-testTraversable = []+testTraversable =+  [ ("[]", lawsList)+  ]++lawsList :: [Laws]+lawsList = [traversableLaws (Gen.list (Range.linear 0 6))]