{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Test.Cardano.Ledger.Constrained.Combinators where

import Cardano.Ledger.Coin (Coin (..))
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.Binary.Random (QC (..))
import Test.Cardano.Ledger.Core.Arbitrary (uniformSubMap, uniformSubSet)
import Test.QuickCheck hiding (Fixed, total)

-- ==========================================================================
-- Tracking Gen-time errors

-- | Report a Gen-time error from the current message 'extra' and the
--   [messages] 'mess' describing the path to this call site.
errorMess :: HasCallStack => String -> [String] -> a
errorMess :: forall a. HasCallStack => String -> [String] -> a
errorMess String
extra [String]
mess = String -> a
forall a. HasCallStack => String -> a
error ([String] -> String
unlines (String
"\nGen-time error" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
forall a. [a] -> [a]
reverse (String
extra String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
mess)))

-- | suchThat version that tracks Gen-time errors
suchThatErr :: [String] -> Gen a -> (a -> Bool) -> Gen a
suchThatErr :: forall a. [String] -> Gen a -> (a -> Bool) -> Gen a
suchThatErr [String]
msgs Gen a
gen a -> Bool
p = (Int -> Gen a) -> Gen a
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen a) -> Gen a) -> (Int -> Gen a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \Int
n -> Int -> Int -> Gen a
try (Int
10 :: Int) Int
n
  where
    try :: Int -> Int -> Gen a
try Int
0 Int
_ = String -> [String] -> Gen a
forall a. HasCallStack => String -> [String] -> a
errorMess String
"SuchThat times out" [String]
msgs
    try Int
k Int
sz = do
      Maybe a
x <- Int -> Gen (Maybe a) -> Gen (Maybe a)
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
sz (Gen (Maybe a) -> Gen (Maybe a)) -> Gen (Maybe a) -> Gen (Maybe a)
forall a b. (a -> b) -> a -> b
$ Gen a -> (a -> Bool) -> Gen (Maybe a)
forall a. Gen a -> (a -> Bool) -> Gen (Maybe a)
suchThatMaybe Gen a
gen a -> Bool
p
      case Maybe a
x of
        Just a
y -> a -> Gen a
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
y
        Maybe a
Nothing -> Int -> Int -> Gen a
try (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5)

-- =======================================================================

-- | add items from 'source' to 'base' until size 'n' is reached.
addUntilSize :: Ord a => [String] -> Set a -> Set a -> Int -> Gen (Set a)
addUntilSize :: forall a. Ord a => [String] -> Set a -> Set a -> Int -> Gen (Set a)
addUntilSize [String]
msgs Set a
base Set a
source Int
n = do
  let possible :: Set a
possible = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set a
source Set a
base
      p :: Int
p = Set a -> Int
forall a. Set a -> Int
Set.size Set a
possible
      m :: Int
m = Set a -> Int
forall a. Set a -> Int
Set.size Set a
base
      loop :: Set a -> Set a -> Gen (Set a)
loop Set a
result Set a
_ | Set a -> Int
forall a. Set a -> Int
Set.size Set a
result Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Set a -> Gen (Set a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set a
result
      loop Set a
_ Set a
extra
        | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
extra =
            String -> [String] -> Gen (Set a)
forall a. HasCallStack => String -> [String] -> a
errorMess
              ( String
"There are not enough unused elements in 'source'("
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
p
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") to reach the size 'n'("
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
              )
              [String]
msgs
      loop Set a
result Set a
extra = do
        Int
i <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Set a -> Int
forall a. Set a -> Int
Set.size Set a
extra Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        Set a -> Set a -> Gen (Set a)
loop (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert (Int -> Set a -> a
forall a. Int -> Set a -> a
Set.elemAt Int
i Set a
extra) Set a
result) (Int -> Set a -> Set a
forall a. Int -> Set a -> Set a
Set.deleteAt Int
i Set a
extra)
  case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
m Int
n of
    Ordering
EQ -> Set a -> Gen (Set a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set a
base
    Ordering
GT ->
      String -> [String] -> Gen (Set a)
forall a. HasCallStack => String -> [String] -> a
errorMess
        (String
"The size(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") of the 'base' set exceeds the target size(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
        [String]
msgs
    Ordering
LT -> Set a -> Set a -> Gen (Set a)
loop Set a
base Set a
possible

-- | Generate a random set of a fixed size 'size', use 'gen' to pick the elements.
setSized :: Ord a => [String] -> Int -> Gen a -> Gen (Set a)
setSized :: forall a. Ord a => [String] -> Int -> Gen a -> Gen (Set a)
setSized [String]
mess Int
size Gen a
gen = do
  Set a
set <- [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> Gen [a] -> Gen (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
size Gen a
gen
  [String] -> Int -> Int -> Gen a -> Set a -> Gen (Set a)
forall a.
Ord a =>
[String] -> Int -> Int -> Gen a -> Set a -> Gen (Set a)
fixSet ((String
"setSized " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
size) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
mess) Int
1000 Int
size Gen a
gen Set a
set

-- | Fix a a set 'source' that is supposed to have 'size' elements, but because of duplicates
--   may not. Fix it by adding random elements using 'genA', not currently in the set. If after 'numTries'
--   the set is still not fixed, report an error.
fixSet :: Ord a => [String] -> Int -> Int -> Gen a -> Set a -> Gen (Set a)
fixSet :: forall a.
Ord a =>
[String] -> Int -> Int -> Gen a -> Set a -> Gen (Set a)
fixSet [String]
mess Int
numTries Int
size Gen a
genA Set a
source
  | Set a -> Int
forall a. Set a -> Int
Set.size Set a
source Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
size = [String] -> Set a -> Int -> Gen (Set a)
forall a. Ord a => [String] -> Set a -> Int -> Gen (Set a)
subsetFromSetWithSize (String
"fixSet" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
mess) Set a
source Int
size
  | Bool
otherwise = Int -> Set a -> Gen a -> Gen (Set a)
go Int
numTries Set a
source Gen a
genA
  where
    go :: Int -> Set a -> Gen a -> Gen (Set a)
go Int
n !Set a
set Gen a
gen
      | Int
currentSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
size = Set a -> Gen (Set a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set a
set
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
          String -> [String] -> Gen (Set a)
forall a. HasCallStack => String -> [String] -> a
errorMess
            ( String
"Ran out of tries("
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
numTries
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") in fixSet: need "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
size
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements, have "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
currentSize
            )
            [String]
mess
      | Bool
otherwise = do
          a
x <- Gen a
gen
          if a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
set
            then Int -> Set a -> Gen a -> Gen (Set a)
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Set a
set (Gen a -> Gen (Set a)) -> Gen a -> Gen (Set a)
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Gen a -> Gen a
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) Gen a
gen
            else Int -> Set a -> Gen a -> Gen (Set a)
go Int
n (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
set) Gen a
gen
      where
        currentSize :: Int
currentSize = Set a -> Int
forall a. Set a -> Int
Set.size Set a
set

-- | Generate a random Map with a fixed size 'n'. use 'genA' to pick the
--   domain of the map, and 'genB' to pick the range.
mapSized :: Ord a => [String] -> Int -> Gen a -> Gen b -> Gen (Map a b)
mapSized :: forall a b.
Ord a =>
[String] -> Int -> Gen a -> Gen b -> Gen (Map a b)
mapSized [String]
mess Int
size Gen a
genA Gen b
genB = do
  Set a
keys <- [String] -> Int -> Gen a -> Gen (Set a)
forall a. Ord a => [String] -> Int -> Gen a -> Gen (Set a)
setSized ((String
"mapSized " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
size) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
mess) Int
size Gen a
genA
  [b]
values <- Int -> Gen b -> Gen [b]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
size Gen b
genB
  Map a b -> Gen (Map a b)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map a b -> Gen (Map a b)) -> Map a b -> Gen (Map a b)
forall a b. (a -> b) -> a -> b
$ Set a -> [b] -> Map a b
forall a b. Ord a => Set a -> [b] -> Map a b
mapFromDomRange Set a
keys [b]
values

coinSized :: Int -> Gen Coin
coinSized :: Int -> Gen Coin
coinSized Int
n = Coin -> Gen Coin
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Coin
Coin (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))

-- | Generate a random subset of a set 'set' with a fixed size 'n'
subsetFromSetWithSize :: Ord a => [String] -> Set a -> Int -> Gen (Set a)
subsetFromSetWithSize :: forall a. Ord a => [String] -> Set a -> Int -> Gen (Set a)
subsetFromSetWithSize [String]
mess Set a
set Int
n
  | Set a -> Int
forall a. Set a -> Int
Set.size Set a
set Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n =
      String -> [String] -> Gen (Set a)
forall a. HasCallStack => String -> [String] -> a
errorMess
        ( String
"subsetFromSetWithSize: Can't make a subset of size "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" from a smaller set of size "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Set a -> Int
forall a. Set a -> Int
Set.size Set a
set)
        )
        [String]
mess
  | Bool
otherwise = Maybe Int -> Set a -> QC -> Gen (Set a)
forall g (m :: * -> *) k.
(StatefulGen g m, Ord k) =>
Maybe Int -> Set k -> g -> m (Set k)
uniformSubSet (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) Set a
set QC
QC

-- | Generate a larger map, from a smaller map 'subset'. The new larger map, should have all the
--   keys and values of the smaller map.
mapFromSubset :: Ord a => [String] -> Map a b -> Int -> Gen a -> Gen b -> Gen (Map a b)
mapFromSubset :: forall a b.
Ord a =>
[String] -> Map a b -> Int -> Gen a -> Gen b -> Gen (Map a b)
mapFromSubset [String]
mess Map a b
subset Int
n Gen a
genA Gen b
genB = do
  Map a b
additions <- [String] -> Int -> Gen a -> Gen b -> Gen (Map a b)
forall a b.
Ord a =>
[String] -> Int -> Gen a -> Gen b -> Gen (Map a b)
mapSized ((String
"mapFromSubset " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
mess) Int
n Gen a
genA Gen b
genB
  Map a b -> Gen (Map a b)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map a b -> Map a b -> Map a b
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map a b
subset Map a b
additions)

-- | Generate a map, from a set. The new map, should have all the
--   elements of 'set' in its keysSet.
mapFromSet :: Ord a => Set a -> Gen b -> Gen (Map a b)
mapFromSet :: forall a b. Ord a => Set a -> Gen b -> Gen (Map a b)
mapFromSet Set a
set Gen b
genB = Set a -> Gen (Map a b)
addRange Set a
set
  where
    addRange :: Set a -> Gen (Map a b)
addRange Set a
s = (Gen (Map a b) -> a -> Gen (Map a b))
-> Gen (Map a b) -> Set a -> Gen (Map a b)
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' Gen (Map a b) -> a -> Gen (Map a b)
accum (Map a b -> Gen (Map a b)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map a b
forall k a. Map k a
Map.empty) Set a
s
    accum :: Gen (Map a b) -> a -> Gen (Map a b)
accum Gen (Map a b)
ansGen a
dom = do Map a b
ans <- Gen (Map a b)
ansGen; b
rng <- Gen b
genB; Map a b -> Gen (Map a b)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b -> Map a b -> Map a b
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert a
dom b
rng Map a b
ans)

-- | Generate a random element from a set. Also return the set with that element removed
itemFromSet :: [String] -> Set a -> Gen (a, Set a)
itemFromSet :: forall a. [String] -> Set a -> Gen (a, Set a)
itemFromSet [String]
mess Set a
set
  | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
set = String -> [String] -> Gen (a, Set a)
forall a. HasCallStack => String -> [String] -> a
errorMess String
"itemFromSet : Can't take an item from the empty set." [String]
mess
itemFromSet [String]
_ Set a
set =
  (\Int
ix -> (Int -> Set a -> a
forall a. Int -> Set a -> a
Set.elemAt Int
ix Set a
set, Int -> Set a -> Set a
forall a. Int -> Set a -> Set a
Set.deleteAt Int
ix Set a
set)) (Int -> (a, Set a)) -> Gen Int -> Gen (a, Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
chooseInt (Int
0, Set a -> Int
forall a. Set a -> Int
Set.size Set a
set Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- Generate a map from a list 'bs'. The result should have the property (Map.elems result == bs)
mapFromRange :: forall a b. Ord a => [String] -> [b] -> Gen a -> Gen (Map a b)
mapFromRange :: forall a b. Ord a => [String] -> [b] -> Gen a -> Gen (Map a b)
mapFromRange [String]
msgs [b]
bs Gen a
genA = do
  Set a
keys <- [String] -> Int -> Gen a -> Gen (Set a)
forall a. Ord a => [String] -> Int -> Gen a -> Gen (Set a)
setSized [String]
msgs ([b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
bs) Gen a
genA
  Map a b -> Gen (Map a b)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map a b -> Gen (Map a b)) -> Map a b -> Gen (Map a b)
forall a b. (a -> b) -> a -> b
$ Set a -> [b] -> Map a b
forall a b. Ord a => Set a -> [b] -> Map a b
mapFromDomRange Set a
keys [b]
bs

mapFromProj :: Ord a => [b] -> Gen a -> (b -> Gen c) -> Gen (Map a c)
mapFromProj :: forall a b c.
Ord a =>
[b] -> Gen a -> (b -> Gen c) -> Gen (Map a c)
mapFromProj [b]
bs Gen a
genA b -> Gen c
genC = do
  [c]
cs <- (b -> Gen c) -> [b] -> Gen [c]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM b -> Gen c
genC [b]
bs
  [String] -> [c] -> Gen a -> Gen (Map a c)
forall a b. Ord a => [String] -> [b] -> Gen a -> Gen (Map a b)
mapFromRange [String
"mapFromProj"] [c]
cs Gen a
genA

-- | Generate a Map from a set 'dom' and a list 'bs'. They should have the same size
--   but this is not checked. The result should have the properties (Map.keysSet result == dom)
--   and (Map.elems result == bs)
mapFromDomRange :: Ord a => Set a -> [b] -> Map a b
mapFromDomRange :: forall a b. Ord a => Set a -> [b] -> Map a b
mapFromDomRange Set a
dom [b]
bs = [(a, b)] -> Map a b
forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList ([(a, b)] -> Map a b) -> [(a, b)] -> Map a b
forall a b. (a -> b) -> a -> b
$ [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set a -> [a]
forall a. Set a -> [a]
Set.toAscList Set a
dom) [b]
bs

-- | Generate an Int, that would be a valid size for a subset of a set 's'
--   it should return 0 or the size of the set infrequently.
subsetSize :: Set a -> Gen Int
subsetSize :: forall a. Set a -> Gen Int
subsetSize Set a
s | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
s = Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
subsetSize Set a
s = [(Int, Gen Int)] -> Gen Int
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0), (Int
20, (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)), (Int
1, Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n)]
  where
    n :: Int
n = Set a -> Int
forall a. Set a -> Int
Set.size Set a
s

-- | Generate a random subset of a set 'set'
subsetFromSet :: Ord a => [String] -> Set a -> Gen (Set a)
subsetFromSet :: forall a. Ord a => [String] -> Set a -> Gen (Set a)
subsetFromSet [String]
mess Set a
set = do
  Int
n <- Set a -> Gen Int
forall a. Set a -> Gen Int
subsetSize Set a
set
  [String] -> Set a -> Int -> Gen (Set a)
forall a. Ord a => [String] -> Set a -> Int -> Gen (Set a)
subsetFromSetWithSize (String
"From subsetFromSet" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
mess) Set a
set Int
n

-- | Generate a random superset of a set 'set'. Use 'genA' to pick random additional elements
superSetFromSet :: Ord a => Gen a -> Set a -> Gen (Set a)
superSetFromSet :: forall a. Ord a => Gen a -> Set a -> Gen (Set a)
superSetFromSet Gen a
genA Set a
setA = do
  Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
4)
  if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then Set a -> Gen (Set a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set a
setA
    else [String] -> Int -> Gen a -> Set a -> Gen (Set a)
forall a. Ord a => [String] -> Int -> Gen a -> Set a -> Gen (Set a)
superSetFromSetWithSize [String
"supersetFromSet " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n] (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
Set.size Set a
setA) Gen a
genA Set a
setA

-- | Generate a random superset of a set 'set' with s fixed size 'n'.
--   Use 'genA' to pick random additional elements.
superSetFromSetWithSize :: Ord a => [String] -> Int -> Gen a -> Set a -> Gen (Set a)
superSetFromSetWithSize :: forall a. Ord a => [String] -> Int -> Gen a -> Set a -> Gen (Set a)
superSetFromSetWithSize [String]
mess Int
n Gen a
_ Set a
setA
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Set a -> Int
forall a. Set a -> Int
Set.size Set a
setA =
      String -> [String] -> Gen (Set a)
forall a. HasCallStack => String -> [String] -> a
errorMess
        ( String
"superSetFromSetWithSize: Size of the superset ("
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") is smaller than "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"the size of the given set ("
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Set a -> Int
forall a. Set a -> Int
Set.size Set a
setA)
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")."
        )
        [String]
mess
superSetFromSetWithSize [String]
msgs Int
size Gen a
genA Set a
setA =
  let tries :: Int
tries = Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Set a -> Int
forall a. Set a -> Int
Set.size Set a
setA) -- at most 10 times per new element
   in [String] -> Int -> Int -> Gen a -> Set a -> Gen (Set a)
