{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
-- |
-- Module : Effectful.QuickCheck
-- Copyright : (c) 2026 Institute for Digital Autonomy
-- License : EUPL-1.2
-- Maintainer : IDA
--
-- Effectful bindings for the <http://hackage.haskell.org/package/QuickCheck QuickCheck library>.
--
-- This library provides lifted 'Testable' and 'Property' types that allow running tests with
-- arbitrary effect stacks.
module Effectful.QuickCheck
( -- * Running tests
quickCheck
, Args (..)
, Result (..)
, stdArgs
, quickCheckWith
, quickCheckWithResult
, quickCheckResult
, recheck
, isSuccess
-- ** Running tests verbosely
, verboseCheck
, verboseCheckWith
, verboseCheckWithResult
, verboseCheckResult
-- * The 'Arbitrary' typeclass: generation of random values
, Arbitrary (..)
-- ** Helper functions for implementing 'shrink'
, genericShrink
, subterms
, recursivelyShrink
, shrinkNothing
, shrinkList
, shrinkMap
, shrinkMapBy
, shrinkIntegral
, shrinkRealFrac
, shrinkBoundedEnum
, shrinkDecimal
-- ** Lifting of 'Arbitrary' to unary and binary type constructors
, Arbitrary1 (..)
, arbitrary1
, shrink1
, Arbitrary2 (..)
, arbitrary2
, shrink2
-- * The 'Gen' monad: combinators for building random generators
, Gen
-- ** Generator combinators
, choose
, chooseInt
, chooseInteger
, chooseBoundedIntegral
, chooseEnum
, chooseAny
, oneof
, frequency
, elements
, growingElements
, sized
, getSize
, resize
, scale
, suchThat
, suchThatMap
, suchThatMaybe
, applyArbitrary2
, applyArbitrary3
, applyArbitrary4
-- ** Generators for lists
, listOf
, listOf1
, vectorOf
, vector
, infiniteListOf
, infiniteList
, shuffle
, sublistOf
, orderedList
-- ** Generators for particular types
, arbitrarySizedIntegral
, arbitrarySizedNatural
, arbitrarySizedFractional
, arbitrarySizedBoundedIntegral
, arbitraryBoundedIntegral
, arbitraryBoundedRandom
, arbitraryBoundedEnum
, arbitraryUnicodeChar
, arbitraryASCIIChar
, arbitraryPrintableChar
-- ** Running generators
, generate
-- ** Debugging generators
, sample
, sample'
-- * The 'Function' typeclass: generation of random shrinkable, showable functions
-- | Example of use:
--
-- >>> :{
-- >>> let prop :: Fun String Integer -> Bool
-- >>> prop (Fun _ f) = f "monkey" == f "banana" || f "banana" == f "elephant"
-- >>> :}
-- >>> quickCheck prop
-- *** Failed! Falsified (after 3 tests and 134 shrinks):
-- {"elephant"->1, "monkey"->1, _->0}
--
-- To generate random values of type @'Fun' a b@,
-- you must have an instance @'Function' a@.
-- If your type has a 'Show' instance, you can use 'functionShow' to write the instance; otherwise,
-- use 'functionMap' to give a bijection between your type and a type that is already an instance of 'Function'.
-- See the @'Function' [a]@ instance for an example of the latter.
--
-- For more information, see the paper \"Shrinking and showing functions\" by Koen Claessen.
, Fun (..)
, applyFun
, applyFun2
, applyFun3
, pattern Fn
, pattern Fn2
, pattern Fn3
, Function (..)
, functionMap
, functionShow
, functionIntegral
, functionRealFrac
, functionBoundedEnum
, functionVoid
-- * The 'CoArbitrary' typeclass: generation of functions the old-fashioned way
, CoArbitrary (..)
, genericCoarbitrary
, variant
, coarbitraryIntegral
, coarbitraryReal
, coarbitraryShow
, coarbitraryEnum
, (><)
-- * Type-level modifiers for changing generator behavior
-- | These types do things such as restricting the kind of test data that can be generated.
-- They can be pattern-matched on in properties as a stylistic
-- alternative to using explicit quantification.
--
-- Examples:
--
-- @
-- -- Functions cannot be shown (but see 'Function')
-- prop_TakeDropWhile ('Blind' p) (xs :: ['A']) =
-- takeWhile p xs ++ dropWhile p xs == xs
-- @
--
-- @
-- prop_TakeDrop ('NonNegative' n) (xs :: ['A']) =
-- take n xs ++ drop n xs == xs
-- @
--
-- @
-- -- cycle does not work for empty lists
-- prop_Cycle ('NonNegative' n) ('NonEmpty' (xs :: ['A'])) =
-- take n (cycle xs) == take n (xs ++ cycle xs)
-- @
--
-- @
-- -- Instead of 'forAll' 'orderedList'
-- prop_Sort ('Ordered' (xs :: ['OrdA'])) =
-- sort xs == xs
-- @
, Blind (..)
, Fixed (..)
, OrderedList (..)
, NonEmptyList (..)
, InfiniteList (..)
, SortedList (..)
, Positive (..)
, Negative (..)
, NonZero (..)
, NonNegative (..)
, NonPositive (..)
, Large (..)
, Small (..)
, Smart (..)
, Shrink2 (..)
, Shrinking (..)
, ShrinkState (..)
, ASCIIString (..)
, UnicodeString (..)
, PrintableString (..)
-- * Property combinators
, Property
, liftProperty
, unliftProperty
, Testable (..)
, forAll
, forAllShrink
, forAllShow
, forAllShrinkShow
, forAllBlind
, forAllShrinkBlind
, shrinking
, (==>)
, Discard (..)
, discard
, (===)
, (=/=)
, total
, effProperty
, idempotentEffProperty
-- ** Controlling property execution
, verbose
, verboseShrinking
, noShrinking
, withMaxSuccess
, within
, discardAfter
, withDiscardRatio
, withMaxSize
, withMaxShrinks
, once
, again
, mapSize
-- ** Conjunction and disjunction
, (.&.)
, (.&&.)
, conjoin
, (.||.)
, disjoin
-- ** What to do on failure
, Witness (..)
, witness
, coerceWitness
, castWitness
, counterexample
, printTestCase
, whenFail
, whenFail'
, expectFailure
-- * Analysing test case distribution
, label
, collect
, classify
, tabulate
-- ** Checking test case distribution
, cover
, coverTable
, checkCoverage
, checkCoverageWith
, Confidence (..)
, stdConfidence
-- ** Generating example test cases
, labelledExamples
, labelledExamplesWith
, labelledExamplesWithResult
, labelledExamplesResult
)
where
import Control.DeepSeq (NFData)
import Data.Functor (void)
import Data.Typeable (Typeable)
import Effectful
import Test.QuickCheck
( Witness (..)
, castWitness
, coerceWitness
, discard
, stdConfidence
)
import Test.QuickCheck qualified as QuickCheck
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Function
import Test.QuickCheck.Gen
import Test.QuickCheck.Gen.Unsafe (promote)
import Test.QuickCheck.Modifiers
import Test.QuickCheck.Property
( Discard (..)
, Prop (..)
, ioRose
, liftBool
, protectProp
, protectResults
, rejected
, succeeded
)
import Test.QuickCheck.Property qualified as Property
import Test.QuickCheck.Property qualified as QuickCheck
import Test.QuickCheck.State
import Test.QuickCheck.Test (Args (..), Result (..), isSuccess, stdArgs)
import Prelude
-- | Lifted 'QuickCheck.Property'.
newtype Property (es :: [Effect]) = Property ((forall a. Eff es a -> IO a) -> QuickCheck.Property)
liftProperty :: QuickCheck.Property -> Property es
liftProperty = Property . const
unliftProperty :: (forall a. Eff es a -> IO a) -> Property es -> QuickCheck.Property
unliftProperty unlift (Property p) = p unlift
mapProperty :: (QuickCheck.Property -> QuickCheck.Property) -> Property es -> Property es
mapProperty f (Property g) = Property $ f . g
class Testable prop es where
property :: prop -> Property es
instance (es ~ es') => Testable (Property es') es where
property = id
instance Testable Discard es where
property Discard = property @_ @es rejected
instance Testable () es where
property () = property @_ @es succeeded
instance (Testable prop es) => Testable (Maybe prop) es where
property = maybe (property @_ @es Discard) property
instance Testable Bool es where
property = property @_ @es . liftBool
instance Testable Property.Result es where
property = liftProperty . QuickCheck.MkProperty . pure . MkProp . protectResults . pure
instance Testable Prop es where
property = liftProperty . QuickCheck.MkProperty . pure . protectProp
instance (Testable prop es) => Testable (Gen prop) es where
property mp =
Property \unlift ->
QuickCheck.MkProperty do
QuickCheck.unProperty . unliftProperty unlift . property =<< mp
instance Testable QuickCheck.Property es where
property (QuickCheck.MkProperty mp) =
liftProperty . QuickCheck.MkProperty $ protectProp <$> mp
instance (Arbitrary a, Show a, Testable prop es) => Testable (a -> prop) es where
property f = Property \unlift -> QuickCheck.property (unliftProperty unlift . property . f)
instance (es ~ es', Testable a es) => Testable (Eff es' a) es where
property eff =
Property \unlift ->
QuickCheck.ioProperty $
unliftProperty unlift . property <$> unlift eff
-- | Lifted QuickCheck.ioProperty'.
effProperty :: (Testable prop es) => Eff es prop -> Property es
effProperty = idempotentEffProperty . fmap noShrinking
-- | Lifted of 'QuickCheck.idempotentIOProperty'.
idempotentEffProperty :: (Testable prop es) => Eff es prop -> Property es
idempotentEffProperty eff =
Property \unlift ->
QuickCheck.MkProperty
. fmap (MkProp . ioRose . unlift . fmap unProp)
. promote
$ QuickCheck.unProperty . unliftProperty unlift . property <$> eff
-- | Lifted 'QuickCheck.quickCheck'.
quickCheck :: (Testable prop es, IOE :> es) => prop -> Eff es ()
quickCheck = quickCheckWith stdArgs
-- | Lifted 'QuickCheck.quickCheckWith'.
quickCheckWith :: (Testable prop es, IOE :> es) => Args -> prop -> Eff es ()
quickCheckWith = (void .) . quickCheckWithResult
-- | Lifted 'QuickCheck.quickCheckResult'.
quickCheckResult :: (Testable prop es, IOE :> es) => prop -> Eff es Result
quickCheckResult = quickCheckWithResult stdArgs
-- | Lifted 'QuickCheck.quickCheckWithResult'.
quickCheckWithResult :: (Testable prop es, IOE :> es) => Args -> prop -> Eff es Result
quickCheckWithResult args prop =
withEffToIO (ConcUnlift Ephemeral Unlimited) $
QuickCheck.quickCheckWithResult args . flip unliftProperty (property prop)
-- | Lifted 'QuickCheck.recheck'.
recheck :: (Testable prop es, IOE :> es) => Result -> prop -> Eff es ()
recheck result prop =
withEffToIO (ConcUnlift Ephemeral Unlimited) $
QuickCheck.recheck result . flip unliftProperty (property prop)
-- | Lifted 'QuickCheck.verboseCheck'.
verboseCheck :: (Testable prop es, IOE :> es) => prop -> Eff es ()
verboseCheck = quickCheck . verbose
-- | Lifted 'QuickCheck.verboseCheckWith'.
verboseCheckWith :: (Testable prop es, IOE :> es) => Args -> prop -> Eff es ()
verboseCheckWith args = quickCheckWith args . verbose
-- | Lifted 'QuickCheck.verboseCheckResult'.
verboseCheckResult :: (Testable prop es, IOE :> es) => prop -> Eff es Result
verboseCheckResult = quickCheckResult . verbose
-- | Lifted 'QuickCheck.verboseCheckWithResult'.
verboseCheckWithResult :: (Testable prop es, IOE :> es) => Args -> prop -> Eff es Result
verboseCheckWithResult args = quickCheckWithResult args . verbose
-- | Lifted 'QuickCheck.noShrinking'.
noShrinking :: (Testable prop es) => prop -> Property es
noShrinking = mapProperty QuickCheck.noShrinking . property
-- | Lifted 'QuickCheck.verbose'.
verbose :: (Testable prop es) => prop -> Property es
verbose = mapProperty QuickCheck.verbose . property
-- | Lifted 'QuickCheck.verboseShrinking'.
verboseShrinking :: (Testable prop es) => prop -> Property es
verboseShrinking = mapProperty QuickCheck.verboseShrinking . property
-- | Lifted 'QuickCheck.withMaxSuccess'.
withMaxSuccess :: (Testable prop es) => Int -> prop -> Property es
withMaxSuccess n = mapProperty (QuickCheck.withMaxSuccess n) . property
-- | Lifted 'QuickCheck.withMaxSize'.
withMaxSize :: (Testable prop es) => Int -> prop -> Property es
withMaxSize n = mapProperty (QuickCheck.withMaxSize n) . property
-- | Lifted 'QuickCheck.withMaxShrinks'.
withMaxShrinks :: (Testable prop es) => Int -> prop -> Property es
withMaxShrinks n = mapProperty (QuickCheck.withMaxShrinks n) . property
-- | Lifted 'QuickCheck.withDiscardRatio'.
withDiscardRatio :: (Testable prop es) => Int -> prop -> Property es
withDiscardRatio n = mapProperty (QuickCheck.withDiscardRatio n) . property
-- | Lifted 'QuickCheck.once'.
once :: (Testable prop es) => prop -> Property es
once = mapProperty QuickCheck.once . property
-- | Lifted 'QuickCheck.again'.
again :: (Testable prop es) => prop -> Property es
again = mapProperty QuickCheck.again . property
-- | Lifted 'QuickCheck.expectFailure'.
expectFailure :: (Testable prop es) => prop -> Property es
expectFailure = mapProperty QuickCheck.expectFailure . property
-- | Lifted 'QuickCheck.within'.
within :: (Testable prop es) => Int -> prop -> Property es
within n = mapProperty (QuickCheck.within n) . property
-- | Lifted 'QuickCheck.discardAfter'.
discardAfter :: (Testable prop es) => Int -> prop -> Property es
discardAfter n = mapProperty (QuickCheck.discardAfter n) . property
-- | Lifted 'QuickCheck.checkCoverage'.
checkCoverage :: (Testable prop es) => prop -> Property es
checkCoverage = mapProperty QuickCheck.checkCoverage . property
-- | Lifted 'QuickCheck.checkCoverageWith'.
checkCoverageWith :: (Testable prop es) => Confidence -> prop -> Property es
checkCoverageWith c = mapProperty (QuickCheck.checkCoverageWith c) . property
-- | Lifted 'QuickCheck.mapSize'.
mapSize :: (Testable prop es) => (Int -> Int) -> prop -> Property es
mapSize f = mapProperty (QuickCheck.mapSize f) . property
-- | Lifted 'QuickCheck.counterexample'.
counterexample :: (Testable prop es) => String -> prop -> Property es
counterexample s = mapProperty (QuickCheck.counterexample s) . property
-- | Lifted 'QuickCheck.printTestCase'.
printTestCase :: (Testable prop es) => String -> prop -> Property es
printTestCase s = mapProperty (QuickCheck.printTestCase s) . property
-- | Lifted 'QuickCheck.label'.
label :: (Testable prop es) => String -> prop -> Property es
label s = mapProperty (QuickCheck.label s) . property
-- | Lifted 'QuickCheck.collect'.
collect :: (Show a, Testable prop es) => a -> prop -> Property es
collect x = mapProperty (QuickCheck.collect x) . property
-- | Lifted 'QuickCheck.classify'.
classify :: (Testable prop es) => Bool -> String -> prop -> Property es
classify b s = mapProperty (QuickCheck.classify b s) . property
-- | Lifted 'QuickCheck.tabulate'.
tabulate :: (Testable prop es) => String -> [String] -> prop -> Property es
tabulate key vals = mapProperty (QuickCheck.tabulate key vals) . property
-- | Lifted 'QuickCheck.cover'.
cover :: (Testable prop es) => Double -> Bool -> String -> prop -> Property es
cover p b s = mapProperty (QuickCheck.cover p b s) . property
-- | Lifted 'QuickCheck.coverTable'.
coverTable :: (Testable prop es) => String -> [(String, Double)] -> prop -> Property es
coverTable key tab = mapProperty (QuickCheck.coverTable key tab) . property
-- | Lifted 'QuickCheck.witness'.
witness :: (Typeable a, Show a, Testable prop es) => a -> prop -> Property es
witness x = mapProperty (QuickCheck.witness x) . property
-- | Lifted 'QuickCheck.total'.
total :: (NFData a) => a -> Property es
total = liftProperty . QuickCheck.total
-- | Lifted 'QuickCheck.forAll'.
forAll :: (Show a, Testable prop es) => Gen a -> (a -> prop) -> Property es
forAll gen pf =
Property \unlift -> QuickCheck.forAll gen (unliftProperty unlift . property . pf)
-- | Lifted 'QuickCheck.forAllShrink'.
forAllShrink :: (Show a, Testable prop es) => Gen a -> (a -> [a]) -> (a -> prop) -> Property es
forAllShrink gen shr pf =
Property \unlift -> QuickCheck.forAllShrink gen shr (unliftProperty unlift . property . pf)
-- | Lifted 'QuickCheck.forAllShow'.
forAllShow :: (Testable prop es) => Gen a -> (a -> String) -> (a -> prop) -> Property es
forAllShow gen shower pf =
Property \unlift -> QuickCheck.forAllShow gen shower (unliftProperty unlift . property . pf)
-- | Lifted 'QuickCheck.forAllShrinkShow'.
forAllShrinkShow
:: (Testable prop es)
=> Gen a
-> (a -> [a])
-> (a -> String)
-> (a -> prop)
-> Property es
forAllShrinkShow gen shr shower pf =
Property \unlift ->
QuickCheck.forAllShrinkShow gen shr shower (unliftProperty unlift . property . pf)
-- | Lifted 'QuickCheck.forAllBlind'.
forAllBlind :: (Testable prop es) => Gen a -> (a -> prop) -> Property es
forAllBlind gen pf =
Property \unlift -> QuickCheck.forAllBlind gen (unliftProperty unlift . property . pf)
-- | Lifted 'QuickCheck.forAllShrinkBlind'.
forAllShrinkBlind :: (Testable prop es) => Gen a -> (a -> [a]) -> (a -> prop) -> Property es
forAllShrinkBlind gen shr pf =
Property \unlift ->
QuickCheck.forAllShrinkBlind gen shr (unliftProperty unlift . property . pf)
-- | Lifted 'QuickCheck.shrinking'.
shrinking :: (Testable prop es) => (a -> [a]) -> a -> (a -> prop) -> Property es
shrinking shr x pf =
Property \unlift -> QuickCheck.shrinking shr x (unliftProperty unlift . property . pf)
-- | Lifted 'QuickCheck.==>'.
(==>) :: (Testable prop es) => Bool -> prop -> Property es
b ==> p = Property \unlift -> b QuickCheck.==> unliftProperty unlift (property p)
infixr 0 ==>
-- | Lifted 'QuickCheck.whenFail'.
whenFail :: (Testable prop es) => Eff es () -> prop -> Property es
whenFail m p =
Property \unlift -> QuickCheck.whenFail (unlift m) (unliftProperty unlift (property p))
-- | Lifted 'QuickCheck.whenFail\''.
whenFail' :: (Testable prop es) => Eff es () -> prop -> Property es
whenFail' m p =
Property \unlift -> QuickCheck.whenFail' (unlift m) (unliftProperty unlift (property p))
-- | Lifted 'QuickCheck..&.'.
(.&.) :: (Testable p1 es, Testable p2 es) => p1 -> p2 -> Property es
p1 .&. p2 =
Property \unlift ->
unliftProperty unlift (property p1) QuickCheck..&. unliftProperty unlift (property p2)
infixr 1 .&.
-- | Lifted 'QuickCheck..&&.'.
(.&&.) :: (Testable p1 es, Testable p2 es) => p1 -> p2 -> Property es
p1 .&&. p2 =
Property \unlift ->
unliftProperty unlift (property p1) QuickCheck..&&. unliftProperty unlift (property p2)
infixr 1 .&&.
-- | Lifted 'QuickCheck..||.'.
(.||.) :: (Testable p1 es, Testable p2 es) => p1 -> p2 -> Property es
p1 .||. p2 =
Property \unlift ->
unliftProperty unlift (property p1) QuickCheck..||. unliftProperty unlift (property p2)
infixr 1 .||.
-- | Lifted 'QuickCheck.==='.
(===) :: (Eq a, Show a) => a -> a -> Property es
x === y = liftProperty (x QuickCheck.=== y)
infix 4 ===
-- | Lifted 'QuickCheck.=/='.
(=/=) :: (Eq a, Show a) => a -> a -> Property es
x =/= y = liftProperty (x QuickCheck.=/= y)
infix 4 =/=
-- | Lifted 'QuickCheck.conjoin'.
conjoin :: (Testable prop es) => [prop] -> Property es
conjoin ps = Property \unlift -> QuickCheck.conjoin $ unliftProperty unlift . property <$> ps
-- | Lifted 'QuickCheck.disjoin'.
disjoin :: (Testable prop es) => [prop] -> Property es
disjoin ps = Property \unlift -> QuickCheck.disjoin $ unliftProperty unlift . property <$> ps
-- | Lifted 'QuickCheck.labelledExamples'.
labelledExamples :: (Testable prop es, IOE :> es) => prop -> Eff es ()
labelledExamples = labelledExamplesWith stdArgs
-- | Lifted 'QuickCheck.labelledExamplesWith'.
labelledExamplesWith :: (Testable prop es, IOE :> es) => Args -> prop -> Eff es ()
labelledExamplesWith = (void .) . labelledExamplesWithResult
-- | Lifted 'QuickCheck.labelledExamplesResult'.
labelledExamplesResult :: (Testable prop es, IOE :> es) => prop -> Eff es Result
labelledExamplesResult = labelledExamplesWithResult stdArgs
-- | Lifted 'QuickCheck.labelledExamplesWithResult'.
labelledExamplesWithResult :: (Testable prop es, IOE :> es) => Args -> prop -> Eff es Result
labelledExamplesWithResult args prop =
withEffToIO (ConcUnlift Ephemeral Unlimited) $
QuickCheck.labelledExamplesWithResult args . flip unliftProperty (property prop)