falsify 0.1.1 → 0.2.0
raw patch · 16 files changed
+381/−82 lines, 16 filesdep ~QuickCheckdep ~basedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: QuickCheck, base, bytestring, containers, data-default, optparse-applicative, tasty
API changes (from Hackage documentation)
+ Test.Falsify.GenDefault: ViaEnum :: a -> ViaEnum a
+ Test.Falsify.GenDefault: ViaGeneric :: a -> ViaGeneric tag a
+ Test.Falsify.GenDefault: ViaIntegral :: a -> ViaIntegral a
+ Test.Falsify.GenDefault: ViaList :: l -> ViaList l (mn :: Nat) (mx :: Nat)
+ Test.Falsify.GenDefault: ViaString :: s -> ViaString s (mn :: Nat) (mx :: Nat)
+ Test.Falsify.GenDefault: ViaTag :: a -> ViaTag tag' a
+ Test.Falsify.GenDefault: [unViaEnum] :: ViaEnum a -> a
+ Test.Falsify.GenDefault: [unViaGeneric] :: ViaGeneric tag a -> a
+ Test.Falsify.GenDefault: [unViaIntegral] :: ViaIntegral a -> a
+ Test.Falsify.GenDefault: [unViaList] :: ViaList l (mn :: Nat) (mx :: Nat) -> l
+ Test.Falsify.GenDefault: [unViaString] :: ViaString s (mn :: Nat) (mx :: Nat) -> s
+ Test.Falsify.GenDefault: [unViaTag] :: ViaTag tag' a -> a
+ Test.Falsify.GenDefault: class GenDefault tag a
+ Test.Falsify.GenDefault: genDefault :: GenDefault tag a => Proxy tag -> Gen a
+ Test.Falsify.GenDefault: instance (Data.String.IsString s, Test.Falsify.GenDefault.GenDefault tag GHC.Types.Char, GHC.TypeNats.KnownNat mn, GHC.TypeNats.KnownNat mx) => Test.Falsify.GenDefault.GenDefault tag (Test.Falsify.GenDefault.ViaString s mn mx)
+ Test.Falsify.GenDefault: instance (GHC.Enum.Enum a, GHC.Enum.Bounded a) => Test.Falsify.GenDefault.GenDefault tag (Test.Falsify.GenDefault.ViaEnum a)
+ Test.Falsify.GenDefault: instance (GHC.Exts.IsList l, Test.Falsify.GenDefault.GenDefault tag (GHC.Exts.Item l), GHC.TypeNats.KnownNat mn, GHC.TypeNats.KnownNat mx) => Test.Falsify.GenDefault.GenDefault tag (Test.Falsify.GenDefault.ViaList l mn mx)
+ Test.Falsify.GenDefault: instance (GHC.Generics.Generic t, Test.Falsify.GenDefault.GGenDefault tag (GHC.Generics.Rep t)) => Test.Falsify.GenDefault.GenDefault tag (Test.Falsify.GenDefault.ViaGeneric tag t)
+ Test.Falsify.GenDefault: instance (GHC.Real.Integral a, GHC.Bits.FiniteBits a, GHC.Enum.Bounded a) => Test.Falsify.GenDefault.GenDefault tag (Test.Falsify.GenDefault.ViaIntegral a)
+ Test.Falsify.GenDefault: instance (Test.Falsify.GenDefault.GGenDefault tag a, Test.Falsify.GenDefault.GGenDefault tag b) => Test.Falsify.GenDefault.GGenDefault tag (a GHC.Generics.:*: b)
+ Test.Falsify.GenDefault: instance (Test.Falsify.GenDefault.GGenDefault tag a, Test.Falsify.GenDefault.GGenDefault tag b) => Test.Falsify.GenDefault.GGenDefault tag (a GHC.Generics.:+: b)
+ Test.Falsify.GenDefault: instance Test.Falsify.GenDefault.GGenDefault tag GHC.Generics.U1
+ Test.Falsify.GenDefault: instance Test.Falsify.GenDefault.GGenDefault tag a => Test.Falsify.GenDefault.GGenDefault tag (GHC.Generics.M1 i c a)
+ Test.Falsify.GenDefault: instance Test.Falsify.GenDefault.GenDefault tag a => Test.Falsify.GenDefault.GGenDefault tag (GHC.Generics.K1 i a)
+ Test.Falsify.GenDefault: instance Test.Falsify.GenDefault.GenDefault tag' a => Test.Falsify.GenDefault.GenDefault tag (Test.Falsify.GenDefault.ViaTag tag' a)
+ Test.Falsify.GenDefault: newtype ViaEnum a
+ Test.Falsify.GenDefault: newtype ViaGeneric tag a
+ Test.Falsify.GenDefault: newtype ViaIntegral a
+ Test.Falsify.GenDefault: newtype ViaList l (mn :: Nat) (mx :: Nat)
+ Test.Falsify.GenDefault: newtype ViaString s (mn :: Nat) (mx :: Nat)
+ Test.Falsify.GenDefault: newtype ViaTag tag' a
+ Test.Falsify.GenDefault.Std: data Std
+ Test.Falsify.GenDefault.Std: instance (Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std a, Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std b) => Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std (Data.Either.Either a b)
+ Test.Falsify.GenDefault.Std: instance (Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std a, Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std b) => Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std (a, b)
+ Test.Falsify.GenDefault.Std: instance (Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std a, Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std b, Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std c) => Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std (a, b, c)
+ Test.Falsify.GenDefault.Std: instance (Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std a, Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std b, Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std c, Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std d) => Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std (a, b, c, d)
+ Test.Falsify.GenDefault.Std: instance (Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std a, Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std b, Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std c, Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std d, Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std e) => Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std (a, b, c, d, e)
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std ()
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std GHC.Int.Int16
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std GHC.Int.Int32
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std GHC.Int.Int64
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std GHC.Int.Int8
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std GHC.Types.Bool
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std GHC.Types.Char
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std GHC.Types.Int
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std GHC.Types.Word
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std GHC.Word.Word16
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std GHC.Word.Word32
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std GHC.Word.Word64
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std GHC.Word.Word8
+ Test.Falsify.GenDefault.Std: instance Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std a => Test.Falsify.GenDefault.GenDefault Test.Falsify.GenDefault.Std.Std (GHC.Maybe.Maybe a)
+ Test.Falsify.Generator: inRange :: Range a -> Gen a
+ Test.Falsify.Generator: oneof :: NonEmpty (Gen a) -> Gen a
+ Test.Falsify.Range: enum :: Enum a => (a, a) -> Range a
- Test.Falsify.Generator: enum :: forall a. Enum a => Range a -> Gen a
+ Test.Falsify.Generator: enum :: Range a -> Gen a
- Test.Falsify.Generator: integral :: Integral a => Range a -> Gen a
+ Test.Falsify.Generator: integral :: Range a -> Gen a
- Test.Falsify.Predicate: at :: Predicate (x : xs) -> (Expr, String, x) -> Predicate xs
+ Test.Falsify.Predicate: at :: Predicate (x : xs) -> (Var, String, x) -> Predicate xs
- Test.Falsify.Range: eval :: forall f a. (Applicative f, Ord a, Num a) => (Precision -> f ProperFraction) -> Range a -> f a
+ Test.Falsify.Range: eval :: forall f a. Applicative f => (Precision -> f ProperFraction) -> Range a -> f a
- Test.Falsify.Range: towards :: a -> [Range a] -> Range a
+ Test.Falsify.Range: towards :: forall a. (Ord a, Num a) => a -> [Range a] -> Range a
Files
- CHANGELOG.md +10/−0
- falsify.cabal +8/−7
- src/Test/Falsify/GenDefault.hs +91/−0
- src/Test/Falsify/GenDefault/Std.hs +57/−0
- src/Test/Falsify/Generator.hs +3/−1
- src/Test/Falsify/Internal/Range.hs +19/−6
- src/Test/Falsify/Predicate.hs +17/−7
- src/Test/Falsify/Range.hs +31/−26
- src/Test/Falsify/Reexported/Generator/Compound.hs +16/−9
- src/Test/Falsify/Reexported/Generator/Simple.hs +17/−12
- test/Main.hs +3/−0
- test/TestSuite/GenDefault.hs +80/−0
- test/TestSuite/Prop/Generator/Compound.hs +5/−5
- test/TestSuite/Prop/Generator/Function.hs +1/−1
- test/TestSuite/Prop/Generator/Simple.hs +22/−7
- test/TestSuite/Sanity/Range.hs +1/−1
CHANGELOG.md view
@@ -1,5 +1,15 @@ # Revision history for falsify +## 0.2.0 -- 2023-11-08++* Avoid use of `Expr` in `at` (#48)+* Add `oneof` (#54; Simon Kohlmeyer)+* Generalize `Range`, so that it can be used for types like `Char` (#51).+ As a consequence, `Gen.integral` and `Gen.enum` are now deprecated, and+ superseded by `Gen.inRange`.+* Add `GenDefault` class and `DerivingVia` helpers to derive generators+ (Eric Conlon; #61, #64).+ ## 0.1.1 -- 2023-04-07 * Better verbose mode for test failures
falsify.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: falsify-version: 0.1.1+version: 0.2.0 synopsis: Property-based testing with internal integrated shrinking description: This library provides property based testing with support for internal integrated shrinking: integrated in the sense@@ -25,13 +25,11 @@ category: Testing build-type: Simple extra-doc-files: CHANGELOG.md-tested-with: GHC==8.6.5- , GHC==8.8.4- , GHC==8.10.7+tested-with: GHC==8.10.7 , GHC==9.0.2- , GHC==9.2.5- , GHC==9.4.4- , GHC==9.6.1+ , GHC==9.2.8+ , GHC==9.4.7+ , GHC==9.6.3 source-repository head type: git@@ -83,6 +81,8 @@ import: lang exposed-modules:+ Test.Falsify.GenDefault+ Test.Falsify.GenDefault.Std Test.Falsify.Generator Test.Falsify.Interactive Test.Falsify.Predicate@@ -144,6 +144,7 @@ main-is: Main.hs other-modules:+ TestSuite.GenDefault TestSuite.Sanity.Predicate TestSuite.Sanity.Range TestSuite.Sanity.Selective
+ src/Test/Falsify/GenDefault.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE UndecidableInstances #-}++-- | This module defines something similar to QuickCheck's Arbitrary class along with+-- some DerivingVia helpers. Our version, 'GenDefault', allows one to choose between+-- sets of default generators with a user-defined tag. See 'Test.Falsify.GenDefault.Std' for+-- the standard tag with a few useful instances.+module Test.Falsify.GenDefault+ ( GenDefault (..)+ , ViaTag (..)+ , ViaIntegral (..)+ , ViaEnum (..)+ , ViaList (..)+ , ViaString (..)+ , ViaGeneric (..)+ ) where++import Control.Applicative (liftA2)+import Data.Proxy (Proxy (..))+import GHC.Generics (Generic (..), K1 (..), M1 (..), U1 (..), (:+:) (..), (:*:) (..))+import Test.Falsify.Generator (Gen)+import qualified Test.Falsify.Generator as Gen+import qualified Test.Falsify.Range as Range+import Data.Bits (FiniteBits)+import GHC.Exts (IsList (..), IsString (..))+import GHC.TypeLits (KnownNat, natVal, Nat)++class GenDefault tag a where+ -- | Default generator for @a@+ --+ -- The type-level @tag@ allows types @a@ to have multiple defaults.+ genDefault :: Proxy tag -> Gen a++-- | DerivingVia wrapper for types with default instances under other tags+newtype ViaTag tag' a = ViaTag {unViaTag :: a}++instance GenDefault tag' a => GenDefault tag (ViaTag tag' a) where+ genDefault _ = fmap ViaTag (genDefault @tag' Proxy)++-- | DerivingVia wrapper for Integral types+newtype ViaIntegral a = ViaIntegral {unViaIntegral :: a}++instance (Integral a, FiniteBits a, Bounded a) => GenDefault tag (ViaIntegral a) where+ genDefault _ = fmap ViaIntegral (Gen.inRange (Range.between (minBound, maxBound)))++-- | DerivingVia wrapper for Enum types+newtype ViaEnum a = ViaEnum {unViaEnum :: a}++instance (Enum a, Bounded a) => GenDefault tag (ViaEnum a) where+ genDefault _ = fmap ViaEnum (Gen.inRange (Range.enum (minBound, maxBound)))++-- | DerivingVia wrapper for FromList types+newtype ViaList l (mn :: Nat) (mx :: Nat) = ViaList {unViaList :: l}++instance (IsList l, GenDefault tag (Item l), KnownNat mn, KnownNat mx) => GenDefault tag (ViaList l mn mx) where+ genDefault p =+ let bn = fromInteger (natVal (Proxy @mn))+ bx = fromInteger (natVal (Proxy @mx))+ in fmap (ViaList . fromList) (Gen.list (Range.between (bn, bx)) (genDefault p))++-- | DerivingVia wrapper for FromString types+newtype ViaString s (mn :: Nat) (mx :: Nat) = ViaString {unViaString :: s}++instance (IsString s, GenDefault tag Char, KnownNat mn, KnownNat mx) => GenDefault tag (ViaString s mn mx) where+ genDefault p =+ let bn = fromInteger (natVal (Proxy @mn))+ bx = fromInteger (natVal (Proxy @mx))+ in fmap (ViaString . fromString) (Gen.list (Range.between (bn, bx)) (genDefault p))++class GGenDefault tag f where+ ggenDefault :: Proxy tag -> Gen (f a)++instance GGenDefault tag U1 where+ ggenDefault _ = pure U1++instance GGenDefault tag a => GGenDefault tag (M1 i c a) where+ ggenDefault = fmap M1 . ggenDefault++instance (GGenDefault tag a, GGenDefault tag b) => GGenDefault tag (a :*: b) where+ ggenDefault p = liftA2 (:*:) (ggenDefault p) (ggenDefault p)++instance (GGenDefault tag a, GGenDefault tag b) => GGenDefault tag (a :+: b) where+ ggenDefault p = Gen.choose (fmap L1 (ggenDefault p)) (fmap R1 (ggenDefault p))++instance GenDefault tag a => GGenDefault tag (K1 i a) where+ ggenDefault = fmap K1 . genDefault++-- | DerivingVia wrapper for Generic types+newtype ViaGeneric tag a = ViaGeneric {unViaGeneric :: a}++instance (Generic t, GGenDefault tag (Rep t)) => GenDefault tag (ViaGeneric tag t) where+ genDefault = fmap (ViaGeneric . to) . ggenDefault
+ src/Test/Falsify/GenDefault/Std.hs view
@@ -0,0 +1,57 @@+module Test.Falsify.GenDefault.Std+ ( Std+ ) where++import Test.Falsify.GenDefault (ViaIntegral (..), GenDefault, ViaEnum (..), ViaGeneric (..))+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word8, Word16, Word32, Word64)++-- | Type tag for these "standard" default generators.+-- You can use this tag directly or choose type-by-type with 'ViaTag'.+data Std++deriving via (ViaEnum ()) instance GenDefault Std ()+deriving via (ViaEnum Bool) instance GenDefault Std Bool+deriving via (ViaEnum Char) instance GenDefault Std Char++deriving via (ViaIntegral Int) instance GenDefault Std Int+deriving via (ViaIntegral Int8) instance GenDefault Std Int8+deriving via (ViaIntegral Int16) instance GenDefault Std Int16+deriving via (ViaIntegral Int32) instance GenDefault Std Int32+deriving via (ViaIntegral Int64) instance GenDefault Std Int64++deriving via (ViaIntegral Word) instance GenDefault Std Word+deriving via (ViaIntegral Word8) instance GenDefault Std Word8+deriving via (ViaIntegral Word16) instance GenDefault Std Word16+deriving via (ViaIntegral Word32) instance GenDefault Std Word32+deriving via (ViaIntegral Word64) instance GenDefault Std Word64++deriving via (ViaGeneric Std (Maybe a))+ instance GenDefault Std a => GenDefault Std (Maybe a)++deriving via (ViaGeneric Std (Either a b))+ instance (GenDefault Std a, GenDefault Std b) => GenDefault Std (Either a b)++deriving via+ (ViaGeneric Std (a, b))+ instance+ (GenDefault Std a, GenDefault Std b)+ => GenDefault Std (a, b)++deriving via+ (ViaGeneric Std (a, b, c))+ instance+ (GenDefault Std a, GenDefault Std b, GenDefault Std c)+ => GenDefault Std (a, b, c)++deriving via+ (ViaGeneric Std (a, b, c, d))+ instance+ (GenDefault Std a, GenDefault Std b, GenDefault Std c, GenDefault Std d)+ => GenDefault Std (a, b, c, d)++deriving via+ (ViaGeneric Std (a, b, c, d, e))+ instance+ (GenDefault Std a, GenDefault Std b, GenDefault Std c, GenDefault Std d, GenDefault Std e)+ => GenDefault Std (a, b, c, d, e)
src/Test/Falsify/Generator.hs view
@@ -9,12 +9,14 @@ Gen -- opaque -- * Simple (non-compound) generators , bool+ , inRange , integral- , int , enum+ , int -- * Compound generators -- ** Taking advantage of 'Selective' , choose+ , oneof -- ** Lists , list , elem
src/Test/Falsify/Internal/Range.hs view
@@ -6,12 +6,13 @@ , Precision(..) ) where +import Data.List.NonEmpty (NonEmpty) import Data.Word import GHC.Show import GHC.Stack {-------------------------------------------------------------------------------- Proper frations+ Proper fractions -------------------------------------------------------------------------------} -- | Value @x@ such that @0 <= x < 1@@@ -51,8 +52,20 @@ -------------------------------------------------------------------------------} -- | Range of values-data Range a =- Constant a- | FromProperFraction Precision (ProperFraction -> a)- | Towards a [Range a]- deriving stock (Functor)+data Range a where+ -- | Constant (point) range+ Constant :: a -> Range a++ -- | Construct values in the range from a 'ProperFraction'+ --+ -- This is the main constructor for 'Range'.+ FromProperFraction :: Precision -> (ProperFraction -> a) -> Range a++ -- | Evaluate each range and choose the \"smallest\"+ --+ -- Each value in the range is annotated with some distance metric; for+ -- example, this could be the distance to some predefined point (e.g. as in+ -- 'Test.Falsify.Range.towards')+ Smallest :: Ord b => NonEmpty (Range (a, b)) -> Range a++deriving stock instance Functor Range
src/Test/Falsify/Predicate.hs view
@@ -495,15 +495,25 @@ -- > .$ ("x", x) -- > .$ ("y", y) (.$) :: Show x => Predicate (x : xs) -> (Var, x) -> Predicate xs-p .$ (n, x) = p `at` (Var n, show x, x)+p .$ (n, x) = p `at` (n, show x, x) --- | Generation of '(.$)' that does not require a 'Show' instance+-- | Generalization of '(.$)' that does not require a 'Show' instance at :: Predicate (x : xs)- -> (Expr, String, x) -- ^ Renderded name, expression, and input proper+ -> (Var, String, x) -- ^ Rendered name, expression, and input proper -> Predicate xs-p `at` (e, r, x) = p `At` (Input e r x)+p `at` (n, r, x) = p `atExpr` (Var n, r, x) +-- | Generalization of 'at' for an arbitrary 'Expr'+--+-- This is not currently part of the public API, since we haven't yet decided+-- how exactly we want to expose 'Expr' (if at all).+atExpr ::+ Predicate (x : xs)+ -> (Expr, String, x) -- ^ Rendered name, expression, and input proper+ -> Predicate xs+p `atExpr` (e, r, x) = p `At` (Input e r x)+ {------------------------------------------------------------------------------- Specific predicates -------------------------------------------------------------------------------}@@ -590,7 +600,7 @@ pred :: Expr -> (Word, a) -> (Word, a) -> Predicate '[] pred xs (i, x) (j, y) =- p- `at` (Infix "!!" xs (Var $ show i), show x, x)- `at` (Infix "!!" xs (Var $ show j), show y, y)+ p+ `atExpr` (Infix "!!" xs (Var $ show i), show x, x)+ `atExpr` (Infix "!!" xs (Var $ show j), show y, y)
src/Test/Falsify/Range.hs view
@@ -4,6 +4,7 @@ -- * Constructors -- ** Linear , between+ , enum , withOrigin -- ** Non-linear , skewedBy@@ -19,11 +20,14 @@ , eval ) where -import Data.List (minimumBy)+import Data.Bits+import Data.List.NonEmpty (NonEmpty(..)) import Data.Ord +import qualified Data.List.NonEmpty as NE+ import Test.Falsify.Internal.Range-import Data.Bits+import Data.Functor.Identity {------------------------------------------------------------------------------- Primitive ranges@@ -46,9 +50,18 @@ -- that is closest to the specified origin -- -- Precondition: the target must be within the bounds of all ranges.-towards :: a -> [Range a] -> Range a-towards = Towards+towards :: forall a. (Ord a, Num a) => a -> [Range a] -> Range a+towards o [] = Constant o+towards o (r:rs) = Smallest $ fmap aux (r :| rs)+ where+ aux :: Range a -> Range (a, a)+ aux = fmap $ \x -> (x, distanceToOrigin x) + distanceToOrigin :: a -> a+ distanceToOrigin x+ | x >= o = x - o+ | otherwise = o - x+ {------------------------------------------------------------------------------- Constructing ranges -------------------------------------------------------------------------------}@@ -57,6 +70,13 @@ between :: forall a. (Integral a, FiniteBits a) => (a, a) -> Range a between = skewedBy 0 +-- | Variation on 'between' for types that are 'Enum' but not 'Integral'+--+-- This is useful for types such as 'Char'. However, since this relies on+-- 'Enum', it's limited by the precision of 'Int'.+enum :: Enum a => (a, a) -> Range a+enum (x, y) = toEnum <$> between (fromEnum x, fromEnum y)+ -- | Selection within the given bounds, shrinking towards the specified origin -- -- All else being equal, prefers values in the /second/ half of the range@@ -254,41 +274,26 @@ -- | Origin of the range (value we shrink towards) origin :: Range a -> a-origin (Constant x) = x-origin (FromProperFraction _ f) = f (ProperFraction 0)-origin (Towards o _) = o+origin = runIdentity . eval (\_precision -> Identity $ ProperFraction 0) {------------------------------------------------------------------------------- Evaluation -------------------------------------------------------------------------------} --- | Internal auxiliary for 'eval'-evalTowards :: forall f a.- (Applicative f, Ord a, Num a)- => a -> [f a] -> f a-evalTowards o gens =- pick <$> sequenceA gens- where- pick :: [a] -> a- pick [] = o- pick as = minimumBy (comparing distanceToOrigin) as-- distanceToOrigin :: a -> a- distanceToOrigin x- | x >= o = x - o- | otherwise = o - x- -- | Evaluate a range, given an action to generate fractions -- -- Most users will probably never need to call this function. eval :: forall f a.- (Applicative f, Ord a, Num a)+ Applicative f => (Precision -> f ProperFraction) -> Range a -> f a eval genFraction = go where- go :: Range a -> f a+ go :: forall x. Range x -> f x go r = case r of Constant x -> pure x FromProperFraction p f -> f <$> genFraction p- Towards o rs -> evalTowards o (map go rs)+ Smallest rs -> smallest <$> sequenceA (fmap go rs)++ smallest :: Ord b => NonEmpty (x, b) -> x+ smallest = fst . NE.head . NE.sortBy (comparing snd)
src/Test/Falsify/Reexported/Generator/Compound.hs view
@@ -2,6 +2,7 @@ module Test.Falsify.Reexported.Generator.Compound ( -- * Taking advantage of 'Selective' choose+ , oneof -- * Lists , list , elem@@ -103,6 +104,12 @@ choose :: Gen a -> Gen a -> Gen a choose = ifS (bool True) +-- | Generate a value with one of many generators+--+-- Uniformly selects a generator and shrinks towards the first one.+oneof :: NonEmpty (Gen a) -> Gen a+oneof gens = frequency $ map (1,) $ NE.toList gens+ {------------------------------------------------------------------------------- Auxiliary: marking elements -------------------------------------------------------------------------------}@@ -143,7 +150,7 @@ -- nonetheless it might result in confusing intermediate shrinking steps. list :: Range Word -> Gen a -> Gen [a] list len gen = do- -- We do /NOT/ mark this call to 'integral' as 'withoutShrinking': it could+ -- We do /NOT/ mark this call to 'inRange' as 'withoutShrinking': it could -- shrink towards larger values, in which case we really need to generate -- more elements. This doesn't really have any downsides: it merely means -- that we would prefer to shrink towards a prefix of the list first, before@@ -153,7 +160,7 @@ -- lists will be shrunk independently from each other due to the branching -- point above them. Hence, it doesn't matter if first generator uses "fewer -- samples" as it shrinks.- n <- integral len+ n <- inRange len -- Generate @n@ marks, indicating for each element if we want to keep that -- element or not, so that we can drop elements from the middle of the list.@@ -180,7 +187,7 @@ pick :: NonEmpty a -> Gen ([a], a, [a]) pick = \xs -> aux [] (NE.toList xs) <$>- integral (Range.between (0, length xs - 1))+ inRange (Range.between (0, length xs - 1)) where aux :: [a] -> [a] -> Int -> ([a], a, [a]) aux _ [] _ = error "pick: impossible"@@ -250,11 +257,11 @@ gens' -> do let r :: Range Word r = Range.between (0, sum (map fst gens') - 1)- (gen, genIx) <- (\i -> frequencyLookup i gens') <$> integral r+ (gen, genIx) <- (\i -> frequencyLookup i gens') <$> inRange r perturb genIx gen where -- We need to be careful: we don't want to perturb the generator by the- -- value generated by 'integral', because many different values could+ -- value generated by 'inRange', because many different values could -- correspond to the /same/ generator. Instead, we assign each generator its -- own index, and use that instead. indexedGens :: [(Word, (Gen a, Word))]@@ -321,8 +328,8 @@ where genSwap :: Word -> Gen (Word, Word) genSwap i = do- i' <- integral $ Range.between (1, i)- j <- integral $ Range.between (i, 0)+ i' <- inRange $ Range.between (1, i)+ j <- inRange $ Range.between (i, 0) return (i', min i' j) {-------------------------------------------------------------------------------@@ -332,7 +339,7 @@ -- | Generate binary tree tree :: forall a. Range Word -> Gen a -> Gen (Tree a) tree size gen = do- n <- integral size+ n <- inRange size t <- Tree.keepAtLeast (Range.origin size) . Tree.propagate <$> go n Tree.genKept t where@@ -346,7 +353,7 @@ -- -- This ranges from none (right-biased) to all (left-biased), shrinking -- towards half the number of elements: hence, towards a balanced tree.- inLeft <- integral $ Range.withOrigin (0, n - 1) ((n - 1) `div` 2)+ inLeft <- inRange $ Range.withOrigin (0, n - 1) ((n - 1) `div` 2) let inRight = (n - 1) - inLeft Branch x <$> go inLeft <*> go inRight
src/Test/Falsify/Reexported/Generator/Simple.hs view
@@ -1,9 +1,10 @@ -- | Simple (i.e., non-compound) generators module Test.Falsify.Reexported.Generator.Simple ( bool+ , inRange , integral- , int , enum+ , int ) where import Prelude hiding (properFraction)@@ -43,17 +44,21 @@ Integral ranges -------------------------------------------------------------------------------} --- | Generate value of integral type-integral :: Integral a => Range a -> Gen a-integral r = Range.eval properFraction r+-- | Generate value in the specified range+inRange :: Range a -> Gen a+inRange r = Range.eval properFraction r --- | Type-specialization of 'integral'+-- | Deprecated alias for 'inRange'+integral :: Range a -> Gen a+{-# DEPRECATED integral "Use inRange instead" #-}+integral = inRange++-- | Deprecated alias for 'inRange'+enum :: Range a -> Gen a+{-# DEPRECATED enum "Use inRange instead" #-}+enum = inRange++-- | Type-specialization of 'inRange' int :: Range Int -> Gen Int-int = integral+int = inRange --- | Generate value of enumerable type------ For most types 'integral' is preferred; the 'Enum' class goes through 'Int',--- and is therefore also limited by the range of 'Int'.-enum :: forall a. Enum a => Range a -> Gen a-enum r = toEnum <$> integral (fromEnum <$> r)
test/Main.hs view
@@ -2,6 +2,8 @@ import Test.Tasty +import qualified TestSuite.GenDefault+ import qualified TestSuite.Sanity.Predicate import qualified TestSuite.Sanity.Range import qualified TestSuite.Sanity.Selective@@ -32,4 +34,5 @@ , TestSuite.Prop.Generator.Compound.tests , TestSuite.Prop.Generator.Function.tests ]+ , TestSuite.GenDefault.tests ]
+ test/TestSuite/GenDefault.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-}++-- | We test the 'GenDefault' machinery by defining a tag, deriving some 'GenDefault'+-- instances, and asserting that the derived generators yield more than one distinct+-- value.+module TestSuite.GenDefault (tests) where++import Data.Proxy (Proxy (..))+import qualified Data.Set as Set+import GHC.Exts (IsList, IsString)+import GHC.Generics (Generic)+import qualified Test.Falsify.GenDefault as FD+import qualified Test.Falsify.GenDefault.Std as FDS+import qualified Test.Falsify.Generator as FG+import qualified Test.Falsify.Interactive as FI+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, testCase)+import Control.Monad (replicateM)++data Tag++-- Exercise ViaTag++deriving via (FD.ViaTag FDS.Std Int) instance FD.GenDefault Tag Int+deriving via (FD.ViaTag FDS.Std Char) instance FD.GenDefault Tag Char++-- Exercise ViaList++newtype AList a = AList [a]+ deriving newtype (Eq, Ord, Show, IsList)++deriving via (FD.ViaList (AList a) 0 2) instance FD.GenDefault Tag a => FD.GenDefault Tag (AList a)++-- Exercise ViaString++newtype AString = AString String+ deriving newtype (Eq, Ord, Show, IsString)+ deriving (FD.GenDefault Tag) via (FD.ViaString AString 0 2)++-- Exercise ViaEnum++data Choice = ChoiceA | ChoiceB+ deriving stock (Eq, Ord, Show, Enum, Bounded)+ deriving (FD.GenDefault Tag) via (FD.ViaEnum Choice)++-- Exercise ViaGeneric++deriving via (FD.ViaGeneric Tag (Maybe a)) instance FD.GenDefault Tag a => FD.GenDefault Tag (Maybe a)++data Record = Record !Int !(Maybe Record)+ deriving stock (Eq, Ord, Show, Generic)+ deriving (FD.GenDefault Tag) via (FD.ViaGeneric Tag Record)++data GenCase where+ GenCase :: Ord a => String -> FG.Gen a -> GenCase++genDefaultByProxy :: FD.GenDefault Tag a => Proxy a -> FG.Gen a+genDefaultByProxy _ = FD.genDefault (Proxy @Tag)++mkGenCase :: (Ord a, FD.GenDefault Tag a) => String -> Proxy a -> GenCase+mkGenCase name = GenCase name . genDefaultByProxy++genCases :: [GenCase]+genCases =+ [ mkGenCase "Int" (Proxy @Int)+ , mkGenCase "Char" (Proxy @Char)+ , mkGenCase "Choice" (Proxy @Choice)+ , mkGenCase "AList" (Proxy @(AList Char))+ , mkGenCase "AString" (Proxy @AString)+ , mkGenCase "Record" (Proxy @Record)+ ]++testGenCase :: GenCase -> TestTree+testGenCase (GenCase name gen) = testCase name $ do+ xs <- fmap Set.fromList (replicateM 10 (FI.sample gen))+ assertBool "generates more than one value" (Set.size xs > 1)++tests :: TestTree+tests = testGroup "TestSuite.GenDefault" (fmap testGenCase genCases)
test/TestSuite/Prop/Generator/Compound.hs view
@@ -294,15 +294,15 @@ genListFrequency :: Gen [Word] genListFrequency = Gen.frequency [- (1, replicateM 1 $ Gen.integral $ Range.between (0, 10))- , (2, replicateM 2 $ Gen.integral $ Range.between (0, 10))- , (3, replicateM 3 $ Gen.integral $ Range.between (0, 10))+ (1, replicateM 1 $ Gen.inRange $ Range.between (0, 10))+ , (2, replicateM 2 $ Gen.inRange $ Range.between (0, 10))+ , (3, replicateM 3 $ Gen.inRange $ Range.between (0, 10)) ] genListMonad :: Gen [Word] genListMonad = do- n <- Gen.integral $ Range.between (1, 3)- replicateM n $ Gen.integral $ Range.between (0, 10)+ n <- Gen.inRange $ Range.between (1, 3)+ replicateM n $ Gen.inRange $ Range.between (0, 10) prop_frequency_shrinking :: Property () prop_frequency_shrinking =
test/TestSuite/Prop/Generator/Function.hs view
@@ -112,7 +112,7 @@ prop_IntToInt :: Property () prop_IntToInt = testMinimum (P.satisfies ("expected", expected)) $ do- fn <- gen $ Gen.fun (Gen.integral $ Range.between (0, 100))+ fn <- gen $ Gen.fun (Gen.inRange $ Range.between (0, 100)) let Fn f = fn unless (f 0 == 0 && f 1 == 0) $ testFailed fn where
test/TestSuite/Prop/Generator/Simple.hs view
@@ -83,6 +83,11 @@ , test_int_withOrigin (Proxy @Word) ] ]+ , testGroup "char" [+ testGroup "enum" [+ testProperty "shrinking" $ prop_char_enum_shrinking ('a', 'z')+ ]+ ] ] @@ -124,19 +129,19 @@ prop_int_between_shrinking :: (Int, Int) -> Property () prop_int_between_shrinking (x, y)- | x <= y = testShrinkingOfGen P.ge $ Gen.integral $ Range.between (x, y)- | otherwise = testShrinkingOfGen P.le $ Gen.integral $ Range.between (x, y)+ | x <= y = testShrinkingOfGen P.ge $ Gen.inRange $ Range.between (x, y)+ | otherwise = testShrinkingOfGen P.le $ Gen.inRange $ Range.between (x, y) prop_int_between_minimum :: (Int, Int) -> Int -> Property () prop_int_between_minimum (x, y) _target | x == y = testMinimum (P.expect x) $ do- n <- gen $ Gen.integral $ Range.between (x, y)+ n <- gen $ Gen.inRange $ Range.between (x, y) -- The only value we can produce here is @x@, so no point looking for -- anything these (that would just result in all tests being discarded) testFailed n prop_int_between_minimum (x, y) target = testMinimum (P.expect expected) $ do- n <- gen $ Gen.integral $ Range.between (x, y)+ n <- gen $ Gen.inRange $ Range.between (x, y) unless (n == target) $ testFailed n where expected :: Int@@ -153,7 +158,7 @@ => (a, a) -> a -> Property () prop_integral_withOrigin_shrinking (x, y) o = testShrinkingOfGen (P.towards o) $- Gen.integral $ Range.withOrigin (x, y) o+ Gen.inRange $ Range.withOrigin (x, y) o prop_integral_withOrigin_minimum :: forall a. (Show a, Integral a, FiniteBits a)@@ -161,14 +166,24 @@ prop_integral_withOrigin_minimum (x, y) o _target | x == y = testMinimum (P.expect x) $ do -- See discussion in 'prop_int_between_minimum'- n <- gen $ Gen.integral $ Range.withOrigin (x, y) o+ n <- gen $ Gen.inRange $ Range.withOrigin (x, y) o testFailed n prop_integral_withOrigin_minimum (x, y) o target = testMinimum (P.elem .$ ("expected", expected)) $ do- n <- gen $ Gen.integral $ Range.withOrigin (x, y) o+ n <- gen $ Gen.inRange $ Range.withOrigin (x, y) o unless (n == target) $ testFailed n where expected :: [a] expected | target == o = [o + 1, o - 1] | otherwise = [o]++{-------------------------------------------------------------------------------+ Range: 'enum'+-------------------------------------------------------------------------------}++prop_char_enum_shrinking :: (Char, Char) -> Property ()+prop_char_enum_shrinking (x, y)+ | x <= y = testShrinkingOfGen P.ge $ Gen.inRange $ Range.enum (x, y)+ | otherwise = testShrinkingOfGen P.le $ Gen.inRange $ Range.enum (x, y)+
test/TestSuite/Sanity/Range.hs view
@@ -61,7 +61,7 @@ -- Whenever the 'Range' asks for a fraction with a certain precision, we give -- it /all/ possible fractions with that precision. We then count how often -- each value in the range is produced.-stats :: forall a. (Ord a, Num a) => Range a -> [(a, Percentage)]+stats :: forall a. Ord a => Range a -> [(a, Percentage)] stats r = count Map.empty $ Range.eval genFraction r where