diff --git a/genvalidity.cabal b/genvalidity.cabal --- a/genvalidity.cabal +++ b/genvalidity.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 840d6c35489d2fd27bd375fb91b3e78ad68bc9ce90eb12e72b74816a81a8b8f5 +-- hash: 44ca0d7036af5c0a3fb7191edbe25a916909be1094ab9036589bc8bb76b7609b name: genvalidity -version: 0.4.0.4 +version: 0.5.0.0 synopsis: Testing utilities for the validity library description: Note: There are companion instance packages for this library: . @@ -33,7 +33,7 @@ bug-reports: https://github.com/NorfairKing/validity/issues author: Tom Sydney Kerckhove maintainer: syd.kerckhove@gmail.com -copyright: Copyright: (c) 2016 Tom Sydney Kerckhove +copyright: Copyright: (c) 2016-2018 Tom Sydney Kerckhove license: MIT license-file: LICENSE build-type: Simple @@ -49,7 +49,7 @@ build-depends: QuickCheck >=2.7 && <2.12 , base >=4.7 && <5 - , validity >=0.4.0.3 && <0.5 + , validity >=0.5 && <0.6 if impl(ghc >=8.0.0) ghc-options: -Wno-redundant-constraints exposed-modules: @@ -72,5 +72,6 @@ , hspec other-modules: Data.GenValiditySpec + Data.InstanceSpec Paths_genvalidity default-language: Haskell2010 diff --git a/src/Data/GenValidity.hs b/src/Data/GenValidity.hs --- a/src/Data/GenValidity.hs +++ b/src/Data/GenValidity.hs @@ -67,6 +67,7 @@ import Data.List.NonEmpty (NonEmpty((:|))) #endif import Data.Word (Word, Word8, Word16, Word32, Word64) +import Data.Int (Int, Int8, Int16, Int32, Int64) import GHC.Generics import GHC.Real (Ratio(..)) @@ -353,7 +354,32 @@ shrinkUnchecked = shrink instance GenValid Int +instance GenUnchecked Int8 where + genUnchecked = arbitrary + shrinkUnchecked = shrink +instance GenValid Int8 + +instance GenUnchecked Int16 where + genUnchecked = arbitrary + shrinkUnchecked = shrink + +instance GenValid Int16 + +instance GenUnchecked Int32 where + genUnchecked = arbitrary + shrinkUnchecked = shrink + +instance GenValid Int32 + +instance GenUnchecked Int64 where + genUnchecked = arbitrary + shrinkUnchecked = shrink + +instance GenValid Int64 where + genValid = arbitrary + shrinkValid = shrink + instance GenUnchecked Word where genUnchecked = arbitrary shrinkUnchecked = shrink @@ -419,6 +445,8 @@ shrinkUnchecked (n :% d) = [n' :% d' | (n', d') <- shrinkUnchecked (n, d)] instance (Integral a, Num a, Ord a, GenValid a) => GenValid (Ratio a) + +instance (Integral a, Num a, Ord a, GenValid a) => GenInvalid (Ratio a) instance HasResolution a => GenUnchecked (Fixed a) where genUnchecked = MkFixed <$> genUnchecked diff --git a/test/Data/InstanceSpec.hs b/test/Data/InstanceSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/InstanceSpec.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} + +module Data.InstanceSpec + ( spec + ) where + +import Data.Data +import Data.Int +#if MIN_VERSION_base(4,9,0) +import Data.List.NonEmpty (NonEmpty) +#endif +import Data.Ratio +import Data.Word + +import Control.Monad + +import Test.Hspec +import Test.QuickCheck + +import Control.Applicative (pure) + +import Data.GenValidity + +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) + threeTests (Proxy :: Proxy Float) + threeTests (Proxy :: Proxy Double) + threeTests (Proxy :: Proxy (Double, Double)) + threeTests (Proxy :: Proxy (Double, Double, Double)) + threeTests (Proxy :: Proxy (Double, Double, Double, Double)) + threeTests (Proxy :: Proxy (Either Double Double)) + threeTests (Proxy :: Proxy (Maybe Double)) + threeTests (Proxy :: Proxy [Double]) + threeTests (Proxy :: Proxy (Ratio Integer)) + threeTests (Proxy :: Proxy (Ratio Int)) +#if MIN_VERSION_base(4,9,0) + threeTests (Proxy :: Proxy (NonEmpty Double)) +#endif +twoTests :: + forall a. (Show a, Typeable a, GenValid a) + => Proxy a + -> Spec +twoTests proxy = + describe (nameOf proxy) $ do + genUncheckedTest proxy + genValidTest proxy + +threeTests :: + forall a. (Show a, Typeable a, GenValid a, GenInvalid a) + => Proxy a + -> Spec +threeTests proxy = + describe (nameOf proxy) $ do + genUncheckedTest proxy + genValidTest proxy + genInvalidTest proxy + +genUncheckedTest :: + forall a. (Show a, Typeable a, GenValid a) + => Proxy a + -> Spec +genUncheckedTest proxy = do + it (unwords + ["genUnchecked of", nameOf proxy, "does not crash while validating"]) $ + forAll genUnchecked $ \a -> + case prettyValidation (a :: a) of + Right _ -> True + Left err -> seq err True + it (unwords + [ "shrinkUnchecked of" + , nameOf proxy + , "only produces values that do not crash while validating" + ]) $ + forAll genUnchecked $ \a -> + forM_ (shrinkUnchecked a) $ \v -> + case prettyValidation (v :: a) of + Right _ -> pure () :: IO () + Left err -> seq err $ pure () + +genValidTest :: + forall a. (Show 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 prettyValidation (a :: a) of + Right _ -> pure () + Left err -> + expectationFailure $ + unlines + [ "'validate' reported this value to be invalid:" + , show a + , err + , "" + ] + it (unwords ["shrinkValid of", nameOf proxy, "shrinks to only valid values"]) $ + forAll genValid $ \a -> + forM_ (shrinkValid a) $ \v -> + case prettyValidation (v :: a) of + Right _ -> pure () + Left err -> + expectationFailure $ + unlines + [ "'validate' reported this value to be invalid:" + , show v + , err + , "" + ] + +genInvalidTest :: + forall a. (Show a, Typeable a, GenInvalid a) + => Proxy a + -> Spec +genInvalidTest proxy = do + it (unwords ["genInvalid of", nameOf proxy, "generates only invalid values"]) $ + forAll genInvalid $ \a -> + case prettyValidation (a :: a) of + Right _ -> + expectationFailure $ + unlines + ["'validate' reported this value to be valid: ", show a] + Left _ -> pure () + it (unwords + ["shrinkInvalid of", nameOf proxy, "shrinks to only invalid values"]) $ + forAll genInvalid $ \a -> + forM_ (shrinkInvalid a) $ \v -> + case prettyValidation (v :: a) of + Right _ -> + expectationFailure $ + unlines + [ "'validate' reported this value to be valid: " + , show v + ] + Left _ -> pure () + +nameOf :: + forall a. Typeable a + => Proxy a + -> String +nameOf = show . typeRep