Remove more Gen weeds

lib/core/src/Cardano/Wallet/Primitive/Types/Coin/Gen.hs

@@ -5,10 +5,7 @@ module Cardano.Wallet.Primitive.Types.Coin.Gen
     , genCoinSmall
     , genCoinSmallPositive
     , genCoinLargePositive
-    , shrinkCoinAny
-    , shrinkCoinSmall
-    , shrinkCoinSmallPositive
-    , shrinkCoinLargePositive
+    , shrinkCoin
     ) where
 
 import Prelude
@@ -25,18 +22,15 @@ import Test.QuickCheck
 genCoinAny :: Gen Coin
 genCoinAny = Coin <$> choose (unCoin minBound, unCoin maxBound)
 
-shrinkCoinAny :: Coin -> [Coin]
-shrinkCoinAny (Coin c) = Coin <$> shrink c
-
 --------------------------------------------------------------------------------
 -- Coins chosen to be small and possibly zero
 --------------------------------------------------------------------------------
 
 genCoinSmall :: Gen Coin
 genCoinSmall = Coin <$> choose (0, 10)
 
-shrinkCoinSmall :: Coin -> [Coin]
-shrinkCoinSmall (Coin c) = Coin <$> shrink c
+shrinkCoin :: Coin -> [Coin]
+shrinkCoin (Coin c) = Coin <$> shrink c
 
 --------------------------------------------------------------------------------
 -- Coins chosen to be small and strictly positive
@@ -45,15 +39,9 @@ shrinkCoinSmall (Coin c) = Coin <$> shrink c
 genCoinSmallPositive :: Gen Coin
 genCoinSmallPositive = Coin <$> choose (1, 10)
 
-shrinkCoinSmallPositive :: Coin -> [Coin]
-shrinkCoinSmallPositive (Coin c) = Coin <$> filter (> 0) (shrink c)
-
 --------------------------------------------------------------------------------
 -- Coins chosen from a large range and strictly positive
 --------------------------------------------------------------------------------
 
 genCoinLargePositive :: Gen Coin
 genCoinLargePositive = Coin <$> choose (1, 1_000_000_000_000)
-
-shrinkCoinLargePositive :: Coin -> [Coin]
-shrinkCoinLargePositive (Coin c) = Coin <$> filter (> 0) (shrink c)

lib/core/src/Cardano/Wallet/Primitive/Types/TokenBundle/Gen.hs

@@ -3,24 +3,19 @@ module Cardano.Wallet.Primitive.Types.TokenBundle.Gen
     , genTokenBundleSmallRange
     , genTokenBundleSmallRangePositive
     , genVariableSizedTokenBundle
-    , shrinkTokenBundleSmallRange
-    , shrinkTokenBundleSmallRangePositive
+    , shrinkTokenBundle
     ) where
 
 import Prelude
 
 import Cardano.Wallet.Primitive.Types.Coin
     ( Coin (..) )
 import Cardano.Wallet.Primitive.Types.Coin.Gen
-    ( genCoinSmall
-    , genCoinSmallPositive
-    , shrinkCoinSmall
-    , shrinkCoinSmallPositive
-    )
+    ( genCoinSmall, genCoinSmallPositive, shrinkCoin )
 import Cardano.Wallet.Primitive.Types.TokenBundle
     ( TokenBundle (..) )
 import Cardano.Wallet.Primitive.Types.TokenMap.Gen
-    ( genAssetIdLargeRange, genTokenMapSmallRange, shrinkTokenMapSmallRange )
+    ( genAssetIdLargeRange, genTokenMapSmallRange, shrinkTokenMap )
 import Cardano.Wallet.Primitive.Types.TokenQuantity
     ( TokenQuantity (..) )
 import Cardano.Wallet.Primitive.Types.Tx
@@ -88,19 +83,13 @@ genTokenBundleSmallRange = TokenBundle
     <$> genCoinSmall
     <*> genTokenMapSmallRange
 
-shrinkTokenBundleSmallRange :: TokenBundle -> [TokenBundle]
-shrinkTokenBundleSmallRange (TokenBundle c m) =
+shrinkTokenBundle :: TokenBundle -> [TokenBundle]
+shrinkTokenBundle (TokenBundle c m) =
     uncurry TokenBundle <$> shrinkInterleaved
-        (c, shrinkCoinSmall)
-        (m, shrinkTokenMapSmallRange)
+        (c, shrinkCoin)
+        (m, shrinkTokenMap)
 
 genTokenBundleSmallRangePositive :: Gen TokenBundle
 genTokenBundleSmallRangePositive = TokenBundle
     <$> genCoinSmallPositive
     <*> genTokenMapSmallRange
