-- | Utilities for generating 'MergingRun's. Tests and benchmarks should
-- preferably use these utilities instead of (re-)defining their own.
module Database.LSMTree.Extras.MergingRunData (
    -- * Create merging runs
    withMergingRun
  , unsafeCreateMergingRun
    -- * MergingRunData
  , MergingRunData (..)
  , mergingRunDataMergeType
  , mergingRunDataInvariant
  , mapMergingRunData
  , SerialisedMergingRunData
  , serialiseMergingRunData
    -- * QuickCheck
  , labelMergingRunData
  , genMergingRunData
  , shrinkMergingRunData
  ) where

import           Control.Exception (bracket)
import           Control.RefCount
import qualified Data.Vector as V
import           Database.LSMTree.Extras (showPowersOf)
import           Database.LSMTree.Extras.Generators ()
import           Database.LSMTree.Extras.RunData
import           Database.LSMTree.Internal.Lookup (ResolveSerialisedValue)
import           Database.LSMTree.Internal.MergingRun (MergingRun)
import qualified Database.LSMTree.Internal.MergingRun as MR
import           Database.LSMTree.Internal.Paths
import qualified Database.LSMTree.Internal.Run as Run
import qualified Database.LSMTree.Internal.RunBuilder as RunBuilder
import           Database.LSMTree.Internal.RunNumber
import           Database.LSMTree.Internal.Serialise
import           Database.LSMTree.Internal.UniqCounter
import qualified System.FS.API as FS
import           System.FS.API (HasFS)
import           System.FS.BlockIO.API (HasBlockIO)
import           Test.QuickCheck as QC

{-------------------------------------------------------------------------------
  Create merging runs
-------------------------------------------------------------------------------}

-- | Create a temporary 'MergingRun' using 'unsafeCreateMergingRun'.
withMergingRun ::
     MR.IsMergeType t
  => HasFS IO h
  -> HasBlockIO IO h
  -> ResolveSerialisedValue
  -> RunBuilder.RunParams
  -> FS.FsPath
  -> UniqCounter IO
  -> SerialisedMergingRunData t
  -> (Ref (MergingRun t IO h) -> IO a)
  -> IO a
withMergingRun :: forall t h a.
IsMergeType t =>
HasFS IO h
-> HasBlockIO IO h
-> ResolveSerialisedValue
-> RunParams
-> FsPath
-> UniqCounter IO
-> SerialisedMergingRunData t
-> (Ref (MergingRun t IO h) -> IO a)
-> IO a
withMergingRun HasFS IO h
hfs HasBlockIO IO h
hbio ResolveSerialisedValue
resolve RunParams
runParams FsPath
path UniqCounter IO
counter SerialisedMergingRunData t
mrd = do
    IO (Ref (MergingRun t IO h))
