antigen (empty) → 0.1.0.0
raw patch · 7 files changed
+432/−0 lines, 7 filesdep +QuickCheckdep +antigendep +base
Dependencies added: QuickCheck, antigen, base, criterion, free, hspec, mtl, quickcheck-transformer
Files
- CHANGELOG.md +5/−0
- LICENSE +20/−0
- antigen.cabal +61/−0
- bench/Main.hs +34/−0
- src/Test/AntiGen.hs +19/−0
- src/Test/AntiGen/Internal.hs +131/−0
- test/Main.hs +162/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for antigen++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2026 Joosep Jääger++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ antigen.cabal view
@@ -0,0 +1,61 @@+cabal-version: 3.0+name: antigen+version: 0.1.0.0+synopsis: Negatable QuickCheck generators +description:+ AntiGen is a library that helps with generating negative examples from a + QuickCheck generator. The `AntiGen` monad is designed to be similar to the+ `Gen` monad, so that migrating the generators would be as frictionless as + possible.+license: MIT+license-file: LICENSE+author: IOG Ledger Team+maintainer: hackage@iohk.io+copyright: 2026 Input Output Global Inc (IOG)+category: Testing+build-type: Simple+extra-doc-files: CHANGELOG.md+-- extra-source-files:++common warnings+ ghc-options: -Wall++library+ import: warnings+ exposed-modules: + Test.AntiGen+ Test.AntiGen.Internal+ build-depends: + base ^>=4.20.2.0,+ QuickCheck >= 2.16.0 && < 2.17,+ free >= 5.2 && < 5.3,+ mtl >= 2.3.1 && < 2.4,+ quickcheck-transformer >= 0.3.1 && < 0.4,+ hs-source-dirs: src+ default-language: Haskell2010++test-suite antigen-test+ import: warnings+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ base ^>=4.20.2.0,+ antigen,+ hspec,+ QuickCheck,+ quickcheck-transformer,++benchmark bench+ import: warnings+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: bench+ default-language: Haskell2010+ build-depends:+ antigen,+ base,+ criterion,+ QuickCheck,+ quickcheck-transformer,
+ bench/Main.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE NumericUnderscores #-}++module Main (main) where++import Criterion.Main (Benchmarkable, bench, defaultMain, nfIO)+import Test.AntiGen.Internal (AntiGen, evalPartial, evalToPartial, zapAt, (|!))+import Test.QuickCheck (Arbitrary (..), generate)+import Test.QuickCheck.GenT (MonadGen (..))++bindList :: Int -> AntiGen [Int]+bindList 1 = (: []) <$> liftGen arbitrary+bindList n+ | n <= 0 = pure []+ | otherwise = do+ rest <- bindList (n - 1)+ case rest of+ x : xs -> do+ y <- pure (succ x) |! pure (pred x)+ pure $ y : x : xs+ [] -> error "Got empty list"++bindListZap :: Int -> Int -> Benchmarkable+bindListZap len i =+ nfIO . generate . variant (12345 :: Int) . fmap evalPartial $+ zapAt i =<< evalToPartial (bindList len)++main :: IO ()+main =+ defaultMain+ [ bench "bindList 10_000 zap at 0" $ bindListZap 10_000 0+ , bench "bindList 10_000 zap at 9_000" $ bindListZap 10_000 9_000+ , bench "bindList 1_000_000 zap at 0" $ bindListZap 1_000_000 0+ , bench "bindList 1_000_000 zap at 900_000" $ bindListZap 1_000_000 900_000+ ]
+ src/Test/AntiGen.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}++module Test.AntiGen (+ AntiGen,+ (|!),+ runAntiGen,+ zapAntiGen,+) where++import Test.AntiGen.Internal
+ src/Test/AntiGen/Internal.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}++module Test.AntiGen.Internal (+ AntiGen,+ (|!),+ zapAntiGen,+ runAntiGen,+ evalToPartial,+ evalPartial,+ countDecisionPoints,+ zapAt,+) where++import Control.Monad ((<=<))+import Control.Monad.Free.Church (F (..), MonadFree (..))+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.GenT (GenT (..), MonadGen (..), runGenT)++data BiGen next where+ BiGen :: Gen t -> Maybe (Gen t) -> (t -> next) -> BiGen next++instance Functor BiGen where+ fmap f (BiGen p n c) = BiGen p n $ f . c++newtype AntiGen a = AntiGen (F BiGen a)+ deriving (Functor, Applicative, Monad, MonadFree BiGen)++mapGen :: (forall x. Gen x -> Gen x) -> AntiGen a -> AntiGen a+mapGen f (AntiGen (F m)) = m pure $ \(BiGen pos neg c) ->+ wrap $ BiGen (f pos) (f <$> neg) c++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)+ choose = liftGen . choose++(|!) :: Gen a -> Gen a -> AntiGen a+pos |! neg = AntiGen $ F $ \p b -> b $ BiGen pos (Just neg) p++data DecisionPoint next where+ DecisionPoint ::+ { dpValue :: t+ , dpPositiveGen :: Gen t+ , dpNegativeGen :: Maybe (Gen t)+ , dpContinuation :: t -> next+ } ->+ DecisionPoint next++instance Functor DecisionPoint where+ fmap f (DecisionPoint v p n c) = DecisionPoint v p n $ f . c++continue :: DecisionPoint next -> next+continue DecisionPoint {..} = dpContinuation dpValue++newtype PartialGen a = PartialGen (F DecisionPoint a)+ deriving (Functor, Applicative, Monad, MonadFree DecisionPoint)++evalToPartial :: AntiGen a -> Gen (PartialGen a)+evalToPartial (AntiGen (F m)) = runGenT $ m pure $ \(BiGen pos mNeg c) -> do+ value <- liftGen pos+ wrapT $ DecisionPoint value pos mNeg c++countDecisionPoints :: PartialGen a -> Int+countDecisionPoints (PartialGen (F m)) = m (const 0) $ \dp@DecisionPoint {..} ->+ case dpNegativeGen of+ Just _ -> succ $ continue dp+ Nothing -> continue dp++zapAt :: Int -> PartialGen a -> Gen (PartialGen a)+zapAt cutoffDepth (PartialGen (F m)) = do+ let+ wrapGenState mm = StateT $ \s -> GenT $ \g sz ->+ let eval (StateT x) =+ let GenT f = x s+ in f g sz+ in wrap $ eval <$> mm+ runGenT . (`evalStateT` cutoffDepth) . m pure $ \dp@DecisionPoint {..} ->+ case dpNegativeGen of+ Just neg -> do+ d <- get+ modify pred+ if d == 0+ then do+ -- Negate the generator+ value <- lift $ liftGen neg+ wrapGenState $ DecisionPoint value neg Nothing dpContinuation+ else wrapGenState dp+ Nothing -> wrapGenState dp++zap :: PartialGen a -> Gen (PartialGen a)+zap p+ | let maxDepth = countDecisionPoints p+ , maxDepth > 0 = do+ cutoffDepth <- choose (0, maxDepth - 1)+ zapAt cutoffDepth p+ | otherwise = pure p++zapNTimes :: Int -> PartialGen a -> Gen (PartialGen a)+zapNTimes n+ | n <= 0 = pure+ | otherwise = zapNTimes (n - 1) <=< zap++evalPartial :: PartialGen a -> a+evalPartial (PartialGen (F m)) = m id continue++zapAntiGen :: Int -> AntiGen a -> Gen a+zapAntiGen n = fmap evalPartial <$> zapNTimes n <=< evalToPartial++runAntiGen :: AntiGen a -> Gen a+runAntiGen ag = evalPartial <$> evalToPartial ag
+ test/Main.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Main (main) where++import Control.Monad (replicateM)+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.QuickCheck (prop)+import Test.QuickCheck (+ Arbitrary (..),+ CoArbitrary,+ Gen,+ NonNegative (..),+ NonPositive (..),+ Positive (..),+ Property,+ Testable (..),+ counterexample,+ forAll,+ forAllBlind,+ label,+ scale,+ suchThat,+ (.&&.),+ (.||.),+ (===),+ )+import Test.QuickCheck.GenT (MonadGen (..), oneof)++antiGenPositive :: AntiGen Int+antiGenPositive = (getPositive @Int <$> arbitrary) |! (getNonPositive <$> arbitrary)++antiGenTuple :: AntiGen (Int, Int)+antiGenTuple = do+ x <- antiGenPositive+ y <- antiGenPositive+ pure (x, y)++antiGenSmall :: AntiGen Int+antiGenSmall = choose (0, 5) |! choose (6, 10)++antiGenLengthStringStatic :: AntiGen (Int, String)+antiGenLengthStringStatic = do+ l <- antiGenSmall+ pure (l, replicate l 'a')++antiGenLengthString :: AntiGen (Int, String)+antiGenLengthString = do+ l <- antiGenSmall+ s <-+ pure (replicate l 'a') |! do+ NonNegative l' <- suchThat arbitrary $ \(NonNegative x) -> x /= l+ pure $ replicate l' 'b'+ pure (l, s)++antiGenEither :: AntiGen (Either Int [Bool])+antiGenEither = do+ oneof+ [ Left <$> antiGenPositive+ , Right <$> do+ l <- antiGenSmall+ replicateM l $ pure True |! pure False+ ]++noneOf :: [Bool] -> Property+noneOf [] = property True+noneOf (x : xs) = not x .&&. noneOf xs++exactlyOne :: [(String, Bool)] -> Property+exactlyOne [] = counterexample "None of the conditions hold" $ property False+exactlyOne ((lbl, p) : ps) = label lbl (p .&&. noneOf (snd <$> ps)) .||. (not p .&&. exactlyOne ps)++someGen :: (Arbitrary a, CoArbitrary a) => Proxy a -> Gen (Gen a)+someGen p =+ oneof+ [ pure <$> arbitrary+ , do+ x <- scale (`div` 2) $ someGen p+ f <- arbitrary+ pure $ f <$> x+ , do+ x <- scale (`div` 4) $ someGen p+ y <- scale (`div` 4) $ someGen p+ f <- arbitrary+ pure $ f <$> x <*> y+ ]++main :: IO ()+main = hspec $ do+ describe "AntiGen" $ do+ describe "treeDepth" $ do+ prop "pure has depth of zero" $ do+ pt <- evalToPartial $ pure ()+ pure $ countDecisionPoints pt `shouldBe` 0+ prop "single bind has depth of one, right identity holds" $ do+ let+ m = return =<< antiGenPositive+ pt <- evalToPartial m+ pt' <- evalToPartial antiGenPositive+ pure $ countDecisionPoints pt === countDecisionPoints pt' .&&. countDecisionPoints pt === 1+ describe "runAntiGen" $ do+ prop "runAntiGen . liftGen == id" $+ \(seed :: Int) -> forAllBlind (someGen $ Proxy @Int) $ \g -> do+ let g' = runAntiGen (liftGen g)+ 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+ )+ ]