-- | Utilities for generating 'MergingTree's. Tests and benchmarks should
-- preferably use these utilities instead of (re-)defining their own.
module Database.LSMTree.Extras.MergingTreeData (
    -- * Create merging trees
    withMergingTree
  , unsafeCreateMergingTree
    -- * MergingTreeData
  , MergingTreeData (..)
  , PreExistingRunData (..)
  , mergingTreeDataInvariant
  , mapMergingTreeData
  , SerialisedMergingTreeData
  , serialiseMergingTreeData
    -- * QuickCheck
  , labelMergingTreeData
  , genMergingTreeData
  , shrinkMergingTreeData
  ) where

import           Control.Exception (assert, bracket)
import           Control.RefCount
import           Data.Foldable (for_, toList)
import           Database.LSMTree.Extras (showPowersOf)
import           Database.LSMTree.Extras.Generators ()
import           Database.LSMTree.Extras.MergingRunData
import           Database.LSMTree.Extras.RunData
import           Database.LSMTree.Internal.Lookup (ResolveSerialisedValue)
import qualified Database.LSMTree.Internal.MergingRun as MR
import           Database.LSMTree.Internal.MergingTree (MergingTree)
import qualified Database.LSMTree.Internal.MergingTree as MT
import           Database.LSMTree.Internal.RunBuilder (RunParams)
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 tree
-------------------------------------------------------------------------------}

-- | Create a temporary 'MergingTree' using 'unsafeCreateMergingTree'.
withMergingTree ::
     HasFS IO h
  -> HasBlockIO IO h
  -> ResolveSerialisedValue
  -> RunParams
  -> FS.FsPath
  -> UniqCounter IO
  -> SerialisedMergingTreeData
  -> (Ref (MergingTree IO h) -> IO a)
  -> IO a
withMergingTree :: forall h a.
HasFS IO h
-> HasBlockIO IO h
-> ResolveSerialisedValue
-> RunParams
-> FsPath
-> UniqCounter IO
-> SerialisedMergingTreeData
-> (Ref (MergingTree IO h) -> IO a)
-> IO a
withMergingTree HasFS IO h
hfs HasBlockIO IO h
hbio ResolveSerialisedValue
resolve RunParams
runParams FsPath
path UniqCounter IO
counter SerialisedMergingTreeData
mrd = do
    IO (Ref (MergingTree IO h))
-> (Ref (MergingTree IO h) -> IO ())
-> (Ref (MergingTree 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
-> SerialisedMergingTreeData
-> IO (Ref (MergingTree IO h))
forall h.
HasFS IO h
-> HasBlockIO IO h
-> ResolveSerialisedValue
-> RunParams
-> FsPath
-> UniqCounter IO
-> SerialisedMergingTreeData
-> IO (Ref (MergingTree IO h))
unsafeCreateMergingTree HasFS IO h
hfs HasBlockIO IO h
hbio ResolveSerialisedValue
resolve RunParams
runParams FsPath
path UniqCounter IO
counter SerialisedMergingTreeData
mrd)
      Ref (MergingTree IO h) -> IO ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m,
 ?callStack::CallStack) =>
Ref obj -> m ()
releaseRef

-- | Flush serialised merging tree data to disk.
--
-- This might leak resources if not run with asynchronous exceptions masked.
-- Consider using 'withMergingTree' instead.
--
-- Use of this function should be paired with a 'releaseRef'.
unsafeCreateMergingTree ::
     HasFS IO h
  -> HasBlockIO IO h
  -> ResolveSerialisedValue
  -> RunParams
  -> FS.FsPath
  -> UniqCounter IO
  -> SerialisedMergingTreeData
  -> IO (Ref (MergingTree IO h))
unsafeCreateMergingTree :: forall h.
HasFS IO h
-> HasBlockIO IO h
-> ResolveSerialisedValue
-> RunParams
-> FsPath
-> UniqCounter IO
-> SerialisedMergingTreeData
-> IO (Ref (MergingTree IO h))
unsafeCreateMergingTree HasFS IO h
hfs HasBlockIO IO h
hbio ResolveSerialisedValue
resolve RunParams
runParams FsPath
path UniqCounter IO
counter = SerialisedMergingTreeData -> IO (Ref (MergingTree IO h))
go
  where
    go :: SerialisedMergingTreeData -> IO (Ref (MergingTree IO h))
go = \case
      CompletedTreeMergeData RunData SerialisedKey SerialisedValue SerialisedBlob
rd ->
        HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> FsPath
-> UniqCounter IO
-> RunData SerialisedKey SerialisedValue SerialisedBlob
-> (Ref (Run IO h) -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree 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 (MergingTree IO h)))
 -> IO (Ref (MergingTree IO h)))
