From 172457ab1597b6a6ac8e46beabbd705c90b7ede8 Mon Sep 17 00:00:00 2001
From: Jonathan Knowles <jonathan.knowles@iohk.io>
Date: Tue, 29 Mar 2022 11:29:49 +0000
Subject: [PATCH] Fix shrinker for `ProtocolParameters`.

Currently, the shrinker always returns the empty list:

```hs
> :set -XTypeApplications
> import Cardano.Wallet.Primitive.Types (ProtocolParameters)
> import Cardano.Wallet.DB.Arbitrary
> import Test.QuickCheck
> generate (arbitrary @ProtocolParameters)
ProtocolParameters {decentralizationLevel = ...}
> a = it
> shrink a
[]
```

By using `genericRoundRobinShrink`, we can get actual shrinking:

```hs
> generate (arbitrary @ProtocolParameters)
ProtocolParameters {decentralizationLevel = ...}
> a = it
> length $ shrink a
68
```
---
 .../test/unit/Cardano/Wallet/DB/Arbitrary.hs  | 28 +++++++++++--------
 1 file changed, 16 insertions(+), 12 deletions(-)

diff --git a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs
index 3962de8a221..4d79ae0daf1 100644
--- a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs
+++ b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs
@@ -11,7 +11,6 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
@@ -174,6 +173,8 @@ import Data.Word.Odd
     ( Word31 )
 import Fmt
     ( Buildable (..), Builder, blockListF', prefixF, suffixF, tupleF )
+import Generics.SOP
+    ( NP (..) )
 import GHC.Generics
     ( Generic )
 import Numeric.Natural
@@ -205,6 +206,8 @@ import Test.QuickCheck
     )
 import Test.QuickCheck.Arbitrary.Generic
     ( genericArbitrary )
+import Test.QuickCheck.Extra
+    ( genericRoundRobinShrink, (<:>), (<@>) )
 import Test.Utils.Time
     ( genUniformTime )
 
@@ -665,17 +668,18 @@ arbitrarySharedAccount =
 -------------------------------------------------------------------------------}
 
 instance Arbitrary ProtocolParameters where
-    shrink ProtocolParameters {..} = ProtocolParameters
-        <$> shrink decentralizationLevel
-        <*> shrink txParameters
-        <*> shrink desiredNumberOfStakePools
-        <*> shrink minimumUTxOvalue
-        <*> shrink stakeKeyDeposit
-        <*> shrink eras
-        <*> shrink maximumCollateralInputCount
-        <*> shrink minimumCollateralPercentage
-        <*> shrink executionUnitPrices
-        <*> pure Nothing
+    shrink = genericRoundRobinShrink
+        <@> shrink
+        <:> shrink
+        <:> shrink
+        <:> shrink
+        <:> shrink
+        <:> shrink
+        <:> shrink
+        <:> shrink
+        <:> shrink
+        <:> const []
+        <:> Nil
     arbitrary = ProtocolParameters
         <$> arbitrary
         <*> arbitrary