-
-shrinkTokenBundleSmallRangePositive :: TokenBundle -> [TokenBundle]
-shrinkTokenBundleSmallRangePositive (TokenBundle c m) =
-    uncurry TokenBundle <$> shrinkInterleaved
-        (c, shrinkCoinSmallPositive)
-        (m, shrinkTokenMapSmallRange)

lib/core/src/Cardano/Wallet/Primitive/Types/TokenMap/Gen.hs

@@ -8,8 +8,8 @@ module Cardano.Wallet.Primitive.Types.TokenMap.Gen
     , genAssetIdSmallRange
     , genTokenMapSized
     , genTokenMapSmallRange
-    , shrinkAssetIdSmallRange
-    , shrinkTokenMapSmallRange
+    , shrinkAssetId
+    , shrinkTokenMap
     , AssetIdF (..)
     ) where
 
@@ -24,13 +24,13 @@ import Cardano.Wallet.Primitive.Types.TokenPolicy.Gen
     , genTokenPolicyIdLargeRange
     , genTokenPolicyIdSized
     , genTokenPolicyIdSmallRange
-    , shrinkTokenNameSmallRange
-    , shrinkTokenPolicyIdSmallRange
+    , shrinkTokenName
+    , shrinkTokenPolicyId
     , tokenNamesMediumRange
     , tokenPolicies
     )
 import Cardano.Wallet.Primitive.Types.TokenQuantity.Gen
-    ( genTokenQuantitySized, genTokenQuantitySmall, shrinkTokenQuantitySmall )
+    ( genTokenQuantitySized, genTokenQuantitySmall, shrinkTokenQuantity )
 import Control.Monad
     ( replicateM )
 import Data.List
@@ -78,6 +78,11 @@ genAssetIdSized = sized $ \size -> do
         <$> resize sizeSquareRoot genTokenPolicyIdSized
         <*> resize sizeSquareRoot genTokenNameSized
 
+shrinkAssetId :: AssetId -> [AssetId]
+shrinkAssetId (AssetId p t) = uncurry AssetId <$> shrinkInterleaved
+    (p, shrinkTokenPolicyId)
+    (t, shrinkTokenName)
+
 --------------------------------------------------------------------------------
 -- Asset identifiers chosen from a small range (to allow collisions)
 --------------------------------------------------------------------------------
@@ -87,11 +92,6 @@ genAssetIdSmallRange = AssetId
     <$> genTokenPolicyIdSmallRange
     <*> genTokenNameSmallRange
 
-shrinkAssetIdSmallRange :: AssetId -> [AssetId]
-shrinkAssetIdSmallRange (AssetId p t) = uncurry AssetId <$> shrinkInterleaved
-    (p, shrinkTokenPolicyIdSmallRange)
-    (t, shrinkTokenNameSmallRange)
-
 --------------------------------------------------------------------------------
 -- Asset identifiers chosen from a large range (to minimize collisions)
 --------------------------------------------------------------------------------
@@ -115,6 +115,16 @@ genTokenMapSized = sized $ \size -> do
         <$> genAssetIdSized
         <*> genTokenQuantitySized
 
+shrinkTokenMap :: TokenMap -> [TokenMap]
+shrinkTokenMap
+    = fmap TokenMap.fromFlatList
+    . shrinkList shrinkAssetQuantity
+    . TokenMap.toFlatList
+  where
+    shrinkAssetQuantity (a, q) = shrinkInterleaved
+        (a, shrinkAssetId)
+        (q, shrinkTokenQuantity)
+
 --------------------------------------------------------------------------------
 -- Token maps with assets and quantities chosen from small ranges
 --------------------------------------------------------------------------------
@@ -132,16 +142,6 @@ genTokenMapSmallRange = do
         <$> genAssetIdSmallRange
         <*> genTokenQuantitySmall
 
-shrinkTokenMapSmallRange :: TokenMap -> [TokenMap]
-shrinkTokenMapSmallRange
-    = fmap TokenMap.fromFlatList
-    . shrinkList shrinkAssetQuantity
-    . TokenMap.toFlatList
-  where
-    shrinkAssetQuantity (a, q) = shrinkInterleaved
-        (a, shrinkAssetIdSmallRange)
-        (q, shrinkTokenQuantitySmall)
-
 --------------------------------------------------------------------------------
 -- Filtering functions
 --------------------------------------------------------------------------------

lib/core/src/Cardano/Wallet/Primitive/Types/TokenPolicy/Gen.hs

@@ -7,8 +7,8 @@ module Cardano.Wallet.Primitive.Types.TokenPolicy.Gen
     , genTokenPolicyIdLargeRange
     , genTokenPolicyIdSmallRange
     , mkTokenPolicyId
