genvalidity 0.9.1.0 → 0.10.0.0
raw patch · 7 files changed
+492/−368 lines, 7 filesdep +randomdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: random
Dependency ranges changed: base
API changes (from Hackage documentation)
- Data.GenValidity: arbPartition :: Int -> Gen [Int]
- Data.GenValidity: genListOf :: Gen a -> Gen [a]
- Data.GenValidity: genNonEmptyOf :: Gen a -> Gen (NonEmpty a)
- Data.GenValidity: genSplit :: Int -> Gen (Int, Int)
- Data.GenValidity: genSplit3 :: Int -> Gen (Int, Int, Int)
- Data.GenValidity: genSplit4 :: Int -> Gen (Int, Int, Int, Int)
- Data.GenValidity: genSplit5 :: Int -> Gen (Int, Int, Int, Int, Int)
- Data.GenValidity: genSplit6 :: Int -> Gen (Int, Int, Int, Int, Int, Int)
- Data.GenValidity: genSplit7 :: Int -> Gen (Int, Int, Int, Int, Int, Int, Int)
- Data.GenValidity: genSplit8 :: Int -> Gen (Int, Int, Int, Int, Int, Int, Int, Int)
- Data.GenValidity: shrinkT2 :: (a -> [a]) -> (a, a) -> [(a, a)]
- Data.GenValidity: shrinkT3 :: (a -> [a]) -> (a, a, a) -> [(a, a, a)]
- Data.GenValidity: shrinkT4 :: (a -> [a]) -> (a, a, a, a) -> [(a, a, a, a)]
- Data.GenValidity: shrinkTuple :: (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
- Data.GenValidity: shuffle :: () => [a] -> Gen [a]
- Data.GenValidity: upTo :: Int -> Gen Int
+ Data.GenValidity.Utils: arbPartition :: Int -> Gen [Int]
+ Data.GenValidity.Utils: genDouble :: Gen Double
+ Data.GenValidity.Utils: genFloat :: Gen Float
+ Data.GenValidity.Utils: genFloatX :: forall a w. (Read a, RealFloat a, Bounded w, Random w) => (w -> a) -> Gen a
+ Data.GenValidity.Utils: genIntX :: forall a. (Integral a, Bounded a, Random a) => Gen a
+ Data.GenValidity.Utils: genInteger :: Gen Integer
+ Data.GenValidity.Utils: genListLength :: Gen Int
+ Data.GenValidity.Utils: genListOf :: Gen a -> Gen [a]
+ Data.GenValidity.Utils: genNonEmptyOf :: Gen a -> Gen (NonEmpty a)
+ Data.GenValidity.Utils: genSplit :: Int -> Gen (Int, Int)
+ Data.GenValidity.Utils: genSplit3 :: Int -> Gen (Int, Int, Int)
+ Data.GenValidity.Utils: genSplit4 :: Int -> Gen (Int, Int, Int, Int)
+ Data.GenValidity.Utils: genSplit5 :: Int -> Gen (Int, Int, Int, Int, Int)
+ Data.GenValidity.Utils: genSplit6 :: Int -> Gen (Int, Int, Int, Int, Int, Int)
+ Data.GenValidity.Utils: genSplit7 :: Int -> Gen (Int, Int, Int, Int, Int, Int, Int)
+ Data.GenValidity.Utils: genSplit8 :: Int -> Gen (Int, Int, Int, Int, Int, Int, Int, Int)
+ Data.GenValidity.Utils: genWordX :: forall a. (Integral a, Bounded a, Random a) => Gen a
+ Data.GenValidity.Utils: shrinkT2 :: (a -> [a]) -> (a, a) -> [(a, a)]
+ Data.GenValidity.Utils: shrinkT3 :: (a -> [a]) -> (a, a, a) -> [(a, a, a)]
+ Data.GenValidity.Utils: shrinkT4 :: (a -> [a]) -> (a, a, a, a) -> [(a, a, a, a)]
+ Data.GenValidity.Utils: shrinkTuple :: (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
+ Data.GenValidity.Utils: shuffle :: () => [a] -> Gen [a]
+ Data.GenValidity.Utils: upTo :: Int -> Gen Int
Files
- LICENSE +1/−1
- genvalidity.cabal +10/−10
- src/Data/GenValidity.hs +61/−32
- src/Data/GenValidity/Utils.hs +173/−19
- test/Data/GenValidity/GenericSpec.hs +69/−69
- test/Data/GenValiditySpec.hs +3/−3
- test/Data/InstanceSpec.hs +175/−234
LICENSE view
@@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2016 Tom Sydney Kerckhove+Copyright (c) 2016-2020 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
genvalidity.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: ba44fb99e6f91291452e903b6e2cb6d5b566b8e667c27442668d66fa1abff13f+-- hash: e90aaf1b087b8075c4ea0ebdc7a6b590389d536577d48df97509b031d9f64fcb name: genvalidity-version: 0.9.1.0+version: 0.10.0.0 synopsis: Testing utilities for the validity library description: Note: There are companion instance packages for this library: .@@ -34,9 +34,8 @@ homepage: https://github.com/NorfairKing/validity#readme bug-reports: https://github.com/NorfairKing/validity/issues author: Tom Sydney Kerckhove-maintainer: syd.kerckhove@gmail.com,- nick.van.den.broeck666@gmail.com-copyright: Copyright: (c) 2016-2019 Tom Sydney Kerckhove+maintainer: syd@cs-syd.eu+copyright: Copyright: (c) 2016-2020 Tom Sydney Kerckhove license: MIT license-file: LICENSE build-type: Simple@@ -47,16 +46,17 @@ library exposed-modules:- Data.GenValidity Data.GenRelativeValidity- other-modules:+ Data.GenValidity Data.GenValidity.Utils+ other-modules: Paths_genvalidity hs-source-dirs: src build-depends: QuickCheck >=2.7 , base >=4.7 && <5+ , random , validity >=0.9 if impl(ghc >=8.0.0) ghc-options: -Wno-redundant-constraints@@ -73,10 +73,10 @@ Paths_genvalidity hs-source-dirs: test- ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fno-warn-name-shadowing+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: QuickCheck- , base+ , base >=4.7 && <5 , genvalidity , hspec , hspec-core
src/Data/GenValidity.hs view
@@ -550,19 +550,25 @@ genUnchecked = arbitrary shrinkUnchecked = shrink -instance GenValid ()+instance GenValid () where+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked instance GenUnchecked Bool where genUnchecked = arbitrary shrinkUnchecked = shrink -instance GenValid Bool+instance GenValid Bool where+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked instance GenUnchecked Ordering where genUnchecked = arbitrary shrinkUnchecked = shrink -instance GenValid Ordering+instance GenValid Ordering where+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked instance GenUnchecked Char where genUnchecked = frequency [(9, choose (minBound, maxBound)), (1, genUtf16SurrogateCodePoint)]@@ -571,71 +577,92 @@ genUtf16SurrogateCodePoint :: Gen Char genUtf16SurrogateCodePoint = chr <$> oneof [choose (0xD800, 0xDBFF), choose (0xDC00, 0xDFFF)] -instance GenValid Char+instance GenValid Char where+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked instance GenUnchecked Int where- genUnchecked = arbitrary+ genUnchecked = genIntX shrinkUnchecked = shrink -instance GenValid Int+instance GenValid Int where+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked+ instance GenUnchecked Int8 where- genUnchecked = arbitrary+ genUnchecked = genIntX shrinkUnchecked = shrink -instance GenValid Int8+instance GenValid Int8 where+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked instance GenUnchecked Int16 where- genUnchecked = arbitrary+ genUnchecked = genIntX shrinkUnchecked = shrink -instance GenValid Int16+instance GenValid Int16 where+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked instance GenUnchecked Int32 where- genUnchecked = arbitrary+ genUnchecked = genIntX shrinkUnchecked = shrink -instance GenValid Int32+instance GenValid Int32 where+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked instance GenUnchecked Int64 where- genUnchecked = arbitrary+ genUnchecked = genIntX shrinkUnchecked = shrink instance GenValid Int64 where- genValid = arbitrary- shrinkValid = shrink+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked instance GenUnchecked Word where- genUnchecked = arbitrary+ genUnchecked = genWordX shrinkUnchecked = shrink -instance GenValid Word+instance GenValid Word where+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked instance GenUnchecked Word8 where- genUnchecked = arbitrary+ genUnchecked = genWordX shrinkUnchecked = shrink -instance GenValid Word8+instance GenValid Word8 where+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked instance GenUnchecked Word16 where- genUnchecked = arbitrary+ genUnchecked = genWordX shrinkUnchecked = shrink -instance GenValid Word16+instance GenValid Word16 where+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked instance GenUnchecked Word32 where- genUnchecked = arbitrary+ genUnchecked = genWordX shrinkUnchecked = shrink -instance GenValid Word32+instance GenValid Word32 where+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked instance GenUnchecked Word64 where- genUnchecked = arbitrary+ genUnchecked = genWordX shrinkUnchecked = shrink -instance GenValid Word64+instance GenValid Word64 where+ genValid = genUnchecked+ shrinkValid = shrinkUnchecked instance GenUnchecked Float where- genUnchecked = frequency [(9, arbitrary), (1, elements [read "NaN", read "Infinity", read "-Infinity", read "-0"])]+ genUnchecked = genFloat #if MIN_VERSION_QuickCheck(2,9,2) shrinkUnchecked f = if | isInfinite f -> []@@ -650,7 +677,7 @@ shrinkValid = shrinkUnchecked instance GenUnchecked Double where- genUnchecked = frequency [(9, arbitrary), (1, elements [read "NaN", read "Infinity", read "-Infinity", read "-0"])]+ genUnchecked = genDouble #if MIN_VERSION_QuickCheck(2,9,2) shrinkUnchecked d = if | isInfinite d -> []@@ -665,7 +692,7 @@ shrinkValid = shrinkUnchecked instance GenUnchecked Integer where- genUnchecked = arbitrary+ genUnchecked = genInteger shrinkUnchecked = shrink instance GenValid Integer@@ -673,8 +700,7 @@ #if MIN_VERSION_base(4,8,0) instance GenUnchecked Natural where genUnchecked = fromInteger . abs <$> genUnchecked- shrinkUnchecked 0 = []- shrinkUnchecked n = [0 .. n-1]+ shrinkUnchecked = fmap (fromInteger . abs) . shrinkUnchecked . toInteger instance GenValid Natural where genValid = fromInteger . abs <$> genValid@@ -685,8 +711,11 @@ shrinkUnchecked (n :% d) = [n' :% d' | (n', d') <- shrinkUnchecked (n, d)] instance (Integral a, Num a, Ord a, GenValid a) => GenValid (Ratio a) where- genValid = (%) <$> genValid <*> (genValid `suchThat` (> 0))- shrinkValid (n :% d) = [n' % d' | (n', d') <- shrinkValid (n, d), d' > 0]+ genValid = (do+ n <- genValid+ d <- (genValid `suchThat` (> 0))+ pure $ n :% d) `suchThat` ((== valid) . validateRatioNormalised)+ shrinkValid (n :% d) = filter isValid [n' % d' | (n', d') <- shrinkValid (n, d), d' > 0] instance (Integral a, Num a, Ord a, Validity a, GenUnchecked a) => GenInvalid (Ratio a)
src/Data/GenValidity/Utils.hs view
@@ -1,10 +1,11 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 710 #define OVERLAPPING_ {-# OVERLAPPING #-} #else@@ -26,6 +27,7 @@ , genSplit8 , arbPartition , shuffle+ , genListLength , genListOf #if MIN_VERSION_base(4,9,0) , genNonEmptyOf@@ -35,9 +37,18 @@ , shrinkT2 , shrinkT3 , shrinkT4+ , genIntX+ , genWordX+ , genFloat+ , genDouble+ , genFloatX+ , genInteger ) where import Test.QuickCheck hiding (Fixed)+import System.Random+import GHC.Float+import Data.Ratio #if !MIN_VERSION_QuickCheck(2,8,0) import Data.List (sortBy) import Data.Ord (comparing)@@ -131,26 +142,9 @@ -- | 'arbPartition n' generates a list 'ls' such that 'sum ls' equals 'n', approximately. arbPartition :: Int -> Gen [Int] arbPartition 0 = pure []-arbPartition i = genLen i >>= go i+arbPartition i = genListLengthWithSize i >>= go i where- genLen :: Int -> Gen Int- genLen maxLen = round . invT (fromIntegral maxLen) <$> choose (0, 1) - -- 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 maxLen u =- let a = 0- b = maxLen- 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))-- go :: Int -> Int -> Gen [Int] go size len = do us <- replicateM len $ choose (0, 1)@@ -180,6 +174,29 @@ Just ne -> pure ne #endif +-- 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))++ -- | A version of @listOf@ that takes size into account more accurately. -- -- This generator distributes the size that is is given among the values@@ -207,3 +224,140 @@ -- | Turn a shrinking function into a function that shrinks quadruples. shrinkT4 :: (a -> [a]) -> (a, a, a, a) -> [(a, a, a, a)] shrinkT4 s (a, b, c, d) = (,,,) <$> s a <*> s b <*> s c <*> s d++-- | 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, uniform)+ ]+ 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)+ uniform :: Gen a+ uniform = 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, uniform)+ ]+ where+ extreme :: Gen a+ extreme = sized $ \s ->+ choose (maxBound - fromIntegral s, maxBound)+ small :: Gen a+ small = sized $ \s -> choose (0, fromIntegral s)+ uniform :: Gen a+ uniform = 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, viaEncoding)+ , (1, uniformViaEncoding)+ , (5, 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+ viaEncoding :: Gen a+ viaEncoding = encodeFloat <$> arbitrary <*> genIntX+ 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
test/Data/GenValidity/GenericSpec.hs view
@@ -4,8 +4,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Data.GenValidity.GenericSpec- ( spec- ) where+ ( spec+ ) where import GHC.Generics (Generic, Rep) @@ -21,84 +21,84 @@ 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 Rational))- 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 Rational))- shrinkValidstructurallySpec (Proxy :: Proxy MyType)+ 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, Eq a, Typeable a, Generic a, GGenValid (Rep a))- => Proxy a- -> Spec+ forall a.+ (Validity a, Show a, Eq 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- , ""- ]+ 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.- ( Validity a- , Show a- , Eq a- , Typeable a- , Generic a- , GenValid a- , GValidRecursivelyShrink (Rep a)- , GValidSubterms (Rep a) a- )- => Proxy a- -> Spec+ forall a.+ ( Validity 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."]+ 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+ forall a. Typeable a+ => Proxy a+ -> String nameOf = show . typeRep data MyType =- MyType Double- Rational- deriving (Show, Eq, Generic, Typeable)+ MyType Double Ordering+ deriving (Show, Eq, Generic, Typeable) instance Validity MyType
test/Data/GenValiditySpec.hs view
@@ -1,6 +1,6 @@ module Data.GenValiditySpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec import Test.QuickCheck@@ -12,7 +12,7 @@ describe "genUtf16SurrogateCodePoint" $ it "generates Utf16 surrogate codepoints" $ forAll genUtf16SurrogateCodePoint $ (`shouldSatisfy` isUtf16SurrogateCodePoint)-+ describe "upTo" $ do it "returns only positive integers" $ forAll arbitrary $ \n -> forAll (upTo n) (`shouldSatisfy` (>= 0))
test/Data/InstanceSpec.hs view
@@ -2,8 +2,8 @@ {-# LANGUAGE CPP #-} module Data.InstanceSpec- ( spec- ) where+ ( spec+ ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<*>), pure) import Data.Functor ((<$>))@@ -29,260 +29,201 @@ 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)- twoTests (Proxy :: Proxy Double)- twoTupleTests (Proxy :: Proxy Double)- threeTests (Proxy :: Proxy Rational)- threeTupleTests (Proxy :: Proxy Rational)- modifyMaxSuccess (`quot` 2) $- modifyMaxSize (`quot` 2) $- threeTests (Proxy :: Proxy (Either Rational Rational))- threeTests (Proxy :: Proxy (Maybe Rational))- threeTests (Proxy :: Proxy (Maybe (Maybe Rational)))- threeTests (Proxy :: Proxy [Rational])- threeTests (Proxy :: Proxy (Ratio Integer))- threeTests (Proxy :: Proxy (Ratio Integer))- threeTupleTests (Proxy :: Proxy (Ratio Integer))- threeTests (Proxy :: Proxy (Ratio Int))- threeTupleTests (Proxy :: Proxy (Ratio Int))- 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)+ 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)+ twoTests (Proxy :: Proxy Double)+ twoTupleTests (Proxy :: Proxy Double)+ threeTests (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))+ -- threeTupleTests (Proxy :: Proxy (Ratio Integer))+ threeTests (Proxy :: Proxy (Ratio Int))+ -- threeTupleTests (Proxy :: Proxy (Ratio Int))+ 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)-- twoTests (Proxy :: Proxy (Ratio Integer))+ twoTests (Proxy :: Proxy Natural) - twoTupleTests (Proxy :: Proxy (Ratio Int))+ twoTupleTests (Proxy :: Proxy Natural) #endif #if MIN_VERSION_base(4,9,0)- threeTests (Proxy :: Proxy (NonEmpty Rational))+ twoTests (Proxy :: Proxy (NonEmpty Ordering)) #endif twoTupleTests ::- forall a. (Show a, Eq a, Typeable a, GenUnchecked a, GenValid a)- => Proxy a- -> Spec+ 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- modifyMaxSuccess (`quot` 3) $- modifyMaxSize (`quot` 3) $ twoTests $ (,,) <$> proxy <*> proxy <*> proxy- modifyMaxSuccess (`quot` 4) $- modifyMaxSize (`quot` 4) $- twoTests $ (,,,) <$> proxy <*> proxy <*> proxy <*> proxy- modifyMaxSuccess (`quot` 5) $- modifyMaxSize (`quot` 5) $- twoTests $ (,,,,) <$> proxy <*> proxy <*> proxy <*> proxy <*> proxy--threeTupleTests ::- forall a. (Show a, Eq a, Typeable a, GenUnchecked a, GenValid a, GenInvalid a)- => Proxy a- -> Spec-threeTupleTests proxy = do- modifyMaxSuccess (`quot` 2) $- modifyMaxSize (`quot` 2) $ threeTests $ (,) <$> proxy <*> proxy- modifyMaxSuccess (`quot` 3) $- modifyMaxSize (`quot` 3) $- threeTests $ (,,) <$> proxy <*> proxy <*> proxy- modifyMaxSuccess (`quot` 4) $- modifyMaxSize (`quot` 4) $- threeTests $ (,,,) <$> proxy <*> proxy <*> proxy <*> proxy- modifyMaxSuccess (`quot` 5) $- modifyMaxSize (`quot` 5) $- threeTests $ (,,,,) <$> proxy <*> proxy <*> proxy <*> proxy <*> proxy+ 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+ 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+ 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+ 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+ describe (nameOf proxy) $ do+ genUncheckedTest proxy+ genValidTest proxy+ genInvalidTest proxy genUncheckedTest ::- forall a. (Show a, Eq a, Typeable a, GenUnchecked a, GenValid a)- => Proxy a- -> Spec+ forall a. (Show a, Eq a, Typeable a, GenUnchecked 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"]+ 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"] genValidTest ::- forall a. (Show a, Eq a, Typeable a, GenValid a)- => Proxy a- -> Spec+ 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"]+ 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"] genInvalidTest ::- forall a. (Show a, Typeable a, GenInvalid a)- => Proxy a- -> Spec+ 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 ()+ 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. Typeable a- => Proxy a- -> String+ forall a. Typeable a+ => Proxy a+ -> String nameOf = show . typeRep