From f70d4d31644761314f165054b979292294bc9ca3 Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Thu, 21 Mar 2024 11:12:50 +0100 Subject: [PATCH 1/8] Add arbitrary instances for Down --- src/Test/QuickCheck/Arbitrary.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/Test/QuickCheck/Arbitrary.hs b/src/Test/QuickCheck/Arbitrary.hs index 94aec03f..da4e5a56 100644 --- a/src/Test/QuickCheck/Arbitrary.hs +++ b/src/Test/QuickCheck/Arbitrary.hs @@ -157,6 +157,7 @@ import Control.Monad import Data.Int(Int8, Int16, Int32, Int64) import Data.Word(Word, Word8, Word16, Word32, Word64) +import Data.Ord import System.Exit (ExitCode(..)) import Foreign.C.Types @@ -1061,6 +1062,17 @@ instance Arbitrary NewlineMode where #endif #endif +#if defined(MIN_VERSION_base) +#if MIN_VERSION_base(4,6,0) +instance Arbitrary1 Down where + liftArbitrary = fmap Down + liftShrink shr = fmap Down . shr . getDown +instance Arbitrary a => Arbitrary (Down a) where + arbitrary = arbitrary1 + shrink = shrink1 +#endif +#endif + -- ** Helper functions for implementing arbitrary -- | Apply a binary function to random arguments. From f1e767c654bb02142c5c7898fcf0924abd17d43f Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Thu, 21 Mar 2024 11:18:40 +0100 Subject: [PATCH 2/8] don't rely on `getDown` --- src/Test/QuickCheck/Arbitrary.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Test/QuickCheck/Arbitrary.hs b/src/Test/QuickCheck/Arbitrary.hs index da4e5a56..9655b2ad 100644 --- a/src/Test/QuickCheck/Arbitrary.hs +++ b/src/Test/QuickCheck/Arbitrary.hs @@ -1066,7 +1066,7 @@ instance Arbitrary NewlineMode where #if MIN_VERSION_base(4,6,0) instance Arbitrary1 Down where liftArbitrary = fmap Down - liftShrink shr = fmap Down . shr . getDown + liftShrink shr (Down a) = Down <$> shr a instance Arbitrary a => Arbitrary (Down a) where arbitrary = arbitrary1 shrink = shrink1 From cbe44c4469fa12954d95b518a63119db813ec2ea Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Thu, 21 Mar 2024 11:33:39 +0100 Subject: [PATCH 3/8] add instance for NonEmpty --- src/Test/QuickCheck/Arbitrary.hs | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/src/Test/QuickCheck/Arbitrary.hs b/src/Test/QuickCheck/Arbitrary.hs index 9655b2ad..1975986b 100644 --- a/src/Test/QuickCheck/Arbitrary.hs +++ b/src/Test/QuickCheck/Arbitrary.hs @@ -147,6 +147,12 @@ import System.IO #endif #endif +#if defined(MIN_VERSION_base) +#if MIN_VERSION_base(4,9,0) +import Data.List.NonEmpty (NonEmpty(..)) +#endif +#endif + import Control.Monad ( liftM , liftM2 @@ -1073,6 +1079,17 @@ instance Arbitrary a => Arbitrary (Down a) where #endif #endif +#if defined(MIN_VERSION_base) +#if MIN_VERSION_base(4,9,0) +instance Arbitrary a => Arbitrary (NonEmpty a) where + arbitrary = (:|) <$> arbitrary <*> arbitrary + shrink (a :| bs) = + [ a' :| bs | a' <- shrink a ] ++ + [ b :| bs' | b : bs' <- [bs] ] ++ + [ a :| bs' | bs' <- shrink bs ] +#endif +#endif + -- ** Helper functions for implementing arbitrary -- | Apply a binary function to random arguments. From 04769c6c5377083eec92e616fa5b79d723884726 Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Thu, 21 Mar 2024 11:38:26 +0100 Subject: [PATCH 4/8] instances of CoArbitrary --- src/Test/QuickCheck/Arbitrary.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/Test/QuickCheck/Arbitrary.hs b/src/Test/QuickCheck/Arbitrary.hs index 1975986b..9f4cee23 100644 --- a/src/Test/QuickCheck/Arbitrary.hs +++ b/src/Test/QuickCheck/Arbitrary.hs @@ -1073,6 +1073,7 @@ instance Arbitrary NewlineMode where instance Arbitrary1 Down where liftArbitrary = fmap Down liftShrink shr (Down a) = Down <$> shr a + instance Arbitrary a => Arbitrary (Down a) where arbitrary = arbitrary1 shrink = shrink1 @@ -1424,6 +1425,21 @@ instance CoArbitrary a => CoArbitrary [a] where instance (Integral a, CoArbitrary a) => CoArbitrary (Ratio a) where coarbitrary r = coarbitrary (numerator r,denominator r) +#if defined(MIN_VERSION_base) +#if MIN_VERSION_base(4,6,0) +instance CoArbitrary a => CoArbitrary (Down a) where + coarbitrary (Down x) = coarbitrary x +#endif +#endif + +#if defined(MIN_VERSION_base) +#if MIN_VERSION_base(4,9,0) +instance CoArbitrary a => CoArbitrary (NonEmpty a) where + coarbitrary (a :| as) = coarbitrary (a, as) +#endif +#endif + + #ifndef NO_FIXED instance HasResolution a => CoArbitrary (Fixed a) where coarbitrary = coarbitraryReal From e126be20b38b891405e443b9ea16842840ea202b Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Thu, 21 Mar 2024 11:51:19 +0100 Subject: [PATCH 5/8] Function instances --- src/Test/QuickCheck/Arbitrary.hs | 1 - src/Test/QuickCheck/Function.hs | 21 +++++++++++++++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/src/Test/QuickCheck/Arbitrary.hs b/src/Test/QuickCheck/Arbitrary.hs index 9f4cee23..2ddfb7f7 100644 --- a/src/Test/QuickCheck/Arbitrary.hs +++ b/src/Test/QuickCheck/Arbitrary.hs @@ -1439,7 +1439,6 @@ instance CoArbitrary a => CoArbitrary (NonEmpty a) where #endif #endif - #ifndef NO_FIXED instance HasResolution a => CoArbitrary (Fixed a) where coarbitrary = coarbitraryReal diff --git a/src/Test/QuickCheck/Function.hs b/src/Test/QuickCheck/Function.hs index d8c0d27f..f2ef5f89 100644 --- a/src/Test/QuickCheck/Function.hs +++ b/src/Test/QuickCheck/Function.hs @@ -72,6 +72,7 @@ import Data.Char import Data.Word import Data.List( intersperse ) import Data.Ratio +import Data.Ord import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet import qualified Data.Map as Map @@ -101,6 +102,12 @@ import Data.Fixed import GHC.Generics hiding (C) #endif +#if defined(MIN_VERSION_base) +#if MIN_VERSION_base(4,9,0) +import Data.List.NonEmpty (NonEmpty(..)) +#endif +#endif + -------------------------------------------------------------------------- -- concrete functions @@ -261,6 +268,13 @@ instance Function a => Function [a] where h (Left _) = [] h (Right (x,xs)) = x:xs +#if defined(MIN_VERSION_base) +#if MIN_VERSION_base(4,9,0) +instance Function a => Function (NonEmpty a) where + function = functionMap (\(a :| as) -> (a, as)) (uncurry (:|)) +#endif +#endif + instance Function a => Function (Maybe a) where function = functionMap g h where @@ -423,6 +437,13 @@ instance Function a => Function (Monoid.First a) where instance Function a => Function (Monoid.Last a) where function = functionMap Monoid.getLast Monoid.Last +#if defined(MIN_VERSION_base) +#if MIN_VERSION_base(4,6,0) +instance Function a => Function (Down a) where + function = functionMap (\(Down a) -> a) Down +#endif +#endif + #if MIN_VERSION_base(4,8,0) instance Function (f a) => Function (Monoid.Alt f a) where function = functionMap Monoid.getAlt Monoid.Alt From cae124f201e52ae37f7ffbcb936e34a34ad95429 Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Thu, 21 Mar 2024 12:03:05 +0100 Subject: [PATCH 6/8] Min and Max from Semigroup --- src/Test/QuickCheck/Arbitrary.hs | 22 ++++++++++++++++++++++ src/Test/QuickCheck/Function.hs | 11 ++++++++++- 2 files changed, 32 insertions(+), 1 deletion(-) diff --git a/src/Test/QuickCheck/Arbitrary.hs b/src/Test/QuickCheck/Arbitrary.hs index 2ddfb7f7..3f649f56 100644 --- a/src/Test/QuickCheck/Arbitrary.hs +++ b/src/Test/QuickCheck/Arbitrary.hs @@ -150,6 +150,7 @@ import System.IO #if defined(MIN_VERSION_base) #if MIN_VERSION_base(4,9,0) import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.Semigroup as Semigroup #endif #endif @@ -1014,6 +1015,18 @@ instance Arbitrary a => Arbitrary (Monoid.Last a) where shrink = map Monoid.Last . shrink . Monoid.getLast #endif +#if defined(MIN_VERSION_base) +#if MIN_VERSION_base(4,9,0) +instance Arbitrary a => Arbitrary (Semigroup.Min a) where + arbitrary = fmap Semigroup.Min arbitrary + shrink = map Semigroup.Min . shrink . Semigroup.getMin + +instance Arbitrary a => Arbitrary (Semigroup.Max a) where + arbitrary = fmap Semigroup.Max arbitrary + shrink = map Semigroup.Max . shrink . Semigroup.getMax +#endif +#endif + #if MIN_VERSION_base(4,8,0) instance Arbitrary (f a) => Arbitrary (Monoid.Alt f a) where arbitrary = fmap Monoid.Alt arbitrary @@ -1584,6 +1597,15 @@ instance CoArbitrary a => CoArbitrary (Monoid.Last a) where coarbitrary = coarbitrary . Monoid.getLast #endif +#if MIN_VERSION_base(4,9,0) +instance CoArbitrary a => CoArbitrary (Semigroup.Min a) where + coarbitrary = coarbitrary . Semigroup.getMin + +instance CoArbitrary a => CoArbitrary (Semigroup.Max a) where + coarbitrary = coarbitrary . Semigroup.getMax +#endif + + #if MIN_VERSION_base(4,8,0) instance CoArbitrary (f a) => CoArbitrary (Monoid.Alt f a) where coarbitrary = coarbitrary . Monoid.getAlt diff --git a/src/Test/QuickCheck/Function.hs b/src/Test/QuickCheck/Function.hs index f2ef5f89..6fa2cc61 100644 --- a/src/Test/QuickCheck/Function.hs +++ b/src/Test/QuickCheck/Function.hs @@ -105,6 +105,7 @@ import GHC.Generics hiding (C) #if defined(MIN_VERSION_base) #if MIN_VERSION_base(4,9,0) import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.Semigroup as Semigroup #endif #endif @@ -442,13 +443,21 @@ instance Function a => Function (Monoid.Last a) where instance Function a => Function (Down a) where function = functionMap (\(Down a) -> a) Down #endif -#endif #if MIN_VERSION_base(4,8,0) instance Function (f a) => Function (Monoid.Alt f a) where function = functionMap Monoid.getAlt Monoid.Alt #endif +#if MIN_VERSION_base(4,9,0) +instance Function a => Function (Semigroup.Min a) where + function = functionMap Semigroup.getMin Semigroup.Min + +instance Function a => Function (Semigroup.Max a) where + function = functionMap Semigroup.getMax Semigroup.Max +#endif +#endif + -- poly instances instance Function A where From 6c4eb242007bab41505bae01f39437ffe6b3523e Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Thu, 21 Mar 2024 13:19:09 +0100 Subject: [PATCH 7/8] CoArbitrary and Function for `Small` --- src/Test/QuickCheck/Modifiers.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Test/QuickCheck/Modifiers.hs b/src/Test/QuickCheck/Modifiers.hs index 62f71c52..467bcc90 100644 --- a/src/Test/QuickCheck/Modifiers.hs +++ b/src/Test/QuickCheck/Modifiers.hs @@ -78,6 +78,7 @@ module Test.QuickCheck.Modifiers import Test.QuickCheck.Gen import Test.QuickCheck.Arbitrary import Test.QuickCheck.Exception +import Test.QuickCheck.Function import Data.List ( sort @@ -384,6 +385,12 @@ instance Integral a => Arbitrary (Small a) where arbitrary = fmap Small arbitrarySizedIntegral shrink (Small x) = map Small (shrinkIntegral x) +instance CoArbitrary a => CoArbitrary (Small a) where + coarbitrary (Small a) = coarbitrary a + +instance Function a => Function (Small a) where + function = functionMap getSmall Small + -------------------------------------------------------------------------- -- | @Shrink2 x@: allows 2 shrinking steps at the same time when shrinking x newtype Shrink2 a = Shrink2 {getShrink2 :: a} From 7e01bf9d71a126dfe00888cc40f34ae52c6e778a Mon Sep 17 00:00:00 2001 From: Maximilian Algehed Date: Thu, 21 Mar 2024 13:23:59 +0100 Subject: [PATCH 8/8] move Small function isntance to Test.QuickCheck.Function --- src/Test/QuickCheck/Function.hs | 6 ++++++ src/Test/QuickCheck/Modifiers.hs | 4 ---- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/Test/QuickCheck/Function.hs b/src/Test/QuickCheck/Function.hs index 6fa2cc61..b8056a69 100644 --- a/src/Test/QuickCheck/Function.hs +++ b/src/Test/QuickCheck/Function.hs @@ -66,6 +66,7 @@ module Test.QuickCheck.Function import Test.QuickCheck.Arbitrary import Test.QuickCheck.Poly +import Test.QuickCheck.Modifiers (Small(..)) import Control.Applicative import Data.Char @@ -478,6 +479,11 @@ instance Function OrdB where instance Function OrdC where function = functionMap unOrdC OrdC +-- Instances for modifiers + +instance Function a => Function (Small a) where + function = functionMap getSmall Small + -- instance Arbitrary instance (Function a, CoArbitrary a, Arbitrary b) => Arbitrary (a:->b) where diff --git a/src/Test/QuickCheck/Modifiers.hs b/src/Test/QuickCheck/Modifiers.hs index 467bcc90..547172ff 100644 --- a/src/Test/QuickCheck/Modifiers.hs +++ b/src/Test/QuickCheck/Modifiers.hs @@ -78,7 +78,6 @@ module Test.QuickCheck.Modifiers import Test.QuickCheck.Gen import Test.QuickCheck.Arbitrary import Test.QuickCheck.Exception -import Test.QuickCheck.Function import Data.List ( sort @@ -388,9 +387,6 @@ instance Integral a => Arbitrary (Small a) where instance CoArbitrary a => CoArbitrary (Small a) where coarbitrary (Small a) = coarbitrary a -instance Function a => Function (Small a) where - function = functionMap getSmall Small - -------------------------------------------------------------------------- -- | @Shrink2 x@: allows 2 shrinking steps at the same time when shrinking x newtype Shrink2 a = Shrink2 {getShrink2 :: a}