packages feed

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