-    , shrinkTokenNameSmallRange
-    , shrinkTokenPolicyIdSmallRange
+    , shrinkTokenName
+    , shrinkTokenPolicyId
     , tokenNamesMediumRange
     , tokenNamesSmallRange
     , tokenPolicies
@@ -39,20 +39,20 @@ genTokenNameSized :: Gen TokenName
 genTokenNameSized = sized $ \size ->
     elements $ UnsafeTokenName . B8.snoc "Token" <$> take size ['A' ..]
 
+shrinkTokenName :: TokenName -> [TokenName]
+shrinkTokenName x
+    | x == simplest = []
+    | otherwise = [simplest]
+  where
+    simplest = head tokenNamesSmallRange
+
 --------------------------------------------------------------------------------
 -- Token names chosen from a small range (to allow collisions)
 --------------------------------------------------------------------------------
 
 genTokenNameSmallRange :: Gen TokenName
 genTokenNameSmallRange = elements tokenNamesSmallRange
 
-shrinkTokenNameSmallRange :: TokenName -> [TokenName]
-shrinkTokenNameSmallRange x
-    | x == simplest = []
-    | otherwise = [simplest]
-  where
-    simplest = head tokenNamesSmallRange
-
 tokenNamesSmallRange :: [TokenName]
 tokenNamesSmallRange = UnsafeTokenName . B8.snoc "Token" <$> ['A' .. 'D']
 
@@ -90,8 +90,8 @@ genTokenPolicyIdSized = sized $ \size ->
 genTokenPolicyIdSmallRange :: Gen TokenPolicyId
 genTokenPolicyIdSmallRange = elements tokenPolicies
 
-shrinkTokenPolicyIdSmallRange :: TokenPolicyId -> [TokenPolicyId]
-shrinkTokenPolicyIdSmallRange x
+shrinkTokenPolicyId :: TokenPolicyId -> [TokenPolicyId]
+shrinkTokenPolicyId x
     | x == simplest = []
     | otherwise = [simplest]
   where

lib/core/src/Cardano/Wallet/Primitive/Types/TokenQuantity/Gen.hs

@@ -5,9 +5,7 @@ module Cardano.Wallet.Primitive.Types.TokenQuantity.Gen
     , genTokenQuantityLarge
     , genTokenQuantityMassive
     , genTokenQuantityMixed
-    , shrinkTokenQuantitySmall
-    , shrinkTokenQuantitySmallPositive
-    , shrinkTokenQuantityMixed
+    , shrinkTokenQuantity
     , tokenQuantitySmall
     , tokenQuantityLarge
     , tokenQuantityMassive
@@ -42,9 +40,6 @@ genTokenQuantitySmall = quantityFromInteger <$> oneof
     , choose (1, quantityToInteger tokenQuantitySmall)
     ]
 
-shrinkTokenQuantitySmall :: TokenQuantity -> [TokenQuantity]
-shrinkTokenQuantitySmall = shrinkTokenQuantity
-
 --------------------------------------------------------------------------------
 -- Small strictly-positive token quantities
 --------------------------------------------------------------------------------
@@ -53,10 +48,6 @@ genTokenQuantitySmallPositive :: Gen TokenQuantity
 genTokenQuantitySmallPositive = quantityFromInteger <$>
     choose (1, quantityToInteger tokenQuantitySmall)
 
-shrinkTokenQuantitySmallPositive :: TokenQuantity -> [TokenQuantity]
-shrinkTokenQuantitySmallPositive q = quantityFromInteger <$>
-    filter (> 0) (shrink $ quantityToInteger q)
-
 --------------------------------------------------------------------------------
 -- Large token quantities
 --------------------------------------------------------------------------------
@@ -88,9 +79,6 @@ genTokenQuantityMixed = oneof
     , genTokenQuantityMassive
     ]
 
-shrinkTokenQuantityMixed :: TokenQuantity -> [TokenQuantity]
-shrinkTokenQuantityMixed = shrinkTokenQuantity
-
 --------------------------------------------------------------------------------
 -- Utilities
 --------------------------------------------------------------------------------

lib/core/src/Cardano/Wallet/Primitive/Types/Tx/Gen.hs

@@ -24,7 +24,7 @@ import Cardano.Wallet.Primitive.Types.Hash
 import Cardano.Wallet.Primitive.Types.TokenBundle
     ( TokenBundle )
 import Cardano.Wallet.Primitive.Types.TokenBundle.Gen
-    ( genTokenBundleSmallRange, shrinkTokenBundleSmallRange )
+    ( genTokenBundleSmallRange, shrinkTokenBundle )
 import Cardano.Wallet.Primitive.Types.Tx
     ( TxIn (..), TxOut (..) )
 import Control.Monad
