diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,21 @@ # Revision history for antigen -## 0.1.0.0 -- YYYY-mm-dd +## 0.1.2.0 + +* Fixed `sized` and `resize` implementations for `AntiGen` +* Added utility functions: + - `(||!)` + - `antiNum` + - `antiBool` + - `antiChoose` + - `antiChooseBounded` + - `antiTry` + - `antiTryGen` + - `antiPositive` + - `antiNonPositive` + - `antiNegative` + - `antiNonNegative` + +## 0.1.0.0 * First version. Released on an unsuspecting world. diff --git a/antigen.cabal b/antigen.cabal --- a/antigen.cabal +++ b/antigen.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: antigen -version: 0.1.1.0 +version: 0.1.2.0 synopsis: Negatable QuickCheck generators description: AntiGen is a library that helps with generating negative examples from a @@ -15,8 +15,11 @@ category: Testing build-type: Simple extra-doc-files: CHANGELOG.md --- extra-source-files: +source-repository head + type: git + location: https://github.com/input-output-hk/antigen + common warnings ghc-options: -Wall @@ -26,10 +29,11 @@ Test.AntiGen Test.AntiGen.Internal build-depends: - base ^>=4.20.2.0, - QuickCheck >= 2.16.0 && < 2.17, + base >=4.18 && <5, + QuickCheck >= 2.16.0 && < 2.18, free >= 5.2 && < 5.3, mtl >= 2.3.1 && < 2.4, + random >= 1.2 && < 1.4, quickcheck-transformer >= 0.3.1 && < 0.4, hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Test/AntiGen.hs b/src/Test/AntiGen.hs --- a/src/Test/AntiGen.hs +++ b/src/Test/AntiGen.hs @@ -12,8 +12,102 @@ module Test.AntiGen ( AntiGen, (|!), + (||!), runAntiGen, zapAntiGen, + + -- * AntiGen combinators + antiNum, + antiBool, + antiChoose, + antiChooseBounded, + antiTry, + antiPositive, + antiNonPositive, + antiNegative, + antiNonNegative, ) where +import Control.Monad (join) +import System.Random (Random) import Test.AntiGen.Internal +import Test.QuickCheck ( + Arbitrary (..), + Gen, + Negative (..), + NonNegative (..), + NonPositive (..), + NonZero (..), + Positive (..), + ) +import Test.QuickCheck.GenT (MonadGen (..), frequency, suchThat) + +-- | Returns the provided number. If negated, returns a value that is not equal +-- to the provided number. +antiNum :: (Eq a, Num a, Arbitrary a) => a -> AntiGen a +antiNum n = pure n |! ((n +) . getNonZero <$> arbitrary) + +-- | Returns the provided `Bool`. If negated, returns the negation of that +-- `Bool`. +antiBool :: Bool -> AntiGen Bool +antiBool b = pure b |! pure (not b) + +-- | In the positive case generates a value from the first range. In the +-- negative case generates a value from the second range excluding the first +-- range. +-- +-- Note: The second range must not be a subset of the first range! +antiChoose :: (Integral a, Random a) => (a, a) -> (a, a) -> AntiGen a +antiChoose rng@(lo, hi) (boundLo, boundHi) = + choose rng + |! frequency + ( mconcat + [ [ (fromIntegral $ lo - boundLo, choose rngLo) + | lo > boundLo + ] + , [ (fromIntegral $ boundHi - hi, choose rngHi) + | boundHi > hi + ] + ] + ) + where + rngLo = (boundLo, lo) + rngHi = (hi, boundHi) + +-- | Generates a value from the range. If negated, returns a random value +-- outside the range between `minBound` and `maxBound`. +antiChooseBounded :: (Integral a, Random a, Bounded a) => (a, a) -> AntiGen a +antiChooseBounded rng = antiChoose rng (minBound, maxBound) + +-- | Returns the provided value unless negated, in which case it generates an +-- arbitrary value that is different from the provided value. It uses `suchThat`, +-- so using it on small types might end up discarding many values. +antiTry :: (Eq a, Arbitrary a) => a -> AntiGen a +antiTry a = antiTryGen a arbitrary + +-- | Returns the provided value unless negated, in which case it uses the +-- generator to generate a random value that is different from the provided +-- value. It uses `suchThat`, so using it on small types might end up +-- discarding many values. +antiTryGen :: Eq a => a -> Gen a -> AntiGen a +antiTryGen a gen = pure a |! (gen `suchThat` (/= a)) + +-- | Negatable generator for positive numbers +antiPositive :: (Num a, Ord a, Arbitrary a) => AntiGen a +antiPositive = (getPositive <$> arbitrary) |! (getNonPositive <$> arbitrary) + +-- | Negatable generator for non-positive numbers +antiNonPositive :: (Num a, Ord a, Arbitrary a) => AntiGen a +antiNonPositive = (getNonPositive <$> arbitrary) |! (getPositive <$> arbitrary) + +-- | Negatable generator for negative numbers +antiNegative :: (Num a, Ord a, Arbitrary a) => AntiGen a +antiNegative = (getNegative <$> arbitrary) |! (getNonNegative <$> arbitrary) + +-- | Negatable generator for non-negative numbers +antiNonNegative :: (Num a, Ord a, Arbitrary a) => AntiGen a +antiNonNegative = (getNonNegative <$> arbitrary) |! (getNegative <$> arbitrary) + +-- | Create an `AntiGen` from a positive and a negative `AntiGen` generator +(||!) :: AntiGen a -> AntiGen a -> AntiGen a +a ||! b = join $ pure a |! pure b diff --git a/src/Test/AntiGen/Internal.hs b/src/Test/AntiGen/Internal.hs --- a/src/Test/AntiGen/Internal.hs +++ b/src/Test/AntiGen/Internal.hs @@ -26,7 +26,7 @@ import Control.Monad.Free.Class (wrapT) import Control.Monad.State.Strict (MonadState (..), StateT (..), evalStateT, modify) import Control.Monad.Trans (MonadTrans (..)) -import Test.QuickCheck (Gen) +import Test.QuickCheck (Gen, getSize) import Test.QuickCheck.GenT (GenT (..), MonadGen (..), runGenT) data BiGen next where @@ -45,17 +45,11 @@ instance MonadGen AntiGen where liftGen g = AntiGen $ F $ \p b -> b $ BiGen g Nothing p variant n = mapGen (variant n) - sized f = AntiGen $ F $ \p b -> - let - pos = sized $ \sz -> - let AntiGen (F m) = f sz - in m pure $ \(BiGen ps _ c) -> ps >>= c - in - b $ BiGen pos Nothing p - resize n = mapGen (resize n) + sized f = wrap $ BiGen (f <$> getSize) Nothing id + resize n m = mapGen (resize n) m choose = liftGen . choose --- | Create a negatable generator by providing a positive and a negative +-- | Create a negatable generator by providing a positive and a negative -- generator (|!) :: Gen a -> Gen a -> AntiGen a pos |! neg = AntiGen $ F $ \p b -> b $ BiGen pos (Just neg) p @@ -126,9 +120,9 @@ evalPartial :: PartialGen a -> a evalPartial (PartialGen (F m)) = m id continue --- | Create a negative generator from an `AntiGen` by introducing at most +-- | Create a negative generator from an `AntiGen` by introducing at most -- `n` mistakes. If there are no negatable generators in the `AntiGen`, it will --- return a positive generator. Also if the number of negatable generators in +-- return a positive generator. Also if the number of negatable generators in -- the `AntiGen` is lower than `n`, then the number of negations will be less -- than `n`. zapAntiGen :: Int -> AntiGen a -> Gen a diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -7,7 +7,7 @@ import Data.Data (Proxy (..)) import Test.AntiGen (AntiGen, runAntiGen, zapAntiGen, (|!)) import Test.AntiGen.Internal (countDecisionPoints, evalToPartial) -import Test.Hspec (describe, hspec, shouldBe) +import Test.Hspec (Spec, describe, hspec, shouldBe) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck ( Arbitrary (..), @@ -21,9 +21,11 @@ counterexample, forAll, forAllBlind, + getSize, label, scale, suchThat, + vector, (.&&.), (.||.), (===), @@ -88,6 +90,61 @@ pure $ f <$> x <*> y ] +zapAntiGenSpec :: Spec +zapAntiGenSpec = + describe "zapAntiGen" $ do + prop "zapping `antiGenPositive` once generates negative examples" $ do + x <- zapAntiGen 1 antiGenPositive + pure $ x <= 0 + prop "zapping `antiGenPositive` zero times generates a positive example" $ do + x <- zapAntiGen 0 antiGenPositive + pure $ x > 0 + prop "zapping `antiGenTuple` once results in a single non-positive Int" $ do + (x, y) <- zapAntiGen 1 antiGenTuple + pure $ + label "x is non-positive" (x <= 0) .||. label "y is non-positive" (y <= 0) + prop "zapping `antiGenTuple` twice results in two non-positive Ints" $ do + (x, y) <- zapAntiGen 2 antiGenTuple + pure $ + counterexample ("x = " <> show x <> " is positive") (x <= 0) + .&&. counterexample ("y = " <> show y <> " is positive") (y <= 0) + prop + "zapping the length of the string propagates to the string generator" + . forAll (zapAntiGen 1 antiGenLengthStringStatic) + $ \(l, s) -> length s === l + prop + "zapping `antiGenLengthString` either generates invalid Int or a string of invalid length" + . forAll (zapAntiGen 1 antiGenLengthString) + $ \(l, s) -> + exactlyOne + [ ("l > 5", l > 5) + , ("length s /= l", length s /= l) + ] + prop + "zapping `antiGenEither` once gives a nice distribution" + . forAll (zapAntiGen 1 antiGenEither) + $ \x -> + exactlyOne + [ + ( "Left v <= 0" + , case x of + Right _ -> False + Left v -> v <= 0 + ) + , + ( "Right length (filter not v) == 1" + , case x of + Left _ -> False + Right v -> length (filter not v) == 1 + ) + , + ( "Right length > 5" + , case x of + Left _ -> False + Right v -> length v > 5 + ) + ] + main :: IO () main = hspec $ do describe "AntiGen" $ do @@ -101,6 +158,7 @@ pt <- evalToPartial m pt' <- evalToPartial antiGenPositive pure $ countDecisionPoints pt === countDecisionPoints pt' .&&. countDecisionPoints pt === 1 + zapAntiGenSpec describe "runAntiGen" $ do prop "runAntiGen . liftGen == id" $ \(seed :: Int) -> forAllBlind (someGen $ Proxy @Int) $ \g -> do @@ -108,55 +166,13 @@ res <- variant seed g res' <- variant seed g' pure $ res === res' - describe "zapAntiGen" $ do - prop "zapping `antiGenPositive` once generates negative examples" $ do - x <- zapAntiGen 1 antiGenPositive - pure $ x <= 0 - prop "zapping `antiGenPositive` zero times generates a positive example" $ do - x <- zapAntiGen 0 antiGenPositive - pure $ x > 0 - prop "zapping `antiGenTuple` once results in a single non-positive Int" $ do - (x, y) <- zapAntiGen 1 antiGenTuple - pure $ - label "x is non-positive" (x <= 0) .||. label "y is non-positive" (y <= 0) - prop "zapping `antiGenTuple` twice results in two non-positive Ints" $ do - (x, y) <- zapAntiGen 2 antiGenTuple - pure $ - counterexample ("x = " <> show x <> " is positive") (x <= 0) - .&&. counterexample ("y = " <> show y <> " is positive") (y <= 0) - prop - "zapping the length of the string propagates to the string generator" - . forAll (zapAntiGen 1 antiGenLengthStringStatic) - $ \(l, s) -> length s === l - prop - "zapping `antiGenLengthString` either generates invalid Int or a string of invalid length" - . forAll (zapAntiGen 1 antiGenLengthString) - $ \(l, s) -> - exactlyOne - [ ("l > 5", l > 5) - , ("length s /= l", length s /= l) - ] - prop - "zapping `antiGenEither` once gives a nice distribution" - . forAll (zapAntiGen 1 antiGenEither) - $ \x -> - exactlyOne - [ - ( "Left v <= 0" - , case x of - Right _ -> False - Left v -> v <= 0 - ) - , - ( "Right length (filter not v) == 1" - , case x of - Left _ -> False - Right v -> length (filter not v) == 1 - ) - , - ( "Right length > 5" - , case x of - Left _ -> False - Right v -> length v > 5 - ) - ] + describe "MonadGen" $ do + prop "applying `sized` to a negatable generator preserves negation" $ do + size <- getSize + val <- zapAntiGen 1 . sized $ \sz -> pure sz |! pure (-sz) + pure $ val === -size + prop "`resize` has an effect when zapping" $ do + sz <- choose (0, 10) + val :: [Bool] <- zapAntiGen 1 . resize sz . sized $ \s -> + liftGen (vector $ 2 * s) |! liftGen (vector s) + pure $ length val === sz