-> (Ref (Run IO h) -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b. (a -> b) -> a -> b
$ \Ref (Run IO h)
run ->
          Ref (Run IO h) -> IO (Ref (MergingTree IO h))
forall (m :: * -> *) h.
(MonadMVar m, PrimMonad m, MonadMask m) =>
Ref (Run m h) -> m (Ref (MergingTree m h))
MT.newCompletedMerge Ref (Run IO h)
run
      OngoingTreeMergeData MergingRunData
  TreeMergeType SerialisedKey SerialisedValue SerialisedBlob
mrd ->
        HasFS IO h
-> HasBlockIO IO h
-> ResolveSerialisedValue
-> RunParams
-> FsPath
-> UniqCounter IO
-> MergingRunData
     TreeMergeType SerialisedKey SerialisedValue SerialisedBlob
-> (Ref (MergingRun TreeMergeType IO h)
    -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
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 MergingRunData
  TreeMergeType SerialisedKey SerialisedValue SerialisedBlob
mrd ((Ref (MergingRun TreeMergeType IO h)
  -> IO (Ref (MergingTree IO h)))
 -> IO (Ref (MergingTree IO h)))
-> (Ref (MergingRun TreeMergeType IO h)
    -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b. (a -> b) -> a -> b
$ \Ref (MergingRun TreeMergeType IO h)
mr ->
          Ref (MergingRun TreeMergeType IO h) -> IO (Ref (MergingTree IO h))
forall (m :: * -> *) h.
(MonadMVar m, PrimMonad m, MonadMask m) =>
Ref (MergingRun TreeMergeType m h) -> m (Ref (MergingTree m h))
MT.newOngoingMerge Ref (MergingRun TreeMergeType IO h)
mr
      PendingLevelMergeData [PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob]
prds Maybe SerialisedMergingTreeData
mtd ->
        [PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob]
-> ([PreExistingRun IO h] -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
withPreExistingRuns [PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob]
prds (([PreExistingRun IO h] -> IO (Ref (MergingTree IO h)))
 -> IO (Ref (MergingTree IO h)))
-> ([PreExistingRun IO h] -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b. (a -> b) -> a -> b
$ \[PreExistingRun IO h]
prs ->
          Maybe SerialisedMergingTreeData
-> (Maybe (Ref (MergingTree IO h)) -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
withMaybeTree Maybe SerialisedMergingTreeData
mtd ((Maybe (Ref (MergingTree IO h)) -> IO (Ref (MergingTree IO h)))
 -> IO (Ref (MergingTree IO h)))
-> (Maybe (Ref (MergingTree IO h)) -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b. (a -> b) -> a -> b
$ \Maybe (Ref (MergingTree IO h))
mt ->
            [PreExistingRun IO h]
-> Maybe (Ref (MergingTree IO h)) -> IO (Ref (MergingTree IO h))
forall (m :: * -> *) h.
(MonadMVar m, MonadMask m, PrimMonad m) =>
[PreExistingRun m h]
-> Maybe (Ref (MergingTree m h)) -> m (Ref (MergingTree m h))
MT.newPendingLevelMerge [PreExistingRun IO h]
prs Maybe (Ref (MergingTree IO h))
mt
      PendingUnionMergeData [SerialisedMergingTreeData]
mtds ->
        [SerialisedMergingTreeData]
-> ([Ref (MergingTree IO h)] -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
withTrees [SerialisedMergingTreeData]
mtds (([Ref (MergingTree IO h)] -> IO (Ref (MergingTree IO h)))
 -> IO (Ref (MergingTree IO h)))
-> ([Ref (MergingTree IO h)] -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b. (a -> b) -> a -> b
$ \[Ref (MergingTree IO h)]
mts ->
          [Ref (MergingTree IO h)] -> IO (Ref (MergingTree IO h))
forall (m :: * -> *) h.
(MonadMVar m, MonadMask m, PrimMonad m) =>
[Ref (MergingTree m h)] -> m (Ref (MergingTree m h))
MT.newPendingUnionMerge [Ref (MergingTree IO h)]
mts

    withTrees :: [SerialisedMergingTreeData]
-> ([Ref (MergingTree IO h)] -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
withTrees []         [Ref (MergingTree IO h)] -> IO (Ref (MergingTree IO h))
act = [Ref (MergingTree IO h)] -> IO (Ref (MergingTree IO h))
act []
    withTrees (SerialisedMergingTreeData
mtd:[SerialisedMergingTreeData]
rest) [Ref (MergingTree IO h)] -> IO (Ref (MergingTree IO h))
act =
        IO (Ref (MergingTree IO h))
-> (Ref (MergingTree IO h) -> IO ())
-> (Ref (MergingTree IO h) -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (SerialisedMergingTreeData -> IO (Ref (MergingTree IO h))
go SerialisedMergingTreeData
mtd) Ref (MergingTree IO h) -> IO ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m,
 ?callStack::CallStack) =>
Ref obj -> m ()
releaseRef ((Ref (MergingTree IO h) -> IO (Ref (MergingTree IO h)))
 -> IO (Ref (MergingTree IO h)))
-> (Ref (MergingTree IO h) -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b. (a -> b) -> a -> b
$ \Ref (MergingTree IO h)
t ->
          [SerialisedMergingTreeData]
-> ([Ref (MergingTree IO h)] -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
withTrees [SerialisedMergingTreeData]
rest (([Ref (MergingTree IO h)] -> IO (Ref (MergingTree IO h)))
 -> IO (Ref (MergingTree IO h)))
-> ([Ref (MergingTree IO h)] -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b. (a -> b) -> a -> b
$ \[Ref (MergingTree IO h)]
ts ->
            [Ref (MergingTree IO h)] -> IO (Ref (MergingTree IO h))
act (Ref (MergingTree IO h)
tRef (MergingTree IO h)
-> [Ref (MergingTree IO h)] -> [Ref (MergingTree IO h)]
forall a. a -> [a] -> [a]
:[Ref (MergingTree IO h)]
ts)

    withMaybeTree :: Maybe SerialisedMergingTreeData
-> (Maybe (Ref (MergingTree IO h)) -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
withMaybeTree Maybe SerialisedMergingTreeData
Nothing    Maybe (Ref (MergingTree IO h)) -> IO (Ref (MergingTree IO h))
act = Maybe (Ref (MergingTree IO h)) -> IO (Ref (MergingTree IO h))
act Maybe (Ref (MergingTree IO h))
forall a. Maybe a
Nothing
    withMaybeTree (Just SerialisedMergingTreeData
mtd) Maybe (Ref (MergingTree IO h)) -> IO (Ref (MergingTree IO h))
act =
        IO (Ref (MergingTree IO h))
-> (Ref (MergingTree IO h) -> IO ())
-> (Ref (MergingTree IO h) -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (SerialisedMergingTreeData -> IO (Ref (MergingTree IO h))
go SerialisedMergingTreeData
mtd) Ref (MergingTree IO h) -> IO ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m,
 ?callStack::CallStack) =>
Ref obj -> m ()
releaseRef ((Ref (MergingTree IO h) -> IO (Ref (MergingTree IO h)))
 -> IO (Ref (MergingTree IO h)))
-> (Ref (MergingTree IO h) -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b. (a -> b) -> a -> b
$ \Ref (MergingTree IO h)
t ->
          Maybe (Ref (MergingTree IO h)) -> IO (Ref (MergingTree IO h))
act (Ref (MergingTree IO h) -> Maybe (Ref (MergingTree IO h))
forall a. a -> Maybe a
Just Ref (MergingTree IO h)
t)

    withPreExistingRuns :: [PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob]
-> ([PreExistingRun IO h] -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
withPreExistingRuns [] [PreExistingRun IO h] -> IO (Ref (MergingTree IO h))
act = [PreExistingRun IO h] -> IO (Ref (MergingTree IO h))
act []
    withPreExistingRuns (PreExistingRunData RunData SerialisedKey SerialisedValue SerialisedBlob
rd : [PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob]
rest) [PreExistingRun IO h] -> IO (Ref (MergingTree IO h))
act =
        HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> FsPath
-> UniqCounter IO
-> RunData SerialisedKey SerialisedValue SerialisedBlob
-> (Ref (Run IO h) -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree 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 (MergingTree IO h)))
 -> IO (Ref (MergingTree IO h)))
-> (Ref (Run IO h) -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b. (a -> b) -> a -> b
$ \Ref (Run IO h)
r ->
          [PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob]
-> ([PreExistingRun IO h] -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
withPreExistingRuns [PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob]
rest (([PreExistingRun IO h] -> IO (Ref (MergingTree IO h)))
 -> IO (Ref (MergingTree IO h)))
-> ([PreExistingRun IO h] -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b. (a -> b) -> a -> b
$ \[PreExistingRun IO h]
prs ->
            [PreExistingRun IO h] -> IO (Ref (MergingTree IO h))
act (Ref (Run IO h) -> PreExistingRun IO h
forall (m :: * -> *) h. Ref (Run m h) -> PreExistingRun m h
MT.PreExistingRun Ref (Run IO h)
r PreExistingRun IO h
-> [PreExistingRun IO h] -> [PreExistingRun IO h]
forall a. a -> [a] -> [a]
: [PreExistingRun IO h]
prs)
    withPreExistingRuns (PreExistingMergingRunData MergingRunData
  LevelMergeType SerialisedKey SerialisedValue SerialisedBlob
mrd : [PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob]
rest) [PreExistingRun IO h] -> IO (Ref (MergingTree IO h))
act =
        HasFS IO h
-> HasBlockIO IO h
-> ResolveSerialisedValue
-> RunParams
-> FsPath
-> UniqCounter IO
-> MergingRunData
     LevelMergeType SerialisedKey SerialisedValue SerialisedBlob
-> (Ref (MergingRun LevelMergeType IO h)
    -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
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 MergingRunData
  LevelMergeType SerialisedKey SerialisedValue SerialisedBlob
mrd ((Ref (MergingRun LevelMergeType IO h)
  -> IO (Ref (MergingTree IO h)))
 -> IO (Ref (MergingTree IO h)))
-> (Ref (MergingRun LevelMergeType IO h)
    -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b. (a -> b) -> a -> b
$ \Ref (MergingRun LevelMergeType IO h)
mr ->
          [PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob]
-> ([PreExistingRun IO h] -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
withPreExistingRuns [PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob]
rest (([PreExistingRun IO h] -> IO (Ref (MergingTree IO h)))
 -> IO (Ref (MergingTree IO h)))
-> ([PreExistingRun IO h] -> IO (Ref (MergingTree IO h)))
-> IO (Ref (MergingTree IO h))
forall a b. (a -> b) -> a -> b
$ \[PreExistingRun IO h]
prs ->
            [PreExistingRun IO h] -> IO (Ref (MergingTree IO h))
act (Ref (MergingRun LevelMergeType IO h) -> PreExistingRun IO h
forall (m :: * -> *) h.
Ref (MergingRun LevelMergeType m h) -> PreExistingRun m h
MT.PreExistingMergingRun Ref (MergingRun LevelMergeType IO h)
mr PreExistingRun IO h
-> [PreExistingRun IO h] -> [PreExistingRun IO h]
forall a. a -> [a] -> [a]
: [PreExistingRun IO h]
prs)

{-------------------------------------------------------------------------------
  MergingTreeData
-------------------------------------------------------------------------------}

-- TODO: This module has quite a lot duplication with the prototype's
-- ScheduledMergesTest module. Maybe we can share some code?

-- | A data structure suitable for creating arbitrary 'MergingTree's.
--
-- Note: 'b ~ Void' should rule out blobs.
data MergingTreeData k v b =
    CompletedTreeMergeData (RunData k v b)
  | OngoingTreeMergeData (MergingRunData MR.TreeMergeType k v b)
  | PendingLevelMergeData
      [PreExistingRunData k v b]
      (Maybe (MergingTreeData k v b))  -- ^ not both empty!
  | PendingUnionMergeData [MergingTreeData k v b]  -- ^ at least 2 children
  deriving stock (Int -> MergingTreeData k v b -> ShowS
[MergingTreeData k v b] -> ShowS
MergingTreeData k v b -> String
(Int -> MergingTreeData k v b -> ShowS)
-> (MergingTreeData k v b -> String)
-> ([MergingTreeData k v b] -> ShowS)
-> Show (MergingTreeData k v b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v b.
(Show k, Show b, Show v) =>
Int -> MergingTreeData k v b -> ShowS
forall k v b.
(Show k, Show b, Show v) =>
[MergingTreeData k v b] -> ShowS
forall k v b.
(Show k, Show b, Show v) =>
MergingTreeData k v b -> String
$cshowsPrec :: forall k v b.
(Show k, Show b, Show v) =>
Int -> MergingTreeData k v b -> ShowS
showsPrec :: Int -> MergingTreeData k v b -> ShowS
$cshow :: forall k v b.
(Show k, Show b, Show v) =>
MergingTreeData k v b -> String
show :: MergingTreeData k v b -> String
$cshowList :: forall k v b.
(Show k, Show b, Show v) =>
[MergingTreeData k v b] -> ShowS
showList :: [MergingTreeData k v b] -> ShowS
Show, MergingTreeData k v b -> MergingTreeData k v b -> Bool
(MergingTreeData k v b -> MergingTreeData k v b -> Bool)
-> (MergingTreeData k v b -> MergingTreeData k v b -> Bool)
-> Eq (MergingTreeData k v b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v b.
(Eq k, Eq b, Eq v) =>
MergingTreeData k v b -> MergingTreeData k v b -> Bool
$c== :: forall k v b.
(Eq k, Eq b, Eq v) =>
MergingTreeData k v b -> MergingTreeData k v b -> Bool
== :: MergingTreeData k v b -> MergingTreeData k v b -> Bool
$c/= :: forall k v b.
(Eq k, Eq b, Eq v) =>
MergingTreeData k v b -> MergingTreeData k v b -> Bool
/= :: MergingTreeData k v b -> MergingTreeData k v b -> Bool
Eq)

data PreExistingRunData k v b =
    PreExistingRunData (RunData k v b)
  | PreExistingMergingRunData (MergingRunData MR.LevelMergeType k v b)
  deriving stock (Int -> PreExistingRunData k v b -> ShowS
[PreExistingRunData k v b] -> ShowS
PreExistingRunData k v b -> String
(Int -> PreExistingRunData k v b -> ShowS)
-> (PreExistingRunData k v b -> String)
-> ([PreExistingRunData k v b] -> ShowS)
-> Show (PreExistingRunData k v b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v b.
(Show k, Show b, Show v) =>
Int -> PreExistingRunData k v b -> ShowS
forall k v b.
(Show k, Show b, Show v) =>
[PreExistingRunData k v b] -> ShowS
forall k v b.
(Show k, Show b, Show v) =>
PreExistingRunData k v b -> String
$cshowsPrec :: forall k v b.
(Show k, Show b, Show v) =>
Int -> PreExistingRunData k v b -> ShowS
showsPrec :: Int -> PreExistingRunData k v b -> ShowS
$cshow :: forall k v b.
(Show k, Show b, Show v) =>
PreExistingRunData k v b -> String
show :: PreExistingRunData k v b -> String
$cshowList :: forall k v b.
(Show k, Show b, Show v) =>
[PreExistingRunData k v b] -> ShowS
showList :: [PreExistingRunData k v b] -> ShowS
Show, PreExistingRunData k v b -> PreExistingRunData k v b -> Bool
(PreExistingRunData k v b -> PreExistingRunData k v b -> Bool)
-> (PreExistingRunData k v b -> PreExistingRunData k v b -> Bool)
-> Eq (PreExistingRunData k v b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v b.
(Eq k, Eq b, Eq v) =>
PreExistingRunData k v b -> PreExistingRunData k v b -> Bool
$c== :: forall k v b.
(Eq k, Eq b, Eq v) =>
PreExistingRunData k v b -> PreExistingRunData k v b -> Bool
== :: PreExistingRunData k v b -> PreExistingRunData k v b -> Bool
$c/= :: forall k v b.
(Eq k, Eq b, Eq v) =>
PreExistingRunData k v b -> PreExistingRunData k v b -> Bool
/= :: PreExistingRunData k v b -> PreExistingRunData k v b -> Bool
Eq)

mergingTreeIsStructurallyEmpty :: MergingTreeData k v b -> Bool
mergingTreeIsStructurallyEmpty :: forall k v b. MergingTreeData k v b -> Bool
mergingTreeIsStructurallyEmpty = \case
    CompletedTreeMergeData RunData k v b
_   -> Bool
False  -- could be, but we match MT
    OngoingTreeMergeData MergingRunData TreeMergeType k v b
_     -> Bool
False
    PendingLevelMergeData [PreExistingRunData k v b]
ps Maybe (MergingTreeData k v b)
t -> [PreExistingRunData k v b] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PreExistingRunData k v b]
ps Bool -> Bool -> Bool
&& Maybe (MergingTreeData k v b) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (MergingTreeData k v b)
t
    PendingUnionMergeData [MergingTreeData k v b]
ts   -> [MergingTreeData k v b] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MergingTreeData k v b]
ts

-- | See @treeInvariant@ in prototype.
mergingTreeDataInvariant :: MergingTreeData k v b -> Either String ()
mergingTreeDataInvariant :: forall k v b. MergingTreeData k v b -> Either String ()
mergingTreeDataInvariant MergingTreeData k v b
mtd
  | MergingTreeData k v b -> Bool
forall k v b. MergingTreeData k v b -> Bool
mergingTreeIsStructurallyEmpty MergingTreeData k v b
mtd = () -> Either String ()
forall a b. b -> Either a b
Right ()
  | Bool
otherwise = case MergingTreeData k v b
mtd of
      CompletedTreeMergeData RunData k v b
_rd ->
        () -> Either String ()
forall a b. b -> Either a b
Right ()
      OngoingTreeMergeData MergingRunData TreeMergeType k v b
mr ->
        MergingRunData TreeMergeType k v b -> Either String ()
forall t k v b. MergingRunData t k v b -> Either String ()
mergingRunDataInvariant MergingRunData TreeMergeType k v b
mr
      PendingLevelMergeData [PreExistingRunData k v b]
prs Maybe (MergingTreeData k v b)
t -> do
        String -> Bool -> Either String ()
forall {a}. a -> Bool -> Either a ()
assertI String
"pending level merges have at least one input" (Bool -> Either String ()) -> Bool -> Either String ()
forall a b. (a -> b) -> a -> b
$
          [PreExistingRunData k v b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PreExistingRunData k v b]
prs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Maybe (MergingTreeData k v b) -> Int
forall a. Maybe a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Maybe (MergingTreeData k v b)
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        [PreExistingRunData k v b]
-> (PreExistingRunData k v b -> Either String ())
-> Either String ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [PreExistingRunData k v b]
prs ((PreExistingRunData k v b -> Either String ())
 -> Either String ())
-> (PreExistingRunData k v b -> Either String ())
-> Either String ()
forall a b. (a -> b) -> a -> b
$ \case
          PreExistingRunData        RunData k v b
_r -> () -> Either String ()
forall a b. b -> Either a b
Right ()
          PreExistingMergingRunData MergingRunData LevelMergeType k v b
mr -> MergingRunData LevelMergeType k v b -> Either String ()
forall t k v b. MergingRunData t k v b -> Either String ()
mergingRunDataInvariant MergingRunData LevelMergeType k v b
mr
        [PreExistingRunData k v b]
-> (PreExistingRunData k v b -> Either String ())
-> Either String ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Int -> [PreExistingRunData k v b] -> [PreExistingRunData k v b]
forall a. Int -> [a] -> [a]
drop Int
1 ([PreExistingRunData k v b] -> [PreExistingRunData k v b]
forall a. [a] -> [a]
reverse [PreExistingRunData k v b]
prs)) ((PreExistingRunData k v b -> Either String ())
 -> Either String ())
-> (PreExistingRunData k v b -> Either String ())
-> Either String ()
forall a b. (a -> b) -> a -> b
$ \case
          PreExistingRunData        RunData k v b
_r -> () -> Either String ()
forall a b. b -> Either a b
Right ()
          PreExistingMergingRunData MergingRunData LevelMergeType k v b
mr ->
            String -> Bool -> Either String ()
forall {a}. a -> Bool -> Either a ()
assertI String
"only the last pre-existing run can be a last level merge" (Bool -> Either String ()) -> Bool -> Either String ()
forall a b. (a -> b) -> a -> b
$
              MergingRunData LevelMergeType k v b -> LevelMergeType
forall t k v b. MergingRunData t k v b -> t
mergingRunDataMergeType MergingRunData LevelMergeType k v b
mr LevelMergeType -> LevelMergeType -> Bool
forall a. Eq a => a -> a -> Bool
== LevelMergeType
MR.MergeMidLevel
        Maybe (MergingTreeData k v b)
-> (MergingTreeData k v b -> Either String ()) -> Either String ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (MergingTreeData k v b)
t MergingTreeData k v b -> Either String ()
forall k v b. MergingTreeData k v b -> Either String ()
mergingTreeDataInvariant
      PendingUnionMergeData [MergingTreeData k v b]
ts -> do
        String -> Bool -> Either String ()
forall {a}. a -> Bool -> Either a ()
assertI String
"pending union merges are non-trivial (at least two inputs)" (Bool -> Either String ()) -> Bool -> Either String ()
forall a b. (a -> b) -> a -> b
$
          [MergingTreeData k v b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MergingTreeData k v b]
ts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
        [MergingTreeData k v b]
-> (MergingTreeData k v b -> Either String ()) -> Either String ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [MergingTreeData k v b]
ts MergingTreeData k v b -> Either String ()
forall k v b. MergingTreeData k v b -> Either String ()
mergingTreeDataInvariant
  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 ()

mapMergingTreeData ::
     Ord k'
  => (k -> k') -> (v -> v') -> (b -> b')
  -> MergingTreeData k v b -> MergingTreeData k' v' b'
mapMergingTreeData :: forall k' k v v' b b'.
Ord k' =>
(k -> k')
-> (v -> v')
-> (b -> b')
-> MergingTreeData k v b
-> MergingTreeData k' v' b'
mapMergingTreeData k -> k'
f v -> v'
g b -> b'
h = \case
    CompletedTreeMergeData RunData k v b
r ->
      RunData k' v' b' -> MergingTreeData k' v' b'
forall k v b. RunData k v b -> MergingTreeData k v b
CompletedTreeMergeData (RunData k' v' b' -> MergingTreeData k' v' b')
-> RunData k' v' b' -> MergingTreeData 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
    OngoingTreeMergeData MergingRunData TreeMergeType k v b
mr ->
      MergingRunData TreeMergeType k' v' b' -> MergingTreeData k' v' b'
forall k v b.
MergingRunData TreeMergeType k v b -> MergingTreeData k v b
OngoingTreeMergeData (MergingRunData TreeMergeType k' v' b' -> MergingTreeData k' v' b')
-> MergingRunData TreeMergeType k' v' b'
-> MergingTreeData k' v' b'
forall a b. (a -> b) -> a -> b
$ (k -> k')
-> (v -> v')
-> (b -> b')
-> MergingRunData TreeMergeType k v b
-> MergingRunData TreeMergeType k' v' b'
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 MergingRunData TreeMergeType k v b
mr
    PendingLevelMergeData [PreExistingRunData k v b]
prs Maybe (MergingTreeData k v b)
t ->
      [PreExistingRunData k' v' b']
-> Maybe (MergingTreeData k' v' b') -> MergingTreeData k' v' b'
forall k v b.
[PreExistingRunData k v b]
-> Maybe (MergingTreeData k v b) -> MergingTreeData k v b
PendingLevelMergeData
        ((PreExistingRunData k v b -> PreExistingRunData k' v' b')
-> [PreExistingRunData k v b] -> [PreExistingRunData k' v' b']
forall a b. (a -> b) -> [a] -> [b]
map ((k -> k')
-> (v -> v')
-> (b -> b')
-> PreExistingRunData k v b
-> PreExistingRunData k' v' b'
forall k' k v v' b b'.
Ord k' =>
(k -> k')
-> (v -> v')
-> (b -> b')
-> PreExistingRunData k v b
-> PreExistingRunData k' v' b'
mapPreExistingRunData k -> k'
f v -> v'
g b -> b'
h) [PreExistingRunData k v b]
prs)
        ((MergingTreeData k v b -> MergingTreeData k' v' b')
-> Maybe (MergingTreeData k v b)
-> Maybe (MergingTreeData k' v' b')
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((k -> k')
-> (v -> v')
-> (b -> b')
-> MergingTreeData k v b
-> MergingTreeData k' v' b'
forall k' k v v' b b'.
Ord k' =>
(k -> k')
-> (v -> v')
-> (b -> b')
-> MergingTreeData k v b
-> MergingTreeData k' v' b'
mapMergingTreeData k -> k'
f v -> v'
g b -> b'
h) Maybe (MergingTreeData k v b)
t)
    PendingUnionMergeData [MergingTreeData k v b]
ts ->
      [MergingTreeData k' v' b'] -> MergingTreeData k' v' b'
forall k v b. [MergingTreeData k v b] -> MergingTreeData k v b
PendingUnionMergeData ([MergingTreeData k' v' b'] -> MergingTreeData k' v' b')
-> [MergingTreeData k' v' b'] -> MergingTreeData k' v' b'
forall a b. (a -> b) -> a -> b
$ (MergingTreeData k v b -> MergingTreeData k' v' b')
-> [MergingTreeData k v b] -> [MergingTreeData k' v' b']
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((k -> k')
-> (v -> v')
-> (b -> b')
-> MergingTreeData k v b
-> MergingTreeData k' v' b'
forall k' k v v' b b'.
Ord k' =>
(k -> k')
-> (v -> v')
-> (b -> b')
-> MergingTreeData k v b
-> MergingTreeData k' v' b'
mapMergingTreeData k -> k'
f v -> v'
g b -> b'
h) [MergingTreeData k v b]
ts

mapPreExistingRunData ::
     Ord k'
  => (k -> k') -> (v -> v') -> (b -> b')
  -> PreExistingRunData k v b -> PreExistingRunData k' v' b'
mapPreExistingRunData :: forall k' k v v' b b'.
Ord k' =>
(k -> k')
-> (v -> v')
-> (b -> b')
-> PreExistingRunData k v b
-> PreExistingRunData k' v' b'
mapPreExistingRunData k -> k'
f v -> v'
g b -> b'
h = \case
    PreExistingRunData RunData k v b
r ->
      RunData k' v' b' -> PreExistingRunData k' v' b'
forall k v b. RunData k v b -> PreExistingRunData k v b
PreExistingRunData ((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)
    PreExistingMergingRunData MergingRunData LevelMergeType k v b
mr ->
      MergingRunData LevelMergeType k' v' b'
-> PreExistingRunData k' v' b'
forall k v b.
MergingRunData LevelMergeType k v b -> PreExistingRunData k v b
PreExistingMergingRunData ((k -> k')
-> (v -> v')
-> (b -> b')
-> MergingRunData LevelMergeType k v b
-> MergingRunData LevelMergeType k' v' b'
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 MergingRunData LevelMergeType k v b
mr)

type SerialisedMergingTreeData =
    MergingTreeData SerialisedKey SerialisedValue SerialisedBlob

type SerialisedPreExistingRunData =
    PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob

serialiseMergingTreeData ::
     (SerialiseKey k, SerialiseValue v, SerialiseValue b)
  => MergingTreeData k v b -> SerialisedMergingTreeData
serialiseMergingTreeData :: forall k v b.
(SerialiseKey k, SerialiseValue v, SerialiseValue b) =>
MergingTreeData k v b -> SerialisedMergingTreeData
serialiseMergingTreeData =
    (k -> SerialisedKey)
-> (v -> SerialisedValue)
-> (b -> SerialisedBlob)
-> MergingTreeData k v b
-> SerialisedMergingTreeData
forall k' k v v' b b'.
Ord k' =>
(k -> k')
-> (v -> v')
-> (b -> b')
-> MergingTreeData k v b
-> MergingTreeData k' v' b'
mapMergingTreeData 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
-------------------------------------------------------------------------------}

labelMergingTreeData :: SerialisedMergingTreeData -> Property -> Property
labelMergingTreeData :: SerialisedMergingTreeData -> Property -> Property
labelMergingTreeData = \SerialisedMergingTreeData
rd ->
    String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"tree depth" [Int -> Int -> String
showPowersOf Int
2 (SerialisedMergingTreeData -> Int
forall {k} {v} {b}. MergingTreeData k v b -> Int
depthTree SerialisedMergingTreeData
rd)] (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialisedMergingTreeData -> Property -> Property
go SerialisedMergingTreeData
rd
  where
    go :: SerialisedMergingTreeData -> Property -> Property
go (CompletedTreeMergeData RunData SerialisedKey SerialisedValue SerialisedBlob
rd) =
          String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"merging tree state" [String
"CompletedTreeMerge"]
        (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
    go (OngoingTreeMergeData MergingRunData
  TreeMergeType SerialisedKey SerialisedValue SerialisedBlob
mrd) =
          String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"merging tree state" [String
"OngoingTreeMerge"]
        (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MergingRunData
  TreeMergeType SerialisedKey SerialisedValue SerialisedBlob
-> Property -> Property
forall t.
Show t =>
SerialisedMergingRunData t -> Property -> Property
labelMergingRunData MergingRunData
  TreeMergeType SerialisedKey SerialisedValue SerialisedBlob
mrd
    go (PendingLevelMergeData [PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob]
prds Maybe SerialisedMergingTreeData
mtd) =
          String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"merging tree state" [String
"PendingLevelMerge"]
        (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob
 -> (Property -> Property) -> Property -> Property)
-> (Property -> Property)
-> [PreExistingRunData
      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)
-> (PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob
    -> Property -> Property)
-> PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob
-> (Property -> Property)
-> Property
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob
-> Property -> Property
labelPreExistingRunData) Property -> Property
forall a. a -> a
id [PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob]
prds
        (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Property -> Property)
-> (SerialisedMergingTreeData -> Property -> Property)
-> Maybe SerialisedMergingTreeData
-> Property
-> Property
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Property -> Property
forall a. a -> a
id SerialisedMergingTreeData -> Property -> Property
go Maybe SerialisedMergingTreeData
mtd
    go (PendingUnionMergeData [SerialisedMergingTreeData]
mtds) =
          String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"merging tree state" [String
"PendingUnionMerge"]
        (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SerialisedMergingTreeData
 -> (Property -> Property) -> Property -> Property)
-> (Property -> Property)
-> [SerialisedMergingTreeData]
-> 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)
-> (SerialisedMergingTreeData -> Property -> Property)
-> SerialisedMergingTreeData
-> (Property -> Property)
-> Property
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialisedMergingTreeData -> Property -> Property
go) Property -> Property
forall a. a -> a
id [SerialisedMergingTreeData]
mtds

    -- the longest path from the root to a run
    depthTree :: MergingTreeData k v b -> Int
depthTree = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int)
-> (MergingTreeData k v b -> Int) -> MergingTreeData k v b -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case  -- maximum depth of children
        CompletedTreeMergeData RunData k v b
_ -> Int
0
        OngoingTreeMergeData MergingRunData TreeMergeType k v b
_   -> Int
0
        PendingLevelMergeData [PreExistingRunData k v b]
prds Maybe (MergingTreeData k v b)
mtds ->
          [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (PreExistingRunData k v b -> Int)
-> [PreExistingRunData k v b] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> PreExistingRunData k v b -> Int
forall a b. a -> b -> a
const Int
1) [PreExistingRunData k v b]
prds [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (MergingTreeData k v b -> Int) -> [MergingTreeData k v b] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map MergingTreeData k v b -> Int
depthTree (Maybe (MergingTreeData k v b) -> [MergingTreeData k v b]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (MergingTreeData k v b)
mtds))
        PendingUnionMergeData [MergingTreeData k v b]
mtds ->
          [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (MergingTreeData k v b -> Int) -> [MergingTreeData k v b] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map MergingTreeData k v b -> Int
depthTree [MergingTreeData k v b]
mtds)


labelPreExistingRunData :: SerialisedPreExistingRunData -> Property -> Property
labelPreExistingRunData :: PreExistingRunData SerialisedKey SerialisedValue SerialisedBlob
-> Property -> Property
labelPreExistingRunData (PreExistingRunData RunData SerialisedKey SerialisedValue SerialisedBlob
rd)         = RunData SerialisedKey SerialisedValue SerialisedBlob
-> Property -> Property
labelRunData RunData SerialisedKey SerialisedValue SerialisedBlob
rd
labelPreExistingRunData (PreExistingMergingRunData MergingRunData
  LevelMergeType SerialisedKey SerialisedValue SerialisedBlob
mrd) = MergingRunData
  LevelMergeType SerialisedKey SerialisedValue SerialisedBlob
-> Property -> Property
forall t.
Show t =>
SerialisedMergingRunData t -> Property -> Property
labelMergingRunData MergingRunData
  LevelMergeType SerialisedKey SerialisedValue SerialisedBlob
mrd

instance ( Ord k, Arbitrary k, Arbitrary v, Arbitrary b
         ) => Arbitrary (MergingTreeData k v b) where
  arbitrary :: Gen (MergingTreeData k v b)
arbitrary = Gen k -> Gen v -> Gen b -> Gen (MergingTreeData k v b)
forall k v b.
Ord k =>
Gen k -> Gen v -> Gen b -> Gen (MergingTreeData k v b)
genMergingTreeData 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 :: MergingTreeData k v b -> [MergingTreeData k v b]
shrink = (k -> [k])
-> (v -> [v])
-> (b -> [b])
-> MergingTreeData k v b
-> [MergingTreeData k v b]
forall k v b.
Ord k =>
(k -> [k])
-> (v -> [v])
-> (b -> [b])
-> MergingTreeData k v b
-> [MergingTreeData k v b]
shrinkMergingTreeData 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

genMergingTreeData ::
     Ord k => Gen k -> Gen v -> Gen b -> Gen (MergingTreeData k v b)
genMergingTreeData :: forall k v b.
Ord k =>
Gen k -> Gen v -> Gen b -> Gen (MergingTreeData k v b)
genMergingTreeData Gen k
genKey Gen v
genVal Gen b
genBlob =
    [(Int, Gen (MergingTreeData k v b))] -> Gen (MergingTreeData k v b)
forall a. (?callStack::CallStack) => [(Int, Gen a)] -> Gen a
QC.frequency
      -- Only at the root, we can have pending merges with no children, see
      -- 'MR.newPendingLevelMerge' and 'MR.newPendingUnionMerge'.
      [ ( Int
1, MergingTreeData k v b -> Gen (MergingTreeData k v b)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MergingTreeData k v b -> Gen (MergingTreeData k v b))
-> MergingTreeData k v b -> Gen (MergingTreeData k v b)
forall a b. (a -> b) -> a -> b
$ [PreExistingRunData k v b]
-> Maybe (MergingTreeData k v b) -> MergingTreeData k v b
forall k v b.
[PreExistingRunData k v b]
-> Maybe (MergingTreeData k v b) -> MergingTreeData k v b
PendingLevelMergeData [] Maybe (MergingTreeData k v b)
forall a. Maybe a
Nothing)
      , ( Int
1, MergingTreeData k v b -> Gen (MergingTreeData k v b)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MergingTreeData k v b -> Gen (MergingTreeData k v b))
-> MergingTreeData k v b -> Gen (MergingTreeData k v b)
forall a b. (a -> b) -> a -> b
$ [MergingTreeData k v b] -> MergingTreeData k v b
forall k v b. [MergingTreeData k v b] -> MergingTreeData k v b
PendingUnionMergeData [])
      , (Int
50, (Int -> Gen (MergingTreeData k v b)) -> Gen (MergingTreeData k v b)
forall a. (Int -> Gen a) -> Gen a
QC.sized ((Int -> Gen (MergingTreeData k v b))
 -> Gen (MergingTreeData k v b))
-> (Int -> Gen (MergingTreeData k v b))
-> Gen (MergingTreeData k v b)
forall a b. (a -> b) -> a -> b
$ \Int
s -> do
          Int
treeSize <- (Int, Int) -> Gen Int
QC.chooseInt (Int
1, Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4)) -- up to 26
          Gen k -> Gen v -> Gen b -> Int -> Gen (MergingTreeData k v b)
forall k v b.
Ord k =>
Gen k -> Gen v -> Gen b -> Int -> Gen (MergingTreeData k v b)
genMergingTreeDataOfSize Gen k
genKey Gen v
genVal Gen b
genBlob Int
treeSize)
      ]

-- | Minimal returned size will be 1. Doesn't generate structurally empty trees!
--
-- The size is measured by the number of MergingTreeData constructors.
genMergingTreeDataOfSize ::
     forall k v b. Ord k
  => Gen k -> Gen v -> Gen b -> Int -> Gen (MergingTreeData k v b)
genMergingTreeDataOfSize :: forall k v b.
Ord k =>
Gen k -> Gen v -> Gen b -> Int -> Gen (MergingTreeData k v b)
genMergingTreeDataOfSize Gen k
genKey Gen v
genVal Gen b
genBlob = \Int
n0 -> do
    MergingTreeData k v b
tree <- Int -> Gen (MergingTreeData k v b)
genMergingTree Int
n0
    Bool -> Gen (MergingTreeData k v b) -> Gen (MergingTreeData k v b)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (MergingTreeData k v b -> Int
forall {k} {v} {b}. MergingTreeData k v b -> Int
mergingTreeDataSize MergingTreeData k v b
tree Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n0) (Gen (MergingTreeData k v b) -> Gen (MergingTreeData k v b))
-> Gen (MergingTreeData k v b) -> Gen (MergingTreeData k v b)
forall a b. (a -> b) -> a -> b
$
      MergingTreeData k v b -> Gen (MergingTreeData k v b)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return MergingTreeData k v b
tree
  where
    genMergingTree :: Int -> Gen (MergingTreeData k v b)
genMergingTree Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
      = String -> Gen (MergingTreeData k v b)
forall a. (?callStack::CallStack) => String -> a
error (String
"arbitrary T: n == " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n)

      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
      = [Gen (MergingTreeData k v b)] -> Gen (MergingTreeData k v b)
forall a. (?callStack::CallStack) => [Gen a] -> Gen a
QC.oneof
          [ RunData k v b -> MergingTreeData k v b
forall k v b. RunData k v b -> MergingTreeData k v b
CompletedTreeMergeData (RunData k v b -> MergingTreeData k v b)
-> Gen (RunData k v b) -> Gen (MergingTreeData k v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (RunData k v b)
genRun
          , MergingRunData TreeMergeType k v b -> MergingTreeData k v b
forall k v b.
MergingRunData TreeMergeType k v b -> MergingTreeData k v b
OngoingTreeMergeData (MergingRunData TreeMergeType k v b -> MergingTreeData k v b)
-> Gen (MergingRunData TreeMergeType k v b)
-> Gen (MergingTreeData k v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TreeMergeType -> Gen (MergingRunData TreeMergeType k v b)
genMergingRun Gen TreeMergeType
forall a. Arbitrary a => Gen a
arbitrary
          , Gen (MergingTreeData k v b)
genPendingLevelMergeNoChild
          ]

      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
      = Int -> Gen (MergingTreeData k v b)
genPendingLevelMergeWithChild Int
n

      | Bool
otherwise
      = [Gen (MergingTreeData k v b)] -> Gen (MergingTreeData k v b)
forall a. (?callStack::CallStack) => [Gen a] -> Gen a
QC.oneof [Int -> Gen (MergingTreeData k v b)
genPendingLevelMergeWithChild Int
n, Int -> Gen (MergingTreeData k v b)
genPendingUnionMerge Int
n]

    -- n == 1
    genPendingLevelMergeNoChild :: Gen (MergingTreeData k v b)
genPendingLevelMergeNoChild = do
        Int
numPreExisting <- (Int, Int) -> Gen Int
chooseIntSkewed (Int
0, Int
6)
        [PreExistingRunData k v b]
initPreExisting <- Int
-> Gen (PreExistingRunData k v b) -> Gen [PreExistingRunData k v b]
forall a. Int -> Gen a -> Gen [a]
QC.vectorOf Int
numPreExisting (Gen (PreExistingRunData k v b) -> Gen [PreExistingRunData k v b])
-> Gen (PreExistingRunData k v b) -> Gen [PreExistingRunData k v b]
forall a b. (a -> b) -> a -> b
$
          -- these can't be last level. we generate the last input below.
          Gen LevelMergeType -> Gen (PreExistingRunData k v b)
genPreExistingRun (LevelMergeType -> Gen LevelMergeType
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LevelMergeType
MR.MergeMidLevel)
        -- there must be at least one (last) input to the pending merge.
        PreExistingRunData k v b
lastPreExisting <- Gen LevelMergeType -> Gen (PreExistingRunData k v b)
genPreExistingRun Gen LevelMergeType
forall a. Arbitrary a => Gen a
arbitrary
        let preExisting :: [PreExistingRunData k v b]
preExisting = [PreExistingRunData k v b]
initPreExisting [PreExistingRunData k v b]
-> [PreExistingRunData k v b] -> [PreExistingRunData k v b]
forall a. [a] -> [a] -> [a]
++ [PreExistingRunData k v b
lastPreExisting]
        MergingTreeData k v b -> Gen (MergingTreeData k v b)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PreExistingRunData k v b]
-> Maybe (MergingTreeData k v b) -> MergingTreeData k v b
forall k v b.
[PreExistingRunData k v b]
-> Maybe (MergingTreeData k v b) -> MergingTreeData k v b
PendingLevelMergeData [PreExistingRunData k v b]
preExisting Maybe (MergingTreeData k v b)
forall a. Maybe a
Nothing)

    -- n >= 2
    genPendingLevelMergeWithChild :: Int -> Gen (MergingTreeData k v b)
genPendingLevelMergeWithChild Int
n = do
        Int
numPreExisting <- (Int, Int) -> Gen Int
chooseIntSkewed (Int
0, Int
6)
        [PreExistingRunData k v b]
preExisting <- Int
-> Gen (PreExistingRunData k v b) -> Gen [PreExistingRunData k v b]
forall a. Int -> Gen a -> Gen [a]
QC.vectorOf Int
numPreExisting (Gen (PreExistingRunData k v b) -> Gen [PreExistingRunData k v b])
-> Gen (PreExistingRunData k v b) -> Gen [PreExistingRunData k v b]
forall a b. (a -> b) -> a -> b
$
          -- there can't be a last level merge, child is last
          Gen LevelMergeType -> Gen (PreExistingRunData k v b)
genPreExistingRun (LevelMergeType -> Gen LevelMergeType
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LevelMergeType
MR.MergeMidLevel)
        MergingTreeData k v b
tree <- Int -> Gen (MergingTreeData k v b)
genMergingTree (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        MergingTreeData k v b -> Gen (MergingTreeData k v b)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PreExistingRunData k v b]
-> Maybe (MergingTreeData k v b) -> MergingTreeData k v b
forall k v b.
[PreExistingRunData k v b]
-> Maybe (MergingTreeData k v b) -> MergingTreeData k v b
PendingLevelMergeData [PreExistingRunData k v b]
preExisting (MergingTreeData k v b -> Maybe (MergingTreeData k v b)
forall a. a -> Maybe a
Just MergingTreeData k v b
tree))

    -- n >= 3, needs 1 constructor + 2 children
    genPendingUnionMerge :: Int -> Gen (MergingTreeData k v b)
genPendingUnionMerge Int
n = do
        [Int]
ns <- [Int] -> Gen [Int]
forall a. [a] -> Gen [a]
QC.shuffle ([Int] -> Gen [Int]) -> Gen [Int] -> Gen [Int]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Gen [Int]
arbitraryPartition2 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        [MergingTreeData k v b] -> MergingTreeData k v b
forall k v b. [MergingTreeData k v b] -> MergingTreeData k v b
PendingUnionMergeData ([MergingTreeData k v b] -> MergingTreeData k v b)
-> Gen [MergingTreeData k v b] -> Gen (MergingTreeData k v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Gen (MergingTreeData k v b))
-> [Int] -> Gen [MergingTreeData k v b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Int -> Gen (MergingTreeData k v b)
genMergingTree [Int]
ns

    genRun :: Gen (RunData k v b)
genRun                    = (Gen k -> Gen v -> Gen b -> Gen (RunData k v b))
-> Gen (RunData k v b)
forall r. (Gen k -> Gen v -> Gen b -> Gen r) -> Gen r
genScaled 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
    genMergingRun :: Gen TreeMergeType -> Gen (MergingRunData TreeMergeType k v b)
genMergingRun Gen TreeMergeType
genType     = (Gen k
 -> Gen v -> Gen b -> Gen (MergingRunData TreeMergeType k v b))
-> Gen (MergingRunData TreeMergeType k v b)
forall r. (Gen k -> Gen v -> Gen b -> Gen r) -> Gen r
genScaled (Gen TreeMergeType
-> Gen k
-> Gen v
-> Gen b
-> Gen (MergingRunData TreeMergeType 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 TreeMergeType
genType)
    genPreExistingRun :: Gen LevelMergeType -> Gen (PreExistingRunData k v b)
genPreExistingRun Gen LevelMergeType
genType = (Gen k -> Gen v -> Gen b -> Gen (PreExistingRunData k v b))
-> Gen (PreExistingRunData k v b)
forall r. (Gen k -> Gen v -> Gen b -> Gen r) -> Gen r
genScaled (Gen LevelMergeType
-> Gen k -> Gen v -> Gen b -> Gen (PreExistingRunData k v b)
forall k v b.
Ord k =>
Gen LevelMergeType
-> Gen k -> Gen v -> Gen b -> Gen (PreExistingRunData k v b)
genPreExistingRunData Gen LevelMergeType
genType)

    -- To avoid generating too large test cases, we reduce the number of
    -- entries for each run. The size of the individual entries is unaffected.
    genScaled :: forall r. (Gen k -> Gen v -> Gen b -> Gen r) -> Gen r
    genScaled :: forall r. (Gen k -> Gen v -> Gen b -> Gen r) -> Gen r
genScaled Gen k -> Gen v -> Gen b -> Gen r
gen =
        (Int -> Gen r) -> Gen r
forall a. (Int -> Gen a) -> Gen a
QC.sized ((Int -> Gen r) -> Gen r) -> (Int -> Gen r) -> Gen r
forall a b. (a -> b) -> a -> b
$ \Int
s ->
          (Int -> Int) -> Gen r -> Gen r
forall a. (Int -> Int) -> Gen a -> Gen a
QC.scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (Gen r -> Gen r) -> Gen r -> Gen r
forall a b. (a -> b) -> a -> b
$
            Gen k -> Gen v -> Gen b -> Gen r
gen (Int -> Gen k -> Gen k
forall a. (?callStack::CallStack) => Int -> Gen a -> Gen a
QC.resize Int
s Gen k
genKey) (Int -> Gen v -> Gen v
forall a. (?callStack::CallStack) => Int -> Gen a -> Gen a
QC.resize Int
s Gen v
genVal) (Int -> Gen b -> Gen b
forall a. (?callStack::CallStack) => Int -> Gen a -> Gen a
QC.resize Int
s Gen b
genBlob)

    -- skewed towards smaller values
    chooseIntSkewed :: (Int, Int) -> Gen Int
chooseIntSkewed (Int
lb, Int
ub) = do
        Int
ub' <- (Int, Int) -> Gen Int
QC.chooseInt (Int
lb, Int
ub)
        (Int, Int) -> Gen Int
QC.chooseInt (Int
lb, Int
ub')

mergingTreeDataSize :: MergingTreeData k v b -> Int
mergingTreeDataSize :: forall {k} {v} {b}. MergingTreeData k v b -> Int
mergingTreeDataSize = \case
    CompletedTreeMergeData RunData k v b
_ -> Int
1
    OngoingTreeMergeData MergingRunData TreeMergeType k v b
_ -> Int
1
    PendingLevelMergeData [PreExistingRunData k v b]
_ Maybe (MergingTreeData k v b)
tree -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
-> (MergingTreeData k v b -> Int)
-> Maybe (MergingTreeData k v b)
-> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 MergingTreeData k v b -> Int
forall {k} {v} {b}. MergingTreeData k v b -> Int
mergingTreeDataSize Maybe (MergingTreeData k v b)
tree
    PendingUnionMergeData [MergingTreeData k v b]
trees -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((MergingTreeData k v b -> Int) -> [MergingTreeData k v b] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map MergingTreeData k v b -> Int
forall {k} {v} {b}. MergingTreeData k v b -> Int
mergingTreeDataSize [MergingTreeData k v b]
trees)

-- Split into at least two smaller positive numbers. The input needs to be
-- greater than or equal to 2.
arbitraryPartition2 :: Int -> QC.Gen [Int]
arbitraryPartition2 :: Int -> Gen [Int]
arbitraryPartition2 Int
n = Bool -> Gen [Int] -> Gen [Int]
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2) (Gen [Int] -> Gen [Int]) -> Gen [Int] -> Gen [Int]
forall a b. (a -> b) -> a -> b
$ do
    Int
first <- (Int, Int) -> Gen Int
QC.chooseInt (Int
1, Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    (Int
first :) ([Int] -> [Int]) -> Gen [Int] -> Gen [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Int]
arbitraryPartition (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
first)

-- Split into smaller positive numbers.
arbitraryPartition :: Int -> QC.Gen [Int]
arbitraryPartition :: Int -> Gen [Int]
arbitraryPartition Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
1 = [Int] -> Gen [Int]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [Int] -> Gen [Int]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int
1]
      | Bool
otherwise = do
        Int
first <- (Int, Int) -> Gen Int
QC.chooseInt (Int
1, Int
n)
        (Int
first :) ([Int] -> [Int]) -> Gen [Int] -> Gen [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Int]
arbitraryPartition (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
first)

-- TODO: Would it be useful to shrink by merging subtrees into a single run?
-- This would simplify the tree while preserving many errors that depend on the
-- specific content of the tree. See prototype tests.
shrinkMergingTreeData ::
     Ord k
  => (k -> [k])
  -> (v -> [v])
  -> (b -> [b])
  -> MergingTreeData k v b
  -> [MergingTreeData k v b]
shrinkMergingTreeData :: forall k v b.
Ord k =>
(k -> [k])
-> (v -> [v])
-> (b -> [b])
-> MergingTreeData k v b
-> [MergingTreeData k v b]
shrinkMergingTreeData k -> [k]
shrinkKey v -> [v]
shrinkVal b -> [b]
shrinkBlob = \case
  CompletedTreeMergeData RunData k v b
r ->
    [ RunData k v b -> MergingTreeData k v b
forall k v b. RunData k v b -> MergingTreeData k v b
CompletedTreeMergeData RunData k v b
r'
    | RunData k v b
r' <- (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
r
    ]
  OngoingTreeMergeData MergingRunData TreeMergeType k v b
mr ->
    [ MergingRunData TreeMergeType k v b -> MergingTreeData k v b
forall k v b.
MergingRunData TreeMergeType k v b -> MergingTreeData k v b
OngoingTreeMergeData MergingRunData TreeMergeType k v b
mr'
    | MergingRunData TreeMergeType k v b
mr' <- (k -> [k])
-> (v -> [v])
-> (b -> [b])
-> MergingRunData TreeMergeType k v b
-> [MergingRunData TreeMergeType 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]
shrinkKey v -> [v]
shrinkVal b -> [b]
shrinkBlob MergingRunData TreeMergeType k v b
mr
    ]
  PendingLevelMergeData [PreExistingRunData k v b]
prs Maybe (MergingTreeData k v b)
t ->
    {- HLINT ignore "Use catMaybes" -}
    -- just use the child tree, if present
    [ MergingTreeData k v b
t' | Just MergingTreeData k v b
t' <- [Maybe (MergingTreeData k v b)
t] ]
    [MergingTreeData k v b]
-> [MergingTreeData k v b] -> [MergingTreeData k v b]
forall a. Semigroup a => a -> a -> a
<>
    -- move completed child tree into regular levels
    [ [PreExistingRunData k v b]
-> Maybe (MergingTreeData k v b) -> MergingTreeData k v b
forall k v b.
[PreExistingRunData k v b]
-> Maybe (MergingTreeData k v b) -> MergingTreeData k v b
PendingLevelMergeData ([PreExistingRunData k v b]
prs [PreExistingRunData k v b]
-> [PreExistingRunData k v b] -> [PreExistingRunData k v b]
forall a. [a] -> [a] -> [a]
++ [RunData k v b -> PreExistingRunData k v b
forall k v b. RunData k v b -> PreExistingRunData k v b
PreExistingRunData RunData k v b
r]) Maybe (MergingTreeData k v b)
forall a. Maybe a
Nothing
    | Just (CompletedTreeMergeData RunData k v b
r) <- [Maybe (MergingTreeData k v b)
t]
    ]
    [MergingTreeData k v b]
-> [MergingTreeData k v b] -> [MergingTreeData k v b]
forall a. Semigroup a => a -> a -> a
<>
    [ [PreExistingRunData k v b]
-> Maybe (MergingTreeData k v b) -> MergingTreeData k v b
forall k v b.
[PreExistingRunData k v b]
-> Maybe (MergingTreeData k v b) -> MergingTreeData k v b
PendingLevelMergeData [PreExistingRunData k v b]
prs' Maybe (MergingTreeData k v b)
t'
    | ([PreExistingRunData k v b]
prs', Maybe (MergingTreeData k v b)
t') <-
        ([PreExistingRunData k v b] -> [[PreExistingRunData k v b]])
-> (Maybe (MergingTreeData k v b)
    -> [Maybe (MergingTreeData k v b)])
-> ([PreExistingRunData k v b], Maybe (MergingTreeData k v b))
-> [([PreExistingRunData k v b], Maybe (MergingTreeData k v b))]
forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
liftShrink2
          ((PreExistingRunData k v b -> [PreExistingRunData k v b])
-> [PreExistingRunData k v b] -> [[PreExistingRunData 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])
-> PreExistingRunData k v b
-> [PreExistingRunData k v b]
forall k v b.
Ord k =>
(k -> [k])
-> (v -> [v])
-> (b -> [b])
-> PreExistingRunData k v b
-> [PreExistingRunData k v b]
shrinkPreExistingRunData k -> [k]
shrinkKey v -> [v]
shrinkVal b -> [b]
shrinkBlob))
          ((MergingTreeData k v b -> [MergingTreeData k v b])
-> Maybe (MergingTreeData k v b) -> [Maybe (MergingTreeData k v b)]
forall a. (a -> [a]) -> Maybe a -> [Maybe a]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink ((k -> [k])
-> (v -> [v])
-> (b -> [b])
-> MergingTreeData k v b
-> [MergingTreeData k v b]
forall k v b.
Ord k =>
(k -> [k])
-> (v -> [v])
-> (b -> [b])
-> MergingTreeData k v b
-> [MergingTreeData k v b]
shrinkMergingTreeData k -> [k]
shrinkKey v -> [v]
shrinkVal b -> [b]
shrinkBlob))
          ([PreExistingRunData k v b]
prs, Maybe (MergingTreeData k v b)
t)
    , [PreExistingRunData k v b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PreExistingRunData k v b]
prs' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Maybe (MergingTreeData k v b) -> Int
forall a. Maybe a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Maybe (MergingTreeData k v b)
t' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    ]
  PendingUnionMergeData [MergingTreeData k v b]
ts ->
    [MergingTreeData k v b]
ts
    [MergingTreeData k v b]
-> [MergingTreeData k v b] -> [MergingTreeData k v b]
forall a. Semigroup a => a -> a -> a
<>
    [ [MergingTreeData k v b] -> MergingTreeData k v b
forall k v b. [MergingTreeData k v b] -> MergingTreeData k v b
PendingUnionMergeData [MergingTreeData k v b]
ts'
    | [MergingTreeData k v b]
ts' <- (MergingTreeData k v b -> [MergingTreeData k v b])
-> [MergingTreeData k v b] -> [[MergingTreeData 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])
-> MergingTreeData k v b
-> [MergingTreeData k v b]
forall k v b.
Ord k =>
(k -> [k])
-> (v -> [v])
-> (b -> [b])
-> MergingTreeData k v b
-> [MergingTreeData k v b]
shrinkMergingTreeData k -> [k]
shrinkKey v -> [v]
shrinkVal b -> [b]
shrinkBlob) [MergingTreeData k v b]
ts
    , [MergingTreeData k v b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MergingTreeData k v b]
ts' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
    ]

genPreExistingRunData ::
     Ord k
  => Gen MR.LevelMergeType
  -> Gen k
  -> Gen v
  -> Gen b
  -> Gen (PreExistingRunData k v b)
genPreExistingRunData :: forall k v b.
Ord k =>
Gen LevelMergeType
-> Gen k -> Gen v -> Gen b -> Gen (PreExistingRunData k v b)
genPreExistingRunData Gen LevelMergeType
genMergeType Gen k
genKey Gen v
genVal Gen b
genBlob =
    [Gen (PreExistingRunData k v b)] -> Gen (PreExistingRunData k v b)
forall a. (?callStack::CallStack) => [Gen a] -> Gen a
QC.oneof
      [ RunData k v b -> PreExistingRunData k v b
forall k v b. RunData k v b -> PreExistingRunData k v b
PreExistingRunData (RunData k v b -> PreExistingRunData k v b)
-> Gen (RunData k v b) -> Gen (PreExistingRunData k v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 LevelMergeType k v b -> PreExistingRunData k v b
forall k v b.
MergingRunData LevelMergeType k v b -> PreExistingRunData k v b
PreExistingMergingRunData (MergingRunData LevelMergeType k v b -> PreExistingRunData k v b)
-> Gen (MergingRunData LevelMergeType k v b)
-> Gen (PreExistingRunData k v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen LevelMergeType
-> Gen k
-> Gen v
-> Gen b
-> Gen (MergingRunData LevelMergeType 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 LevelMergeType
genMergeType Gen k
genKey Gen v
genVal Gen b
genBlob
      ]

shrinkPreExistingRunData ::
     Ord k
  => (k -> [k])
  -> (v -> [v])
  -> (b -> [b])
  -> PreExistingRunData k v b
  -> [PreExistingRunData k v b]
shrinkPreExistingRunData :: forall k v b.
Ord k =>
(k -> [k])
-> (v -> [v])
-> (b -> [b])
-> PreExistingRunData k v b
-> [PreExistingRunData k v b]
shrinkPreExistingRunData k -> [k]
shrinkKey v -> [v]
shrinkVal b -> [b]
shrinkBlob = \case
    PreExistingRunData RunData k v b
r ->
      [ RunData k v b -> PreExistingRunData k v b
forall k v b. RunData k v b -> PreExistingRunData k v b
PreExistingRunData RunData k v b
r'
      | RunData k v b
r' <- (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
r
      ]
    PreExistingMergingRunData MergingRunData LevelMergeType k v b
mr ->
      [ MergingRunData LevelMergeType k v b -> PreExistingRunData k v b
forall k v b.
MergingRunData LevelMergeType k v b -> PreExistingRunData k v b
PreExistingMergingRunData MergingRunData LevelMergeType k v b
mr'
      | MergingRunData LevelMergeType k v b
mr' <- (k -> [k])
-> (v -> [v])
-> (b -> [b])
-> MergingRunData LevelMergeType k v b
-> [MergingRunData LevelMergeType 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]
shrinkKey v -> [v]
shrinkVal b -> [b]
shrinkBlob MergingRunData LevelMergeType k v b
mr
      ]