@@ -119,7 +119,7 @@ genTxOutSmallRange = TxOut
 shrinkTxOutSmallRange :: TxOut -> [TxOut]
 shrinkTxOutSmallRange (TxOut a b) = uncurry TxOut <$> shrinkInterleaved
     (a, shrinkAddressSmallRange)
-    (b, filter tokenBundleHasNonZeroCoin . shrinkTokenBundleSmallRange)
+    (b, filter tokenBundleHasNonZeroCoin . shrinkTokenBundle)
 
 tokenBundleHasNonZeroCoin :: TokenBundle -> Bool
 tokenBundleHasNonZeroCoin b = TokenBundle.getCoin b /= Coin 0

lib/core/test/unit/Cardano/Pool/DB/Arbitrary.hs

@@ -47,7 +47,7 @@ import Cardano.Wallet.Primitive.Types
 import Cardano.Wallet.Primitive.Types.Coin
     ( Coin (..) )
 import Cardano.Wallet.Primitive.Types.Coin.Gen
-    ( genCoinLargePositive, shrinkCoinLargePositive )
+    ( genCoinLargePositive, shrinkCoin )
 import Cardano.Wallet.Primitive.Types.Hash
     ( Hash (..) )
 import Control.Arrow
@@ -141,7 +141,7 @@ instance Arbitrary (Quantity "lovelace" Word64) where
     arbitrary = Quantity <$> arbitrary
 
 instance Arbitrary Coin where
-    shrink = shrinkCoinLargePositive
+    shrink = shrinkCoin
     arbitrary = genCoinLargePositive
 
 arbitraryEpochLength :: Word32

lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs

@@ -244,11 +244,11 @@ import Cardano.Wallet.Primitive.Types.RewardAccount
 import Cardano.Wallet.Primitive.Types.TokenBundle
     ( AssetId (..), TokenBundle )
 import Cardano.Wallet.Primitive.Types.TokenBundle.Gen
-    ( genTokenBundleSmallRange, shrinkTokenBundleSmallRange )
+    ( genTokenBundleSmallRange, shrinkTokenBundle )
 import Cardano.Wallet.Primitive.Types.TokenMap
     ( TokenMap )
 import Cardano.Wallet.Primitive.Types.TokenMap.Gen
-    ( genAssetIdSmallRange, genTokenMapSmallRange, shrinkTokenMapSmallRange )
+    ( genAssetIdSmallRange, genTokenMapSmallRange, shrinkTokenMap )
 import Cardano.Wallet.Primitive.Types.TokenPolicy
     ( AssetDecimals (..)
     , AssetLogo (..)
@@ -1247,9 +1247,6 @@ instance Arbitrary KeyHash where
 instance Arbitrary (Script Cosigner) where
     arbitrary = genScriptCosigners
 
-instance Arbitrary ScriptTemplate where
-    arbitrary = genScriptTemplate
-
 instance Arbitrary ApiCredential where
     arbitrary = do
         pubKey <- BS.pack <$> replicateM 32 arbitrary
@@ -1304,6 +1301,9 @@ instance Arbitrary ApiSharedWallet where
         [ ApiSharedWallet . Right <$> arbitrary
         , ApiSharedWallet . Left <$> arbitrary ]
 
+instance Arbitrary ScriptTemplate where
+    arbitrary = genScriptTemplate
+
 instance Arbitrary ApiScriptTemplateEntry where
     arbitrary = genScriptTemplateEntry
 
@@ -2136,12 +2136,12 @@ instance Arbitrary UTxO where
         return $ UTxO $ Map.fromList utxo
 
 instance Arbitrary TokenBundle where
-    shrink = shrinkTokenBundleSmallRange
     arbitrary = genTokenBundleSmallRange
+    shrink = shrinkTokenBundle
 
 instance Arbitrary TokenMap where
-    shrink = shrinkTokenMapSmallRange
     arbitrary = genTokenMapSmallRange
+    shrink = shrinkTokenMap
 
 instance Arbitrary TxOut where
     -- Shrink token bundle but not address

lib/core/test/unit/Cardano/Wallet/DB/Sqlite/TypesSpec.hs

@@ -21,7 +21,7 @@ import Cardano.Wallet.Primitive.Types.TokenQuantity
     ( TokenQuantity (..) )
 import Cardano.Wallet.Primitive.Types.TokenQuantity.Gen
     ( genTokenQuantityMixed
-    , shrinkTokenQuantityMixed
+    , shrinkTokenQuantity
     , tokenQuantityLarge
     , tokenQuantityMassive
     , tokenQuantitySmall
@@ -119,4 +119,4 @@ instance Arbitrary Word31 where
 
 instance Arbitrary TokenQuantity where
     arbitrary = genTokenQuantityMixed
-    shrink = shrinkTokenQuantityMixed
+    shrink = shrinkTokenQuantity