Reduce duplication

Author: lehins

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Utxo.hs

@@ -74,7 +74,9 @@ import qualified Data.Set as Set
 import qualified Data.Vector as V
 import Lens.Micro
 import NoThunks.Class ()
+import Test.Cardano.Ledger.Binary.Random (QC (..))
 import Test.Cardano.Ledger.Common (tracedDiscard)
+import Test.Cardano.Ledger.Core.Arbitrary (uniformSubMapElems)
 import Test.Cardano.Ledger.Core.KeyPair (
   KeyPair,
   KeyPairs,
@@ -634,14 +636,7 @@ genIndices k (l', u')
 -- | Select @n@ random key value pairs from the supplied map. Order of keys with
 -- respect to each other will also be random, i.e. not sorted.
 pickRandomFromMap :: Int -> Map.Map k t -> Gen [(k, t)]
-pickRandomFromMap n' initMap = go (min (max 0 n') (Map.size initMap)) [] initMap
-  where
-    go n !acc !m
-      | n <= 0 = pure acc
-      | otherwise = do
-          i <- QC.choose (0, Map.size m - 1)
-          let (k, y) = Map.elemAt i m
-          go (n - 1) ((k, y) : acc) (Map.deleteAt i m)
+pickRandomFromMap n initMap = uniformSubMapElems (\k v -> ((k, v) :)) (Just n) initMap QC
 
 mkScriptWits ::
   forall era.

libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Arbitrary.hs

@@ -41,6 +41,7 @@ module Test.Cardano.Ledger.Core.Arbitrary (
   -- | Will need to find a better home in the future
   uniformSubSet,
   uniformSubMap,
+  uniformSubMapElems,
 )
 where
 
@@ -644,18 +645,29 @@ uniformSubMap ::
   Map k v ->
   g ->
   m (Map k v)
-uniformSubMap mSubMapSize inputMap gen = do
+uniformSubMap = uniformSubMapElems Map.insert
+
+uniformSubMapElems ::
+  (StatefulGen g m, Monoid f) =>
+  (k -> v -> f -> f) ->
+  -- | Size of the subMap. If supplied will be clamped to @[0, Map.size s]@ interval,
+  -- otherwise will be generated randomly.
+  Maybe Int ->
+  Map k v ->
+  g ->
+  m f
+uniformSubMapElems insert mSubMapSize inputMap gen = do
   subMapSize <- case mSubMapSize of
     Nothing -> uniformRM (0, Map.size inputMap) gen
     Just n -> pure $ max 0 $ min (Map.size inputMap) n
-  go inputMap Map.empty subMapSize
+  go inputMap mempty subMapSize
   where
     go !s !acc !i
       | i <= 0 = pure acc
       | otherwise = do
           ix <- uniformRM (0, Map.size s - 1) gen
           let (k, v) = Map.elemAt ix s
-          go (Map.deleteAt ix s) (Map.insert k v acc) (i - 1)
+          go (Map.deleteAt ix s) (insert k v acc) (i - 1)
 
 genValidUMapWithCreds :: Gen (UMap StandardCrypto, Set (Credential 'Staking StandardCrypto))
 genValidUMapWithCreds = do

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Combinators.hs

@@ -8,13 +8,13 @@
 module Test.Cardano.Ledger.Constrained.Combinators where
 
 import Cardano.Ledger.Coin (Coin (..))
-import Data.Foldable as F (foldl')
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
 import GHC.Stack (HasCallStack)
-import Test.Cardano.Ledger.Core.Arbitrary ()
+import Test.Cardano.Ledger.Binary.Random (QC (..))
+import Test.Cardano.Ledger.Core.Arbitrary (uniformSubMap)
 import Test.QuickCheck hiding (Fixed, total)
 
 -- ==========================================================================
@@ -234,8 +234,4 @@ genFromMap msgs m
     n = Map.size m
 
 subMapFromMapWithSize :: Ord k => Int -> Map k a -> Gen (Map k a)
-subMapFromMapWithSize n m = do
-  let indexes = [0 .. Map.size m - 1]
-      accum ans i = let (k, v) = Map.elemAt i m in Map.insert k v ans
-  shuffled <- shuffle indexes
-  pure (F.foldl' accum Map.empty (take n shuffled))
+subMapFromMapWithSize n m = uniformSubMap (Just n) m QC