-> (Ref (MergingRun t IO h) -> IO ())
-> (Ref (MergingRun t IO h) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
      (HasFS IO h
-> HasBlockIO IO h
-> ResolveSerialisedValue
-> RunParams
-> FsPath
-> UniqCounter IO
-> SerialisedMergingRunData t
-> IO (Ref (MergingRun t IO h))
forall t h.
IsMergeType t =>
HasFS IO h
-> HasBlockIO IO h
-> ResolveSerialisedValue
-> RunParams
-> FsPath
-> UniqCounter IO
-> SerialisedMergingRunData t
-> IO (Ref (MergingRun t IO h))
unsafeCreateMergingRun HasFS IO h
hfs HasBlockIO IO h
hbio ResolveSerialisedValue
resolve RunParams
runParams FsPath
path UniqCounter IO
counter SerialisedMergingRunData t
mrd)
      Ref (MergingRun t IO h) -> IO ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef

-- | Flush serialised merging run data to disk.
--
-- This might leak resources if not run with asynchronous exceptions masked.
-- Consider using 'withMergingRun' instead.
--
-- Use of this function should be paired with a 'releaseRef'.
unsafeCreateMergingRun ::
     MR.IsMergeType t
  => HasFS IO h
  -> HasBlockIO IO h
  -> ResolveSerialisedValue
  -> RunBuilder.RunParams
  -> FS.FsPath
  -> UniqCounter IO
  -> SerialisedMergingRunData t
  -> IO (Ref (MergingRun t IO h))
unsafeCreateMergingRun :: forall t h.
IsMergeType t =>
HasFS IO h
-> HasBlockIO IO h
-> ResolveSerialisedValue
-> RunParams
-> FsPath
-> UniqCounter IO
-> SerialisedMergingRunData t
-> IO (Ref (MergingRun t IO h))
unsafeCreateMergingRun HasFS IO h
hfs HasBlockIO IO h
hbio ResolveSerialisedValue
resolve RunParams
runParams FsPath
path UniqCounter IO
counter = \case
    CompletedMergeData t
_ RunData SerialisedKey SerialisedValue SerialisedBlob
rd -> do
      HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> FsPath
-> UniqCounter IO
-> RunData SerialisedKey SerialisedValue SerialisedBlob
-> (Ref (Run IO h) -> IO (Ref (MergingRun t IO h)))
-> IO (Ref (MergingRun t IO h))
forall h a.
HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> FsPath
-> UniqCounter IO
-> RunData SerialisedKey SerialisedValue SerialisedBlob
-> (Ref (Run IO h) -> IO a)
-> IO a
withRun HasFS IO h
hfs HasBlockIO IO h
hbio RunParams
runParams FsPath
path UniqCounter IO
counter RunData SerialisedKey SerialisedValue SerialisedBlob
rd ((Ref (Run IO h) -> IO (Ref (MergingRun t IO h)))
 -> IO (Ref (MergingRun t IO h)))
-> (Ref (Run IO h) -> IO (Ref (MergingRun t IO h)))
-> IO (Ref (MergingRun t IO h))
forall a b. (a -> b) -> a -> b
$ \Ref (Run IO h)
run -> do
        -- slightly hacky, generally it's larger
        let totalDebt :: MergeDebt
totalDebt = NumEntries -> MergeDebt
MR.numEntriesToMergeDebt (Ref (Run IO h) -> NumEntries
forall (m :: * -> *) h. Ref (Run m h) -> NumEntries
Run.size Ref (Run IO h)
run)
        MergeDebt -> Ref (Run IO h) -> IO (Ref (MergingRun t IO h))
forall (m :: * -> *) h t.
(MonadMVar m, MonadMask m, MonadSTM m, MonadST m) =>
MergeDebt -> Ref (Run m h) -> m (Ref (MergingRun t m h))
MR.newCompleted MergeDebt
totalDebt Ref (Run IO h)
run

    OngoingMergeData t
mergeType [NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob]
rds -> do
      HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> FsPath
-> UniqCounter IO
-> [RunData SerialisedKey SerialisedValue SerialisedBlob]
-> ([Ref (Run IO h)] -> IO (Ref (MergingRun t IO h)))
-> IO (Ref (MergingRun t IO h))
forall h a.
HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> FsPath
-> UniqCounter IO
-> [RunData SerialisedKey SerialisedValue SerialisedBlob]
-> ([Ref (Run IO h)] -> IO a)
-> IO a
withRuns HasFS IO h
hfs HasBlockIO IO h
hbio RunParams
runParams FsPath
path UniqCounter IO
counter (NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob
-> RunData SerialisedKey SerialisedValue SerialisedBlob
forall k v b. NonEmptyRunData k v b -> RunData k v b
toRunData (NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob
 -> RunData SerialisedKey SerialisedValue SerialisedBlob)
-> [NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob]
-> [RunData SerialisedKey SerialisedValue SerialisedBlob]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob]
rds)
        (([Ref (Run IO h)] -> IO (Ref (MergingRun t IO h)))
 -> IO (Ref (MergingRun t IO h)))
-> ([Ref (Run IO h)] -> IO (Ref (MergingRun t IO h)))
-> IO (Ref (MergingRun t IO h))
forall a b. (a -> b) -> a -> b
$ \[Ref (Run IO h)]
runs -> do
          Unique
n <- UniqCounter IO -> IO Unique
forall (m :: * -> *). PrimMonad m => UniqCounter m -> m Unique
incrUniqCounter UniqCounter IO
counter
          let fsPaths :: RunFsPaths
fsPaths = FsPath -> RunNumber -> RunFsPaths
RunFsPaths FsPath
path (Int -> RunNumber
RunNumber (Unique -> Int
uniqueToInt Unique
n))
          HasFS IO h
