From 0debea30a60e4fd5dc3e99bd03af7e0a221dcfb7 Mon Sep 17 00:00:00 2001
From: Jonathan Knowles <jonathan.knowles@iohk.io>
Date: Tue, 17 Jan 2023 03:42:49 +0000
Subject: [PATCH] Add function `shrinkBoundedEnum` to `Test.QuickCheck.Extra`.

Though the `QuickCheck` library provides a handy `arbitraryBoundedEnum`
function, it currently doesn't provide a `shrinkBoundedEnum`
counterpart. Users have asked for a function like this here:

https://github.com/nick8325/quickcheck/issues/343

This commit adds our own version, for now. Perhaps, later on, we can
submit a PR to the `QuickCheck` repository to add this function, and
delete our own version.
---
 lib/test-utils/src/Test/QuickCheck/Extra.hs | 31 +++++++++++++++++++++
 1 file changed, 31 insertions(+)

diff --git a/lib/test-utils/src/Test/QuickCheck/Extra.hs b/lib/test-utils/src/Test/QuickCheck/Extra.hs
index 595fe6bd97d..b7c9451da5e 100644
--- a/lib/test-utils/src/Test/QuickCheck/Extra.hs
+++ b/lib/test-utils/src/Test/QuickCheck/Extra.hs
@@ -27,6 +27,7 @@ module Test.QuickCheck.Extra
 
       -- * Shrinking
     , liftShrinker
+    , shrinkBoundedEnum
     , shrinkInterleaved
     , shrinkMapWith
     , groundRobinShrink
@@ -207,6 +208,36 @@ genSized2With f genA genB = uncurry f <$> genSized2 genA genB
 interleaveRoundRobin :: [[a]] -> [a]
 interleaveRoundRobin = concat . L.transpose
 
+-- | Shrinks a 'Bounded' 'Enum' value.
+--
+-- Example:
+--
+-- @
+-- data MyEnum = A0 | A1 | A2 | A3 | A4 | A5 | A6 | A7
+--    deriving (Bounded, Enum, Eq, Ord, Show)
+-- @
+--
+-- >>> shrinkBoundedEnum A7
+-- [A0,A4,A6]
+--
+-- >>> shrinkBoundedEnum A4
+-- [A0,A2,A3]
+--
+-- >>> shrinkBoundedEnum A0
+-- []
+--
+-- See 'arbitraryBoundedEnum'.
+--
+shrinkBoundedEnum :: forall a. (Eq a, Enum a, Bounded a) => a -> [a]
+shrinkBoundedEnum a
+    | a == minBound =
+        []
+    | otherwise =
+        toEnum <$> filter (>= minBoundInt) (shrinkIntegral $ fromEnum a)
+  where
+    minBoundInt :: Int
+    minBoundInt = fromEnum (minBound @a)
+
 -- | Shrink the given pair in interleaved fashion.
 --
 -- Successive shrinks of the left and right hand sides are interleaved in the