From 161832045d54361cde60da7199833fa6d5211be8 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Thu, 5 Sep 2024 22:57:29 +0200 Subject: [PATCH] Clean up code a little --- .../Distribution/Solver/Modular/QuickCheck/Utils.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck/Utils.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck/Utils.hs index b650225ca50..24d61e1e72d 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck/Utils.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck/Utils.hs @@ -43,6 +43,8 @@ instance IsTest QCWithSeed where notice normal $ "Using --quickcheck-replay=" ++ show replay run (setOption (QuickCheckReplayLegacy replay) options) test progress +-- | Typeclass for doing arbitrary (but law-abiding) comparisons. See also +-- 'ArbitraryOrd', this is the version that works with 'GHC.Generics'. class GArbitraryOrd f where garbitraryCompare :: QC.Gen (f p -> f p -> Ordering) @@ -83,20 +85,19 @@ instance GArbitraryOrd f => GArbitraryOrd (M1 i t f) where instance ArbitraryOrd c => GArbitraryOrd (K1 i c) where garbitraryCompare = (\c (K1 l) (K1 r) -> c l r) <$> arbitraryCompare +-- | Typeclass for doing arbitrary (but law-abiding) comparisons. class ArbitraryOrd a where arbitraryCompare :: QC.Gen (a -> a -> Ordering) default arbitraryCompare :: (Generic a, GArbitraryOrd (Rep a)) => QC.Gen (a -> a -> Ordering) arbitraryCompare = (\c l r -> c (from l) (from r)) <$> garbitraryCompare -instance ArbitraryOrd Int where - arbitraryCompare = do - bias <- QC.arbitrary - pure $ \l r -> if bias then compare l r else compare r l - instance ArbitraryOrd Char where arbitraryCompare = arbitraryCompareReverseSection +-- | Construct an arbitrary comparison by (conceptually) laying out all values +-- in a list, picking two values (since we are using arbitrary these should +-- be "good" values), and then reversing the section between these two values. arbitraryCompareReverseSection :: (QC.Arbitrary a, Ord a) => QC.Gen (a -> a -> Ordering) arbitraryCompareReverseSection = do