antigen 0.4.0.0 → 0.5.0.0

raw patch · 8 files changed

+197/−77 lines, 8 filesdep +mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: mtl

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +46/−24
• antigen.cabal +3/−1
• bench/Main.hs +1/−1
• src/Test/AntiGen.hs +29/−23
• src/Test/AntiGen/Class.hs +107/−0
• src/Test/AntiGen/Internal.hs +4/−27
• test/Main.hs +1/−1

@@ -1,5 +1,11 @@ # Revision history for antigen +## 0.5.0.0++* Add `Test.AntiGen.Class`+* Add `MonadAntiGen`+* Make all the helper functions work with abstract monads instead of `AntiGen`+ ## 0.4.0.0  * Add `antiSamePair`

@@ -1,39 +1,61 @@ # AntiGen -AntiGen lets you write `QuickCheck` generators that can also be negated to generate negative examples. It can be used as a drop-in replacement for `Gen`.+AntiGen lets you write `QuickCheck` generators that can also produce *negative* examples — subtly malformed variants of the valid data. It's a drop-in replacement for `Gen`. +## Why?++Property-based tests usually check that valid inputs are accepted. But validators and parsers also need to reject malformed inputs, and writing a second generator for the invalid case duplicates logic and tends to drift out of sync with the positive one.++With AntiGen you describe the valid shape once, marking each constrained choice with what an out-of-bounds variant would look like. The same generator can then produce either a valid example or a negative example with `n` of those choices flipped — and any later decisions that depend on an earlier choice see the flipped value, so the rest of the structure cascades accordingly.+ ## Example +Consider validating a length-prefixed message: a declared length field followed by a payload that must have exactly that many characters, each of which must be an `'a'`:+ ```haskell--- Returns an integer `n` (such that 0 <= n <= 5) and a string of length `n` consisting only of characters 'a'-antiGenLengthString :: AntiGen (Int, String)-antiGenLengthString = do-  -- Use (|!) to provide both a positive and a negative generator-  l <- choose (0, 5) |! choose (6, 10)-  s <--    pure (replicate l 'a') |! do-      NonNegative l' <- suchThat arbitrary $ \(NonNegative x) -> x /= l-      pure $ replicate l' 'b'-  pure (l, s)+data Message = Message { declaredLen :: Int, payload :: String } deriving Show++isValid :: Message -> Bool+isValid (Message n s) =+  0 <= n && n <= 10 && length s == n && all (== 'a') s++messageGen :: AntiGen Message+messageGen = do+  n <- choose (0, 10) |! choose (11, 20) -- declared length+  nElems <- pure n |! choose (n + 1, n + 10) -- actual number of elements+  s <- replicateM nElems (pure 'a' |! elements ['b' .. 'z'])+  pure (Message n s) ``` -To generate a positive example, use `runAntiGen`+Use `runAntiGen` to draw a valid example:+ ```-ghci> generate (runAntiGen antiGenLengthString)-(1, "a")+ghci> generate (runAntiGen messageGen)+Message {declaredLen = 5, payload = "aaaaa"} ``` -To generate a negative example, use `zapAntiGen`-```-ghci> generate (zapAntiGen 1 antiGenLengthString)-(6, "aaaaaa") -- length is too long-ghci> generate (zapAntiGen 1 antiGenLengthString)-(2, "bbbb") -- length of the string does not match up with the integer+Use `zapAntiGen k` to draw a negative example by flipping at most `k` of the decision points:+ ```+ghci> generate (zapAntiGen 1 messageGen)+Message {declaredLen = 4, payload = "aaha"}+-- one character was corrupted; the length field and payload length still agree -Notice that there is exactly one mistake in the example above. -The first argument of `zapAntiGen` can be used to specify how many negations the generator should introduce.+ghci> generate (zapAntiGen 1 messageGen)+Message {declaredLen = 17, payload = "aaaaaaaaaaaaaaaaa"}+-- the length field was flipped out of range; the payload cascaded to still+-- match it — and with 17 characters, there are now 17 character-level+-- decision points rather than the original few++ghci> generate (zapAntiGen 3 messageGen)+Message {declaredLen = 15, payload = "aaaaaaaaaadaaaaaa"}+-- three mistakes:+-- length out of range, one character corrupted, declared length does not match actual length (15 vs 17) ```-ghci> generate $ zapAntiGen 2 antiGenLengthString-(10,"b") -- both values are wrong++The same generator now drives both directions of the validator's property:++```haskell+prop_accepts = forAll (runAntiGen   messageGen) isValid+prop_rejects = forAll (zapAntiGen 1 messageGen) (not . isValid) ```

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               antigen-version:            0.4.0.0+version:            0.5.0.0 synopsis:           Fault injection for QuickCheck description:   AntiGen extends QuickCheck to allow injecting random faults into QuickCheck @@ -30,6 +30,7 @@     import:           warnings     exposed-modules:         Test.AntiGen+      Test.AntiGen.Class       Test.AntiGen.Internal     build-depends:       base >=4.18 && <5,@@ -39,6 +40,7 @@       random >= 1.2 && < 1.4,       text >= 2.0 && < 2.2,       quickcheck-transformer >= 0.3.1 && < 0.4,+      mtl >= 2.3.1 && < 2.4,     hs-source-dirs:   src     default-language: Haskell2010 

