packages feed

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 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