-> HasBlockIO IO h
-> ResolveSerialisedValue
-> RunParams
-> t
-> RunFsPaths
-> Vector (Ref (Run IO h))
-> IO (Ref (MergingRun t IO h))
forall t (m :: * -> *) h.
(IsMergeType t, MonadMVar m, MonadMask m, MonadSTM m, MonadST m) =>
HasFS m h
-> HasBlockIO m h
-> ResolveSerialisedValue
-> RunParams
-> t
-> RunFsPaths
-> Vector (Ref (Run m h))
-> m (Ref (MergingRun t m h))
MR.new HasFS IO h
hfs HasBlockIO IO h
hbio ResolveSerialisedValue
resolve RunParams
runParams t
mergeType
                 RunFsPaths
fsPaths ([Ref (Run IO h)] -> Vector (Ref (Run IO h))
forall a. [a] -> Vector a
V.fromList [Ref (Run IO h)]
runs)

{-------------------------------------------------------------------------------
  MergingRunData
-------------------------------------------------------------------------------}

-- | A data structure suitable for creating arbitrary 'MergingRun's.
--
-- Note: 'b ~ Void' should rule out blobs.
--
-- Currently, ongoing merges are always \"fresh\", i.e. there is no merge work
-- already performed.
--
-- TODO: Generate merge credits and supply them in 'unsafeCreateMergingRun',
-- similarly to how @ScheduledMergesTest@ does it.
data MergingRunData t k v b =
    CompletedMergeData t (RunData k v b)
  | OngoingMergeData t [NonEmptyRunData k v b]  -- ^ at least 2 inputs
  deriving stock (Int -> MergingRunData t k v b -> ShowS
[MergingRunData t k v b] -> ShowS
MergingRunData t k v b -> String
(Int -> MergingRunData t k v b -> ShowS)
-> (MergingRunData t k v b -> String)
-> ([MergingRunData t k v b] -> ShowS)
-> Show (MergingRunData t k v b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k v b.
(Show k, Show b, Show v, Show t) =>
Int -> MergingRunData t k v b -> ShowS
forall t k v b.
(Show k, Show b, Show v, Show t) =>
[MergingRunData t k v b] -> ShowS
forall t k v b.
(Show k, Show b, Show v, Show t) =>
MergingRunData t k v b -> String
$cshowsPrec :: forall t k v b.
(Show k, Show b, Show v, Show t) =>
Int -> MergingRunData t k v b -> ShowS
showsPrec :: Int -> MergingRunData t k v b -> ShowS
$cshow :: forall t k v b.
(Show k, Show b, Show v, Show t) =>
MergingRunData t k v b -> String
show :: MergingRunData t k v b -> String
$cshowList :: forall t k v b.
(Show k, Show b, Show v, Show t) =>
[MergingRunData t k v b] -> ShowS
showList :: [MergingRunData t k v b] -> ShowS
Show, MergingRunData t k v b -> MergingRunData t k v b -> Bool
(MergingRunData t k v b -> MergingRunData t k v b -> Bool)
-> (MergingRunData t k v b -> MergingRunData t k v b -> Bool)
-> Eq (MergingRunData t k v b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t k v b.
(Eq k, Eq b, Eq v, Eq t) =>
MergingRunData t k v b -> MergingRunData t k v b -> Bool
$c== :: forall t k v b.
(Eq k, Eq b, Eq v, Eq t) =>
MergingRunData t k v b -> MergingRunData t k v b -> Bool
== :: MergingRunData t k v b -> MergingRunData t k v b -> Bool
$c/= :: forall t k v b.
(Eq k, Eq b, Eq v, Eq t) =>
MergingRunData t k v b -> MergingRunData t k v b -> Bool
/= :: MergingRunData t k v b -> MergingRunData t k v b -> Bool
Eq)

mergingRunDataMergeType :: MergingRunData t k v b -> t
mergingRunDataMergeType :: forall t k v b. MergingRunData t k v b -> t
mergingRunDataMergeType = \case
    CompletedMergeData t
mt RunData k v b
_ -> t
mt
    OngoingMergeData   t
mt [NonEmptyRunData k v b]
_ -> t
mt

-- | See @mergeInvariant@ in the prototype.
mergingRunDataInvariant :: MergingRunData t k v b -> Either String ()
mergingRunDataInvariant :: forall t k v b. MergingRunData t k v b -> Either String ()
mergingRunDataInvariant = \case
    CompletedMergeData t
_ RunData k v b
_ -> () -> Either String ()
forall a b. b -> Either a b
Right ()
    OngoingMergeData t
_ [NonEmptyRunData k v b]
rds -> do
      String -> Bool -> Either String ()
forall {a}. a -> Bool -> Either a ()
assertI String
"ongoing merges are non-trivial (at least two inputs)" (Bool -> Either String ()) -> Bool -> Either String ()
forall a b. (a -> b) -> a -> b
$
        [NonEmptyRunData k v b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NonEmptyRunData k v b]
rds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
  where
    assertI :: a -> Bool -> Either a ()
assertI a
msg Bool
False = a -> Either a ()
forall a b. a -> Either a b
Left a
msg
    assertI a
_   Bool
True  = () -> Either a ()
forall a b. b -> Either a b
Right ()

mapMergingRunData ::
     Ord k'
  => (k -> k') -> (v -> v') -> (b -> b')
  -> MergingRunData t k v b -> MergingRunData t k' v' b'
mapMergingRunData :: forall k' k v v' b b' t.
Ord k' =>
(k -> k')
-> (v -> v')
-> (b -> b')
-> MergingRunData t k v b
-> MergingRunData t k' v' b'
mapMergingRunData k -> k'
f v -> v'
g b -> b'
h = \case
    CompletedMergeData t
t RunData k v b
r ->
      t -> RunData k' v' b' -> MergingRunData t k' v' b'
forall t k v b. t -> RunData k v b -> MergingRunData t k v b
CompletedMergeData t
t (RunData k' v' b' -> MergingRunData t k' v' b')
-> RunData k' v' b' -> MergingRunData t k' v' b'
forall a b. (a -> b) -> a -> b
$ (k -> k')
-> (v -> v') -> (b -> b') -> RunData k v b -> RunData k' v' b'
forall k' k v v' b b'.
Ord k' =>
(k -> k')
-> (v -> v') -> (b -> b') -> RunData k v b -> RunData k' v' b'
mapRunData k -> k'
f v -> v'
g b -> b'
h RunData k v b
r
    OngoingMergeData t
t [NonEmptyRunData k v b]
rs ->
      t -> [NonEmptyRunData k' v' b'] -> MergingRunData t k' v' b'
forall t k v b.
t -> [NonEmptyRunData k v b] -> MergingRunData t k v b
OngoingMergeData t
t ([NonEmptyRunData k' v' b'] -> MergingRunData t k' v' b')
-> [NonEmptyRunData k' v' b'] -> MergingRunData t k' v' b'
forall a b. (a -> b) -> a -> b
$ (NonEmptyRunData k v b -> NonEmptyRunData k' v' b')
-> [NonEmptyRunData k v b] -> [NonEmptyRunData k' v' b']
forall a b. (a -> b) -> [a] -> [b]
map ((k -> k')
-> (v -> v')
-> (b -> b')
-> NonEmptyRunData k v b
-> NonEmptyRunData k' v' b'
forall k' k v v' b b'.
Ord k' =>
(k -> k')
-> (v -> v')
-> (b -> b')
-> NonEmptyRunData k v b
-> NonEmptyRunData k' v' b'
mapNonEmptyRunData k -> k'
f v -> v'
g b -> b'
h) [NonEmptyRunData k v b]
rs

type SerialisedMergingRunData t =
    MergingRunData t SerialisedKey SerialisedValue SerialisedBlob

serialiseMergingRunData ::
     (SerialiseKey k, SerialiseValue v, SerialiseValue b)
  => MergingRunData t k v b -> SerialisedMergingRunData t
serialiseMergingRunData :: forall k v b t.
(SerialiseKey k, SerialiseValue v, SerialiseValue b) =>
MergingRunData t k v b -> SerialisedMergingRunData t
serialiseMergingRunData =
    (k -> SerialisedKey)
-> (v -> SerialisedValue)
-> (b -> SerialisedBlob)
-> MergingRunData t k v b
-> MergingRunData t SerialisedKey SerialisedValue SerialisedBlob
forall k' k v v' b b' t.
Ord k' =>
(k -> k')
-> (v -> v')
-> (b -> b')
-> MergingRunData t k v b
-> MergingRunData t k' v' b'
mapMergingRunData k -> SerialisedKey
forall k. SerialiseKey k => k -> SerialisedKey
serialiseKey v -> SerialisedValue
forall v. SerialiseValue v => v -> SerialisedValue
serialiseValue b -> SerialisedBlob
forall v. SerialiseValue v => v -> SerialisedBlob
serialiseBlob

{-------------------------------------------------------------------------------
  QuickCheck
-------------------------------------------------------------------------------}

labelMergingRunData ::
     Show t => SerialisedMergingRunData t -> Property -> Property
labelMergingRunData :: forall t.
Show t =>
SerialisedMergingRunData t -> Property -> Property
labelMergingRunData (CompletedMergeData t
mt RunData SerialisedKey SerialisedValue SerialisedBlob
rd) =
      String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"merging run state" [String
"CompletedMerge"]
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"merge type" [t -> String
forall a. Show a => a -> String
show t
mt]
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunData SerialisedKey SerialisedValue SerialisedBlob
-> Property -> Property
labelRunData RunData SerialisedKey SerialisedValue SerialisedBlob
rd
labelMergingRunData (OngoingMergeData t
mt [NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob]
rds) =
      String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"merging run state" [String
"OngoingMerge"]
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"merge type" [t -> String
forall a. Show a => a -> String
show t
mt]
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"merging run inputs" [Int -> Int -> String
showPowersOf Int
2 ([NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob]
rds)]
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob
 -> (Property -> Property) -> Property -> Property)
-> (Property -> Property)
-> [NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob]
-> Property
-> Property
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ((Property -> Property)
 -> (Property -> Property) -> Property -> Property)
-> (NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob
    -> Property -> Property)
-> NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob
-> (Property -> Property)
-> Property
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob
-> Property -> Property
labelNonEmptyRunData) Property -> Property
forall a. a -> a
id [NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob]
rds

instance ( Arbitrary t, Ord k, Arbitrary k, Arbitrary v, Arbitrary b
         ) => Arbitrary (MergingRunData t k v b) where
  arbitrary :: Gen (MergingRunData t k v b)
arbitrary = Gen t -> Gen k -> Gen v -> Gen b -> Gen (MergingRunData t k v b)
forall k t v b.
Ord k =>
Gen t -> Gen k -> Gen v -> Gen b -> Gen (MergingRunData t k v b)
genMergingRunData Gen t
forall a. Arbitrary a => Gen a
arbitrary Gen k
forall a. Arbitrary a => Gen a
arbitrary Gen v
forall a. Arbitrary a => Gen a
arbitrary Gen b
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: MergingRunData t k v b -> [MergingRunData t k v b]
shrink = (k -> [k])
-> (v -> [v])
-> (b -> [b])
-> MergingRunData t k v b
-> [MergingRunData t k v b]
forall k v b t.
Ord k =>
(k -> [k])
-> (v -> [v])
-> (b -> [b])
-> MergingRunData t k v b
-> [MergingRunData t k v b]
shrinkMergingRunData k -> [k]
forall a. Arbitrary a => a -> [a]
shrink v -> [v]
forall a. Arbitrary a => a -> [a]
shrink b -> [b]
forall a. Arbitrary a => a -> [a]
shrink

genMergingRunData ::
     Ord k
  => Gen t
  -> Gen k
  -> Gen v
  -> Gen b
  -> Gen (MergingRunData t k v b)
genMergingRunData :: forall k t v b.
Ord k =>
Gen t -> Gen k -> Gen v -> Gen b -> Gen (MergingRunData t k v b)
genMergingRunData Gen t
genMergeType Gen k
genKey Gen v
genVal Gen b
genBlob =
    [Gen (MergingRunData t k v b)] -> Gen (MergingRunData t k v b)
forall a. HasCallStack => [Gen a] -> Gen a
QC.oneof
      [ do
          t
mt <- Gen t
genMergeType
          RunData k v b
rd <- Gen k -> Gen v -> Gen b -> Gen (RunData k v b)
forall k v b.
Ord k =>
Gen k -> Gen v -> Gen b -> Gen (RunData k v b)
genRunData Gen k
genKey Gen v
genVal Gen b
genBlob
          MergingRunData t k v b -> Gen (MergingRunData t k v b)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> RunData k v b -> MergingRunData t k v b
forall t k v b. t -> RunData k v b -> MergingRunData t k v b
CompletedMergeData t
mt RunData k v b
rd)
      , do
          Int
s  <- Gen Int
QC.getSize
          t
mt <- Gen t
genMergeType
          Int
n  <- (Int, Int) -> Gen Int
QC.chooseInt (Int
2, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2 (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100))  -- 2 to 8
          [NonEmptyRunData k v b]
rs <- Int -> Gen (NonEmptyRunData k v b) -> Gen [NonEmptyRunData k v b]
forall a. Int -> Gen a -> Gen [a]
QC.vectorOf Int
n (Gen (NonEmptyRunData k v b) -> Gen [NonEmptyRunData k v b])
-> Gen (NonEmptyRunData k v b) -> Gen [NonEmptyRunData k v b]
forall a b. (a -> b) -> a -> b
$
            -- Scaled, so overall number of entries is similar to a completed
            -- merge. However, the entries themselves should not be smaller.
            (Int -> Int)
-> Gen (NonEmptyRunData k v b) -> Gen (NonEmptyRunData k v b)
forall a. (Int -> Int) -> Gen a -> Gen a
QC.scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
n) (Gen (NonEmptyRunData k v b) -> Gen (NonEmptyRunData k v b))
-> Gen (NonEmptyRunData k v b) -> Gen (NonEmptyRunData k v b)
forall a b. (a -> b) -> a -> b
$
              Gen k -> Gen v -> Gen b -> Gen (NonEmptyRunData k v b)
forall k v b.
Ord k =>
Gen k -> Gen v -> Gen b -> Gen (NonEmptyRunData k v b)
genNonEmptyRunData
                (Int -> Gen k -> Gen k
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
s Gen k
genKey)
                (Int -> Gen v -> Gen v
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
s Gen v
genVal)
                (Int -> Gen b -> Gen b
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
s Gen b
genBlob)
          MergingRunData t k v b -> Gen (MergingRunData t k v b)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> [NonEmptyRunData k v b] -> MergingRunData t k v b
forall t k v b.
t -> [NonEmptyRunData k v b] -> MergingRunData t k v b
OngoingMergeData t
mt [NonEmptyRunData k v b]
rs)
      ]

shrinkMergingRunData ::
     Ord k
  => (k -> [k])
  -> (v -> [v])
  -> (b -> [b])
  -> MergingRunData t k v b
  -> [MergingRunData t k v b]
shrinkMergingRunData :: forall k v b t.
Ord k =>
(k -> [k])
-> (v -> [v])
-> (b -> [b])
-> MergingRunData t k v b
-> [MergingRunData t k v b]
shrinkMergingRunData k -> [k]
shrinkKey v -> [v]
shrinkVal b -> [b]
shrinkBlob = \case
    CompletedMergeData t
mt RunData k v b
rd ->
      [ t -> RunData k v b -> MergingRunData t k v b
forall t k v b. t -> RunData k v b -> MergingRunData t k v b
CompletedMergeData t
mt RunData k v b
rd'
      | RunData k v b
rd' <- (k -> [k])
-> (v -> [v]) -> (b -> [b]) -> RunData k v b -> [RunData k v b]
forall k v b.
Ord k =>
(k -> [k])
-> (v -> [v]) -> (b -> [b]) -> RunData k v b -> [RunData k v b]
shrinkRunData k -> [k]
shrinkKey v -> [v]
shrinkVal b -> [b]
shrinkBlob RunData k v b
rd
      ]
    OngoingMergeData t
mt [NonEmptyRunData k v b]
rds ->
      [ t -> [NonEmptyRunData k v b] -> MergingRunData t k v b
forall t k v b.
t -> [NonEmptyRunData k v b] -> MergingRunData t k v b
OngoingMergeData t
mt [NonEmptyRunData k v b]
rds'
      | [NonEmptyRunData k v b]
rds' <-
          (NonEmptyRunData k v b -> [NonEmptyRunData k v b])
-> [NonEmptyRunData k v b] -> [[NonEmptyRunData k v b]]
forall a. (a -> [a]) -> [a] -> [[a]]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink
            ((k -> [k])
-> (v -> [v])
-> (b -> [b])
-> NonEmptyRunData k v b
-> [NonEmptyRunData k v b]
forall k v b.
Ord k =>
(k -> [k])
-> (v -> [v])
-> (b -> [b])
-> NonEmptyRunData k v b
-> [NonEmptyRunData k v b]
shrinkNonEmptyRunData k -> [k]
shrinkKey v -> [v]
shrinkVal b -> [b]
shrinkBlob)
            [NonEmptyRunData k v b]
rds
      , [NonEmptyRunData k v b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NonEmptyRunData k v b]
rds' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
      ]