@@ -7,6 +7,7 @@ import Control.DeepSeq (deepseq) import Criterion.Main (Benchmarkable, bench, bgroup, defaultMain, nfIO) import qualified Data.Text as T+import Test.AntiGen ((|!)) import Test.AntiGen.Internal (   AntiGen,   ZapResult (..),@@ -14,7 +15,6 @@   evalToPartial,   withAnnotation,   zapAt,-  (|!),  ) import Test.QuickCheck (Arbitrary (..), generate) import Test.QuickCheck.GenT (MonadGen (..))

@@ -12,6 +12,7 @@ module Test.AntiGen (   AntiGen,   ZapResult (..),+  MonadAntiGen (..),   (|!),   (#!),   (||!),@@ -20,6 +21,7 @@   zapAntiGen,   zapAntiGenResult,   prettyZapResult,+  annotate,   scaleWeight,   reweigh, @@ -46,18 +48,15 @@  import Control.Monad (join, replicateM) import System.Random (Random)+import Test.AntiGen.Class (MonadAntiGen (..), annotate, reweigh, scaleWeight, (#!), (|!)) import Test.AntiGen.Internal (   AntiGen,   ZapResult (..),   prettyZapResult,-  reweigh,   runAntiGen,-  scaleWeight,   withAnnotation,   zapAntiGen,   zapAntiGenResult,-  (#!),-  (|!),  ) import Test.QuickCheck (   Arbitrary (..),@@ -72,22 +71,22 @@ -- | Returns the provided number. -- -- Negative: returns a value that is not equal to the provided number.-faultyNum :: (Eq a, Num a, Arbitrary a) => a -> AntiGen a+faultyNum :: (Eq a, Num a, Arbitrary a, MonadAntiGen m) => a -> m a faultyNum n = pure n |! ((n +) . getNonZero <$> arbitrary) -faultyNumRange :: (Random a, Eq a) => a -> (a, a) -> AntiGen a+faultyNumRange :: (Random a, Eq a, MonadAntiGen m) => a -> (a, a) -> m a faultyNumRange n rng = pure n |! (choose rng `suchThat` (/= n))  -- | Returns the provided `Bool`. -- -- Negative: returns the negation of that `Bool`.-faultyBool :: Bool -> AntiGen Bool+faultyBool :: MonadAntiGen m => Bool -> m Bool faultyBool b = pure b |! pure (not b)  -- | Generates a value from the first range. -- -- Negative: Generates a value from the second range excluding the first range.-antiChoose :: (Integral a, Random a) => (a, a) -> (a, a) -> AntiGen a+antiChoose :: (Integral a, Random a, MonadAntiGen m, MonadGen m) => (a, a) -> (a, a) -> m a antiChoose rng@(lo, hi) (boundLo, boundHi)   | lo > boundLo || boundHi > hi =       choose rng@@ -102,7 +101,14 @@ -- -- Negative: Returns a random value outside the range between `minBound` and -- `maxBound`.-antiChooseBounded :: (Integral a, Random a, Bounded a) => (a, a) -> AntiGen a+antiChooseBounded ::+  ( Integral a+  , Random a+  , Bounded a+  , MonadAntiGen m+  , MonadGen m+  ) =>+  (a, a) -> m a antiChooseBounded rng = antiChoose rng (minBound, maxBound)  -- | Returns the provided value@@ -112,7 +118,7 @@ -- -- Warning: It uses `suchThat`, so using it on small types might end up -- discarding many values.-faultyTry :: (Eq a, Arbitrary a) => a -> AntiGen a+faultyTry :: (Eq a, Arbitrary a, MonadGen m, MonadAntiGen m) => a -> m a faultyTry a = faultyTryGen a $ liftGen arbitrary  -- | Returns the provided value@@ -122,49 +128,49 @@ -- -- Warning: It uses `suchThat`, so using it on small types might end up -- discarding many values.-faultyTryGen :: Eq a => a -> AntiGen a -> AntiGen a+faultyTryGen :: (Eq a, MonadAntiGen m, MonadGen m) => a -> m a -> m a faultyTryGen a gen = pure a ||! (gen `suchThat` (/= a))  -- | Returns a positive number -- -- Negative: Returns a non-positive number-antiPositive :: (Num a, Ord a, Arbitrary a) => AntiGen a+antiPositive :: (Num a, Ord a, Arbitrary a, MonadAntiGen m) => m a antiPositive = (getPositive <$> arbitrary) |! (getNonPositive <$> arbitrary)  -- | Returns a non-positive number -- -- Negative: Returns a positive number-antiNonPositive :: (Num a, Ord a, Arbitrary a) => AntiGen a+antiNonPositive :: (Num a, Ord a, Arbitrary a, MonadAntiGen m) => m a antiNonPositive = (getNonPositive <$> arbitrary) |! (getPositive <$> arbitrary)  -- | Returns a negative number -- -- Negative: Returns a non-negative number-antiNegative :: (Num a, Ord a, Arbitrary a) => AntiGen a+antiNegative :: (Num a, Ord a, Arbitrary a, MonadAntiGen m) => m a antiNegative = (getNegative <$> arbitrary) |! (getNonNegative <$> arbitrary)  -- | Returns a non-negative number -- -- Negative: Returns a negative number-antiNonNegative :: (Num a, Ord a, Arbitrary a) => AntiGen a+antiNonNegative :: (Num a, Ord a, Arbitrary a, MonadAntiGen m) => m a antiNonNegative = (getNonNegative <$> arbitrary) |! (getNegative <$> arbitrary)  -- | Returns `Just x` -- -- Negative: Returns `Nothing`-antiJust :: a -> AntiGen (Maybe a)+antiJust :: MonadAntiGen m => a -> m (Maybe a) antiJust x = pure (Just x) ||! pure Nothing  -- | Returns a non-empty list -- -- Negative: Generate an empty list-antiNonEmpty :: AntiGen a -> AntiGen [a]+antiNonEmpty :: (MonadGen m, MonadAntiGen m) => m a -> m [a] antiNonEmpty x = listOf1 x ||! pure []  -- | Generate a pair with equal values -- -- Negative: Generates a pair of distinct values-antiSamePair :: (Arbitrary a, Num a, Eq a) => AntiGen (a, a)+antiSamePair :: (Arbitrary a, Num a, Eq a, MonadAntiGen m) => m (a, a) antiSamePair =   ((\x -> (x, x)) <$> arbitrary)     |! ( do@@ -176,7 +182,7 @@ -- | Generates a pair (x, y) where x /= y. -- -- Negative: Generates a pair (x, y) where x == y.-antiDistinctPair :: (Num a, Arbitrary a, Eq a) => AntiGen (a, a)+antiDistinctPair :: (Num a, Arbitrary a, Eq a, MonadAntiGen m) => m (a, a) antiDistinctPair =   ( do       x <- arbitrary@@ -189,15 +195,15 @@        )  -- | Create an `AntiGen` from a positive and a negative `AntiGen` generator-(||!) :: AntiGen a -> AntiGen a -> AntiGen a+(||!) :: MonadAntiGen m => m a -> m a -> m a a ||! b = join $ pure a |! pure b +infixl 6 ||!+ -- | Like 'replicateM', but normalizes the weight of each element by @1\/n@. -- -- The total weight of the list becomes the average weight of its elements, -- rather than the sum. This prevents longer lists from having a -- disproportionately higher chance of being zapped.-replicateMNorm :: Int -> AntiGen a -> AntiGen [a]+replicateMNorm :: MonadAntiGen m => Int -> m a -> m [a] replicateMNorm n = replicateM n . scaleWeight (/ fromIntegral n)--infixl 6 ||!

@@ -0,0 +1,107 @@+{-# LANGUAGE RankNTypes #-}++module Test.AntiGen.Class (+  MonadAntiGen (..),+  annotate,+  reweigh,+  scaleWeight,+  (|!),+  (#!),+) where++import Control.Monad.Except (ExceptT, mapExceptT)+import Control.Monad.Identity (IdentityT, mapIdentityT)+import qualified Control.Monad.RWS.CPS as CPSRWS+import qualified Control.Monad.RWS.Lazy as LazyRWS+import qualified Control.Monad.RWS.Strict as StrictRWS+import Control.Monad.Reader (ReaderT, mapReaderT)+import qualified Control.Monad.State.Lazy as Lazy+import qualified Control.Monad.State.Strict as Strict+import Control.Monad.Trans (MonadTrans (..))+import qualified Control.Monad.Writer.CPS as CPS+import qualified Control.Monad.Writer.Lazy as Lazy+import qualified Control.Monad.Writer.Strict as Strict+import Data.Text (Text)+import Test.AntiGen.Internal+import Test.QuickCheck.Gen (Gen)++class Monad m => MonadAntiGen m where+  liftAntiGen :: AntiGen a -> m a+  mapAntiGen :: (forall x. AntiGen x -> AntiGen x) -> m a -> m a++annotate :: MonadAntiGen m => Text -> m a -> m a+annotate m = mapAntiGen $ withAnnotation m++scaleWeight :: MonadAntiGen m => (Float -> Float) -> m a -> m a+scaleWeight f = mapAntiGen $ withScaledWeight f++-- | Create a negatable generator by providing a positive and a negative+-- generator+(|!) :: MonadAntiGen m => Gen a -> Gen a -> m a+p |! n = liftAntiGen $ mkAntiGen p n++infixl 6 |!++instance MonadAntiGen AntiGen where+  liftAntiGen = id+  mapAntiGen f = f++reweigh :: MonadAntiGen m => Float -> m a -> m a+reweigh w = scaleWeight $ const w++-- | Postfix annotation operator. Annotates an 'AntiGen' with a label that+-- will be included in 'ZapResult' when this generator is zapped.+--+-- @+-- myGen = positive |! negative #! "sign"+-- @+(#!) :: MonadAntiGen m => m a -> Text -> m a+(#!) = flip annotate++infixl 5 #!++-- # MTL instances++instance MonadAntiGen m => MonadAntiGen (ExceptT e m) where+  liftAntiGen = lift . liftAntiGen+  mapAntiGen f = mapExceptT $ mapAntiGen f++instance MonadAntiGen m => MonadAntiGen (IdentityT m) where+  liftAntiGen = lift . liftAntiGen+  mapAntiGen f = mapIdentityT $ mapAntiGen f++instance MonadAntiGen m => MonadAntiGen (Lazy.StateT e m) where+  liftAntiGen = lift . liftAntiGen+  mapAntiGen f = Lazy.mapStateT $ mapAntiGen f++instance MonadAntiGen m => MonadAntiGen (Strict.StateT e m) where+  liftAntiGen = lift . liftAntiGen+  mapAntiGen f = Strict.mapStateT $ mapAntiGen f++instance (MonadAntiGen m, Monoid e) => MonadAntiGen (Lazy.WriterT e m) where+  liftAntiGen = lift . liftAntiGen+  mapAntiGen f = Lazy.mapWriterT $ mapAntiGen f++instance (MonadAntiGen m, Monoid e) => MonadAntiGen (Strict.WriterT e m) where+  liftAntiGen = lift . liftAntiGen+  mapAntiGen f = Strict.mapWriterT $ mapAntiGen f++instance (MonadAntiGen m, Monoid e) => MonadAntiGen (CPS.WriterT e m) where+  liftAntiGen = lift . liftAntiGen+  mapAntiGen f = CPS.mapWriterT $ mapAntiGen f++instance MonadAntiGen m => MonadAntiGen (ReaderT e m) where+  liftAntiGen = lift . liftAntiGen+  mapAntiGen f = mapReaderT $ mapAntiGen f++instance (MonadAntiGen m, Monoid w) => MonadAntiGen (LazyRWS.RWST r w s m) where+  liftAntiGen = lift . liftAntiGen+  mapAntiGen f = LazyRWS.mapRWST $ mapAntiGen f++instance (MonadAntiGen m, Monoid w) => MonadAntiGen (StrictRWS.RWST r w s m) where+  liftAntiGen = lift . liftAntiGen+  mapAntiGen f = StrictRWS.mapRWST $ mapAntiGen f++instance (MonadAntiGen m, Monoid w) => MonadAntiGen (CPSRWS.RWST r w s m) where+  liftAntiGen = lift . liftAntiGen+  mapAntiGen f = CPSRWS.mapRWST $ mapAntiGen f

@@ -14,8 +14,7 @@   AntiGen,   ZapResult (..),   prettyZapResult,-  (|!),-  (#!),+  mkAntiGen,   zapAntiGen,   zapAntiGenResult,   runAntiGen,@@ -24,8 +23,7 @@   countDecisionPoints,   zapAt,   withAnnotation,-  scaleWeight,-  reweigh,+  withScaledWeight, ) where  import Control.Monad ((<=<))@@ -82,33 +80,12 @@ mkAntiGen active alt =   AntiGen $ F $ \p b -> b $ BiGen (p <$> active) (Just $ p <$> alt) 1 id --- | Create a negatable generator by providing a positive and a negative--- generator-(|!) :: Gen a -> Gen a -> AntiGen a-(|!) = mkAntiGen--infixl 6 |!---- | Postfix annotation operator. Annotates an 'AntiGen' with a label that--- will be included in 'ZapResult' when this generator is zapped.------ @--- myGen = positive |! negative #! "sign"--- @-(#!) :: AntiGen a -> Text -> AntiGen a-(#!) = flip withAnnotation--infixl 5 #!- -- | Wrap an AntiGen with an annotation withAnnotation :: Text -> AntiGen a -> AntiGen a withAnnotation ann inner = wrap $ Annotate ann inner pure -scaleWeight :: (Float -> Float) -> AntiGen a -> AntiGen a-scaleWeight rw inner = wrap $ Reweigh rw inner pure--reweigh :: Float -> AntiGen a -> AntiGen a-reweigh w = scaleWeight $ const w+withScaledWeight :: (Float -> Float) -> AntiGen a -> AntiGen a+withScaledWeight rw inner = wrap $ Reweigh rw inner pure  data DecisionPoint next where   DecisionPoint ::

@@ -26,6 +26,7 @@   faultyNum,   faultyTry,   replicateMNorm,+  reweigh,   runAntiGen,   zapAntiGen,   (|!),@@ -36,7 +37,6 @@   countDecisionPoints,   evalToPartial,   prettyZapResult,-  reweigh,   withAnnotation,   zapAntiGenResult,  )