genvalidity 1.1.0.0 → 1.1.1.0

raw patch · 6 files changed

+62/−26 lines, 6 filesdep ~validityPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: validity

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• genvalidity.cabal +3/−3
• src/Data/GenValidity.hs +33/−9
• test/Data/GenValidity/GenericSpec.hs +5/−3
• test/Data/GenValiditySpec.hs +2/−1
• test/Data/InstanceSpec.hs +13/−10

@@ -1,5 +1,11 @@ # Changelog +## [1.1.1.0] - 2024-07-18++### Added++* `GenValid` instances for various newtypes in base+ ## [1.1.0.0] - 2022-08-30  ### Added

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.7.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           genvalidity-version:        1.1.0.0+version:        1.1.1.0 synopsis:       Testing utilities for the validity library description:    Note: There are companion instance packages for this library:                 .@@ -58,7 +58,7 @@       QuickCheck >=2.13     , base >=4.13 && <5     , random >=1.1-    , validity >=0.12+    , validity >=0.12.1   default-language: Haskell2010  test-suite genvalidity-test

@@ -1,7 +1,10 @@ {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} @@ -84,10 +87,15 @@ import Control.Monad (guard) import Data.Char (chr) import Data.Fixed (Fixed (..), HasResolution)+import Data.Functor.Const (Const (Const))+import Data.Functor.Identity (Identity (Identity)) import Data.GenValidity.Utils import Data.Int (Int16, Int32, Int64, Int8) import Data.List.NonEmpty (NonEmpty)+import Data.Monoid (Alt, Dual)+import qualified Data.Monoid as Monoid import Data.Ratio ((%))+import qualified Data.Semigroup as Semigroup import Data.Validity import Data.Word (Word16, Word32, Word64, Word8) import GHC.Generics@@ -123,7 +131,7 @@ -- > instance Arbitrary A where -- >   arbitrary = genValid -- >   shrink = shrinkValid-class Validity a => GenValid a where+class (Validity a) => GenValid a where   -- | Generate a valid datum, this should cover all possible valid values in   -- the type   --@@ -208,15 +216,15 @@       | (a', (b', (c', (d', e')))) <- shrinkValid (a, (b, (c, (d, e))))     ] -instance GenValid a => GenValid (Maybe a) where+instance (GenValid a) => GenValid (Maybe a) where   genValid = genMaybe genValid   shrinkValid = shrinkMaybe shrinkValid -instance GenValid a => GenValid (NonEmpty a) where+instance (GenValid a) => GenValid (NonEmpty a) where   genValid = genNonEmptyOf genValid   shrinkValid = shrinkNonEmpty shrinkValid -instance GenValid a => GenValid [a] where+instance (GenValid a) => GenValid [a] where   genValid = genListOf genValid   shrinkValid = shrinkList shrinkValid @@ -328,7 +336,7 @@     guard $ isValid candidate     pure $ n' % d' -instance HasResolution a => GenValid (Fixed a) where+instance (HasResolution a) => GenValid (Fixed a) where   genValid = MkFixed <$> genValid   shrinkValid (MkFixed i) = MkFixed <$> shrinkValid i @@ -371,6 +379,22 @@ instance (GenValid a) => GGenValid (K1 i a) where   gGenValid = K1 <$> genValid +deriving newtype instance (GenValid a) => GenValid (Identity a)++deriving newtype instance (GenValid (f a)) => GenValid (Alt f a)++deriving newtype instance (GenValid a) => GenValid (Dual a)++deriving newtype instance (GenValid a) => GenValid (Semigroup.First a)++deriving newtype instance (GenValid a) => GenValid (Semigroup.Last a)++deriving newtype instance (GenValid a) => GenValid (Monoid.First a)++deriving newtype instance (GenValid a) => GenValid (Monoid.Last a)++deriving newtype instance (GenValid a) => GenValid (Const a b)+ -- | 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. --@@ -408,10 +432,10 @@   gValidRecursivelyShrink (L1 x) = map L1 (gValidRecursivelyShrink x)   gValidRecursivelyShrink (R1 x) = map R1 (gValidRecursivelyShrink x) -instance GValidRecursivelyShrink f => GValidRecursivelyShrink (M1 i c f) where+instance (GValidRecursivelyShrink f) => GValidRecursivelyShrink (M1 i c f) where   gValidRecursivelyShrink (M1 x) = map M1 (gValidRecursivelyShrink x) -instance GenValid a => GValidRecursivelyShrink (K1 i a) where+instance (GenValid a) => GValidRecursivelyShrink (K1 i a) where   gValidRecursivelyShrink (K1 x) = map K1 (shrinkValid x)  instance GValidRecursivelyShrink U1 where@@ -441,7 +465,7 @@   gValidSubterms (L1 x) = gValidSubtermsIncl x   gValidSubterms (R1 x) = gValidSubtermsIncl x -instance GValidSubterms f a => GValidSubterms (M1 i c f) a where+instance (GValidSubterms f a) => GValidSubterms (M1 i c f) a where   gValidSubterms (M1 x) = gValidSubterms x  instance GValidSubterms (K1 i a) b where@@ -463,7 +487,7 @@   gValidSubtermsIncl (L1 x) = gValidSubtermsIncl x   gValidSubtermsIncl (R1 x) = gValidSubtermsIncl x -instance GValidSubtermsIncl f a => GValidSubtermsIncl (M1 i c f) a where+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.

@@ -82,14 +82,16 @@     ( unwords         ["never shrinks to itself for valid", "\"" ++ nameOf proxy ++ "\"s"]     )-    $ forAll (genValid :: Gen a) $ \a ->+    $ forAll (genValid :: Gen a)+    $ \a ->       forM_ (shrinkValidStructurally a) $ \subA ->         when (subA == a) $-          expectationFailure $ unlines [show a, "was shrunk to itself."]+          expectationFailure $+            unlines [show a, "was shrunk to itself."]  nameOf ::   forall a.-  Typeable a =>+  (Typeable a) =>   Proxy a ->   String nameOf = show . typeRep

@@ -23,7 +23,8 @@       forAll genSingleLineString (`shouldSatisfy` isSingleLine)   describe "upTo" $ do     it "returns only positive integers" $-      forAll arbitrary $ \n -> forAll (upTo n) (`shouldSatisfy` (>= 0))+      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)))

@@ -54,7 +54,8 @@   tupleTest (Proxy :: Proxy Double)   genValidTest (Proxy :: Proxy (Ratio Int))   modifyMaxSuccess (`quot` 2) $-    modifyMaxSize (`quot` 2) $ genValidTest (Proxy :: Proxy (Either Bool Ordering))+    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))@@ -118,26 +119,28 @@             Left err ->               expectationFailure $                 unlines ["'validate' reported this value to be invalid:", show v, err, ""]-  modifyMaxSuccess (`quot` 5) $-    it+  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 ()+    $ 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"]+            expectationFailure $+              unlines ["The value", show (a :: a), "was shrunk to itself"]  nameOf ::   forall a.-  Typeable a =>+  (Typeable a) =>   Proxy a ->   String nameOf = show . typeRep