genvalidity 0.11.0.2 → 1.0.0.0
raw patch · 10 files changed
+329/−942 lines, 10 filesdep ~QuickCheckdep ~basedep ~randomsetup-changed
Dependency ranges changed: QuickCheck, base, random, validity
Files
- CHANGELOG.md +175/−0
- LICENSE +1/−1
- Setup.hs +0/−3
- genvalidity.cabal +10/−8
- src/Data/GenRelativeValidity.hs +0/−32
- src/Data/GenValidity.hs +78/−656
- src/Data/GenValidity/Utils.hs +5/−64
- test/Data/GenValidity/GenericSpec.hs +0/−2
- test/Data/GenValidity/ShrinkGenericSpec.hs +7/−20
- test/Data/InstanceSpec.hs +53/−156
+ CHANGELOG.md view
@@ -0,0 +1,175 @@+# Changelog++## [1.0.0.0] - 2021-11-20++### Changed++* The default implementation of `GenValid` now uses `genValidStructurally` and `shrinkValidStructurally`.++### Removed++* `GenUnchecked`: It is no longer necessary after changing the default implementation of `GenValid`.+* `GenInvalid`: It was a misfeature.+* `GenRelativeValidity`: It was a misfeature. ++## [0.11.0.1] - 2021-06-20++### Changed++Updated the base lower bound to be more accurate.++## [0.11.0.1] - 2020-04-28++### Changed++* Got rid of some unnecessary extra special values in the generator for double++## [0.11.0.0] - 2020-04-12++### Changed++* Changed the genUnchecked and shrinkUnchecked definitions for Word8, Word16, Word32 and Int8, Int16, Int32 according to their new validity instance in validity 0.10.0.0++## [0.10.0.2] - 2020-03-18++### Changed++* Better lower bound for genvalidity++## [0.10.0.1] - 2020-02-20++### Changed++* Fixed a bug where shrinking ratios of bounded types would crash if the minimum bound was in the numerator.++## [0.10.0.0] - 2020-02-10++### Added++* `Data.GenValidity.Utils.genIntX`+* `Data.GenValidity.Utils.genWordX`+* `Data.GenValidity.Utils.genFloat`+* `Data.GenValidity.Utils.genDouble`+* `Data.GenValidity.Utils.genFloatX`+* `Data.GenValidity.Utils.genInteger`+++### Changed++* Improved the cabal file+* Sped up the 'genValid' generators for the following types+ * ()+ * Bool+ * Ordering+ * Char+ * Int, Int8, Int16, Int32, Int64+ * Word, Word8, Word16, Word32, Word64+ * Float, Double+* Improved the generators of+ * Int, Int8, Int16, Int32, Int64+ Now also generates extreme values, but mostly uniform values.+ * Word, Word8, Word16, Word32, Word64+ Now also generates extreme values, but mostly uniform values.+ * Float, Double+ Now also generates values around the bounds, but mostly uniform values.+ * Natural, Integer+ Now also generates numbers larger than can be contained in a single Word/Int.+ * Ratio+ Fixed a bug: no longer generates invalid ratios for fixed-sized numerators+* Removed a lot of shrinking tests++## [0.9.1.0] - 2019-12-04++### Added++* `genSplit6`, `genSplit7`, `genSplit8`+* `genNonEmptyOf`++### Changed++* Changed `arbPartition` to generate nicer partitions.+ This influences `genListOf` and `genTreeOf` and the+ instances for all collections as well.++## [0.9.0.1] - 2019-09-27++### Changed++* Tests for `genUtf16SurrogateCodePoint`++## [0.9.0.0] - 2019-09-23++### Added++* `genUtf16SurrogateCodePoint`++### Changed++* Changed `GenValid Char` to generate UTF16 surrogate codepoints 10% of the time+* Changed `GenValid Char` to ignore sizes.++## [0.8.0.0] - 2019-03-06++### Added++* 'shrinkTuple'++### Changed++* Removed the 'GenUnchecked' constraint for 'GenValid' and 'GenInvalid'.++## [0.7.0.2] - 2019-02-28++### Added++* 'shrinkT4'++### Changed++* Clearer docs++## [0.7.0.1] - 2019-02-21++### Changed++* Sped up the shrinking test suite.++## [0.7.0.0] - 2018-11-07++### Changed++* `genUnchecked` of `Double` and `Float` now generates `NaN`, `+Infinity`, `-Infinity` and `-0` according to the new version of `validity`.++## [0.6.1.0] - 2018-10-06++### Changed++* Changed 'genValid`, `genUnchecked` and `genInvalid` for NonEmpty to better take the size into account.+* Sped up `shrinkUnchecked` for `Maybe`+* Sped up `shrinkValid` for `Maybe`+* Sped up `shrinkUnchecked` for `Either`+* Sped up `shrinkValid` for `Either`+* Sped up `shrinkUnchecked` for `(,)`+* Sped up `shrinkUnchecked` for `(,,)`+* Sped up `shrinkUnchecked` for `(,,,)`+* Sped up `shrinkValid` for lists+* Sped up `shrinkValid` for `NonEmpty` lists++## [0.6.0.0] - 2018-08-25++### Added++* `genValidStructurally` and `genValidStructurallyWithoutExtraChecking`+* `shrinkValidStructurally` and `shrinkValidStructurallyWithoutExtraFiltering` with `structurallyValidRecursivelyShrink` and `structurallyValidSubterms`++### Changed++* `-0` is now a valid value for `Double` and `Float`.+* `genUnchecked :: Gen Double` now also generates invalid values.+* `arbPartition` now shuffles the partitions, which means that `genListOf` produces lists of elements with shuffled sizes.+ This also fixes the same problem with `instance GenUnchecked a => GenUnchecked [a]`.++## Older versions++No history before version 0.6.0.0+
LICENSE view
@@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2016-2020 Tom Sydney Kerckhove+Copyright (c) 2016-2021 Tom Sydney Kerckhove Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
− Setup.hs
@@ -1,3 +0,0 @@-import Distribution.Simple--main = defaultMain
genvalidity.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: genvalidity-version: 0.11.0.2+version: 1.0.0.0 synopsis: Testing utilities for the validity library description: Note: There are companion instance packages for this library: .@@ -33,10 +33,13 @@ bug-reports: https://github.com/NorfairKing/validity/issues author: Tom Sydney Kerckhove maintainer: syd@cs-syd.eu-copyright: Copyright: (c) 2016-2020 Tom Sydney Kerckhove+copyright: Copyright: (c) 2016-2021 Tom Sydney Kerckhove license: MIT license-file: LICENSE build-type: Simple+extra-source-files:+ LICENSE+ CHANGELOG.md source-repository head type: git@@ -44,7 +47,6 @@ library exposed-modules:- Data.GenRelativeValidity Data.GenValidity Data.GenValidity.Utils other-modules:@@ -53,10 +55,10 @@ src ghc-options: -Wno-redundant-constraints build-depends:- QuickCheck >=2.12- , base >=4.11 && <5- , random- , validity >=0.9+ QuickCheck >=2.13+ , base >=4.13 && <5+ , random >=1.1+ , validity >=0.12 default-language: Haskell2010 test-suite genvalidity-test@@ -73,7 +75,7 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: QuickCheck- , base >=4.11 && <5+ , base >=4.13 && <5 , genvalidity , hspec , hspec-core
− src/Data/GenRelativeValidity.hs
@@ -1,32 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}--module Data.GenRelativeValidity- ( module Data.RelativeValidity,- module Data.GenRelativeValidity,- )-where--import Data.GenValidity-import Data.RelativeValidity-import Test.QuickCheck--class- (GenUnchecked a, RelativeValidity a b) =>- GenRelativeUnchecked a b- where- genUncheckedFor :: b -> Gen a- genUncheckedFor _ = genUnchecked--class- (GenValid a, RelativeValidity a b) =>- GenRelativeValid a b- where- genValidFor :: b -> Gen a- genValidFor b = genValid `suchThat` (`isValidFor` b)--class- (GenUnchecked a, RelativeValidity a b, GenRelativeUnchecked a b) =>- GenRelativeInvalid a b- where- genInvalidFor :: b -> Gen a- genInvalidFor b = genUncheckedFor b `suchThat` (not . (`isValidFor` b))
src/Data/GenValidity.hs view
@@ -1,45 +1,33 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators #-}--#if __GLASGOW_HASKELL__ >= 710-#define OVERLAPPING_ {-# OVERLAPPING #-}-#else-{-# LANGUAGE OverlappingInstances #-}-#define OVERLAPPING_-#endif-#if MIN_VERSION_base(4,9,0) {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}-#endif -- | ----- @GenValidity@ exists to make tests involving @Validity@ types easier and speed--- up the generation of data for them.+-- @GenValid@ exists to make tests involving @Validity@ types easier and+-- speed up the generation of data for them. ----- Let's use the example from @Data.Validity@ again: A datatype that represents--- primes.--- To implement tests for this datatype, we would have to be able to generate--- both primes and non-primes. We could do this with--- @(Prime <$> arbitrary) `suchThat` isValid@--- but this is tedious and inefficient.+-- To implement tests for this datatype, we would have to be able to+-- generate both primes. We could do this with a generator like this one: --+-- > (Prime <$> 'arbitrary') `suchThat` isValid+--+-- However, this is tedious and inefficient, as well as quite+-- naive (because 'arbitrary' tends to use very naive generators).+-- -- The @GenValid@ type class allows you to specify how to (efficiently) -- generate valid data of the given type to allow for easier and quicker testing.--- Just instantiating @GenUnchecked@ already gives you access to a default instance--- of @GenValid@ and @GenInvalid@ but writing custom implementations of these functions--- may speed up the generation of data.+-- The default implementation of `GenValid` already gives you a generator and shrinking function+-- for free: --+-- > instance GenValid Prime+-- -- For example, to generate primes, we don't have to consider even numbers other -- than 2. A more efficient implementation could then look as follows: ----- > instance GenUnchecked Prime where--- > genUnchecked = Prime <$> arbitrary--- -- > instance GenValid Prime where -- > genValid = Prime <$> -- > (oneof@@ -55,17 +43,14 @@ -- > myFunction input `shouldSatisfy` isRight -- -- > it "produces valid output when it succeeds" $ do--- > forAllUnchecked $ \input ->+-- > forAllValid $ \input -> -- > case myFunction input of -- > Nothing -> return () -- Can happen -- > Just output -> output `shouldSatisfy` isValid ----- Definitely also look at the genvalidity-property and genvalidity-hspec packages--- for more info on how to use this package.+-- Definitely also look at the companion packages for more info on how to use this package. module Data.GenValidity- ( GenUnchecked (..),- GenValid (..),- GenInvalid (..),+ ( GenValid (..), -- * Helper functions genValidStructurally,@@ -88,14 +73,6 @@ module Data.Validity, -- * The Generics magic- genericGenUnchecked,- GGenUnchecked (..),- genericShrinkUnchecked,- uncheckedRecursivelyShrink,- GUncheckedRecursivelyShrink (..),- uncheckedSubterms,- GUncheckedSubterms (..),- GUncheckedSubtermsIncl (..), GGenValid (..), GValidRecursivelyShrink (..), structurallyValidSubterms,@@ -104,112 +81,38 @@ ) where -#if MIN_VERSION_base(4,9,0)-import Data.List.NonEmpty (NonEmpty((:|)))-#endif-#if MIN_VERSION_base(4,8,0)-import Data.Word (Word64)-import GHC.Word (Word8(..), Word16(..), Word32(..), Word(..))-#else-import Data.Word (Word, Word64)-import GHC.Word (Word8(..), Word16(..), Word32(..), Word(..))-#endif- import Control.Monad (guard) import Data.Char (chr) import Data.Fixed (Fixed (..), HasResolution)-#if MIN_VERSION_base(4,8,0)-import GHC.Natural-#else-import Control.Applicative ((<*>), (<$>), pure)-#endif- import Data.GenValidity.Utils-import Data.Int (Int64)+import Data.Int (Int16, Int32, Int64, Int8)+import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Ratio ((%)) import Data.Validity+import Data.Word (Word16, Word32, Word64, Word8) import GHC.Generics-import GHC.Int (Int (..), Int16 (..), Int32 (..), Int8 (..)) import GHC.Real (Ratio (..))+import Numeric.Natural import Test.QuickCheck hiding (Fixed) {-# ANN module "HLint: ignore Reduce duplication" #-} --- | A class of types for which truly arbitrary values can be generated.------ === How to instantiate 'GenUnchecked'------ __Step 1__: Try to instantiate 'GenUnchecked' via 'Generic'.--- __this is probably what you want__------ An instance of this class can be made automatically if the type in question--- has a 'Generic' instance. This instance will try to use 'genUnchecked' to--- generate all structural sub-parts of the value that is being generated.------ Example:------ > {-# LANGUAGE DeriveGeneric #-}--- >--- > data MyType = MyType Rational String--- > deriving (Show, Eq, Generic)--- >--- > instance GenUnchecked MyType------ generates something like:------ > instance GenUnchecked MyType where--- > genUnchecked = MyType <$> genUnchecked <*> genUnchecked------ If this is not possible because there is no 'GenUnchecked' instance available for one of the--- sub-parts of your type, __then do not instantiate 'GenUnchecked' for your type__.--- Just continue with 'GenValid' instead.------ __Step 2__: If an instatiation via 'Generic' is not possible, then you should emulate what--- 'genericGenUnchecked' does.--- This means that all sub-parts should be generated using 'genUnchecked'.--- Make sure to generate any possible value, valid or not, that can exist at runtime--- even when taking the existence of 'Unsafe.Coerce.unsafeCoerce' into account.------ === Warning: Invalid values can be funky------ Some types have serious validity constraints. See 'Rational' for example.--- These can behave very strangely when they are not valid.--- In that case, __do not override 'GenUnchecked' such that 'genUnchecked' only generates valid values__.--- In that case, do not override 'genUnchecked' at all.--- Instead, use 'genValid' from 'GenValid' (see below) instead and consider not instantiating 'GenUnchecked' at all.-class GenUnchecked a where- genUnchecked :: Gen a- default genUnchecked ::- (Generic a, GGenUnchecked (Rep a)) =>- Gen a- genUnchecked = genericGenUnchecked-- shrinkUnchecked :: a -> [a]- default shrinkUnchecked ::- (Generic a, GUncheckedRecursivelyShrink (Rep a), GUncheckedSubterms (Rep a) a) =>- a ->- [a]- shrinkUnchecked = genericShrinkUnchecked---- | A class of types for which valid values can be generated.+-- | A class of types for which valid values can be generated to be valid. -- -- === How to instantiate 'GenValid' -- -- __Step 1__: Try to instantiate 'GenValid' without overriding any functions.--- This is only possible if your type has a 'GenUnchecked' instance.--- If it doesn't, go to step 2. -- It is possible that, if few values are valid or if validity--- checking is expensive, that the resulting generator is too slow.+-- checking is expensive, the resulting generator is too slow. -- In that case, go to Step 2. ----- __Step 2__: Try to instantiate 'GenValid' using the helper functions via 'Generic'--- This involves using 'genValidStructurally' to override 'genValid' and--- using 'shrinkValidStructurally' to override 'shrinkValid'.--- __Every time you override 'genValid', you should also override 'shrinkValid'__+-- __Step 2__: Consider using 'genValidStructurallyWithoutExtraChecking' and+-- 'shrinkValidStructurallyWithoutExtraFiltering' to speed up generation.+-- This only works if your type has a derived or trivial 'Validity'+-- instance. ----- __Step 3__: If the above is not possible due to lack of a 'Generic' instance,--- then you should emulate what 'genValidStructurally' does.--- This means that all sub-parts should be generated using 'genValid'.+-- __Step 3__: If that still is not fast enough, consider writing your own+-- generator and shrinking function. -- Make sure to generate any possible valid value, but only valid values. -- -- === A note about 'Arbitrary'@@ -217,79 +120,37 @@ -- If you also write @Arbitrary@ instances for @GenValid@ types, it may be -- best to simply use ----- > arbitrary = genValid--- > shrink = shrinkValid+-- > instance Arbitrary A where+-- > arbitrary = genValid+-- > shrink = shrinkValid class Validity a => GenValid a where -- | Generate a valid datum, this should cover all possible valid values in -- the type -- -- The default implementation is as follows: --- -- > genValid = genUnchecked `suchThat` isValid+ -- > genValid = genValidStructurally -- -- To speed up testing, it may be a good idea to implement this yourself. -- If you do, make sure that it is possible to generate all possible valid -- data, otherwise your testing may not cover all cases. genValid :: Gen a- default genValid :: GenUnchecked a => Gen a- genValid = genUnchecked `suchThat` isValid+ default genValid :: (Generic a, GGenValid (Rep a)) => Gen a+ genValid = genValidStructurally -- | Shrink a valid value. -- -- The default implementation is as follows: --- -- > shrinkValid = filter isValid . shrinkUnchecked+ -- > shrinkValid = shrinkValidStructurally -- -- It is important that this shrinking function only shrinks values to valid values. -- If `shrinkValid` ever shrinks a value to an invalid value, the test that is being shrunk for -- might fail for a different reason than for the reason that it originally failed. -- This would lead to very confusing error messages. shrinkValid :: a -> [a]- default shrinkValid :: GenUnchecked a => a -> [a]- shrinkValid = filter isValid . shrinkUnchecked---- | A class of types for which invalid values can be generated.------ === How to instantiate 'GenInvalid'------ __Step 1__: Realise that you probably do not want to.--- It makes no sense, and serves no purpose, to instantiate 'GenInvalid' for types--- which contain no invalid values. (In fact, the default implementation will go into--- an infinite loop for such types.)--- You should only instantiate 'GenInvalid' if you explicitly want to use it--- to write tests that deal with invalid values, or if you are writing a container--- for parametric values.------ __Step 2__: Instantiate 'GenInvalid' without overriding any functions.-class Validity a => GenInvalid a where- genInvalid :: Gen a-- -- | Generate an invalid datum, this should cover all possible invalid- -- values- --- -- > genInvalid = genUnchecked `suchThat` isInvalid- --- -- To speed up testing, it may be a good idea to implement this yourself.- -- If you do, make sure that it is possible to generate all possible- -- invalid data, otherwise your testing may not cover all cases.- default genInvalid :: GenUnchecked a => Gen a- genInvalid = genUnchecked `suchThat` isInvalid-- shrinkInvalid :: a -> [a]- default shrinkInvalid :: GenUnchecked a => a -> [a]- shrinkInvalid = filter isInvalid . shrinkUnchecked--instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (a, b) where- genUnchecked =- sized $ \n -> do- (r, s) <- genSplit n- a <- resize r genUnchecked- b <- resize s genUnchecked- return (a, b)- shrinkUnchecked (a, b) =- ((,) <$> shrinkUnchecked a <*> shrinkUnchecked b)- ++ [(a', b) | a' <- shrinkUnchecked a]- ++ [(a, b') | b' <- shrinkUnchecked b]+ default shrinkValid :: (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a]+ shrinkValid = shrinkValidStructurally instance (GenValid a, GenValid b) => GenValid (a, b) where genValid =@@ -300,53 +161,11 @@ return (a, b) shrinkValid = shrinkTuple shrinkValid shrinkValid -instance (GenUnchecked a, GenInvalid a, GenUnchecked b, GenInvalid b) => GenInvalid (a, b) where- genInvalid =- sized $ \n -> do- (r, s) <- genSplit n- oneof- [ do- a <- resize r genUnchecked- b <- resize s genInvalid- return (a, b),- do- a <- resize r genInvalid- b <- resize s genUnchecked- return (a, b)- ]--instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (Either a b) where- genUnchecked = oneof [Left <$> genUnchecked, Right <$> genUnchecked]- shrinkUnchecked (Left a) = Left <$> shrinkUnchecked a- shrinkUnchecked (Right b) = Right <$> shrinkUnchecked b- instance (GenValid a, GenValid b) => GenValid (Either a b) where genValid = oneof [Left <$> genValid, Right <$> genValid] shrinkValid (Left a) = Left <$> shrinkValid a shrinkValid (Right b) = Right <$> shrinkValid b --- | This instance ensures that the generated tupse contains at least one invalid element. The other element is unchecked.-instance (GenInvalid a, GenInvalid b) => GenInvalid (Either a b) where- genInvalid = oneof [Left <$> genInvalid, Right <$> genInvalid]- shrinkInvalid (Left v) = Left <$> shrinkInvalid v- shrinkInvalid (Right v) = Right <$> shrinkInvalid v--instance- (GenUnchecked a, GenUnchecked b, GenUnchecked c) =>- GenUnchecked (a, b, c)- where- genUnchecked =- sized $ \n -> do- (r, s, t) <- genSplit3 n- a <- resize r genUnchecked- b <- resize s genUnchecked- c <- resize t genUnchecked- return (a, b, c)- shrinkUnchecked (a, b, c) =- [ (a', b', c')- | (a', (b', c')) <- shrinkUnchecked (a, (b, c))- ]- instance (GenValid a, GenValid b, GenValid c) => GenValid (a, b, c) where genValid = sized $ \n -> do@@ -360,56 +179,7 @@ | (a', (b', c')) <- shrinkValid (a, (b, c)) ] --- | This instance ensures that the generated triple contains at least one invalid element. The other two are unchecked. instance- ( GenUnchecked a,- GenUnchecked b,- GenUnchecked c,- GenInvalid a,- GenInvalid b,- GenInvalid c- ) =>- GenInvalid (a, b, c)- where- genInvalid =- sized $ \n -> do- (r, s, t) <- genSplit3 n- oneof- [ do- a <- resize r genInvalid- b <- resize s genUnchecked- c <- resize t genUnchecked- return (a, b, c),- do- a <- resize r genUnchecked- b <- resize s genInvalid- c <- resize t genUnchecked- return (a, b, c),- do- a <- resize r genUnchecked- b <- resize s genUnchecked- c <- resize t genInvalid- return (a, b, c)- ]--instance- (GenUnchecked a, GenUnchecked b, GenUnchecked c, GenUnchecked d) =>- GenUnchecked (a, b, c, d)- where- genUnchecked =- sized $ \n -> do- (r, s, t, u) <- genSplit4 n- a <- resize r genUnchecked- b <- resize s genUnchecked- c <- resize t genUnchecked- d <- resize u genUnchecked- return (a, b, c, d)- shrinkUnchecked (a, b, c, d) =- [ (a', b', c', d')- | (a', (b', (c', d'))) <- shrinkUnchecked (a, (b, (c, d)))- ]--instance (GenValid a, GenValid b, GenValid c, GenValid d) => GenValid (a, b, c, d) where@@ -426,68 +196,7 @@ | (a', (b', (c', d'))) <- shrinkValid (a, (b, (c, d))) ] --- | This instance ensures that the generated triple contains at least one invalid element. The other two are unchecked. instance- ( GenUnchecked a,- GenUnchecked b,- GenUnchecked c,- GenUnchecked d,- GenInvalid a,- GenInvalid b,- GenInvalid c,- GenInvalid d- ) =>- GenInvalid (a, b, c, d)- where- genInvalid =- sized $ \n -> do- (r, s, t, u) <- genSplit4 n- oneof- [ do- a <- resize r genInvalid- b <- resize s genUnchecked- c <- resize t genUnchecked- d <- resize u genUnchecked- return (a, b, c, d),- do- a <- resize r genUnchecked- b <- resize s genInvalid- c <- resize t genUnchecked- d <- resize u genUnchecked- return (a, b, c, d),- do- a <- resize r genUnchecked- b <- resize s genUnchecked- c <- resize t genInvalid- d <- resize u genUnchecked- return (a, b, c, d),- do- a <- resize r genUnchecked- b <- resize s genUnchecked- c <- resize t genUnchecked- d <- resize u genInvalid- return (a, b, c, d)- ]--instance- (GenUnchecked a, GenUnchecked b, GenUnchecked c, GenUnchecked d, GenUnchecked e) =>- GenUnchecked (a, b, c, d, e)- where- genUnchecked =- sized $ \n -> do- (r, s, t, u, v) <- genSplit5 n- a <- resize r genUnchecked- b <- resize s genUnchecked- c <- resize t genUnchecked- d <- resize u genUnchecked- e <- resize v genUnchecked- return (a, b, c, d, e)- shrinkUnchecked (a, b, c, d, e) =- [ (a', b', c', d', e')- | (a', (b', (c', (d', e')))) <- shrinkUnchecked (a, (b, (c, (d, e))))- ]--instance (GenValid a, GenValid b, GenValid c, GenValid d, GenValid e) => GenValid (a, b, c, d, e) where@@ -505,146 +214,42 @@ | (a', (b', (c', (d', e')))) <- shrinkValid (a, (b, (c, (d, e)))) ] --- | This instance ensures that the generated triple contains at least one invalid element. The other two are unchecked.-instance- ( GenUnchecked a,- GenUnchecked b,- GenUnchecked c,- GenUnchecked d,- GenUnchecked e,- GenInvalid a,- GenInvalid b,- GenInvalid c,- GenInvalid d,- GenInvalid e- ) =>- GenInvalid (a, b, c, d, e)- where- genInvalid =- sized $ \n -> do- (r, s, t, u, v) <- genSplit5 n- oneof- [ do- a <- resize r genInvalid- b <- resize s genUnchecked- c <- resize t genUnchecked- d <- resize u genUnchecked- e <- resize v genUnchecked- return (a, b, c, d, e),- do- a <- resize r genUnchecked- b <- resize s genInvalid- c <- resize t genUnchecked- d <- resize u genUnchecked- e <- resize v genUnchecked- return (a, b, c, d, e),- do- a <- resize r genUnchecked- b <- resize s genUnchecked- c <- resize t genInvalid- d <- resize u genUnchecked- e <- resize v genUnchecked- return (a, b, c, d, e),- do- a <- resize r genUnchecked- b <- resize s genUnchecked- c <- resize t genUnchecked- d <- resize u genInvalid- e <- resize v genUnchecked- return (a, b, c, d, e),- do- a <- resize r genUnchecked- b <- resize s genUnchecked- c <- resize t genUnchecked- d <- resize u genUnchecked- e <- resize v genInvalid- return (a, b, c, d, e)- ]--instance GenUnchecked a => GenUnchecked (Maybe a) where- genUnchecked = oneof [pure Nothing, Just <$> genUnchecked]- shrinkUnchecked Nothing = []- shrinkUnchecked (Just a) = Nothing : (Just <$> shrinkUnchecked a)- instance GenValid a => GenValid (Maybe a) where genValid = oneof [pure Nothing, Just <$> genValid] shrinkValid Nothing = [] shrinkValid (Just a) = Nothing : (Just <$> shrinkValid a) -instance GenInvalid a => GenInvalid (Maybe a) where- genInvalid = Just <$> genInvalid- shrinkInvalid Nothing = [] -- Should not happen- shrinkInvalid (Just a) = Just <$> shrinkInvalid a--#if MIN_VERSION_base(4,9,0)-instance GenUnchecked a => GenUnchecked (NonEmpty a) where- genUnchecked = genNonEmptyOf genUnchecked- shrinkUnchecked (v :| vs) = [ e :| es | (e, es) <- shrinkUnchecked (v, vs)]- instance GenValid a => GenValid (NonEmpty a) where- genValid = genNonEmptyOf genValid- shrinkValid (v :| vs) = [ e :| es | (e, es) <- shrinkValid (v, vs)]--instance (GenUnchecked a, GenInvalid a) => GenInvalid (NonEmpty a) where- genInvalid = genNonEmptyOf genInvalid-#endif--instance GenUnchecked a => GenUnchecked [a] where- genUnchecked = genListOf genUnchecked- shrinkUnchecked = shrinkList shrinkUnchecked+ genValid = genNonEmptyOf genValid+ shrinkValid (v :| vs) = [e :| es | (e, es) <- shrinkValid (v, vs)] --- | If we can generate values of a certain type, we can also generate lists of--- them. instance GenValid a => GenValid [a] where genValid = genListOf genValid shrinkValid = shrinkList shrinkValid --- | This instance ensures that the generated list contains at least one element--- that satisfies 'isInvalid'. The rest is unchecked.-instance (GenUnchecked a, GenInvalid a) => GenInvalid [a] where- genInvalid =- sized $ \n -> do- (x, y, z) <- genSplit3 n- before <- resize x $ genListOf genUnchecked- middle <- resize y genInvalid- after <- resize z $ genListOf genUnchecked- return $ before ++ [middle] ++ after--instance GenUnchecked () where- genUnchecked = arbitrary- shrinkUnchecked = shrink- instance GenValid () where- genValid = genUnchecked- shrinkValid = shrinkUnchecked--instance GenUnchecked Bool where- genUnchecked = arbitrary- shrinkUnchecked = shrink+ genValid = pure ()+ shrinkValid () = [] instance GenValid Bool where- genValid = genUnchecked- shrinkValid = shrinkUnchecked--instance GenUnchecked Ordering where- genUnchecked = arbitrary- shrinkUnchecked = shrink+ genValid = arbitrary+ shrinkValid = shrink instance GenValid Ordering where- genValid = genUnchecked- shrinkValid = shrinkUnchecked+ genValid = arbitrary+ shrinkValid = shrink -instance GenUnchecked Char where- genUnchecked = frequency [(9, choose (minBound, maxBound)), (1, genUtf16SurrogateCodePoint)]- shrinkUnchecked = shrink+instance GenValid Char where+ genValid =+ frequency+ [ (9, choose (minBound, maxBound)),+ (1, genUtf16SurrogateCodePoint)+ ]+ shrinkValid = shrink genUtf16SurrogateCodePoint :: Gen Char genUtf16SurrogateCodePoint = chr <$> oneof [choose (0xD800, 0xDBFF), choose (0xDC00, 0xDFFF)] -instance GenValid Char where- genValid = genUnchecked- shrinkValid = shrinkUnchecked- genLineSeparator :: Gen Char genLineSeparator = elements ['\n', '\r'] @@ -654,138 +259,67 @@ genSingleLineString :: Gen String genSingleLineString = genListOf genNonLineSeparator -instance GenUnchecked Int where- genUnchecked = genIntX- shrinkUnchecked = shrink- instance GenValid Int where- genValid = genUnchecked- shrinkValid = shrinkUnchecked--instance GenUnchecked Int8 where- genUnchecked = genUncheckedInt (I8#)- shrinkUnchecked = shrinkUncheckedInt (\(I# i#) -> I8# i#) (\(I8# i#) -> I# i#)+ genValid = genIntX+ shrinkValid = shrink instance GenValid Int8 where genValid = genIntX shrinkValid = shrink -instance GenUnchecked Int16 where- genUnchecked = genUncheckedInt (I16#)- shrinkUnchecked = shrinkUncheckedInt (\(I# i#) -> I16# i#) (\(I16# i#) -> I# i#)- instance GenValid Int16 where genValid = genIntX shrinkValid = shrink -instance GenUnchecked Int32 where- genUnchecked = genUncheckedInt (I32#)- shrinkUnchecked = shrinkUncheckedInt (\(I# i#) -> I32# i#) (\(I32# i#) -> I# i#)- instance GenValid Int32 where genValid = genIntX shrinkValid = shrink -instance GenUnchecked Int64 where- genUnchecked = genIntX- shrinkUnchecked = shrink- instance GenValid Int64 where- genValid = genUnchecked- shrinkValid = shrinkUnchecked--instance GenUnchecked Word where- genUnchecked = genWordX- shrinkUnchecked = shrink+ genValid = genIntX+ shrinkValid = shrink instance GenValid Word where- genValid = genUnchecked- shrinkValid = shrinkUnchecked--instance GenUnchecked Word8 where- genUnchecked = genUncheckedWord (W8#)- shrinkUnchecked = shrinkUncheckedWord (\(W# w#) -> W8# w#) (\(W8# w#) -> W# w#)+ genValid = genWordX+ shrinkValid = shrink instance GenValid Word8 where genValid = genWordX shrinkValid = shrink -instance GenUnchecked Word16 where- genUnchecked = genUncheckedWord (W16#)- shrinkUnchecked = shrinkUncheckedWord (\(W# w#) -> W16# w#) (\(W16# w#) -> W# w#)- instance GenValid Word16 where genValid = genWordX shrinkValid = shrink -instance GenUnchecked Word32 where- genUnchecked = genUncheckedWord (W32#)- shrinkUnchecked = shrinkUncheckedWord (\(W# w#) -> W32# w#) (\(W32# w#) -> W# w#)- instance GenValid Word32 where genValid = genWordX shrinkValid = shrink -instance GenUnchecked Word64 where- genUnchecked = genWordX- shrinkUnchecked = shrink- instance GenValid Word64 where- genValid = genUnchecked- shrinkValid = shrinkUnchecked+ genValid = genWordX+ shrinkValid = shrink -#if MIN_VERSION_QuickCheck(2,9,2)-instance GenUnchecked Float where- genUnchecked = genFloat- shrinkUnchecked f+instance GenValid Float where+ genValid = genFloat+ shrinkValid f | isInfinite f = [] | isNaN f = [] | otherwise = shrink f-#else-instance GenUnchecked Float where- genUnchecked = genFloat- shrinkUnchecked _ = []-#endif -instance GenValid Float where- genValid = genUnchecked- shrinkValid = shrinkUnchecked--#if MIN_VERSION_QuickCheck(2,9,2)-instance GenUnchecked Double where- genUnchecked = genDouble- shrinkUnchecked d- | isInfinite d = []- | isNaN d = []- | otherwise = shrink d-#else-instance GenUnchecked Double where- genUnchecked = genDouble- shrinkUnchecked _ = []-#endif- instance GenValid Double where- genValid = genUnchecked- shrinkValid = shrinkUnchecked--instance GenUnchecked Integer where- genUnchecked = genInteger- shrinkUnchecked = shrink--instance GenValid Integer+ genValid = genDouble+ shrinkValid d+ | isInfinite d = []+ | isNaN d = []+ | otherwise = shrink d -#if MIN_VERSION_base(4,8,0)-instance GenUnchecked Natural where- genUnchecked = fromInteger . abs <$> genUnchecked- shrinkUnchecked = fmap (fromInteger . abs) . shrinkUnchecked . toInteger+instance GenValid Integer where+ genValid = genInteger+ shrinkValid = shrink instance GenValid Natural where- genValid = fromInteger . abs <$> genValid-#endif--instance (Integral a, GenUnchecked a) => GenUnchecked (Ratio a) where- genUnchecked = (:%) <$> genUnchecked <*> genUnchecked- shrinkUnchecked (n :% d) = [n' :% d' | (n', d') <- shrinkUnchecked (n, d)]+ genValid = fromInteger . abs <$> genValid+ shrinkValid = fmap (fromInteger . abs) . shrinkValid . toInteger instance (Integral a, Num a, Ord a, GenValid a) => GenValid (Ratio a) where genValid =@@ -802,121 +336,9 @@ guard $ isValid candidate pure $ n' % d' -instance (Integral a, Num a, Ord a, Validity a, GenUnchecked a) => GenInvalid (Ratio a)--instance HasResolution a => GenUnchecked (Fixed a) where- genUnchecked = MkFixed <$> genUnchecked- shrinkUnchecked (MkFixed i) = MkFixed <$> shrinkUnchecked i--instance HasResolution a => GenValid (Fixed a)--genericGenUnchecked :: (Generic a, GGenUnchecked (Rep a)) => Gen a-genericGenUnchecked = to <$> gGenUnchecked--class GGenUnchecked f where- gGenUnchecked :: Gen (f a)--instance GGenUnchecked U1 where- gGenUnchecked = pure U1--instance (GGenUnchecked a, GGenUnchecked b) => GGenUnchecked (a :*: b) where- gGenUnchecked = (:*:) <$> gGenUnchecked <*> gGenUnchecked--instance (GGenUnchecked a, GGenUnchecked b) => GGenUnchecked (a :+: b) where- gGenUnchecked = oneof [L1 <$> gGenUnchecked, R1 <$> gGenUnchecked]--instance (GGenUnchecked a) => GGenUnchecked (M1 i c a) where- gGenUnchecked = M1 <$> gGenUnchecked--instance (GenUnchecked a) => GGenUnchecked (K1 i a) where- gGenUnchecked = K1 <$> genUnchecked---- | Shrink a term to any of its immediate subterms,--- and also recursively shrink all subterms.-genericShrinkUnchecked :: (Generic a, GUncheckedRecursivelyShrink (Rep a), GUncheckedSubterms (Rep a) a) => a -> [a]-genericShrinkUnchecked x = uncheckedSubterms x ++ uncheckedRecursivelyShrink x---- | Recursively shrink all immediate uncheckedSubterms.-uncheckedRecursivelyShrink :: (Generic a, GUncheckedRecursivelyShrink (Rep a)) => a -> [a]-uncheckedRecursivelyShrink = map to . gUncheckedRecursivelyShrink . from--class GUncheckedRecursivelyShrink f where- gUncheckedRecursivelyShrink :: f a -> [f a]--instance (GUncheckedRecursivelyShrink f, GUncheckedRecursivelyShrink g) => GUncheckedRecursivelyShrink (f :*: g) where- gUncheckedRecursivelyShrink (x :*: y) =- ((:*:) <$> gUncheckedRecursivelyShrink x <*> gUncheckedRecursivelyShrink y)- ++ [x' :*: y | x' <- gUncheckedRecursivelyShrink x]- ++ [x :*: y' | y' <- gUncheckedRecursivelyShrink y]--instance (GUncheckedRecursivelyShrink f, GUncheckedRecursivelyShrink g) => GUncheckedRecursivelyShrink (f :+: g) where- gUncheckedRecursivelyShrink (L1 x) = map L1 (gUncheckedRecursivelyShrink x)- gUncheckedRecursivelyShrink (R1 x) = map R1 (gUncheckedRecursivelyShrink x)--instance GUncheckedRecursivelyShrink f => GUncheckedRecursivelyShrink (M1 i c f) where- gUncheckedRecursivelyShrink (M1 x) = map M1 (gUncheckedRecursivelyShrink x)--instance GenUnchecked a => GUncheckedRecursivelyShrink (K1 i a) where- gUncheckedRecursivelyShrink (K1 x) = map K1 (shrinkUnchecked x)--instance GUncheckedRecursivelyShrink U1 where- gUncheckedRecursivelyShrink U1 = []--instance GUncheckedRecursivelyShrink V1 where- -- The empty type can't be shrunk to anything.- gUncheckedRecursivelyShrink _ = []---- | All immediate uncheckedSubterms of a term.-uncheckedSubterms :: (Generic a, GUncheckedSubterms (Rep a) a) => a -> [a]-uncheckedSubterms = gUncheckedSubterms . from--class GUncheckedSubterms f a where- gUncheckedSubterms :: f a -> [a]--instance GUncheckedSubterms V1 a where- gUncheckedSubterms _ = []--instance GUncheckedSubterms U1 a where- gUncheckedSubterms U1 = []--instance (GUncheckedSubtermsIncl f a, GUncheckedSubtermsIncl g a) => GUncheckedSubterms (f :*: g) a where- gUncheckedSubterms (l :*: r) = gUncheckedSubtermsIncl l ++ gUncheckedSubtermsIncl r--instance (GUncheckedSubtermsIncl f a, GUncheckedSubtermsIncl g a) => GUncheckedSubterms (f :+: g) a where- gUncheckedSubterms (L1 x) = gUncheckedSubtermsIncl x- gUncheckedSubterms (R1 x) = gUncheckedSubtermsIncl x--instance GUncheckedSubterms f a => GUncheckedSubterms (M1 i c f) a where- gUncheckedSubterms (M1 x) = gUncheckedSubterms x--instance GUncheckedSubterms (K1 i a) b where- gUncheckedSubterms (K1 _) = []--class GUncheckedSubtermsIncl f a where- gUncheckedSubtermsIncl :: f a -> [a]--instance GUncheckedSubtermsIncl V1 a where- gUncheckedSubtermsIncl _ = []--instance GUncheckedSubtermsIncl U1 a where- gUncheckedSubtermsIncl U1 = []--instance (GUncheckedSubtermsIncl f a, GUncheckedSubtermsIncl g a) => GUncheckedSubtermsIncl (f :*: g) a where- gUncheckedSubtermsIncl (l :*: r) = gUncheckedSubtermsIncl l ++ gUncheckedSubtermsIncl r--instance (GUncheckedSubtermsIncl f a, GUncheckedSubtermsIncl g a) => GUncheckedSubtermsIncl (f :+: g) a where- gUncheckedSubtermsIncl (L1 x) = gUncheckedSubtermsIncl x- gUncheckedSubtermsIncl (R1 x) = gUncheckedSubtermsIncl x--instance GUncheckedSubtermsIncl f a => GUncheckedSubtermsIncl (M1 i c f) a where- gUncheckedSubtermsIncl (M1 x) = gUncheckedSubtermsIncl x---- This is the important case: We've found a term of the same type.-instance OVERLAPPING_ GUncheckedSubtermsIncl (K1 i a) a where- gUncheckedSubtermsIncl (K1 x) = [x]--instance OVERLAPPING_ GUncheckedSubtermsIncl (K1 i a) b where- gUncheckedSubtermsIncl (K1 _) = []+instance HasResolution a => GenValid (Fixed a) where+ genValid = MkFixed <$> genValid+ shrinkValid (MkFixed i) = MkFixed <$> shrinkValid i -- | Generate a valid value by generating all the sub parts using the 'Generic' instance, -- and trying that until a valid value has been generated@@ -1053,8 +475,8 @@ gValidSubtermsIncl (M1 x) = gValidSubtermsIncl x -- This is the important case: We've found a term of the same type.-instance OVERLAPPING_ GValidSubtermsIncl (K1 i a) a where+instance {-# OVERLAPPING #-} GValidSubtermsIncl (K1 i a) a where gValidSubtermsIncl (K1 x) = [x] -instance OVERLAPPING_ GValidSubtermsIncl (K1 i a) b where+instance {-# OVERLAPPING #-} GValidSubtermsIncl (K1 i a) b where gValidSubtermsIncl (K1 _) = []
src/Data/GenValidity/Utils.hs view
@@ -1,19 +1,8 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}--#if __GLASGOW_HASKELL__ >= 710-#define OVERLAPPING_ {-# OVERLAPPING #-}-#else-{-# LANGUAGE OverlappingInstances #-}-#define OVERLAPPING_-#endif-#if MIN_VERSION_base(4,9,0) {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}-#endif+ module Data.GenValidity.Utils ( -- ** Helper functions for implementing generators upTo,@@ -28,9 +17,7 @@ shuffle, genListLength, genListOf,-#if MIN_VERSION_base(4,9,0) genNonEmptyOf,-#endif -- ** Helper functions for implementing shrinking functions shrinkTuple,@@ -43,37 +30,17 @@ genDouble, genFloatX, genInteger,- genUncheckedInt,- shrinkUncheckedInt,- genUncheckedWord,- shrinkUncheckedWord, ) where +import Control.Monad (forM, replicateM)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE import Data.Ratio-import GHC.Exts (Int#, Word#) import GHC.Float (castWord32ToFloat, castWord64ToDouble)-import GHC.Int (Int (..))-import GHC.Word (Word (..)) import System.Random import Test.QuickCheck hiding (Fixed) -#if !MIN_VERSION_QuickCheck(2,8,0)-import Data.List (sortBy)-import Data.Ord (comparing)-#endif-#if MIN_VERSION_base(4,9,0)-import Data.List.NonEmpty(NonEmpty(..))-import qualified Data.List.NonEmpty as NE-#endif--#if MIN_VERSION_base(4,8,0)-import Control.Monad (forM, replicateM)-#else-import Control.Applicative ((<$>), (<*>), pure)-import Control.Monad (forM, replicateM)-#endif- -- | 'upTo' generates an integer between 0 (inclusive) and 'n'. upTo :: Int -> Gen Int upTo n@@ -165,22 +132,12 @@ invE :: Double -> Double -> Double invE lambda u = (- log (1 - u)) / lambda -#if !MIN_VERSION_QuickCheck(2,8,0)--- | Generates a random permutation of the given list.-shuffle :: [a] -> Gen [a]-shuffle xs = do- ns <- vectorOf (length xs) (choose (minBound :: Int, maxBound))- return (map snd (sortBy (comparing fst) (zip ns xs)))-#endif--#if MIN_VERSION_base(4,9,0) genNonEmptyOf :: Gen a -> Gen (NonEmpty a) genNonEmptyOf gen = do l <- genListOf gen case NE.nonEmpty l of- Nothing -> scale (+1) $ genNonEmptyOf gen+ Nothing -> scale (+ 1) $ genNonEmptyOf gen Just ne -> pure ne-#endif -- Uses 'genListLengthWithSize' with the size parameter genListLength :: Gen Int@@ -370,19 +327,3 @@ bi <- resize b genInteger ci <- resize c genIntSizedInteger pure $ ai * bi + ci--genUncheckedInt :: (Int# -> a) -> Gen a-genUncheckedInt func = do- (I# i#) <- genIntX- pure $ func i#--shrinkUncheckedInt :: (Int -> a) -> (a -> Int) -> a -> [a]-shrinkUncheckedInt fromInt toInt = fmap fromInt . shrink . toInt--genUncheckedWord :: (Word# -> a) -> Gen a-genUncheckedWord func = do- (W# w#) <- genWordX- pure $ func w#--shrinkUncheckedWord :: (Word -> a) -> (a -> Word) -> a -> [a]-shrinkUncheckedWord fromWord toWord = fmap fromWord . shrink . toWord
test/Data/GenValidity/GenericSpec.hs view
@@ -100,6 +100,4 @@ instance Validity MyType -instance GenUnchecked MyType- instance GenValid MyType
test/Data/GenValidity/ShrinkGenericSpec.hs view
@@ -8,13 +8,6 @@ spec :: Spec spec = do- describe "genericShrinkUnchecked" $ do- it "shrinks tuples correctly" $- genericShrinkUnchecked ((A2, B3))- `shouldBe` [(A1, B1), (A1, B2), (A1, B3), (A2, B1), (A2, B2)]- it "figures out the right shrinking function for Ex" $- genericShrinkUnchecked (Ex A2 B3)- `shouldBe` [Ex A1 B1, Ex A1 B2, Ex A1 B3, Ex A2 B1, Ex A2 B2] describe "default shrinkValid" $ do it "figures out the right shrinking function for A" $ shrinkValid A2 `shouldBe` [A1]@@ -40,8 +33,6 @@ instance Validity Ex -instance GenUnchecked Ex- instance GenValid Ex data A@@ -51,11 +42,9 @@ instance Validity A -instance GenUnchecked A where- shrinkUnchecked A1 = []- shrinkUnchecked A2 = [A1]--instance GenValid A+instance GenValid A where+ shrinkValid A1 = []+ shrinkValid A2 = [A1] data B = B1@@ -68,9 +57,7 @@ validate B2 = invalid "for test" validate B3 = valid -instance GenUnchecked B where- shrinkUnchecked B1 = []- shrinkUnchecked B2 = [B1]- shrinkUnchecked B3 = [B1, B2]--instance GenValid B+instance GenValid B where+ shrinkValid B1 = []+ shrinkValid B2 = [B1]+ shrinkValid B3 = [B1]
test/Data/InstanceSpec.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.InstanceSpec@@ -6,72 +5,62 @@ ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<*>), pure)-import Data.Functor ((<$>))-#endif--#if MIN_VERSION_base(4,9,0)-import Data.List.NonEmpty (NonEmpty)-#endif- import Control.Monad import Data.Data import Data.Fixed-#if MIN_VERSION_base(4,8,0)-import GHC.Natural-#endif import Data.GenValidity import Data.Int+import Data.List.NonEmpty (NonEmpty) import Data.Ratio import Data.Word+import Numeric.Natural import Test.Hspec import Test.Hspec.Core.QuickCheck (modifyMaxSize, modifyMaxSuccess) import Test.QuickCheck spec :: Spec spec = do- twoTests (Proxy :: Proxy ())- twoTests (Proxy :: Proxy Bool)- twoTests (Proxy :: Proxy Ordering)- twoTests (Proxy :: Proxy Char)- twoTests (Proxy :: Proxy Word)- twoTests (Proxy :: Proxy Word8)- twoTests (Proxy :: Proxy Word16)- twoTests (Proxy :: Proxy Word32)- twoTests (Proxy :: Proxy Word64)- twoTests (Proxy :: Proxy Int)- twoTests (Proxy :: Proxy Int8)- twoTests (Proxy :: Proxy Int16)- twoTests (Proxy :: Proxy Int32)- twoTests (Proxy :: Proxy Int64)- twoTests (Proxy :: Proxy Integer)- twoTests (Proxy :: Proxy Float)- twoTupleTests (Proxy :: Proxy Float)+ genValidTest (Proxy :: Proxy ())+ genValidTest (Proxy :: Proxy Bool)+ genValidTest (Proxy :: Proxy Ordering)+ genValidTest (Proxy :: Proxy Char)+ genValidTest (Proxy :: Proxy Word)+ genValidTest (Proxy :: Proxy Word8)+ genValidTest (Proxy :: Proxy Word16)+ genValidTest (Proxy :: Proxy Word32)+ genValidTest (Proxy :: Proxy Word64)+ genValidTest (Proxy :: Proxy Int)+ genValidTest (Proxy :: Proxy Int8)+ genValidTest (Proxy :: Proxy Int16)+ genValidTest (Proxy :: Proxy Int32)+ genValidTest (Proxy :: Proxy Int64)+ genValidTest (Proxy :: Proxy Integer)+ genValidTest (Proxy :: Proxy Float)+ tupleTest (Proxy :: Proxy Float) -- Regression tests- describe "shrinkUnchecked Float" $ do+ describe "shrinkValid Float" $ do let sf :: Float -> Spec- sf f = it (unwords ["Does not shrink", show f, "to itself"]) $ f `shouldNotSatisfy` (`elem` shrinkUnchecked f)+ sf f = it (unwords ["Does not shrink", show f, "to itself"]) $ f `shouldNotSatisfy` (`elem` shrinkValid f) sf (-2.1393704e20) sf 1.2223988e-12 sf 2.7896812e10- describe "shrinkUnchecked Double" $ do+ describe "shrinkValid Double" $ do let sd :: Double -> Spec- sd d = it (unwords ["Does not shrink", show d, "to itself"]) $ d `shouldNotSatisfy` (`elem` shrinkUnchecked d)+ sd d = it (unwords ["Does not shrink", show d, "to itself"]) $ d `shouldNotSatisfy` (`elem` shrinkValid d) sd (-1.032730679986007e18)- twoTests (Proxy :: Proxy Double)- twoTupleTests (Proxy :: Proxy Double)- threeTests (Proxy :: Proxy (Ratio Int))+ genValidTest (Proxy :: Proxy Double)+ tupleTest (Proxy :: Proxy Double)+ genValidTest (Proxy :: Proxy (Ratio Int)) modifyMaxSuccess (`quot` 2) $- modifyMaxSize (`quot` 2) $ twoTests (Proxy :: Proxy (Either Bool Ordering))- twoTests (Proxy :: Proxy (Maybe Ordering))- twoTests (Proxy :: Proxy (Maybe (Maybe (Ordering))))- threeTests (Proxy :: Proxy (Ratio Integer))+ modifyMaxSize (`quot` 2) $ genValidTest (Proxy :: Proxy (Either Bool Ordering))+ genValidTest (Proxy :: Proxy (Maybe Ordering))+ genValidTest (Proxy :: Proxy (Maybe (Maybe (Ordering))))+ genValidTest (Proxy :: Proxy (Ratio Integer)) -- threeTupleTests (Proxy :: Proxy (Ratio Integer))- threeTests (Proxy :: Proxy (Ratio Int))+ genValidTest (Proxy :: Proxy (Ratio Int)) -- threeTupleTests (Proxy :: Proxy (Ratio Int))- threeTests (Proxy :: Proxy (Ratio Int8))+ genValidTest (Proxy :: Proxy (Ratio Int8)) describe "shrinking (Ratio Int)" $ it "can shrink this example" $ let v = ((-9223372036854775808) % 9223372036854775761) :: Ratio Int@@ -80,88 +69,31 @@ it "can shrink this example" $ let v = ((-128) % 113) :: Ratio Int8 in v `notElem` shrinkValid v- twoTests (Proxy :: Proxy Uni)- twoTupleTests (Proxy :: Proxy Uni)- twoTests (Proxy :: Proxy Deci)- twoTupleTests (Proxy :: Proxy Deci)- twoTests (Proxy :: Proxy Centi)- twoTupleTests (Proxy :: Proxy Centi)- twoTests (Proxy :: Proxy Milli)- twoTupleTests (Proxy :: Proxy Milli)- twoTests (Proxy :: Proxy Micro)- twoTupleTests (Proxy :: Proxy Micro)- twoTests (Proxy :: Proxy Nano)- twoTupleTests (Proxy :: Proxy Nano)- twoTests (Proxy :: Proxy Pico)- twoTupleTests (Proxy :: Proxy Pico)--#if MIN_VERSION_base(4,8,0)- twoTests (Proxy :: Proxy Natural)-- twoTupleTests (Proxy :: Proxy Natural)-#endif-#if MIN_VERSION_base(4,9,0)- twoTests (Proxy :: Proxy (NonEmpty Ordering))-#endif-twoTupleTests ::- forall a.- (Show a, Eq a, Typeable a, GenUnchecked a, GenValid a) =>- Proxy a ->- Spec-twoTupleTests proxy = do- modifyMaxSuccess (`quot` 2) $ modifyMaxSize (`quot` 2) $ twoTests $ (,) <$> proxy <*> proxy--twoTests ::- forall a.- (Show a, Eq a, Typeable a, GenUnchecked a, GenValid a) =>- Proxy a ->- Spec-twoTests proxy =- describe (nameOf proxy) $ do- genUncheckedTest proxy- genValidTest proxy--threeTests ::- forall a.- (Show a, Eq a, Typeable a, GenUnchecked a, GenValid a, GenInvalid a) =>- Proxy a ->- Spec-threeTests proxy =- describe (nameOf proxy) $ do- genUncheckedTest proxy- genValidTest proxy- genInvalidTest proxy+ genValidTest (Proxy :: Proxy Uni)+ tupleTest (Proxy :: Proxy Uni)+ genValidTest (Proxy :: Proxy Deci)+ tupleTest (Proxy :: Proxy Deci)+ genValidTest (Proxy :: Proxy Centi)+ tupleTest (Proxy :: Proxy Centi)+ genValidTest (Proxy :: Proxy Milli)+ tupleTest (Proxy :: Proxy Milli)+ genValidTest (Proxy :: Proxy Micro)+ tupleTest (Proxy :: Proxy Micro)+ genValidTest (Proxy :: Proxy Nano)+ tupleTest (Proxy :: Proxy Nano)+ genValidTest (Proxy :: Proxy Pico)+ tupleTest (Proxy :: Proxy Pico)+ genValidTest (Proxy :: Proxy Natural)+ tupleTest (Proxy :: Proxy Natural)+ genValidTest (Proxy :: Proxy (NonEmpty Ordering)) -genUncheckedTest ::+tupleTest :: forall a.- (Show a, Eq a, Typeable a, GenUnchecked a, GenValid a) =>+ (Show a, Eq a, Typeable a, GenValid a) => Proxy a -> Spec-genUncheckedTest proxy = do- it (unwords ["genUnchecked of", nameOf proxy, "does not crash while validating"]) $- forAll genUnchecked $ \a ->- case prettyValidate (a :: a) of- Right v -> seq v True- Left err -> seq err True- modifyMaxSuccess (`quot` 5) $- it- ( unwords- [ "shrinkUnchecked of",- nameOf proxy,- "only produces values that do not crash while validating"- ]- )- $ forAll genUnchecked $ \a ->- forM_ (shrinkUnchecked a) $ \v ->- case prettyValidate (v :: a) of- Right v_ -> seq v_ $ pure () :: IO ()- Left err -> seq err $ pure ()- modifyMaxSuccess (`quot` 5) $- it (unwords ["shrinkUnchecked of", nameOf proxy, "does not shrink to itself"]) $- forAll genValid $ \a ->- forM_ (shrinkUnchecked a) $ \a' ->- unless (a /= a') $- expectationFailure $ unlines ["The value", show (a :: a), "was shrunk to itself"]+tupleTest proxy = do+ modifyMaxSuccess (`quot` 2) $ modifyMaxSize (`quot` 2) $ genValidTest $ (,) <$> proxy <*> proxy genValidTest :: forall a.@@ -201,41 +133,6 @@ forM_ (shrinkValid a) $ \a' -> unless (a /= a') $ expectationFailure $ unlines ["The value", show (a :: a), "was shrunk to itself"]--genInvalidTest ::- forall a.- (Show a, Typeable a, GenInvalid a) =>- Proxy a ->- Spec-genInvalidTest proxy = do- it (unwords ["genInvalid of", nameOf proxy, "generates only invalid values"]) $- forAll genInvalid $ \a ->- case prettyValidate (a :: a) of- Right _ ->- expectationFailure $ unlines ["'validate' reported this value to be valid: ", show a]- Left e -> seq e $ pure ()- modifyMaxSuccess (`quot` 5) $- it (unwords ["shrinkInvalid of", nameOf proxy, "shrinks to only invalid values"]) $- forAll genInvalid $ \a ->- forM_ (shrinkInvalid a) $ \v ->- case prettyValidate (v :: a) of- Right _ ->- expectationFailure $ unlines ["'validate' reported this value to be valid: ", show v]- Left e -> seq e $ pure ()- modifyMaxSuccess (`quot` 5) $- it- ( unwords- [ "shrinkInvalid of",- nameOf proxy,- "only produces values that do not crash while validating"- ]- )- $ forAll genInvalid $ \a ->- forM_ (shrinkInvalid a) $ \v ->- case prettyValidate (v :: a) of- Right _ ->- expectationFailure $ unlines ["'validate' reported this value to be valid: ", show v]- Left e -> seq e $ pure () nameOf :: forall a.