forall a.
Ord a =>
[String] -> Int -> Int -> Gen a -> Set a -> Gen (Set a)
fixSet (String
"superSetFromSetWithSize" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
msgs) Int
tries Int
size Gen a
genA Set a
setA

-- | Generates things both in (Set a) and not in (Set a) with differing frequencies.
superItemFromSet :: Ord a => Gen a -> Set a -> Gen a
superItemFromSet :: forall a. Ord a => Gen a -> Set a -> Gen a
superItemFromSet Gen a
genA Set a
set | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
set = Gen a
genA
superItemFromSet Gen a
genA Set a
set =
  [(Int, Gen a)] -> Gen a
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
3, (a, Set a) -> a
forall a b. (a, b) -> a
fst ((a, Set a) -> a) -> Gen (a, Set a) -> Gen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Set a -> Gen (a, Set a)
forall a. [String] -> Set a -> Gen (a, Set a)
itemFromSet [String
"Not possible since set is not empty"] Set a
set)
    , (Int
1, Gen a -> (a -> Bool) -> Gen a
forall a. Gen a -> (a -> Bool) -> Gen a
suchThat Gen a
genA (a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set a
set))
    ]

-- | Pick a random (key,value) pair from a Map
genFromMap :: [String] -> Map k a -> Gen (k, a)
genFromMap :: forall k a. [String] -> Map k a -> Gen (k, a)
genFromMap [String]
msgs Map k a
m
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = String -> [String] -> Gen (k, a)
forall a. HasCallStack => String -> [String] -> a
errorMess String
"The map is empty in genFromMap" [String]
msgs
  | Bool
otherwise = do
      Int
i <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      (k, a) -> Gen (k, a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((k, a) -> Gen (k, a)) -> (k, a) -> Gen (k, a)
forall a b. (a -> b) -> a -> b
$ Int -> Map k a -> (k, a)
forall k a. Int -> Map k a -> (k, a)
Map.elemAt Int
i Map k a
m
  where
    n :: Int
n = Map k a -> Int
forall k a. Map k a -> Int
Map.size Map k a
m

subMapFromMapWithSize :: Ord k => Int -> Map k a -> Gen (Map k a)
subMapFromMapWithSize :: forall k a. Ord k => Int -> Map k a -> Gen (Map k a)
subMapFromMapWithSize Int
n Map k a
m = Maybe Int -> Map k a -> QC -> Gen (Map k a)
forall g (m :: * -> *) k v.
(StatefulGen g m, Ord k) =>
Maybe Int -> Map k v -> g -> m (Map k v)
uniformSubMap (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) Map k a
m QC
QC