Simplify QC generators for commonly-used types.

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