genvalidity-1.1.0.0/src/0000755000000000000000000000000014263116073013146 5ustar0000000000000000genvalidity-1.1.0.0/src/Data/0000755000000000000000000000000014303373607014022 5ustar0000000000000000genvalidity-1.1.0.0/src/Data/GenValidity/0000755000000000000000000000000014303373663016243 5ustar0000000000000000genvalidity-1.1.0.0/test/0000755000000000000000000000000014263116073013336 5ustar0000000000000000genvalidity-1.1.0.0/test/Data/0000755000000000000000000000000014303207267014210 5ustar0000000000000000genvalidity-1.1.0.0/test/Data/GenValidity/0000755000000000000000000000000014263116073016426 5ustar0000000000000000genvalidity-1.1.0.0/src/Data/GenValidity.hs0000644000000000000000000003727214303373252016604 0ustar0000000000000000{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -- | -- -- @GenValid@ exists to make tests involving @Validity@ types easier and -- speed up the generation of data for them. -- -- 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. -- 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 GenValid Prime where -- > genValid = Prime <$> -- > (oneof -- > [ pure 2 -- > , ((\y -> 2 * abs y + 1) <$> arbitrary) `suchThat` isPrime) -- > ]) -- -- -- Typical examples of tests involving validity could look as follows: -- -- > it "succeeds when given valid input" $ do -- > forAllValid $ \input -> -- > myFunction input `shouldSatisfy` isRight -- -- > it "produces valid output when it succeeds" $ do -- > forAllValid $ \input -> -- > case myFunction input of -- > Nothing -> return () -- Can happen -- > Just output -> output `shouldSatisfy` isValid -- -- Definitely also look at the companion packages for more info on how to use this package. module Data.GenValidity ( GenValid (..), -- * Helper functions genValidStructurally, genValidStructurallyWithoutExtraChecking, shrinkValidStructurally, shrinkValidStructurallyWithoutExtraFiltering, module Data.GenValidity.Utils, -- ** Helper functions for specific types -- *** Char genUtf16SurrogateCodePoint, genLineSeparator, genNonLineSeparator, -- *** String genSingleLineString, -- * Re-exports module Data.Validity, -- * The Generics magic GGenValid (..), GValidRecursivelyShrink (..), structurallyValidSubterms, GValidSubterms (..), GValidSubtermsIncl (..), ) where import Control.Monad (guard) import Data.Char (chr) import Data.Fixed (Fixed (..), HasResolution) import Data.GenValidity.Utils 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.Real (Ratio (..)) import Numeric.Natural import Test.QuickCheck hiding (Fixed) {-# ANN module "HLint: ignore Reduce duplication" #-} -- | 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. -- It is possible that, if few values are valid or if validity -- checking is expensive, the resulting generator is too slow. -- In that case, go to Step 2. -- -- __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 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' -- -- If you also write @Arbitrary@ instances for @GenValid@ types, it may be -- best to simply use -- -- > 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 = 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 :: (Generic a, GGenValid (Rep a)) => Gen a genValid = genValidStructurally -- | Shrink a valid value. -- -- The default implementation is as follows: -- -- > 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 :: (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a] shrinkValid = shrinkValidStructurally instance (GenValid a, GenValid b) => GenValid (a, b) where genValid = sized $ \n -> do (r, s) <- genSplit n a <- resize r genValid b <- resize s genValid return (a, b) shrinkValid = shrinkTuple shrinkValid shrinkValid 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 instance (GenValid a, GenValid b, GenValid c) => GenValid (a, b, c) where genValid = sized $ \n -> do (r, s, t) <- genSplit3 n a <- resize r genValid b <- resize s genValid c <- resize t genValid return (a, b, c) shrinkValid = shrinkTriple shrinkValid shrinkValid shrinkValid instance (GenValid a, GenValid b, GenValid c, GenValid d) => GenValid (a, b, c, d) where genValid = sized $ \n -> do (r, s, t, u) <- genSplit4 n a <- resize r genValid b <- resize s genValid c <- resize t genValid d <- resize u genValid return (a, b, c, d) shrinkValid = shrinkQuadruple shrinkValid shrinkValid shrinkValid shrinkValid instance (GenValid a, GenValid b, GenValid c, GenValid d, GenValid e) => GenValid (a, b, c, d, e) where genValid = sized $ \n -> do (r, s, t, u, v) <- genSplit5 n a <- resize r genValid b <- resize s genValid c <- resize t genValid d <- resize u genValid e <- resize v genValid return (a, b, c, d, e) shrinkValid (a, b, c, d, e) = [ (a', b', c', d', e') | (a', (b', (c', (d', e')))) <- shrinkValid (a, (b, (c, (d, e)))) ] instance GenValid a => GenValid (Maybe a) where genValid = genMaybe genValid shrinkValid = shrinkMaybe shrinkValid instance GenValid a => GenValid (NonEmpty a) where genValid = genNonEmptyOf genValid shrinkValid = shrinkNonEmpty shrinkValid instance GenValid a => GenValid [a] where genValid = genListOf genValid shrinkValid = shrinkList shrinkValid instance GenValid () where genValid = pure () shrinkValid () = [] instance GenValid Bool where genValid = arbitrary shrinkValid = shrink instance GenValid Ordering where genValid = arbitrary shrinkValid = 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)] genLineSeparator :: Gen Char genLineSeparator = elements ['\n', '\r'] genNonLineSeparator :: Gen Char genNonLineSeparator = genValid `suchThat` (not . isLineSeparator) genSingleLineString :: Gen String genSingleLineString = genListOf genNonLineSeparator instance GenValid Int where genValid = genIntX shrinkValid = shrink instance GenValid Int8 where genValid = genIntX shrinkValid = shrink instance GenValid Int16 where genValid = genIntX shrinkValid = shrink instance GenValid Int32 where genValid = genIntX shrinkValid = shrink instance GenValid Int64 where genValid = genIntX shrinkValid = shrink instance GenValid Word where genValid = genWordX shrinkValid = shrink instance GenValid Word8 where genValid = genWordX shrinkValid = shrink instance GenValid Word16 where genValid = genWordX shrinkValid = shrink instance GenValid Word32 where genValid = genWordX shrinkValid = shrink instance GenValid Word64 where genValid = genWordX shrinkValid = shrink instance GenValid Float where genValid = genFloat shrinkValid f | isInfinite f = [] | isNaN f = [] | otherwise = shrink f instance GenValid Double where genValid = genDouble shrinkValid d | isInfinite d = [] | isNaN d = [] | otherwise = shrink d instance GenValid Integer where genValid = genInteger shrinkValid = shrink instance GenValid Natural where genValid = fromInteger . abs <$> genValid shrinkValid = fmap (fromInteger . abs) . shrinkValid . toInteger instance (Integral a, Num a, Ord a, GenValid a) => GenValid (Ratio a) where genValid = ( do n <- genValid d <- (genValid `suchThat` (> 0)) pure $ n :% d ) `suchThat` isValid shrinkValid (n :% d) = do (n', d') <- shrinkTuple shrinkValid (filter (> 0) . shrinkValid) (n, d) let candidate = n' :% d' guard $ isValid candidate pure $ n' % d' 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 -- -- > genValidStructurally = genValidStructurallyWithoutExtraChecking `suchThat` isValid -- -- This is probably the function that you are looking for. -- If you do use this function to override `genValid`, you probably also want to use -- 'shrinkValidStructurally' to override 'shrinkValid'. genValidStructurally :: (Validity a, Generic a, GGenValid (Rep a)) => Gen a genValidStructurally = genValidStructurallyWithoutExtraChecking `suchThat` isValid -- | Generate a valid value by generating all the sub parts using the 'Generic' instance, -- -- This generator is _not_ guaranteed to generate a valid value. -- -- This is probably _not_ the function that you are looking for when overriding -- `genValid` _unless_ the type in question has no _extra_ validity constraints on top of -- the validity of its sub parts. genValidStructurallyWithoutExtraChecking :: (Generic a, GGenValid (Rep a)) => Gen a genValidStructurallyWithoutExtraChecking = to <$> gGenValid class GGenValid f where gGenValid :: Gen (f a) instance GGenValid U1 where gGenValid = pure U1 instance (GGenValid a, GGenValid b) => GGenValid (a :*: b) where gGenValid = (:*:) <$> gGenValid <*> gGenValid instance (GGenValid a, GGenValid b) => GGenValid (a :+: b) where gGenValid = oneof [L1 <$> gGenValid, R1 <$> gGenValid] instance (GGenValid a) => GGenValid (M1 i c a) where gGenValid = M1 <$> gGenValid instance (GenValid a) => GGenValid (K1 i a) where gGenValid = K1 <$> genValid -- | Shrink a term to any of its immediate valid subterms, -- and also recursively shrink all subterms, and then filtering out the results that are not valid. -- -- > shrinkValidStructurally = filter isValid . shrinkValidStructurallyWithoutExtraFiltering -- -- This is probably the function that you are looking for. shrinkValidStructurally :: (Validity a, Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a] shrinkValidStructurally = filter isValid . shrinkValidStructurallyWithoutExtraFiltering -- | Shrink a term to any of its immediate valid subterms, -- and also recursively shrink all subterms. -- -- This shrinking function is _not_ guaranteed to shrink to valid values. -- -- This is probably _not_ the function that you are looking for when overriding -- `shrinkValid` _unless_ the type in question has no _extra_ validity constraints on top of -- the validity of its sub parts. shrinkValidStructurallyWithoutExtraFiltering :: (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a] shrinkValidStructurallyWithoutExtraFiltering x = structurallyValidSubterms x ++ structurallyValidRecursivelyShrink x -- | Recursively shrink all immediate structurally valid subterms. structurallyValidRecursivelyShrink :: (Generic a, GValidRecursivelyShrink (Rep a)) => a -> [a] structurallyValidRecursivelyShrink = map to . gValidRecursivelyShrink . from class GValidRecursivelyShrink f where gValidRecursivelyShrink :: f a -> [f a] instance (GValidRecursivelyShrink f, GValidRecursivelyShrink g) => GValidRecursivelyShrink (f :*: g) where gValidRecursivelyShrink (x :*: y) = ((:*:) <$> gValidRecursivelyShrink x <*> gValidRecursivelyShrink y) ++ [x' :*: y | x' <- gValidRecursivelyShrink x] ++ [x :*: y' | y' <- gValidRecursivelyShrink y] instance (GValidRecursivelyShrink f, GValidRecursivelyShrink g) => GValidRecursivelyShrink (f :+: g) where gValidRecursivelyShrink (L1 x) = map L1 (gValidRecursivelyShrink x) gValidRecursivelyShrink (R1 x) = map R1 (gValidRecursivelyShrink x) instance GValidRecursivelyShrink f => GValidRecursivelyShrink (M1 i c f) where gValidRecursivelyShrink (M1 x) = map M1 (gValidRecursivelyShrink x) instance GenValid a => GValidRecursivelyShrink (K1 i a) where gValidRecursivelyShrink (K1 x) = map K1 (shrinkValid x) instance GValidRecursivelyShrink U1 where gValidRecursivelyShrink U1 = [] instance GValidRecursivelyShrink V1 where -- The empty type can't be shrunk to anything. gValidRecursivelyShrink _ = [] -- | All immediate validSubterms of a term. structurallyValidSubterms :: (Generic a, GValidSubterms (Rep a) a) => a -> [a] structurallyValidSubterms = gValidSubterms . from class GValidSubterms f a where gValidSubterms :: f a -> [a] instance GValidSubterms V1 a where gValidSubterms _ = [] instance GValidSubterms U1 a where gValidSubterms U1 = [] instance (GValidSubtermsIncl f a, GValidSubtermsIncl g a) => GValidSubterms (f :*: g) a where gValidSubterms (l :*: r) = gValidSubtermsIncl l ++ gValidSubtermsIncl r instance (GValidSubtermsIncl f a, GValidSubtermsIncl g a) => GValidSubterms (f :+: g) a where gValidSubterms (L1 x) = gValidSubtermsIncl x gValidSubterms (R1 x) = gValidSubtermsIncl x instance GValidSubterms f a => GValidSubterms (M1 i c f) a where gValidSubterms (M1 x) = gValidSubterms x instance GValidSubterms (K1 i a) b where gValidSubterms (K1 _) = [] class GValidSubtermsIncl f a where gValidSubtermsIncl :: f a -> [a] instance GValidSubtermsIncl V1 a where gValidSubtermsIncl _ = [] instance GValidSubtermsIncl U1 a where gValidSubtermsIncl U1 = [] instance (GValidSubtermsIncl f a, GValidSubtermsIncl g a) => GValidSubtermsIncl (f :*: g) a where gValidSubtermsIncl (l :*: r) = gValidSubtermsIncl l ++ gValidSubtermsIncl r instance (GValidSubtermsIncl f a, GValidSubtermsIncl g a) => GValidSubtermsIncl (f :+: g) a where gValidSubtermsIncl (L1 x) = gValidSubtermsIncl x gValidSubtermsIncl (R1 x) = gValidSubtermsIncl x instance GValidSubtermsIncl f a => GValidSubtermsIncl (M1 i c f) a where 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 gValidSubtermsIncl (K1 x) = [x] instance {-# OVERLAPPING #-} GValidSubtermsIncl (K1 i a) b where gValidSubtermsIncl (K1 _) = [] genvalidity-1.1.0.0/src/Data/GenValidity/Utils.hs0000644000000000000000000002635014303373421017675 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} module Data.GenValidity.Utils ( -- ** Helper functions for implementing generators upTo, genSplit, genSplit3, genSplit4, genSplit5, genSplit6, genSplit7, genSplit8, arbPartition, shuffle, genListLength, genStringBy, genStringBy1, genListOf, genListOf1, genMaybe, genNonEmptyOf, genIntX, genWordX, genFloat, genDouble, genFloatX, genInteger, -- ** Helper functions for implementing shrinking functions shrinkMaybe, shrinkTuple, shrinkTriple, shrinkQuadruple, shrinkT2, shrinkT3, shrinkT4, shrinkList, shrinkNonEmpty, ) where import Control.Monad (forM, replicateM) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe import Data.Ratio import GHC.Float (castWord32ToFloat, castWord64ToDouble) import System.Random import Test.QuickCheck hiding (Fixed) -- | 'upTo' generates an integer between 0 (inclusive) and 'n'. upTo :: Int -> Gen Int upTo n | n <= 0 = pure 0 | otherwise = choose (0, n) -- | 'genSplit a' generates a tuple '(b, c)' such that 'b + c' equals 'a'. genSplit :: Int -> Gen (Int, Int) genSplit n | n < 0 = pure (0, 0) | otherwise = do i <- choose (0, n) let j = n - i pure (i, j) -- | 'genSplit3 a' generates a triple '(b, c, d)' such that 'b + c + d' equals 'a'. genSplit3 :: Int -> Gen (Int, Int, Int) genSplit3 n | n < 0 = pure (0, 0, 0) | otherwise = do (a, z) <- genSplit n (b, c) <- genSplit z return (a, b, c) -- | 'genSplit4 a' generates a quadruple '(b, c, d, e)' such that 'b + c + d + e' equals 'a'. genSplit4 :: Int -> Gen (Int, Int, Int, Int) genSplit4 n | n < 0 = pure (0, 0, 0, 0) | otherwise = do (y, z) <- genSplit n (a, b) <- genSplit y (c, d) <- genSplit z return (a, b, c, d) -- | 'genSplit5 a' generates a quintuple '(b, c, d, e, f)' such that 'b + c + d + e + f' equals 'a'. genSplit5 :: Int -> Gen (Int, Int, Int, Int, Int) genSplit5 n | n < 0 = pure (0, 0, 0, 0, 0) | otherwise = do (y, z) <- genSplit n (a, b, c) <- genSplit3 y (d, e) <- genSplit z return (a, b, c, d, e) -- | 'genSplit6 a' generates a sextuple '(b, c, d, e, f, g)' such that 'b + c + d + e + f + g' equals 'a'. genSplit6 :: Int -> Gen (Int, Int, Int, Int, Int, Int) genSplit6 n | n < 0 = pure (0, 0, 0, 0, 0, 0) | otherwise = do (y, z) <- genSplit n (a, b, c) <- genSplit3 y (d, e, f) <- genSplit3 z return (a, b, c, d, e, f) -- | 'genSplit7 a' generates a septtuple '(b, c, d, e, f, g)' such that 'b + c + d + e + f + g' equals 'a'. genSplit7 :: Int -> Gen (Int, Int, Int, Int, Int, Int, Int) genSplit7 n | n < 0 = pure (0, 0, 0, 0, 0, 0, 0) | otherwise = do (y, z) <- genSplit n (a, b, c) <- genSplit3 y (d, e, f, g) <- genSplit4 z return (a, b, c, d, e, f, g) -- | 'genSplit8 a' generates a octtuple '(b, c, d, e, f, g, h)' such that 'b + c + d + e + f + g + h' equals 'a'. genSplit8 :: Int -> Gen (Int, Int, Int, Int, Int, Int, Int, Int) genSplit8 n | n < 0 = pure (0, 0, 0, 0, 0, 0, 0, 0) | otherwise = do (y, z) <- genSplit n (a, b, c, d) <- genSplit4 y (e, f, g, h) <- genSplit4 z return (a, b, c, d, e, f, g, h) -- | 'arbPartition n' generates a list 'ls' such that 'sum ls' equals 'n', approximately. arbPartition :: Int -> Gen [Int] arbPartition 0 = pure [] arbPartition i = genListLengthWithSize i >>= go i where go :: Int -> Int -> Gen [Int] go size len = do us <- replicateM len $ choose (0, 1) let invs = map (invE 0.25) us -- Rescale the sizes to (approximately) sum to the given size. pure $ map (round . (* (fromIntegral size / sum invs))) invs -- Use an exponential distribution for generating the -- sizes in the partition. invE :: Double -> Double -> Double invE lambda u = (-log (1 - u)) / lambda genMaybe :: Gen a -> Gen (Maybe a) genMaybe gen = oneof [pure Nothing, Just <$> gen] genNonEmptyOf :: Gen a -> Gen (NonEmpty a) genNonEmptyOf gen = do l <- genListOf gen case NE.nonEmpty l of Nothing -> scale (+ 1) $ genNonEmptyOf gen Just ne -> pure ne -- Uses 'genListLengthWithSize' with the size parameter genListLength :: Gen Int genListLength = sized genListLengthWithSize -- Generate a list length with the given size genListLengthWithSize :: Int -> Gen Int genListLengthWithSize maxLen = round . invT (fromIntegral maxLen) <$> choose (0, 1) where -- Use a triangle distribution for generating the -- length of the list -- with minimum length '0', mode length '2' -- and given max length. invT :: Double -> Double -> Double invT m u = let a = 0 b = m c = 2 fc = (c - a) / (b - a) in if u < fc then a + sqrt (u * (b - a) * (c - a)) else b - sqrt ((1 - u) * (b - a) * (b - c)) -- Generate a String using a generator of 'Char's genStringBy :: Gen Char -> Gen String genStringBy = genListOf -- Generate a String using a generator of 'Char's genStringBy1 :: Gen Char -> Gen String genStringBy1 = genListOf1 -- | A version of @listOf@ that takes size into account more accurately. -- -- This generator distributes the size that is is given among the values -- in the list that it generates. genListOf :: Gen a -> Gen [a] genListOf func = sized $ \n -> do pars <- arbPartition n forM pars $ \i -> resize i func -- | A version of 'genNonEmptyOf' that returns a list instead of a 'NonEmpty'. genListOf1 :: Gen a -> Gen [a] genListOf1 gen = NE.toList <$> genNonEmptyOf gen -- | Lift a shrinker function into a maybe shrinkMaybe :: (a -> [a]) -> Maybe a -> [Maybe a] shrinkMaybe shrinker = \case Nothing -> [] Just a -> Nothing : (Just <$> shrinker a) -- | Combine two shrinking functions to shrink a tuple. shrinkTuple :: (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)] shrinkTuple sa sb (a, b) = ((,) <$> sa a <*> sb b) ++ [(a', b) | a' <- sa a] ++ [(a, b') | b' <- sb b] -- | Like 'shrinkTuple', but for triples shrinkTriple :: (a -> [a]) -> (b -> [b]) -> (c -> [c]) -> (a, b, c) -> [(a, b, c)] shrinkTriple sa sb sc (a, b, c) = do (a', (b', c')) <- shrinkTuple sa (shrinkTuple sb sc) (a, (b, c)) pure (a', b', c') -- | Like 'shrinkTuple', but for quadruples shrinkQuadruple :: (a -> [a]) -> (b -> [b]) -> (c -> [c]) -> (d -> [d]) -> (a, b, c, d) -> [(a, b, c, d)] shrinkQuadruple sa sb sc sd (a, b, c, d) = do ((a', b'), (c', d')) <- shrinkTuple (shrinkTuple sa sb) (shrinkTuple sc sd) ((a, b), (c, d)) pure (a', b', c', d') -- | Turn a shrinking function into a function that shrinks tuples. shrinkT2 :: (a -> [a]) -> (a, a) -> [(a, a)] shrinkT2 s = shrinkTuple s s -- | Turn a shrinking function into a function that shrinks triples. shrinkT3 :: (a -> [a]) -> (a, a, a) -> [(a, a, a)] shrinkT3 s = shrinkTriple s s s -- | Turn a shrinking function into a function that shrinks quadruples. shrinkT4 :: (a -> [a]) -> (a, a, a, a) -> [(a, a, a, a)] shrinkT4 s = shrinkQuadruple s s s s -- Shrink a nonempty list given a shrinker for values. shrinkNonEmpty :: (a -> [a]) -> NonEmpty a -> [NonEmpty a] shrinkNonEmpty shrinker = mapMaybe NE.nonEmpty . shrinkList shrinker . NE.toList -- | Generate Int, Int8, Int16, Int32 and Int64 values smartly. -- -- * Some at the border -- * Some around zero -- * Mostly uniformly genIntX :: forall a. (Integral a, Bounded a, Random a) => Gen a genIntX = frequency [ (1, extreme), (1, small), (8, uniformInt) ] where extreme :: Gen a extreme = sized $ \s -> oneof [ choose (maxBound - fromIntegral s, maxBound), choose (minBound, minBound + fromIntegral s) ] small :: Gen a small = sized $ \s -> choose (-fromIntegral s, fromIntegral s) uniformInt :: Gen a uniformInt = choose (minBound, maxBound) -- | Generate Word, Word8, Word16, Word32 and Word64 values smartly. -- -- * Some at the border -- * Some around zero -- * Mostly uniformly genWordX :: forall a. (Integral a, Bounded a, Random a) => Gen a genWordX = frequency [ (1, extreme), (1, small), (8, uniformWord) ] where extreme :: Gen a extreme = sized $ \s -> choose (maxBound - fromIntegral s, maxBound) small :: Gen a small = sized $ \s -> choose (0, fromIntegral s) uniformWord :: Gen a uniformWord = choose (minBound, maxBound) -- | See 'genFloatX' genFloat :: Gen Float genFloat = genFloatX castWord32ToFloat -- | See 'genFloatX' genDouble :: Gen Double genDouble = genFloatX castWord64ToDouble -- | Generate floating point numbers smartly: -- -- * Some denormalised -- * Some around zero -- * Some around the bounds -- * Some by encoding an Integer and an Int to a floating point number. -- * Some accross the entire range -- * Mostly uniformly via the bitrepresentation -- -- The function parameter is to go from the bitrepresentation to the floating point value. genFloatX :: forall a w. (Read a, RealFloat a, Bounded w, Random w) => (w -> a) -> Gen a genFloatX func = frequency [ (1, denormalised), (1, small), (1, aroundBounds), (1, uniformViaEncoding), (6, reallyUniform) ] where denormalised :: Gen a denormalised = elements [ read "NaN", read "Infinity", read "-Infinity", read "-0" ] -- This is what Quickcheck does, -- but inlined so QuickCheck cannot change -- it behind the scenes in the future. small :: Gen a small = sized $ \n -> do let n' = toInteger n let precision = 9999999999999 :: Integer b <- choose (1, precision) a <- choose ((-n') * b, n' * b) pure (fromRational (a % b)) upperSignificand :: Integer upperSignificand = floatRadix (0.0 :: a) ^ floatDigits (0.0 :: a) lowerSignificand :: Integer lowerSignificand = (-upperSignificand) (lowerExponent, upperExponent) = floatRange (0.0 :: a) aroundBounds :: Gen a aroundBounds = do s <- sized $ \n -> oneof [ choose (lowerSignificand, lowerSignificand + fromIntegral n), choose (upperSignificand - fromIntegral n, upperSignificand) ] e <- sized $ \n -> oneof [ choose (lowerExponent, lowerExponent + n), choose (upperExponent - n, upperExponent) ] pure $ encodeFloat s e uniformViaEncoding :: Gen a uniformViaEncoding = do s <- choose (lowerSignificand, upperSignificand) e <- choose $ floatRange (0.0 :: a) pure $ encodeFloat s e -- Not really uniform, but good enough reallyUniform :: Gen a reallyUniform = func <$> choose (minBound, maxBound) genInteger :: Gen Integer genInteger = sized $ \s -> oneof $ (if s >= 10 then (genBiggerInteger :) else id) [ genIntSizedInteger, small ] where small = sized $ \s -> choose (-toInteger s, toInteger s) genIntSizedInteger = toInteger <$> (genIntX :: Gen Int) genBiggerInteger = sized $ \s -> do (a, b, c) <- genSplit3 s ai <- resize a genIntSizedInteger bi <- resize b genInteger ci <- resize c genIntSizedInteger pure $ ai * bi + ci genvalidity-1.1.0.0/test/Spec.hs0000644000000000000000000000005414263116073014563 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} genvalidity-1.1.0.0/test/Data/GenValidity/GenericSpec.hs0000644000000000000000000000562314263116073021157 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.GenValidity.GenericSpec ( spec, ) where import Control.Monad import Data.GenValidity import Data.Proxy import Data.Typeable import GHC.Generics (Generic, Rep) import Test.Hspec import Test.QuickCheck spec :: Spec spec = do describe "genValidStructurally" $ do genValidstructurallySpec (Proxy :: Proxy Bool) genValidstructurallySpec (Proxy :: Proxy Ordering) genValidstructurallySpec (Proxy :: Proxy (Maybe Double)) genValidstructurallySpec (Proxy :: Proxy (Either Double Ordering)) genValidstructurallySpec (Proxy :: Proxy MyType) describe "shrinkValidStructurally" $ do shrinkValidstructurallySpec (Proxy :: Proxy Bool) shrinkValidstructurallySpec (Proxy :: Proxy Ordering) shrinkValidstructurallySpec (Proxy :: Proxy (Maybe Double)) shrinkValidstructurallySpec (Proxy :: Proxy (Either Double Ordering)) shrinkValidstructurallySpec (Proxy :: Proxy MyType) genValidstructurallySpec :: forall a. (Validity a, Show a, Typeable a, Generic a, GGenValid (Rep a)) => Proxy a -> Spec genValidstructurallySpec proxy = it (unwords ["only generates valid", "\"" ++ nameOf proxy ++ "\"s"]) $ forAll (genValidStructurally :: Gen a) $ \a -> case prettyValidate a of Right _ -> return () Left err -> expectationFailure $ unlines [ "'validate' reported this value to be invalid: ", show a, "with explanation", err, "" ] shrinkValidstructurallySpec :: forall a. ( Show a, Eq a, Typeable a, Generic a, GenValid a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a ) => Proxy a -> Spec shrinkValidstructurallySpec proxy = do it (unwords ["only shrinks to valid", "\"" ++ nameOf proxy ++ "\"s"]) $ forAll (genValid :: Gen a) $ \a -> forM_ (shrinkValidStructurally a) $ \subA -> case prettyValidate subA of Right _ -> return () Left err -> expectationFailure $ unlines [ "'validate' reported this value to be invalid: ", show subA, "with explanation", err, "but it should have been valid from shrinking" ] it ( unwords ["never shrinks to itself for valid", "\"" ++ nameOf proxy ++ "\"s"] ) $ forAll (genValid :: Gen a) $ \a -> forM_ (shrinkValidStructurally a) $ \subA -> when (subA == a) $ expectationFailure $ unlines [show a, "was shrunk to itself."] nameOf :: forall a. Typeable a => Proxy a -> String nameOf = show . typeRep data MyType = MyType Double Ordering deriving (Show, Eq, Generic, Typeable) instance Validity MyType instance GenValid MyType genvalidity-1.1.0.0/test/Data/GenValidity/ShrinkGenericSpec.hs0000644000000000000000000000270614263116073022335 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} module Data.GenValidity.ShrinkGenericSpec where import Data.GenValidity import GHC.Generics (Generic) import Test.Hspec spec :: Spec spec = do describe "default shrinkValid" $ do it "figures out the right shrinking function for A" $ shrinkValid A2 `shouldBe` [A1] it "figures out the right shrinking function for B" $ shrinkValid B3 `shouldBe` [B1] it "shrinks tuples correctly" $ shrinkValid ((A2, B3)) `shouldBe` [(A1, B1), (A1, B3), (A2, B1)] it "figures out the right shrinking function for Ex" $ shrinkValid (Ex A2 B3) `shouldBe` [Ex A1 B1, Ex A1 B3, Ex A2 B1] describe "shrinkValidStructurally" $ do it "shrinks tuples correctly" $ shrinkValidStructurally ((A2, B3)) `shouldBe` [(A1, B1), (A1, B3), (A2, B1)] it "figures out the right shrinking function for Ex" $ shrinkValidStructurally (Ex A2 B3) `shouldBe` [Ex A1 B1, Ex A1 B3, Ex A2 B1] data Ex = Ex A B deriving (Show, Eq, Generic) instance Validity Ex instance GenValid Ex data A = A1 | A2 deriving (Show, Eq, Generic) instance Validity A instance GenValid A where shrinkValid A1 = [] shrinkValid A2 = [A1] data B = B1 | B2 | B3 deriving (Show, Eq, Generic) instance Validity B where validate B1 = valid validate B2 = invalid "for test" validate B3 = valid instance GenValid B where shrinkValid B1 = [] shrinkValid B2 = [B1] shrinkValid B3 = [B1] genvalidity-1.1.0.0/test/Data/GenValiditySpec.hs0000644000000000000000000000622314263116073017600 0ustar0000000000000000module Data.GenValiditySpec ( spec, ) where import Data.GenValidity import Test.Hspec import Test.QuickCheck spec :: Spec spec = do describe "genUtf16SurrogateCodePoint" $ it "generates Utf16 surrogate codepoints" $ forAll genUtf16SurrogateCodePoint (`shouldSatisfy` isUtf16SurrogateCodePoint) describe "genLineSeparator" $ it "generates only line separators" $ forAll genLineSeparator (`shouldSatisfy` isLineSeparator) describe "genNonLineSeparator" $ it "never generates line separators" $ forAll genNonLineSeparator (`shouldSatisfy` (not . isLineSeparator)) describe "genSingleLineString" $ it "generates only single line strings" $ forAll genSingleLineString (`shouldSatisfy` isSingleLine) describe "upTo" $ do it "returns only positive integers" $ forAll arbitrary $ \n -> forAll (upTo n) (`shouldSatisfy` (>= 0)) it "returns only integers smaller than or equal to the given number" $ forAll arbitrary $ \n -> forAll (upTo n) (`shouldSatisfy` (<= (max n 0))) describe "genSplit" $ do it "returns positive integers" $ forAll arbitrary $ \i -> forAll (genSplit i) $ \(a, b) -> do a `shouldSatisfy` (>= 0) b `shouldSatisfy` (>= 0) it "returns two integers such that the sum is the original integer" $ forAll arbitrary $ \i -> forAll (genSplit i) $ \(a, b) -> a + b `shouldBe` max 0 i describe "genSplit3" $ do it "returns positive integers" $ forAll arbitrary $ \i -> forAll (genSplit3 i) $ \(a, b, c) -> do a `shouldSatisfy` (>= 0) b `shouldSatisfy` (>= 0) c `shouldSatisfy` (>= 0) it "returns three integers such that the sum is the original integer" $ forAll arbitrary $ \i -> forAll (genSplit3 i) $ \(a, b, c) -> a + b + c `shouldBe` max 0 i describe "genSplit4" $ do it "returns positive integers" $ forAll arbitrary $ \i -> forAll (genSplit4 i) $ \(a, b, c, d) -> do a `shouldSatisfy` (>= 0) b `shouldSatisfy` (>= 0) c `shouldSatisfy` (>= 0) d `shouldSatisfy` (>= 0) it "returns four integers such that the sum is the original integer" $ forAll arbitrary $ \i -> forAll (genSplit4 i) $ \(a, b, c, d) -> a + b + c + d `shouldBe` max 0 i describe "genSplit5" $ do it "returns positive integers" $ forAll arbitrary $ \i -> forAll (genSplit5 i) $ \(a, b, c, d, e) -> do a `shouldSatisfy` (>= 0) b `shouldSatisfy` (>= 0) c `shouldSatisfy` (>= 0) d `shouldSatisfy` (>= 0) e `shouldSatisfy` (>= 0) it "returns four integers such that the sum is the original integer" $ forAll arbitrary $ \i -> forAll (genSplit5 i) $ \(a, b, c, d, e) -> a + b + c + d + e `shouldBe` max 0 i describe "arbPartition" $ do it "returns an empty list upon strictly negative input" $ forAll (arbitrary `suchThat` (< 0)) $ \n -> forAll (arbPartition n) (`shouldBe` []) it "returns a list of positive integers" $ forAll arbitrary $ \n -> forAll (arbPartition n) $ \p -> p `shouldSatisfy` all (>= 0) genvalidity-1.1.0.0/test/Data/InstanceSpec.hs0000644000000000000000000001150114303207267017121 0ustar0000000000000000{-# LANGUAGE NegativeLiterals #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.InstanceSpec ( spec, ) where import Control.Monad import Data.Data import Data.Fixed 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 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 "shrinkValid Float" $ do let sf :: Float -> Spec 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 "shrinkValid Double" $ do let sd :: Double -> Spec sd d = it (unwords ["Does not shrink", show d, "to itself"]) $ d `shouldNotSatisfy` (`elem` shrinkValid d) sd (-1.032730679986007e18) genValidTest (Proxy :: Proxy Double) tupleTest (Proxy :: Proxy Double) genValidTest (Proxy :: Proxy (Ratio Int)) modifyMaxSuccess (`quot` 2) $ 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)) genValidTest (Proxy :: Proxy (Ratio Int)) -- threeTupleTests (Proxy :: Proxy (Ratio Int)) genValidTest (Proxy :: Proxy (Ratio Int8)) describe "shrinking (Ratio Int)" $ it "can shrink this example" $ let v = ((-9223372036854775808) % 9223372036854775761) :: Ratio Int in v `notElem` shrinkValid v describe "shrinking (Ratio Int8)" $ it "can shrink this example" $ let v = ((-128) % 113) :: Ratio Int8 in v `notElem` shrinkValid v 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)) tupleTest :: forall a. (Show a, Eq a, Typeable a, GenValid a) => Proxy a -> Spec tupleTest proxy = do modifyMaxSuccess (`quot` 2) $ modifyMaxSize (`quot` 2) $ genValidTest $ (,) <$> proxy <*> proxy genValidTest :: forall a. (Show a, Eq a, Typeable a, GenValid a) => Proxy a -> Spec genValidTest proxy = do it (unwords ["genValid of", nameOf proxy, "generates only valid values"]) $ forAll genValid $ \a -> case prettyValidate (a :: a) of Right v -> seq v $ pure () Left err -> expectationFailure $ unlines ["'validate' reported this value to be invalid:", show a, err, ""] modifyMaxSuccess (`quot` 5) $ it (unwords ["shrinkValid of", nameOf proxy, "shrinks to only valid values"]) $ forAll genValid $ \a -> forM_ (shrinkValid a) $ \v -> case prettyValidate (v :: a) of Right v_ -> seq v_ $ pure () Left err -> expectationFailure $ unlines ["'validate' reported this value to be invalid:", show v, err, ""] modifyMaxSuccess (`quot` 5) $ it ( unwords ["shrinkValid of", nameOf proxy, "only produces values that do not crash while validating"] ) $ forAll genValid $ \a -> forM_ (shrinkValid a) $ \v -> case prettyValidate (v :: a) of Right v_ -> seq v_ $ pure () :: IO () Left err -> seq err $ pure () modifyMaxSuccess (`quot` 5) $ it (unwords ["shrinkValid of", nameOf proxy, "does not shrink to itself"]) $ forAll genValid $ \a -> forM_ (shrinkValid a) $ \a' -> unless (a /= a') $ expectationFailure $ unlines ["The value", show (a :: a), "was shrunk to itself"] nameOf :: forall a. Typeable a => Proxy a -> String nameOf = show . typeRep genvalidity-1.1.0.0/LICENSE0000644000000000000000000000210414263116073013361 0ustar0000000000000000The MIT License (MIT) 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 in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. genvalidity-1.1.0.0/CHANGELOG.md0000644000000000000000000001116014303400301014150 0ustar0000000000000000# Changelog ## [1.1.0.0] - 2022-08-30 ### Added * `genListOf1` * `genMaybe` * `shrinkMaybe` * `shrinkNonEmpty` * `shrinkTriple` * `shrinkQuadruple` ### Changed * Sped up shrinking of `NonEmpty` lists by an order of magnitude. * Changed shrinking of `Ratio`s to be 10x faster. * Reimplemented `shrinkT2`, `shrinkT3` and `shrinkT4` in terms of `shrinkTuple`, `shrinkTriple` and `shrinkQuadruple`. ## [1.0.0.1] - 2021-11-20 ### Changed * Added compatibility with `lts-18.16` ## [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 genvalidity-1.1.0.0/genvalidity.cabal0000644000000000000000000000530614303356147015671 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.34.7. -- -- see: https://github.com/sol/hpack name: genvalidity version: 1.1.0.0 synopsis: Testing utilities for the validity library description: Note: There are companion instance packages for this library: . * . * . * . * . * . * . * . * . * . * category: Testing homepage: https://github.com/NorfairKing/validity#readme bug-reports: https://github.com/NorfairKing/validity/issues author: Tom Sydney Kerckhove maintainer: syd@cs-syd.eu 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 location: https://github.com/NorfairKing/validity library exposed-modules: Data.GenValidity Data.GenValidity.Utils other-modules: Paths_genvalidity hs-source-dirs: src ghc-options: -Wno-redundant-constraints build-depends: QuickCheck >=2.13 , base >=4.13 && <5 , random >=1.1 , validity >=0.12 default-language: Haskell2010 test-suite genvalidity-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Data.GenValidity.GenericSpec Data.GenValidity.ShrinkGenericSpec Data.GenValiditySpec Data.InstanceSpec Paths_genvalidity hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: QuickCheck , base >=4.13 && <5 , genvalidity , hspec , hspec-core default-language: Haskell2010