Move generators and shrinkers for UTxOIndex to dedicated Gen module.

cardano-foundation · Jan 14, 2021 · cca7bbc · cca7bbc
1 parent 66b6ab7
commit cca7bbc
Show file tree

Hide file tree

Showing 3 changed files with 52 additions and 24 deletions.
diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal
@@ -218,6 +218,7 @@ library
       Cardano.Wallet.Primitive.Types.TokenPolicy.Gen
       Cardano.Wallet.Primitive.Types.TokenQuantity.Gen
       Cardano.Wallet.Primitive.Types.Tx.Gen
+      Cardano.Wallet.Primitive.Types.UTxOIndex.Gen
   other-modules:
       Paths_cardano_wallet_core
 

diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs b/lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Gen.hs
@@ -0,0 +1,47 @@
+module Cardano.Wallet.Primitive.Types.UTxOIndex.Gen
+    ( genUTxOIndexSmall
+    , shrinkUTxOIndexSmall
+    ) where
+
+import Prelude
+
+import Cardano.Wallet.Primitive.Types.Tx
+    ( TxIn, TxOut )
+import Cardano.Wallet.Primitive.Types.Tx.Gen
+    ( genTxInSmallRange
+    , genTxOutSmallRange
+    , shrinkTxInSmallRange
+    , shrinkTxOutSmallRange
+    )
+import Cardano.Wallet.Primitive.Types.UTxOIndex
+    ( UTxOIndex )
+import Control.Monad
+    ( replicateM )
+import Test.QuickCheck
+    ( Gen, choose, shrinkList )
+import Test.QuickCheck.Extra
+    ( shrinkInterleaved )
+
+import qualified Cardano.Wallet.Primitive.Types.UTxOIndex as UTxOIndex
+
+genUTxOIndexSmall :: Gen UTxOIndex
+genUTxOIndexSmall = do
+    entryCount <- choose (0, 64)
+    UTxOIndex.fromSequence <$> replicateM entryCount genEntrySmallRange
+
+shrinkUTxOIndexSmall :: UTxOIndex -> [UTxOIndex]
+shrinkUTxOIndexSmall
+    = take 16
+    . fmap UTxOIndex.fromSequence
+    . shrinkList shrinkEntrySmallRange
+    . UTxOIndex.toList
+
+genEntrySmallRange :: Gen (TxIn, TxOut)
+genEntrySmallRange = (,)
+    <$> genTxInSmallRange
+    <*> genTxOutSmallRange
+
+shrinkEntrySmallRange :: (TxIn, TxOut) -> [(TxIn, TxOut)]
+shrinkEntrySmallRange (i, o) = uncurry (,) <$> shrinkInterleaved
+    (i, shrinkTxInSmallRange)
+    (o, shrinkTxOutSmallRange)
diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs
@@ -23,10 +23,10 @@ import Cardano.Wallet.Primitive.Types.Tx.Gen
     , shrinkTxInSmallRange
     , shrinkTxOutSmallRange
     )
+import Cardano.Wallet.Primitive.Types.UTxOIndex.Gen
+    ( genUTxOIndexSmall, shrinkUTxOIndexSmall )
 import Cardano.Wallet.Primitive.Types.UTxOIndex.Internal
     ( InvariantStatus (..), SelectionFilter (..), UTxOIndex, checkInvariant )
-import Control.Monad
-    ( replicateM )
 import Control.Monad.Random.Class
     ( MonadRandom (..) )
 import Data.Generics.Internal.VL.Lens
@@ -48,21 +48,17 @@ import Test.QuickCheck
     , Property
     , checkCoverage
     , checkCoverageWith
-    , choose
     , conjoin
     , counterexample
     , cover
     , oneof
     , property
-    , shrinkList
     , stdConfidence
     , withMaxSuccess
     , (===)
     )
 import Test.QuickCheck.Classes
     ( eqLaws )
-import Test.QuickCheck.Extra
-    ( shrinkInterleaved )
 import Test.QuickCheck.Monadic
     ( assert, monadicIO, monitor, run )
 import Test.Utils.Laws
@@ -530,24 +526,8 @@ instance Arbitrary AssetId where
     shrink = shrinkAssetIdSmallRange
 
 instance Arbitrary UTxOIndex where
-    arbitrary = do
-        entryCount <- choose (0, 64)
-        UTxOIndex.fromSequence <$> replicateM entryCount genEntrySmallRange
-    shrink
-        = take 16
-        . fmap UTxOIndex.fromSequence
-        . shrinkList shrinkEntrySmallRange
-        . UTxOIndex.toList
-
-genEntrySmallRange :: Gen (TxIn, TxOut)
-genEntrySmallRange = (,)
-    <$> genTxInSmallRange
-    <*> genTxOutSmallRange
-
-shrinkEntrySmallRange :: (TxIn, TxOut) -> [(TxIn, TxOut)]
-shrinkEntrySmallRange (i, o) = uncurry (,) <$> shrinkInterleaved
-    (i, shrinkTxInSmallRange)
-    (o, shrinkTxOutSmallRange)
+    arbitrary = genUTxOIndexSmall
+    shrink = shrinkUTxOIndexSmall
 
 instance Arbitrary TxIn where
     arbitrary = genTxInSmallRange