Try #2768:

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

@@ -1,59 +1,60 @@
-{-# LANGUAGE NumericUnderscores #-}
-
 module Cardano.Wallet.Primitive.Types.Coin.Gen
-    ( genCoinAny
-    , genCoinSmall
-    , genCoinSmallPositive
-    , genCoinLargePositive
-    , shrinkCoinAny
-    , shrinkCoinSmall
-    , shrinkCoinSmallPositive
-    , shrinkCoinLargePositive
+    ( genCoin
+    , genCoinPositive
+    , genCoinFullRange
+    , shrinkCoin
+    , shrinkCoinPositive
+    , shrinkCoinFullRange
     ) where
 
 import Prelude
 
 import Cardano.Wallet.Primitive.Types.Coin
     ( Coin (..) )
 import Test.QuickCheck
-    ( Gen, choose, shrink )
-
---------------------------------------------------------------------------------
--- Coins chosen from the full range available
---------------------------------------------------------------------------------
-
-genCoinAny :: Gen Coin
-genCoinAny = Coin <$> choose (unCoin minBound, unCoin maxBound)
-
-shrinkCoinAny :: Coin -> [Coin]
-shrinkCoinAny (Coin c) = Coin <$> shrink c
+    ( Gen, choose, frequency, shrink, sized )
 
 --------------------------------------------------------------------------------
--- Coins chosen to be small and possibly zero
+-- Coins chosen according to the size parameter.
 --------------------------------------------------------------------------------
 
-genCoinSmall :: Gen Coin
-genCoinSmall = Coin <$> choose (0, 10)
+genCoin :: Gen Coin
+genCoin = sized $ \n -> Coin . fromIntegral <$> choose (0, n)
 
-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
+-- Coins chosen according to the size parameter, but strictly positive.
 --------------------------------------------------------------------------------
 
-genCoinSmallPositive :: Gen Coin
-genCoinSmallPositive = Coin <$> choose (1, 10)
+genCoinPositive :: Gen Coin
+genCoinPositive = sized $ \n -> Coin . fromIntegral <$> choose (1, max 1 n)
 
-shrinkCoinSmallPositive :: Coin -> [Coin]
-shrinkCoinSmallPositive (Coin c) = Coin <$> filter (> 0) (shrink c)
+shrinkCoinPositive :: Coin -> [Coin]
+shrinkCoinPositive (Coin c) = Coin <$> filter (> 0) (shrink c)
 
 --------------------------------------------------------------------------------
--- Coins chosen from a large range and strictly positive
+-- Coins chosen from the full range available.
 --------------------------------------------------------------------------------
 
-genCoinLargePositive :: Gen Coin
-genCoinLargePositive = Coin <$> choose (1, 1_000_000_000_000)
+-- | Generates coins across the full range available.
+--
+-- This generator has a slight bias towards the limits of the range, but
+-- otherwise generates values uniformly across the whole range.
+--
+-- This can be useful when testing roundtrip conversions between different
+-- types.
+--
+genCoinFullRange :: Gen Coin
+genCoinFullRange = frequency
+    [ (1, pure (Coin 0))
+    , (1, pure (maxBound :: Coin))
+    , (8, Coin <$> choose (1, unCoin (maxBound :: Coin) - 1))
+    ]
 
-shrinkCoinLargePositive :: Coin -> [Coin]
-shrinkCoinLargePositive (Coin c) = Coin <$> filter (> 0) (shrink c)
+shrinkCoinFullRange :: Coin -> [Coin]
+shrinkCoinFullRange =
+    -- Given that we may have a large value, we limit the number of results
+    -- returned in order to avoid processing long lists of shrunken values.
+    take 8 . shrinkCoin

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

@@ -9,13 +9,12 @@ module Cardano.Wallet.Primitive.Types.TokenBundle.Gen
 
 import Prelude
 
-import Cardano.Wallet.Primitive.Types.Coin
-    ( Coin (..) )
 import Cardano.Wallet.Primitive.Types.Coin.Gen
-    ( genCoinSmall
-    , genCoinSmallPositive
-    , shrinkCoinSmall
-    , shrinkCoinSmallPositive
+    ( genCoin
+    , genCoinFullRange
+    , genCoinPositive
+    , shrinkCoin
+    , shrinkCoinPositive
     )
 import Cardano.Wallet.Primitive.Types.TokenBundle
     ( TokenBundle (..) )
@@ -43,17 +42,12 @@ import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 genFixedSizeTokenBundle :: Int -> Gen TokenBundle
 genFixedSizeTokenBundle fixedAssetCount
     = TokenBundle.fromFlatList
-        <$> genCoin
+        <$> genCoinFullRange
         <*> replicateM fixedAssetCount genAssetQuantity
   where
     genAssetQuantity = (,)
         <$> genAssetIdLargeRange
         <*> genTokenQuantity
-    genCoin = Coin <$> oneof
-        [ pure $ unCoin minBound
-        , pure $ unCoin maxBound
-        , choose (unCoin minBound + 1, unCoin maxBound - 1)
-        ]
     genTokenQuantity = integerToTokenQuantity <$> oneof
         [ pure $ tokenQuantityToInteger txOutMinTokenQuantity
         , pure $ tokenQuantityToInteger txOutMaxTokenQuantity
@@ -85,22 +79,22 @@ genVariableSizedTokenBundle maxAssetCount =
 
 genTokenBundleSmallRange :: Gen TokenBundle
 genTokenBundleSmallRange = TokenBundle
-    <$> genCoinSmall
+    <$> genCoin
     <*> genTokenMapSmallRange
 
 shrinkTokenBundleSmallRange :: TokenBundle -> [TokenBundle]
 shrinkTokenBundleSmallRange (TokenBundle c m) =
     uncurry TokenBundle <$> shrinkInterleaved
-        (c, shrinkCoinSmall)
+        (c, shrinkCoin)
         (m, shrinkTokenMapSmallRange)
 
 genTokenBundleSmallRangePositive :: Gen TokenBundle
 genTokenBundleSmallRangePositive = TokenBundle
-    <$> genCoinSmallPositive
+    <$> genCoinPositive
     <*> genTokenMapSmallRange
 
 shrinkTokenBundleSmallRangePositive :: TokenBundle -> [TokenBundle]
 shrinkTokenBundleSmallRangePositive (TokenBundle c m) =
     uncurry TokenBundle <$> shrinkInterleaved
-        (c, shrinkCoinSmallPositive)
+        (c, shrinkCoinPositive)
         (m, shrinkTokenMapSmallRange)

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

@@ -3,12 +3,11 @@
 {-# LANGUAGE TypeApplications #-}
 
 module Cardano.Wallet.Primitive.Types.TokenMap.Gen
-    ( genAssetIdSized
+    ( genAssetId
     , genAssetIdLargeRange
-    , genAssetIdSmallRange
     , genTokenMapSized
     , genTokenMapSmallRange
-    , shrinkAssetIdSmallRange
+    , shrinkAssetId
     , shrinkTokenMapSmallRange
     , AssetIdF (..)
     ) where
@@ -18,19 +17,17 @@ import Prelude
 import Cardano.Wallet.Primitive.Types.TokenMap
     ( AssetId (..), TokenMap )
 import Cardano.Wallet.Primitive.Types.TokenPolicy.Gen
-    ( genTokenNameLargeRange
-    , genTokenNameSized
-    , genTokenNameSmallRange
+    ( genTokenName
+    , genTokenNameLargeRange
+    , genTokenPolicyId
     , genTokenPolicyIdLargeRange
-    , genTokenPolicyIdSized
-    , genTokenPolicyIdSmallRange
-    , shrinkTokenNameSmallRange
-    , shrinkTokenPolicyIdSmallRange
-    , tokenNamesMediumRange
-    , tokenPolicies
+    , shrinkTokenName
+    , shrinkTokenPolicyId
+    , testTokenNames
+    , testTokenPolicyIds
     )
 import Cardano.Wallet.Primitive.Types.TokenQuantity.Gen
-    ( genTokenQuantitySized, genTokenQuantitySmall, shrinkTokenQuantitySmall )
+    ( genTokenQuantity, shrinkTokenQuantity )
 import Control.Monad
     ( replicateM )
 import Data.List
@@ -60,8 +57,8 @@ import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
 -- Asset identifiers chosen from a range that depends on the size parameter
 --------------------------------------------------------------------------------
 
-genAssetIdSized :: Gen AssetId
-genAssetIdSized = sized $ \size -> do
+genAssetId :: Gen AssetId
+genAssetId = sized $ \size -> do
     -- Ideally, we want to choose asset identifiers from a range that scales
     -- /linearly/ with the size parameter.
     --
@@ -75,22 +72,13 @@ genAssetIdSized = sized $ \size -> do
     --
     let sizeSquareRoot = max 1 $ ceiling $ sqrt $ fromIntegral @Int @Double size
     AssetId
-        <$> resize sizeSquareRoot genTokenPolicyIdSized
-        <*> resize sizeSquareRoot genTokenNameSized
+        <$> resize sizeSquareRoot genTokenPolicyId
+        <*> resize sizeSquareRoot genTokenName
 
---------------------------------------------------------------------------------
--- Asset identifiers chosen from a small range (to allow collisions)
---------------------------------------------------------------------------------
-
-genAssetIdSmallRange :: Gen AssetId
-genAssetIdSmallRange = AssetId
-    <$> genTokenPolicyIdSmallRange
-    <*> genTokenNameSmallRange
-
-shrinkAssetIdSmallRange :: AssetId -> [AssetId]
-shrinkAssetIdSmallRange (AssetId p t) = uncurry AssetId <$> shrinkInterleaved
-    (p, shrinkTokenPolicyIdSmallRange)
-    (t, shrinkTokenNameSmallRange)
+shrinkAssetId :: AssetId -> [AssetId]
+shrinkAssetId (AssetId p t) = uncurry AssetId <$> shrinkInterleaved
+    (p, shrinkTokenPolicyId)
+    (t, shrinkTokenName)
 
 --------------------------------------------------------------------------------
 -- Asset identifiers chosen from a large range (to minimize collisions)
@@ -112,8 +100,8 @@ genTokenMapSized = sized $ \size -> do
     TokenMap.fromFlatList <$> replicateM assetCount genAssetQuantity
   where
     genAssetQuantity = (,)
-        <$> genAssetIdSized
-        <*> genTokenQuantitySized
+        <$> genAssetId
+        <*> genTokenQuantity
 
 --------------------------------------------------------------------------------
 -- Token maps with assets and quantities chosen from small ranges
@@ -129,8 +117,8 @@ genTokenMapSmallRange = do
     TokenMap.fromFlatList <$> replicateM assetCount genAssetQuantity
   where
     genAssetQuantity = (,)
-        <$> genAssetIdSmallRange
-        <*> genTokenQuantitySmall
+        <$> genAssetId
+        <*> genTokenQuantity
 
 shrinkTokenMapSmallRange :: TokenMap -> [TokenMap]
 shrinkTokenMapSmallRange
@@ -139,8 +127,8 @@ shrinkTokenMapSmallRange
     . TokenMap.toFlatList
   where
     shrinkAssetQuantity (a, q) = shrinkInterleaved
-        (a, shrinkAssetIdSmallRange)
-        (q, shrinkTokenQuantitySmall)
+        (a, shrinkAssetId)
+        (q, shrinkTokenQuantity)
 
 --------------------------------------------------------------------------------
 -- Filtering functions
@@ -154,6 +142,6 @@ instance Function AssetIdF where
 
 instance CoArbitrary AssetIdF where
     coarbitrary (AssetIdF AssetId{tokenName, tokenPolicyId}) genB = do
-        let n = fromMaybe 0 (elemIndex tokenName tokenNamesMediumRange)
-        let m = fromMaybe 0 (elemIndex tokenPolicyId tokenPolicies)
+        let n = fromMaybe 0 (elemIndex tokenName testTokenNames)
+        let m = fromMaybe 0 (elemIndex tokenPolicyId testTokenPolicyIds)
         variant (n+m) genB