{-# OPTIONS_HADDOCK not-home #-}

module Database.LSMTree.Internal.Snapshot (
    -- * Snapshot metadata
    SnapshotLabel (..)
  , SnapshotTableType (..)
  , SnapshotMetaData (..)
    -- * Levels snapshot format
  , SnapLevels (..)
  , SnapLevel (..)
  , SnapIncomingRun (..)
  , SnapMergingRun (..)
    -- * MergeTree snapshot format
  , SnapMergingTree(..)
  , SnapMergingTreeState(..)
  , SnapPendingMerge(..)
  , SnapPreExistingRun(..)
    -- * Conversion to levels snapshot format
  , toSnapLevels
    -- * Conversion to merging tree snapshot format
  , toSnapMergingTree
    -- * Write buffer
  , snapshotWriteBuffer
  , openWriteBuffer
    -- * Run
  , SnapshotRun (..)
  , snapshotRun
  , openRun
    -- * Opening snapshot formats
    -- ** Levels format
  , fromSnapLevels
    -- ** Merging Tree format
  , fromSnapMergingTree
    -- * Hard links
  , hardLinkRunFiles
  ) where

import           Control.ActionRegistry
import           Control.Concurrent.Class.MonadMVar.Strict
import           Control.Concurrent.Class.MonadSTM (MonadSTM)
import           Control.DeepSeq (NFData (..))
import           Control.Monad (void)
import           Control.Monad.Class.MonadST (MonadST)
import           Control.Monad.Class.MonadThrow (MonadMask, bracket,
                     bracketOnError)
import           Control.Monad.Primitive (PrimMonad)
import           Control.RefCount
import           Data.Foldable (sequenceA_, traverse_)
import           Data.String (IsString)
import           Data.Text (Text)
import qualified Data.Vector as V
import           Database.LSMTree.Internal.Config
import           Database.LSMTree.Internal.CRC32C (checkCRC)
import qualified Database.LSMTree.Internal.CRC32C as CRC
import           Database.LSMTree.Internal.IncomingRun
import           Database.LSMTree.Internal.Lookup (ResolveSerialisedValue)
import qualified Database.LSMTree.Internal.Merge as Merge
import           Database.LSMTree.Internal.MergeSchedule
import qualified Database.LSMTree.Internal.MergingRun as MR
import qualified Database.LSMTree.Internal.MergingTree as MT
import           Database.LSMTree.Internal.Paths (ActiveDir (..), ForBlob (..),
                     ForKOps (..), NamedSnapshotDir (..), RunFsPaths (..),
                     WriteBufferFsPaths (..),
                     fromChecksumsFileForWriteBufferFiles, pathsForRunFiles,
                     runChecksumsPath, runPath, writeBufferBlobPath,
                     writeBufferChecksumsPath, writeBufferKOpsPath)
import           Database.LSMTree.Internal.Run (Run, RunParams)
import qualified Database.LSMTree.Internal.Run as Run
import           Database.LSMTree.Internal.RunNumber
import           Database.LSMTree.Internal.UniqCounter (UniqCounter,
                     incrUniqCounter, uniqueToInt, uniqueToRunNumber)
import           Database.LSMTree.Internal.WriteBuffer (WriteBuffer)
import           Database.LSMTree.Internal.WriteBufferBlobs (WriteBufferBlobs)
import qualified Database.LSMTree.Internal.WriteBufferBlobs as WBB
import qualified Database.LSMTree.Internal.WriteBufferReader as WBR
import qualified Database.LSMTree.Internal.WriteBufferWriter as WBW
import qualified System.FS.API as FS
import           System.FS.API (HasFS, (<.>), (</>))
import qualified System.FS.API.Lazy as FSL
import qualified System.FS.BlockIO.API as FS
import           System.FS.BlockIO.API (HasBlockIO)

{-------------------------------------------------------------------------------
  Snapshot metadata
-------------------------------------------------------------------------------}

-- | Custom, user-supplied text that is included in the metadata.
--
-- The main use case for a 'SnapshotLabel' is for the user to supply textual
-- information about the key\/value\/blob type for the table that corresponds to
-- the snapshot. This information is used to dynamically check that a snapshot
-- is opened at the correct key\/value\/blob type.
newtype SnapshotLabel = SnapshotLabel Text
  deriving stock (Int -> SnapshotLabel -> ShowS
[SnapshotLabel] -> ShowS
SnapshotLabel -> String
(Int -> SnapshotLabel -> ShowS)
-> (SnapshotLabel -> String)
-> ([SnapshotLabel] -> ShowS)
-> Show SnapshotLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotLabel -> ShowS
showsPrec :: Int -> SnapshotLabel -> ShowS
$cshow :: SnapshotLabel -> String
show :: SnapshotLabel -> String
$cshowList :: [SnapshotLabel] -> ShowS
showList :: [SnapshotLabel] -> ShowS
Show, SnapshotLabel -> SnapshotLabel -> Bool
(SnapshotLabel -> SnapshotLabel -> Bool)
-> (SnapshotLabel -> SnapshotLabel -> Bool) -> Eq SnapshotLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotLabel -> SnapshotLabel -> Bool
== :: SnapshotLabel -> SnapshotLabel -> Bool
$c/= :: SnapshotLabel -> SnapshotLabel -> Bool
/= :: SnapshotLabel -> SnapshotLabel -> Bool
Eq)
  deriving newtype (SnapshotLabel -> ()
(SnapshotLabel -> ()) -> NFData SnapshotLabel
forall a. (a -> ()) -> NFData a
$crnf :: SnapshotLabel -> ()
rnf :: SnapshotLabel -> ()
NFData, String -> SnapshotLabel
(String -> SnapshotLabel) -> IsString SnapshotLabel
forall a. (String -> a) -> IsString a
$cfromString :: String -> SnapshotLabel
fromString :: String -> SnapshotLabel
IsString)

-- TODO: revisit if we need three table types.
data SnapshotTableType = SnapNormalTable | SnapMonoidalTable | SnapFullTable
  deriving stock (SnapshotTableType -> SnapshotTableType -> Bool
(SnapshotTableType -> SnapshotTableType -> Bool)
-> (SnapshotTableType -> SnapshotTableType -> Bool)
-> Eq SnapshotTableType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotTableType -> SnapshotTableType -> Bool
== :: SnapshotTableType -> SnapshotTableType -> Bool
$c/= :: SnapshotTableType -> SnapshotTableType -> Bool
/= :: SnapshotTableType -> SnapshotTableType -> Bool
Eq, Int -> SnapshotTableType -> ShowS
[SnapshotTableType] -> ShowS
SnapshotTableType -> String
(Int -> SnapshotTableType -> ShowS)
-> (SnapshotTableType -> String)
-> ([SnapshotTableType] -> ShowS)
-> Show SnapshotTableType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotTableType -> ShowS
showsPrec :: Int -> SnapshotTableType -> ShowS
$cshow :: SnapshotTableType -> String
show :: SnapshotTableType -> String
$cshowList :: [SnapshotTableType] -> ShowS
showList :: [SnapshotTableType] -> ShowS
Show)

instance NFData SnapshotTableType where
  rnf :: SnapshotTableType -> ()
rnf SnapshotTableType
SnapNormalTable   = ()
  rnf SnapshotTableType
SnapMonoidalTable = ()
  rnf SnapshotTableType
SnapFullTable     = ()

data SnapshotMetaData = SnapshotMetaData {
    -- | See 'SnapshotLabel'.
    --
    -- One could argue that the 'SnapshotName' could be used to to hold this
    -- type information, but the file name of snapshot metadata is not guarded
    -- by a checksum, whereas the contents of the file are. Therefore using the
    -- 'SnapshotLabel' is safer.
    SnapshotMetaData -> SnapshotLabel
snapMetaLabel     :: !SnapshotLabel
    -- | Whether a table is normal or monoidal.
    --
    -- TODO: if we at some point decide to get rid of the normal vs. monoidal
    -- distinction, we can get rid of this field.
  , SnapshotMetaData -> SnapshotTableType
snapMetaTableType :: !SnapshotTableType
    -- | The 'TableConfig' for the snapshotted table.
    --
    -- Some of these configuration options can be overridden when a snapshot is
    -- opened: see 'TableConfigOverride'.
  , SnapshotMetaData -> TableConfig
snapMetaConfig    :: !TableConfig
    -- | The write buffer.
  , SnapshotMetaData -> RunNumber
snapWriteBuffer   :: !RunNumber
    -- | The shape of the levels of the LSM tree.
  , SnapshotMetaData -> SnapLevels SnapshotRun
snapMetaLevels    :: !(SnapLevels SnapshotRun)
    -- | The state of tree merging of the LSM tree.
  , SnapshotMetaData -> Maybe (SnapMergingTree SnapshotRun)
snapMergingTree   :: !(Maybe (SnapMergingTree SnapshotRun))
  }
  deriving stock SnapshotMetaData -> SnapshotMetaData -> Bool
(SnapshotMetaData -> SnapshotMetaData -> Bool)
-> (SnapshotMetaData -> SnapshotMetaData -> Bool)
-> Eq SnapshotMetaData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotMetaData -> SnapshotMetaData -> Bool
== :: SnapshotMetaData -> SnapshotMetaData -> Bool
$c/= :: SnapshotMetaData -> SnapshotMetaData -> Bool
/= :: SnapshotMetaData -> SnapshotMetaData -> Bool
Eq

instance NFData SnapshotMetaData where
  rnf :: SnapshotMetaData -> ()
rnf (SnapshotMetaData SnapshotLabel
a SnapshotTableType
b TableConfig
c RunNumber
d SnapLevels SnapshotRun
e Maybe (SnapMergingTree SnapshotRun)
f) =
    SnapshotLabel -> ()
forall a. NFData a => a -> ()
rnf SnapshotLabel
a () -> () -> ()
forall a b. a -> b -> b
`seq` SnapshotTableType -> ()
forall a. NFData a => a -> ()
rnf SnapshotTableType
b () -> () -> ()
forall a b. a -> b -> b
`seq` TableConfig -> ()
forall a. NFData a => a -> ()
rnf TableConfig
c () -> () -> ()
forall a b. a -> b -> b
`seq`
    RunNumber -> ()
forall a. NFData a => a -> ()
rnf RunNumber
d () -> () -> ()
forall a b. a -> b -> b
`seq` SnapLevels SnapshotRun -> ()
forall a. NFData a => a -> ()
rnf SnapLevels SnapshotRun
e () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe (SnapMergingTree SnapshotRun) -> ()
forall a. NFData a => a -> ()
rnf Maybe (SnapMergingTree SnapshotRun)
f

{-------------------------------------------------------------------------------
  Levels snapshot format
-------------------------------------------------------------------------------}

newtype SnapLevels r = SnapLevels { forall r. SnapLevels r -> Vector (SnapLevel r)
getSnapLevels :: V.Vector (SnapLevel r) }
  deriving stock (SnapLevels r -> SnapLevels r -> Bool
(SnapLevels r -> SnapLevels r -> Bool)
-> (SnapLevels r -> SnapLevels r -> Bool) -> Eq (SnapLevels r)
forall r. Eq r => SnapLevels r -> SnapLevels r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r. Eq r => SnapLevels r -> SnapLevels r -> Bool
== :: SnapLevels r -> SnapLevels r -> Bool
$c/= :: forall r. Eq r => SnapLevels r -> SnapLevels r -> Bool
/= :: SnapLevels r -> SnapLevels r -> Bool
Eq, (forall a b. (a -> b) -> SnapLevels a -> SnapLevels b)
-> (forall a b. a -> SnapLevels b -> SnapLevels a)
-> Functor SnapLevels
forall a b. a -> SnapLevels b -> SnapLevels a
forall a b. (a -> b) -> SnapLevels a -> SnapLevels b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SnapLevels a -> SnapLevels b
fmap :: forall a b. (a -> b) -> SnapLevels a -> SnapLevels b
$c<$ :: forall a b. a -> SnapLevels b -> SnapLevels a
<$ :: forall a b. a -> SnapLevels b -> SnapLevels a
Functor, (forall m. Monoid m => SnapLevels m -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapLevels a -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapLevels a -> m)
-> (forall a b. (a -> b -> b) -> b -> SnapLevels a -> b)
-> (forall a b. (a -> b -> b) -> b -> SnapLevels a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapLevels a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapLevels a -> b)
-> (forall a. (a -> a -> a) -> SnapLevels a -> a)
-> (forall a. (a -> a -> a) -> SnapLevels a -> a)
-> (forall a. SnapLevels a -> [a])
-> (forall a. SnapLevels a -> Bool)
-> (forall a. SnapLevels a -> Int)
-> (forall a. Eq a => a -> SnapLevels a -> Bool)
-> (forall a. Ord a => SnapLevels a -> a)
-> (forall a. Ord a => SnapLevels a -> a)
-> (forall a. Num a => SnapLevels a -> a)
-> (forall a. Num a => SnapLevels a -> a)
-> Foldable SnapLevels
forall a. Eq a => a -> SnapLevels a -> Bool
forall a. Num a => SnapLevels a -> a
forall a. Ord a => SnapLevels a -> a
forall m. Monoid m => SnapLevels m -> m
forall a. SnapLevels a -> Bool
forall a. SnapLevels a -> Int
forall a. SnapLevels a -> [a]
forall a. (a -> a -> a) -> SnapLevels a -> a
forall m a. Monoid m => (a -> m) -> SnapLevels a -> m
forall b a. (b -> a -> b) -> b -> SnapLevels a -> b
forall a b. (a -> b -> b) -> b -> SnapLevels a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => SnapLevels m -> m
fold :: forall m. Monoid m => SnapLevels m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SnapLevels a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SnapLevels a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SnapLevels a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SnapLevels a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> SnapLevels a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SnapLevels a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SnapLevels a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SnapLevels a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SnapLevels a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SnapLevels a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SnapLevels a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SnapLevels a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> SnapLevels a -> a
foldr1 :: forall a. (a -> a -> a) -> SnapLevels a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SnapLevels a -> a
foldl1 :: forall a. (a -> a -> a) -> SnapLevels a -> a
$ctoList :: forall a. SnapLevels a -> [a]
toList :: forall a. SnapLevels a -> [a]
$cnull :: forall a. SnapLevels a -> Bool
null :: forall a. SnapLevels a -> Bool
$clength :: forall a. SnapLevels a -> Int
length :: forall a. SnapLevels a -> Int
$celem :: forall a. Eq a => a -> SnapLevels a -> Bool
elem :: forall a. Eq a => a -> SnapLevels a -> Bool
$cmaximum :: forall a. Ord a => SnapLevels a -> a
maximum :: forall a. Ord a => SnapLevels a -> a
$cminimum :: forall a. Ord a => SnapLevels a -> a
minimum :: forall a. Ord a => SnapLevels a -> a
$csum :: forall a. Num a => SnapLevels a -> a
sum :: forall a. Num a => SnapLevels a -> a
$cproduct :: forall a. Num a => SnapLevels a -> a
product :: forall a. Num a => SnapLevels a -> a
Foldable, Functor SnapLevels
Foldable SnapLevels
(Functor SnapLevels, Foldable SnapLevels) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> SnapLevels a -> f (SnapLevels b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SnapLevels (f a) -> f (SnapLevels a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SnapLevels a -> m (SnapLevels b))
-> (forall (m :: * -> *) a.
    Monad m =>
    SnapLevels (m a) -> m (SnapLevels a))
-> Traversable SnapLevels
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SnapLevels (m a) -> m (SnapLevels a)
forall (f :: * -> *) a.
Applicative f =>
SnapLevels (f a) -> f (SnapLevels a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapLevels a -> m (SnapLevels b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapLevels a -> f (SnapLevels b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapLevels a -> f (SnapLevels b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapLevels a -> f (SnapLevels b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapLevels (f a) -> f (SnapLevels a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapLevels (f a) -> f (SnapLevels a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapLevels a -> m (SnapLevels b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapLevels a -> m (SnapLevels b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SnapLevels (m a) -> m (SnapLevels a)
sequence :: forall (m :: * -> *) a.
Monad m =>
SnapLevels (m a) -> m (SnapLevels a)
Traversable)
  deriving newtype SnapLevels r -> ()
(SnapLevels r -> ()) -> NFData (SnapLevels r)
forall r. NFData r => SnapLevels r -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall r. NFData r => SnapLevels r -> ()
rnf :: SnapLevels r -> ()
NFData

data SnapLevel r = SnapLevel {
    forall r. SnapLevel r -> SnapIncomingRun r
snapIncoming     :: !(SnapIncomingRun r)
  , forall r. SnapLevel r -> Vector r
snapResidentRuns :: !(V.Vector r)
  }
  deriving stock (SnapLevel r -> SnapLevel r -> Bool
(SnapLevel r -> SnapLevel r -> Bool)
-> (SnapLevel r -> SnapLevel r -> Bool) -> Eq (SnapLevel r)
forall r. Eq r => SnapLevel r -> SnapLevel r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r. Eq r => SnapLevel r -> SnapLevel r -> Bool
== :: SnapLevel r -> SnapLevel r -> Bool
$c/= :: forall r. Eq r => SnapLevel r -> SnapLevel r -> Bool
/= :: SnapLevel r -> SnapLevel r -> Bool
Eq, (forall a b. (a -> b) -> SnapLevel a -> SnapLevel b)
-> (forall a b. a -> SnapLevel b -> SnapLevel a)
-> Functor SnapLevel
forall a b. a -> SnapLevel b -> SnapLevel a
forall a b. (a -> b) -> SnapLevel a -> SnapLevel b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SnapLevel a -> SnapLevel b
fmap :: forall a b. (a -> b) -> SnapLevel a -> SnapLevel b
$c<$ :: forall a b. a -> SnapLevel b -> SnapLevel a
<$ :: forall a b. a -> SnapLevel b -> SnapLevel a
Functor, (forall m. Monoid m => SnapLevel m -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapLevel a -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapLevel a -> m)
-> (forall a b. (a -> b -> b) -> b -> SnapLevel a -> b)
-> (forall a b. (a -> b -> b) -> b -> SnapLevel a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapLevel a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapLevel a -> b)
-> (forall a. (a -> a -> a) -> SnapLevel a -> a)
-> (forall a. (a -> a -> a) -> SnapLevel a -> a)
-> (forall a. SnapLevel a -> [a])
-> (forall a. SnapLevel a -> Bool)
-> (forall a. SnapLevel a -> Int)
-> (forall a. Eq a => a -> SnapLevel a -> Bool)
-> (forall a. Ord a => SnapLevel a -> a)
-> (forall a. Ord a => SnapLevel a -> a)
-> (forall a. Num a => SnapLevel a -> a)
-> (forall a. Num a => SnapLevel a -> a)
-> Foldable SnapLevel
forall a. Eq a => a -> SnapLevel a -> Bool
forall a. Num a => SnapLevel a -> a
forall a. Ord a => SnapLevel a -> a
forall m. Monoid m => SnapLevel m -> m
forall a. SnapLevel a -> Bool
forall a. SnapLevel a -> Int
forall a. SnapLevel a -> [a]
forall a. (a -> a -> a) -> SnapLevel a -> a
forall m a. Monoid m => (a -> m) -> SnapLevel a -> m
forall b a. (b -> a -> b) -> b -> SnapLevel a -> b
forall a b. (a -> b -> b) -> b -> SnapLevel a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => SnapLevel m -> m
fold :: forall m. Monoid m => SnapLevel m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SnapLevel a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SnapLevel a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SnapLevel a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SnapLevel a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> SnapLevel a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SnapLevel a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SnapLevel a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SnapLevel a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SnapLevel a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SnapLevel a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SnapLevel a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SnapLevel a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> SnapLevel a -> a
foldr1 :: forall a. (a -> a -> a) -> SnapLevel a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SnapLevel a -> a
foldl1 :: forall a. (a -> a -> a) -> SnapLevel a -> a
$ctoList :: forall a. SnapLevel a -> [a]
toList :: forall a. SnapLevel a -> [a]
$cnull :: forall a. SnapLevel a -> Bool
null :: forall a. SnapLevel a -> Bool
$clength :: forall a. SnapLevel a -> Int
length :: forall a. SnapLevel a -> Int
$celem :: forall a. Eq a => a -> SnapLevel a -> Bool
elem :: forall a. Eq a => a -> SnapLevel a -> Bool
$cmaximum :: forall a. Ord a => SnapLevel a -> a
maximum :: forall a. Ord a => SnapLevel a -> a
$cminimum :: forall a. Ord a => SnapLevel a -> a
minimum :: forall a. Ord a => SnapLevel a -> a
$csum :: forall a. Num a => SnapLevel a -> a
sum :: forall a. Num a => SnapLevel a -> a
$cproduct :: forall a. Num a => SnapLevel a -> a
product :: forall a. Num a => SnapLevel a -> a
Foldable, Functor SnapLevel
Foldable SnapLevel
(Functor SnapLevel, Foldable SnapLevel) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> SnapLevel a -> f (SnapLevel b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SnapLevel (f a) -> f (SnapLevel a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SnapLevel a -> m (SnapLevel b))
-> (forall (m :: * -> *) a.
    Monad m =>
    SnapLevel (m a) -> m (SnapLevel a))
-> Traversable SnapLevel
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SnapLevel (m a) -> m (SnapLevel a)
forall (f :: * -> *) a.
Applicative f =>
SnapLevel (f a) -> f (SnapLevel a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapLevel a -> m (SnapLevel b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapLevel a -> f (SnapLevel b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapLevel a -> f (SnapLevel b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapLevel a -> f (SnapLevel b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapLevel (f a) -> f (SnapLevel a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapLevel (f a) -> f (SnapLevel a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapLevel a -> m (SnapLevel b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapLevel a -> m (SnapLevel b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SnapLevel (m a) -> m (SnapLevel a)
sequence :: forall (m :: * -> *) a.
Monad m =>
SnapLevel (m a) -> m (SnapLevel a)
Traversable)

instance NFData r => NFData (SnapLevel r) where
  rnf :: SnapLevel r -> ()
rnf (SnapLevel SnapIncomingRun r
a Vector r
b) = SnapIncomingRun r -> ()
forall a. NFData a => a -> ()
rnf SnapIncomingRun r
a () -> () -> ()
forall a b. a -> b -> b
`seq` Vector r -> ()
forall a. NFData a => a -> ()
rnf Vector r
b

-- | Note that for snapshots of incoming runs, we store only the merge debt and
-- nominal credits, not the nominal debt or the merge credits. The rationale is
-- a bit subtle.
--
-- The nominal debt does not need to be stored because it can be derived based
-- on the table's write buffer size (which is stored in the snapshot's
-- TableConfig), and on the level number that the merge is at (which also known
-- from the snapshot structure).
--
-- The merge credits can be recalculated from the combination of the nominal debt,
-- nominal credits and merge debt.
--
-- The merge debt is always the sum of the size of the input runs, so at first
-- glance this seems redundant. However for completed merges we no longer have
-- the input runs, so we must store the merge debt if we are to perfectly round
-- trip the snapshot. This is a nice simple property to have though it is
-- probably not 100% essential. We could weaken the round trip property to
-- allow forgetting the merge debt and credit of completed merges (and set them
-- both to zero).
--
data SnapIncomingRun r =
    SnapIncomingMergingRun
      !MergePolicyForLevel
      !NominalDebt
      !NominalCredits -- ^ The nominal credits supplied, and that
                     -- need to be supplied on snapshot open.
      !(SnapMergingRun MR.LevelMergeType r)
  | SnapIncomingSingleRun !r
  deriving stock (SnapIncomingRun r -> SnapIncomingRun r -> Bool
(SnapIncomingRun r -> SnapIncomingRun r -> Bool)
-> (SnapIncomingRun r -> SnapIncomingRun r -> Bool)
-> Eq (SnapIncomingRun r)
forall r. Eq r => SnapIncomingRun r -> SnapIncomingRun r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r. Eq r => SnapIncomingRun r -> SnapIncomingRun r -> Bool
== :: SnapIncomingRun r -> SnapIncomingRun r -> Bool
$c/= :: forall r. Eq r => SnapIncomingRun r -> SnapIncomingRun r -> Bool
/= :: SnapIncomingRun r -> SnapIncomingRun r -> Bool
Eq, (forall a b. (a -> b) -> SnapIncomingRun a -> SnapIncomingRun b)
-> (forall a b. a -> SnapIncomingRun b -> SnapIncomingRun a)
-> Functor SnapIncomingRun
forall a b. a -> SnapIncomingRun b -> SnapIncomingRun a
forall a b. (a -> b) -> SnapIncomingRun a -> SnapIncomingRun b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SnapIncomingRun a -> SnapIncomingRun b
fmap :: forall a b. (a -> b) -> SnapIncomingRun a -> SnapIncomingRun b
$c<$ :: forall a b. a -> SnapIncomingRun b -> SnapIncomingRun a
<$ :: forall a b. a -> SnapIncomingRun b -> SnapIncomingRun a
Functor, (forall m. Monoid m => SnapIncomingRun m -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapIncomingRun a -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapIncomingRun a -> m)
-> (forall a b. (a -> b -> b) -> b -> SnapIncomingRun a -> b)
-> (forall a b. (a -> b -> b) -> b -> SnapIncomingRun a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapIncomingRun a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapIncomingRun a -> b)
-> (forall a. (a -> a -> a) -> SnapIncomingRun a -> a)
-> (forall a. (a -> a -> a) -> SnapIncomingRun a -> a)
-> (forall a. SnapIncomingRun a -> [a])
-> (forall a. SnapIncomingRun a -> Bool)
-> (forall a. SnapIncomingRun a -> Int)
-> (forall a. Eq a => a -> SnapIncomingRun a -> Bool)
-> (forall a. Ord a => SnapIncomingRun a -> a)
-> (forall a. Ord a => SnapIncomingRun a -> a)
-> (forall a. Num a => SnapIncomingRun a -> a)
-> (forall a. Num a => SnapIncomingRun a -> a)
-> Foldable SnapIncomingRun
forall a. Eq a => a -> SnapIncomingRun a -> Bool
forall a. Num a => SnapIncomingRun a -> a
forall a. Ord a => SnapIncomingRun a -> a
forall m. Monoid m => SnapIncomingRun m -> m
forall a. SnapIncomingRun a -> Bool
forall a. SnapIncomingRun a -> Int
forall a. SnapIncomingRun a -> [a]
forall a. (a -> a -> a) -> SnapIncomingRun a -> a
forall m a. Monoid m => (a -> m) -> SnapIncomingRun a -> m
forall b a. (b -> a -> b) -> b -> SnapIncomingRun a -> b
forall a b. (a -> b -> b) -> b -> SnapIncomingRun a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => SnapIncomingRun m -> m
fold :: forall m. Monoid m => SnapIncomingRun m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SnapIncomingRun a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SnapIncomingRun a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SnapIncomingRun a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SnapIncomingRun a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> SnapIncomingRun a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SnapIncomingRun a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SnapIncomingRun a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SnapIncomingRun a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SnapIncomingRun a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SnapIncomingRun a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SnapIncomingRun a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SnapIncomingRun a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> SnapIncomingRun a -> a
foldr1 :: forall a. (a -> a -> a) -> SnapIncomingRun a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SnapIncomingRun a -> a
foldl1 :: forall a. (a -> a -> a) -> SnapIncomingRun a -> a
$ctoList :: forall a. SnapIncomingRun a -> [a]
toList :: forall a. SnapIncomingRun a -> [a]
$cnull :: forall a. SnapIncomingRun a -> Bool
null :: forall a. SnapIncomingRun a -> Bool
$clength :: forall a. SnapIncomingRun a -> Int
length :: forall a. SnapIncomingRun a -> Int
$celem :: forall a. Eq a => a -> SnapIncomingRun a -> Bool
elem :: forall a. Eq a => a -> SnapIncomingRun a -> Bool
$cmaximum :: forall a. Ord a => SnapIncomingRun a -> a
maximum :: forall a. Ord a => SnapIncomingRun a -> a
$cminimum :: forall a. Ord a => SnapIncomingRun a -> a
minimum :: forall a. Ord a => SnapIncomingRun a -> a
$csum :: forall a. Num a => SnapIncomingRun a -> a
sum :: forall a. Num a => SnapIncomingRun a -> a
$cproduct :: forall a. Num a => SnapIncomingRun a -> a
product :: forall a. Num a => SnapIncomingRun a -> a
Foldable, Functor SnapIncomingRun
Foldable SnapIncomingRun
(Functor SnapIncomingRun, Foldable SnapIncomingRun) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> SnapIncomingRun a -> f (SnapIncomingRun b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SnapIncomingRun (f a) -> f (SnapIncomingRun a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SnapIncomingRun a -> m (SnapIncomingRun b))
-> (forall (m :: * -> *) a.
    Monad m =>
    SnapIncomingRun (m a) -> m (SnapIncomingRun a))
-> Traversable SnapIncomingRun
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SnapIncomingRun (m a) -> m (SnapIncomingRun a)
forall (f :: * -> *) a.
Applicative f =>
SnapIncomingRun (f a) -> f (SnapIncomingRun a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapIncomingRun a -> m (SnapIncomingRun b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapIncomingRun a -> f (SnapIncomingRun b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapIncomingRun a -> f (SnapIncomingRun b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapIncomingRun a -> f (SnapIncomingRun b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapIncomingRun (f a) -> f (SnapIncomingRun a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapIncomingRun (f a) -> f (SnapIncomingRun a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapIncomingRun a -> m (SnapIncomingRun b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapIncomingRun a -> m (SnapIncomingRun b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SnapIncomingRun (m a) -> m (SnapIncomingRun a)
sequence :: forall (m :: * -> *) a.
Monad m =>
SnapIncomingRun (m a) -> m (SnapIncomingRun a)
Traversable)

instance NFData r => NFData (SnapIncomingRun r) where
  rnf :: SnapIncomingRun r -> ()
rnf (SnapIncomingMergingRun MergePolicyForLevel
a NominalDebt
b NominalCredits
c SnapMergingRun LevelMergeType r
d) =
      MergePolicyForLevel -> ()
forall a. NFData a => a -> ()
rnf MergePolicyForLevel
a () -> () -> ()
forall a b. a -> b -> b
`seq` NominalDebt -> ()
forall a. NFData a => a -> ()
rnf NominalDebt
b () -> () -> ()
forall a b. a -> b -> b
`seq` NominalCredits -> ()
forall a. NFData a => a -> ()
rnf NominalCredits
c () -> () -> ()
forall a b. a -> b -> b
`seq` SnapMergingRun LevelMergeType r -> ()
forall a. NFData a => a -> ()
rnf SnapMergingRun LevelMergeType r
d
  rnf (SnapIncomingSingleRun r
a) = r -> ()
forall a. NFData a => a -> ()
rnf r
a

-- | The total number of supplied credits. This total is used on snapshot load
-- to restore merging work that was lost when the snapshot was created.
newtype SuppliedCredits = SuppliedCredits { SuppliedCredits -> Int
getSuppliedCredits :: Int }
  deriving stock (SuppliedCredits -> SuppliedCredits -> Bool
(SuppliedCredits -> SuppliedCredits -> Bool)
-> (SuppliedCredits -> SuppliedCredits -> Bool)
-> Eq SuppliedCredits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SuppliedCredits -> SuppliedCredits -> Bool
== :: SuppliedCredits -> SuppliedCredits -> Bool
$c/= :: SuppliedCredits -> SuppliedCredits -> Bool
/= :: SuppliedCredits -> SuppliedCredits -> Bool
Eq, ReadPrec [SuppliedCredits]
ReadPrec SuppliedCredits
Int -> ReadS SuppliedCredits
ReadS [SuppliedCredits]
(Int -> ReadS SuppliedCredits)
-> ReadS [SuppliedCredits]
-> ReadPrec SuppliedCredits
-> ReadPrec [SuppliedCredits]
-> Read SuppliedCredits
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SuppliedCredits
readsPrec :: Int -> ReadS SuppliedCredits
$creadList :: ReadS [SuppliedCredits]
readList :: ReadS [SuppliedCredits]
$creadPrec :: ReadPrec SuppliedCredits
readPrec :: ReadPrec SuppliedCredits
$creadListPrec :: ReadPrec [SuppliedCredits]
readListPrec :: ReadPrec [SuppliedCredits]
Read)
  deriving newtype SuppliedCredits -> ()
(SuppliedCredits -> ()) -> NFData SuppliedCredits
forall a. (a -> ()) -> NFData a
$crnf :: SuppliedCredits -> ()
rnf :: SuppliedCredits -> ()
NFData

data SnapMergingRun t r =
    SnapCompletedMerge !MergeDebt !r
  | SnapOngoingMerge   !RunParams !MergeCredits !(V.Vector r) !t
  deriving stock (SnapMergingRun t r -> SnapMergingRun t r -> Bool
(SnapMergingRun t r -> SnapMergingRun t r -> Bool)
-> (SnapMergingRun t r -> SnapMergingRun t r -> Bool)
-> Eq (SnapMergingRun t r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t r.
(Eq r, Eq t) =>
SnapMergingRun t r -> SnapMergingRun t r -> Bool
$c== :: forall t r.
(Eq r, Eq t) =>
SnapMergingRun t r -> SnapMergingRun t r -> Bool
== :: SnapMergingRun t r -> SnapMergingRun t r -> Bool
$c/= :: forall t r.
(Eq r, Eq t) =>
SnapMergingRun t r -> SnapMergingRun t r -> Bool
/= :: SnapMergingRun t r -> SnapMergingRun t r -> Bool
Eq, (forall a b. (a -> b) -> SnapMergingRun t a -> SnapMergingRun t b)
-> (forall a b. a -> SnapMergingRun t b -> SnapMergingRun t a)
-> Functor (SnapMergingRun t)
forall a b. a -> SnapMergingRun t b -> SnapMergingRun t a
forall a b. (a -> b) -> SnapMergingRun t a -> SnapMergingRun t b
forall t a b. a -> SnapMergingRun t b -> SnapMergingRun t a
forall t a b. (a -> b) -> SnapMergingRun t a -> SnapMergingRun t b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall t a b. (a -> b) -> SnapMergingRun t a -> SnapMergingRun t b
fmap :: forall a b. (a -> b) -> SnapMergingRun t a -> SnapMergingRun t b
$c<$ :: forall t a b. a -> SnapMergingRun t b -> SnapMergingRun t a
<$ :: forall a b. a -> SnapMergingRun t b -> SnapMergingRun t a
Functor, (forall m. Monoid m => SnapMergingRun t m -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapMergingRun t a -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapMergingRun t a -> m)
-> (forall a b. (a -> b -> b) -> b -> SnapMergingRun t a -> b)
-> (forall a b. (a -> b -> b) -> b -> SnapMergingRun t a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapMergingRun t a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapMergingRun t a -> b)
-> (forall a. (a -> a -> a) -> SnapMergingRun t a -> a)
-> (forall a. (a -> a -> a) -> SnapMergingRun t a -> a)
-> (forall a. SnapMergingRun t a -> [a])
-> (forall a. SnapMergingRun t a -> Bool)
-> (forall a. SnapMergingRun t a -> Int)
-> (forall a. Eq a => a -> SnapMergingRun t a -> Bool)
-> (forall a. Ord a => SnapMergingRun t a -> a)
-> (forall a. Ord a => SnapMergingRun t a -> a)
-> (forall a. Num a => SnapMergingRun t a -> a)
-> (forall a. Num a => SnapMergingRun t a -> a)
-> Foldable (SnapMergingRun t)
forall a. Eq a => a -> SnapMergingRun t a -> Bool
forall a. Num a => SnapMergingRun t a -> a
forall a. Ord a => SnapMergingRun t a -> a
forall m. Monoid m => SnapMergingRun t m -> m
forall a. SnapMergingRun t a -> Bool
forall a. SnapMergingRun t a -> Int
forall a. SnapMergingRun t a -> [a]
forall a. (a -> a -> a) -> SnapMergingRun t a -> a
forall t a. Eq a => a -> SnapMergingRun t a -> Bool
forall t a. Num a => SnapMergingRun t a -> a
forall t a. Ord a => SnapMergingRun t a -> a
forall m a. Monoid m => (a -> m) -> SnapMergingRun t a -> m
forall t m. Monoid m => SnapMergingRun t m -> m
forall t a. SnapMergingRun t a -> Bool
forall t a. SnapMergingRun t a -> Int
forall t a. SnapMergingRun t a -> [a]
forall b a. (b -> a -> b) -> b -> SnapMergingRun t a -> b
forall a b. (a -> b -> b) -> b -> SnapMergingRun t a -> b
forall t a. (a -> a -> a) -> SnapMergingRun t a -> a
forall t m a. Monoid m => (a -> m) -> SnapMergingRun t a -> m
forall t b a. (b -> a -> b) -> b -> SnapMergingRun t a -> b
forall t a b. (a -> b -> b) -> b -> SnapMergingRun t a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall t m. Monoid m => SnapMergingRun t m -> m
fold :: forall m. Monoid m => SnapMergingRun t m -> m
$cfoldMap :: forall t m a. Monoid m => (a -> m) -> SnapMergingRun t a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SnapMergingRun t a -> m
$cfoldMap' :: forall t m a. Monoid m => (a -> m) -> SnapMergingRun t a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SnapMergingRun t a -> m
$cfoldr :: forall t a b. (a -> b -> b) -> b -> SnapMergingRun t a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SnapMergingRun t a -> b
$cfoldr' :: forall t a b. (a -> b -> b) -> b -> SnapMergingRun t a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SnapMergingRun t a -> b
$cfoldl :: forall t b a. (b -> a -> b) -> b -> SnapMergingRun t a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SnapMergingRun t a -> b
$cfoldl' :: forall t b a. (b -> a -> b) -> b -> SnapMergingRun t a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SnapMergingRun t a -> b
$cfoldr1 :: forall t a. (a -> a -> a) -> SnapMergingRun t a -> a
foldr1 :: forall a. (a -> a -> a) -> SnapMergingRun t a -> a
$cfoldl1 :: forall t a. (a -> a -> a) -> SnapMergingRun t a -> a
foldl1 :: forall a. (a -> a -> a) -> SnapMergingRun t a -> a
$ctoList :: forall t a. SnapMergingRun t a -> [a]
toList :: forall a. SnapMergingRun t a -> [a]
$cnull :: forall t a. SnapMergingRun t a -> Bool
null :: forall a. SnapMergingRun t a -> Bool
$clength :: forall t a. SnapMergingRun t a -> Int
length :: forall a. SnapMergingRun t a -> Int
$celem :: forall t a. Eq a => a -> SnapMergingRun t a -> Bool
elem :: forall a. Eq a => a -> SnapMergingRun t a -> Bool
$cmaximum :: forall t a. Ord a => SnapMergingRun t a -> a
maximum :: forall a. Ord a => SnapMergingRun t a -> a
$cminimum :: forall t a. Ord a => SnapMergingRun t a -> a
minimum :: forall a. Ord a => SnapMergingRun t a -> a
$csum :: forall t a. Num a => SnapMergingRun t a -> a
sum :: forall a. Num a => SnapMergingRun t a -> a
$cproduct :: forall t a. Num a => SnapMergingRun t a -> a
product :: forall a. Num a => SnapMergingRun t a -> a
Foldable, Functor (SnapMergingRun t)
Foldable (SnapMergingRun t)
(Functor (SnapMergingRun t), Foldable (SnapMergingRun t)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> SnapMergingRun t a -> f (SnapMergingRun t b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SnapMergingRun t (f a) -> f (SnapMergingRun t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SnapMergingRun t a -> m (SnapMergingRun t b))
-> (forall (m :: * -> *) a.
    Monad m =>
    SnapMergingRun t (m a) -> m (SnapMergingRun t a))
-> Traversable (SnapMergingRun t)
forall t. Functor (SnapMergingRun t)
forall t. Foldable (SnapMergingRun t)
forall t (m :: * -> *) a.
Monad m =>
SnapMergingRun t (m a) -> m (SnapMergingRun t a)
forall t (f :: * -> *) a.
Applicative f =>
SnapMergingRun t (f a) -> f (SnapMergingRun t a)
forall t (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapMergingRun t a -> m (SnapMergingRun t b)
forall t (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapMergingRun t a -> f (SnapMergingRun t b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SnapMergingRun t (m a) -> m (SnapMergingRun t a)
forall (f :: * -> *) a.
Applicative f =>
SnapMergingRun t (f a) -> f (SnapMergingRun t a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapMergingRun t a -> m (SnapMergingRun t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapMergingRun t a -> f (SnapMergingRun t b)
$ctraverse :: forall t (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapMergingRun t a -> f (SnapMergingRun t b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapMergingRun t a -> f (SnapMergingRun t b)
$csequenceA :: forall t (f :: * -> *) a.
Applicative f =>
SnapMergingRun t (f a) -> f (SnapMergingRun t a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapMergingRun t (f a) -> f (SnapMergingRun t a)
$cmapM :: forall t (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapMergingRun t a -> m (SnapMergingRun t b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapMergingRun t a -> m (SnapMergingRun t b)
$csequence :: forall t (m :: * -> *) a.
Monad m =>
SnapMergingRun t (m a) -> m (SnapMergingRun t a)
sequence :: forall (m :: * -> *) a.
Monad m =>
SnapMergingRun t (m a) -> m (SnapMergingRun t a)
Traversable)

instance (NFData t, NFData r) => NFData (SnapMergingRun t r) where
  rnf :: SnapMergingRun t r -> ()
rnf (SnapCompletedMerge MergeDebt
a r
b)     = MergeDebt -> ()
forall a. NFData a => a -> ()
rnf MergeDebt
a () -> () -> ()
forall a b. a -> b -> b
`seq` r -> ()
forall a. NFData a => a -> ()
rnf r
b
  rnf (SnapOngoingMerge   RunParams
a MergeCredits
b Vector r
c t
d) = RunParams -> ()
forall a. NFData a => a -> ()
rnf RunParams
a () -> () -> ()
forall a b. a -> b -> b
`seq` MergeCredits -> ()
forall a. NFData a => a -> ()
rnf MergeCredits
b () -> () -> ()
forall a b. a -> b -> b
`seq` Vector r -> ()
forall a. NFData a => a -> ()
rnf Vector r
c () -> () -> ()
forall a b. a -> b -> b
`seq` t -> ()
forall a. NFData a => a -> ()
rnf t
d

{-------------------------------------------------------------------------------
  Snapshot MergingTree
-------------------------------------------------------------------------------}

newtype SnapMergingTree r = SnapMergingTree (SnapMergingTreeState r)
  deriving stock (SnapMergingTree r -> SnapMergingTree r -> Bool
(SnapMergingTree r -> SnapMergingTree r -> Bool)
-> (SnapMergingTree r -> SnapMergingTree r -> Bool)
-> Eq (SnapMergingTree r)
forall r. Eq r => SnapMergingTree r -> SnapMergingTree r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r. Eq r => SnapMergingTree r -> SnapMergingTree r -> Bool
== :: SnapMergingTree r -> SnapMergingTree r -> Bool
$c/= :: forall r. Eq r => SnapMergingTree r -> SnapMergingTree r -> Bool
/= :: SnapMergingTree r -> SnapMergingTree r -> Bool
Eq, (forall a b. (a -> b) -> SnapMergingTree a -> SnapMergingTree b)
-> (forall a b. a -> SnapMergingTree b -> SnapMergingTree a)
-> Functor SnapMergingTree
forall a b. a -> SnapMergingTree b -> SnapMergingTree a
forall a b. (a -> b) -> SnapMergingTree a -> SnapMergingTree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SnapMergingTree a -> SnapMergingTree b
fmap :: forall a b. (a -> b) -> SnapMergingTree a -> SnapMergingTree b
$c<$ :: forall a b. a -> SnapMergingTree b -> SnapMergingTree a
<$ :: forall a b. a -> SnapMergingTree b -> SnapMergingTree a
Functor, (forall m. Monoid m => SnapMergingTree m -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapMergingTree a -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapMergingTree a -> m)
-> (forall a b. (a -> b -> b) -> b -> SnapMergingTree a -> b)
-> (forall a b. (a -> b -> b) -> b -> SnapMergingTree a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapMergingTree a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapMergingTree a -> b)
-> (forall a. (a -> a -> a) -> SnapMergingTree a -> a)
-> (forall a. (a -> a -> a) -> SnapMergingTree a -> a)
-> (forall a. SnapMergingTree a -> [a])
-> (forall a. SnapMergingTree a -> Bool)
-> (forall a. SnapMergingTree a -> Int)
-> (forall a. Eq a => a -> SnapMergingTree a -> Bool)
-> (forall a. Ord a => SnapMergingTree a -> a)
-> (forall a. Ord a => SnapMergingTree a -> a)
-> (forall a. Num a => SnapMergingTree a -> a)
-> (forall a. Num a => SnapMergingTree a -> a)
-> Foldable SnapMergingTree
forall a. Eq a => a -> SnapMergingTree a -> Bool
forall a. Num a => SnapMergingTree a -> a
forall a. Ord a => SnapMergingTree a -> a
forall m. Monoid m => SnapMergingTree m -> m
forall a. SnapMergingTree a -> Bool
forall a. SnapMergingTree a -> Int
forall a. SnapMergingTree a -> [a]
forall a. (a -> a -> a) -> SnapMergingTree a -> a
forall m a. Monoid m => (a -> m) -> SnapMergingTree a -> m
forall b a. (b -> a -> b) -> b -> SnapMergingTree a -> b
forall a b. (a -> b -> b) -> b -> SnapMergingTree a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => SnapMergingTree m -> m
fold :: forall m. Monoid m => SnapMergingTree m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SnapMergingTree a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SnapMergingTree a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SnapMergingTree a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SnapMergingTree a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> SnapMergingTree a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SnapMergingTree a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SnapMergingTree a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SnapMergingTree a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SnapMergingTree a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SnapMergingTree a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SnapMergingTree a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SnapMergingTree a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> SnapMergingTree a -> a
foldr1 :: forall a. (a -> a -> a) -> SnapMergingTree a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SnapMergingTree a -> a
foldl1 :: forall a. (a -> a -> a) -> SnapMergingTree a -> a
$ctoList :: forall a. SnapMergingTree a -> [a]
toList :: forall a. SnapMergingTree a -> [a]
$cnull :: forall a. SnapMergingTree a -> Bool
null :: forall a. SnapMergingTree a -> Bool
$clength :: forall a. SnapMergingTree a -> Int
length :: forall a. SnapMergingTree a -> Int
$celem :: forall a. Eq a => a -> SnapMergingTree a -> Bool
elem :: forall a. Eq a => a -> SnapMergingTree a -> Bool
$cmaximum :: forall a. Ord a => SnapMergingTree a -> a
maximum :: forall a. Ord a => SnapMergingTree a -> a
$cminimum :: forall a. Ord a => SnapMergingTree a -> a
minimum :: forall a. Ord a => SnapMergingTree a -> a
$csum :: forall a. Num a => SnapMergingTree a -> a
sum :: forall a. Num a => SnapMergingTree a -> a
$cproduct :: forall a. Num a => SnapMergingTree a -> a
product :: forall a. Num a => SnapMergingTree a -> a
Foldable, Functor SnapMergingTree
Foldable SnapMergingTree
(Functor SnapMergingTree, Foldable SnapMergingTree) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> SnapMergingTree a -> f (SnapMergingTree b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SnapMergingTree (f a) -> f (SnapMergingTree a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SnapMergingTree a -> m (SnapMergingTree b))
-> (forall (m :: * -> *) a.
    Monad m =>
    SnapMergingTree (m a) -> m (SnapMergingTree a))
-> Traversable SnapMergingTree
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SnapMergingTree (m a) -> m (SnapMergingTree a)
forall (f :: * -> *) a.
Applicative f =>
SnapMergingTree (f a) -> f (SnapMergingTree a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapMergingTree a -> m (SnapMergingTree b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapMergingTree a -> f (SnapMergingTree b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapMergingTree a -> f (SnapMergingTree b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapMergingTree a -> f (SnapMergingTree b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapMergingTree (f a) -> f (SnapMergingTree a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapMergingTree (f a) -> f (SnapMergingTree a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapMergingTree a -> m (SnapMergingTree b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapMergingTree a -> m (SnapMergingTree b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SnapMergingTree (m a) -> m (SnapMergingTree a)
sequence :: forall (m :: * -> *) a.
Monad m =>
SnapMergingTree (m a) -> m (SnapMergingTree a)
Traversable)
  deriving newtype SnapMergingTree r -> ()
(SnapMergingTree r -> ()) -> NFData (SnapMergingTree r)
forall r. NFData r => SnapMergingTree r -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall r. NFData r => SnapMergingTree r -> ()
rnf :: SnapMergingTree r -> ()
NFData

data SnapMergingTreeState r =
    SnapCompletedTreeMerge !r
  | SnapPendingTreeMerge   !(SnapPendingMerge r)
  | SnapOngoingTreeMerge   !(SnapMergingRun MR.TreeMergeType r)
  deriving stock (SnapMergingTreeState r -> SnapMergingTreeState r -> Bool
(SnapMergingTreeState r -> SnapMergingTreeState r -> Bool)
-> (SnapMergingTreeState r -> SnapMergingTreeState r -> Bool)
-> Eq (SnapMergingTreeState r)
forall r.
Eq r =>
SnapMergingTreeState r -> SnapMergingTreeState r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r.
Eq r =>
SnapMergingTreeState r -> SnapMergingTreeState r -> Bool
== :: SnapMergingTreeState r -> SnapMergingTreeState r -> Bool
$c/= :: forall r.
Eq r =>
SnapMergingTreeState r -> SnapMergingTreeState r -> Bool
/= :: SnapMergingTreeState r -> SnapMergingTreeState r -> Bool
Eq, (forall a b.
 (a -> b) -> SnapMergingTreeState a -> SnapMergingTreeState b)
-> (forall a b.
    a -> SnapMergingTreeState b -> SnapMergingTreeState a)
-> Functor SnapMergingTreeState
forall a b. a -> SnapMergingTreeState b -> SnapMergingTreeState a
forall a b.
(a -> b) -> SnapMergingTreeState a -> SnapMergingTreeState b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> SnapMergingTreeState a -> SnapMergingTreeState b
fmap :: forall a b.
(a -> b) -> SnapMergingTreeState a -> SnapMergingTreeState b
$c<$ :: forall a b. a -> SnapMergingTreeState b -> SnapMergingTreeState a
<$ :: forall a b. a -> SnapMergingTreeState b -> SnapMergingTreeState a
Functor, (forall m. Monoid m => SnapMergingTreeState m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> SnapMergingTreeState a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> SnapMergingTreeState a -> m)
-> (forall a b. (a -> b -> b) -> b -> SnapMergingTreeState a -> b)
-> (forall a b. (a -> b -> b) -> b -> SnapMergingTreeState a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapMergingTreeState a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapMergingTreeState a -> b)
-> (forall a. (a -> a -> a) -> SnapMergingTreeState a -> a)
-> (forall a. (a -> a -> a) -> SnapMergingTreeState a -> a)
-> (forall a. SnapMergingTreeState a -> [a])
-> (forall a. SnapMergingTreeState a -> Bool)
-> (forall a. SnapMergingTreeState a -> Int)
-> (forall a. Eq a => a -> SnapMergingTreeState a -> Bool)
-> (forall a. Ord a => SnapMergingTreeState a -> a)
-> (forall a. Ord a => SnapMergingTreeState a -> a)
-> (forall a. Num a => SnapMergingTreeState a -> a)
-> (forall a. Num a => SnapMergingTreeState a -> a)
-> Foldable SnapMergingTreeState
forall a. Eq a => a -> SnapMergingTreeState a -> Bool
forall a. Num a => SnapMergingTreeState a -> a
forall a. Ord a => SnapMergingTreeState a -> a
forall m. Monoid m => SnapMergingTreeState m -> m
forall a. SnapMergingTreeState a -> Bool
forall a. SnapMergingTreeState a -> Int
forall a. SnapMergingTreeState a -> [a]
forall a. (a -> a -> a) -> SnapMergingTreeState a -> a
forall m a. Monoid m => (a -> m) -> SnapMergingTreeState a -> m
forall b a. (b -> a -> b) -> b -> SnapMergingTreeState a -> b
forall a b. (a -> b -> b) -> b -> SnapMergingTreeState a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => SnapMergingTreeState m -> m
fold :: forall m. Monoid m => SnapMergingTreeState m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SnapMergingTreeState a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SnapMergingTreeState a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SnapMergingTreeState a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SnapMergingTreeState a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> SnapMergingTreeState a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SnapMergingTreeState a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SnapMergingTreeState a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SnapMergingTreeState a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SnapMergingTreeState a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SnapMergingTreeState a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SnapMergingTreeState a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SnapMergingTreeState a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> SnapMergingTreeState a -> a
foldr1 :: forall a. (a -> a -> a) -> SnapMergingTreeState a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SnapMergingTreeState a -> a
foldl1 :: forall a. (a -> a -> a) -> SnapMergingTreeState a -> a
$ctoList :: forall a. SnapMergingTreeState a -> [a]
toList :: forall a. SnapMergingTreeState a -> [a]
$cnull :: forall a. SnapMergingTreeState a -> Bool
null :: forall a. SnapMergingTreeState a -> Bool
$clength :: forall a. SnapMergingTreeState a -> Int
length :: forall a. SnapMergingTreeState a -> Int
$celem :: forall a. Eq a => a -> SnapMergingTreeState a -> Bool
elem :: forall a. Eq a => a -> SnapMergingTreeState a -> Bool
$cmaximum :: forall a. Ord a => SnapMergingTreeState a -> a
maximum :: forall a. Ord a => SnapMergingTreeState a -> a
$cminimum :: forall a. Ord a => SnapMergingTreeState a -> a
minimum :: forall a. Ord a => SnapMergingTreeState a -> a
$csum :: forall a. Num a => SnapMergingTreeState a -> a
sum :: forall a. Num a => SnapMergingTreeState a -> a
$cproduct :: forall a. Num a => SnapMergingTreeState a -> a
product :: forall a. Num a => SnapMergingTreeState a -> a
Foldable, Functor SnapMergingTreeState
Foldable SnapMergingTreeState
(Functor SnapMergingTreeState, Foldable SnapMergingTreeState) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> SnapMergingTreeState a -> f (SnapMergingTreeState b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SnapMergingTreeState (f a) -> f (SnapMergingTreeState a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SnapMergingTreeState a -> m (SnapMergingTreeState b))
-> (forall (m :: * -> *) a.
    Monad m =>
    SnapMergingTreeState (m a) -> m (SnapMergingTreeState a))
-> Traversable SnapMergingTreeState
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SnapMergingTreeState (m a) -> m (SnapMergingTreeState a)
forall (f :: * -> *) a.
Applicative f =>
SnapMergingTreeState (f a) -> f (SnapMergingTreeState a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapMergingTreeState a -> m (SnapMergingTreeState b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapMergingTreeState a -> f (SnapMergingTreeState b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapMergingTreeState a -> f (SnapMergingTreeState b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapMergingTreeState a -> f (SnapMergingTreeState b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapMergingTreeState (f a) -> f (SnapMergingTreeState a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapMergingTreeState (f a) -> f (SnapMergingTreeState a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapMergingTreeState a -> m (SnapMergingTreeState b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapMergingTreeState a -> m (SnapMergingTreeState b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SnapMergingTreeState (m a) -> m (SnapMergingTreeState a)
sequence :: forall (m :: * -> *) a.
Monad m =>
SnapMergingTreeState (m a) -> m (SnapMergingTreeState a)
Traversable)

instance NFData r => NFData (SnapMergingTreeState r) where
  rnf :: SnapMergingTreeState r -> ()
rnf (SnapCompletedTreeMerge r
a) = r -> ()
forall a. NFData a => a -> ()
rnf r
a
  rnf (SnapPendingTreeMerge SnapPendingMerge r
a)   = SnapPendingMerge r -> ()
forall a. NFData a => a -> ()
rnf SnapPendingMerge r
a
  rnf (SnapOngoingTreeMerge SnapMergingRun TreeMergeType r
a)   = SnapMergingRun TreeMergeType r -> ()
forall a. NFData a => a -> ()
rnf SnapMergingRun TreeMergeType r
a

data SnapPendingMerge r =
    SnapPendingLevelMerge
      ![SnapPreExistingRun r]
      !(Maybe (SnapMergingTree r))
  | SnapPendingUnionMerge
      ![SnapMergingTree r]
  deriving stock (SnapPendingMerge r -> SnapPendingMerge r -> Bool
(SnapPendingMerge r -> SnapPendingMerge r -> Bool)
-> (SnapPendingMerge r -> SnapPendingMerge r -> Bool)
-> Eq (SnapPendingMerge r)
forall r. Eq r => SnapPendingMerge r -> SnapPendingMerge r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r. Eq r => SnapPendingMerge r -> SnapPendingMerge r -> Bool
== :: SnapPendingMerge r -> SnapPendingMerge r -> Bool
$c/= :: forall r. Eq r => SnapPendingMerge r -> SnapPendingMerge r -> Bool
/= :: SnapPendingMerge r -> SnapPendingMerge r -> Bool
Eq, (forall a b. (a -> b) -> SnapPendingMerge a -> SnapPendingMerge b)
-> (forall a b. a -> SnapPendingMerge b -> SnapPendingMerge a)
-> Functor SnapPendingMerge
forall a b. a -> SnapPendingMerge b -> SnapPendingMerge a
forall a b. (a -> b) -> SnapPendingMerge a -> SnapPendingMerge b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SnapPendingMerge a -> SnapPendingMerge b
fmap :: forall a b. (a -> b) -> SnapPendingMerge a -> SnapPendingMerge b
$c<$ :: forall a b. a -> SnapPendingMerge b -> SnapPendingMerge a
<$ :: forall a b. a -> SnapPendingMerge b -> SnapPendingMerge a
Functor, (forall m. Monoid m => SnapPendingMerge m -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapPendingMerge a -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapPendingMerge a -> m)
-> (forall a b. (a -> b -> b) -> b -> SnapPendingMerge a -> b)
-> (forall a b. (a -> b -> b) -> b -> SnapPendingMerge a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapPendingMerge a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapPendingMerge a -> b)
-> (forall a. (a -> a -> a) -> SnapPendingMerge a -> a)
-> (forall a. (a -> a -> a) -> SnapPendingMerge a -> a)
-> (forall a. SnapPendingMerge a -> [a])
-> (forall a. SnapPendingMerge a -> Bool)
-> (forall a. SnapPendingMerge a -> Int)
-> (forall a. Eq a => a -> SnapPendingMerge a -> Bool)
-> (forall a. Ord a => SnapPendingMerge a -> a)
-> (forall a. Ord a => SnapPendingMerge a -> a)
-> (forall a. Num a => SnapPendingMerge a -> a)
-> (forall a. Num a => SnapPendingMerge a -> a)
-> Foldable SnapPendingMerge
forall a. Eq a => a -> SnapPendingMerge a -> Bool
forall a. Num a => SnapPendingMerge a -> a
forall a. Ord a => SnapPendingMerge a -> a
forall m. Monoid m => SnapPendingMerge m -> m
forall a. SnapPendingMerge a -> Bool
forall a. SnapPendingMerge a -> Int
forall a. SnapPendingMerge a -> [a]
forall a. (a -> a -> a) -> SnapPendingMerge a -> a
forall m a. Monoid m => (a -> m) -> SnapPendingMerge a -> m
forall b a. (b -> a -> b) -> b -> SnapPendingMerge a -> b
forall a b. (a -> b -> b) -> b -> SnapPendingMerge a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => SnapPendingMerge m -> m
fold :: forall m. Monoid m => SnapPendingMerge m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SnapPendingMerge a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SnapPendingMerge a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SnapPendingMerge a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SnapPendingMerge a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> SnapPendingMerge a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SnapPendingMerge a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SnapPendingMerge a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SnapPendingMerge a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SnapPendingMerge a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SnapPendingMerge a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SnapPendingMerge a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SnapPendingMerge a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> SnapPendingMerge a -> a
foldr1 :: forall a. (a -> a -> a) -> SnapPendingMerge a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SnapPendingMerge a -> a
foldl1 :: forall a. (a -> a -> a) -> SnapPendingMerge a -> a
$ctoList :: forall a. SnapPendingMerge a -> [a]
toList :: forall a. SnapPendingMerge a -> [a]
$cnull :: forall a. SnapPendingMerge a -> Bool
null :: forall a. SnapPendingMerge a -> Bool
$clength :: forall a. SnapPendingMerge a -> Int
length :: forall a. SnapPendingMerge a -> Int
$celem :: forall a. Eq a => a -> SnapPendingMerge a -> Bool
elem :: forall a. Eq a => a -> SnapPendingMerge a -> Bool
$cmaximum :: forall a. Ord a => SnapPendingMerge a -> a
maximum :: forall a. Ord a => SnapPendingMerge a -> a
$cminimum :: forall a. Ord a => SnapPendingMerge a -> a
minimum :: forall a. Ord a => SnapPendingMerge a -> a
$csum :: forall a. Num a => SnapPendingMerge a -> a
sum :: forall a. Num a => SnapPendingMerge a -> a
$cproduct :: forall a. Num a => SnapPendingMerge a -> a
product :: forall a. Num a => SnapPendingMerge a -> a
Foldable, Functor SnapPendingMerge
Foldable SnapPendingMerge
(Functor SnapPendingMerge, Foldable SnapPendingMerge) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> SnapPendingMerge a -> f (SnapPendingMerge b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SnapPendingMerge (f a) -> f (SnapPendingMerge a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SnapPendingMerge a -> m (SnapPendingMerge b))
-> (forall (m :: * -> *) a.
    Monad m =>
    SnapPendingMerge (m a) -> m (SnapPendingMerge a))
-> Traversable SnapPendingMerge
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SnapPendingMerge (m a) -> m (SnapPendingMerge a)
forall (f :: * -> *) a.
Applicative f =>
SnapPendingMerge (f a) -> f (SnapPendingMerge a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapPendingMerge a -> m (SnapPendingMerge b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapPendingMerge a -> f (SnapPendingMerge b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapPendingMerge a -> f (SnapPendingMerge b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapPendingMerge a -> f (SnapPendingMerge b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapPendingMerge (f a) -> f (SnapPendingMerge a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapPendingMerge (f a) -> f (SnapPendingMerge a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapPendingMerge a -> m (SnapPendingMerge b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapPendingMerge a -> m (SnapPendingMerge b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SnapPendingMerge (m a) -> m (SnapPendingMerge a)
sequence :: forall (m :: * -> *) a.
Monad m =>
SnapPendingMerge (m a) -> m (SnapPendingMerge a)
Traversable)

instance NFData r => NFData (SnapPendingMerge r) where
  rnf :: SnapPendingMerge r -> ()
rnf (SnapPendingLevelMerge [SnapPreExistingRun r]
a Maybe (SnapMergingTree r)
b) = [SnapPreExistingRun r] -> ()
forall a. NFData a => a -> ()
rnf [SnapPreExistingRun r]
a () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe (SnapMergingTree r) -> ()
forall a. NFData a => a -> ()
rnf Maybe (SnapMergingTree r)
b
  rnf (SnapPendingUnionMerge [SnapMergingTree r]
a)   = [SnapMergingTree r] -> ()
forall a. NFData a => a -> ()
rnf [SnapMergingTree r]
a

data SnapPreExistingRun r =
    SnapPreExistingRun        !r
  | SnapPreExistingMergingRun !(SnapMergingRun MR.LevelMergeType r)
  deriving stock (SnapPreExistingRun r -> SnapPreExistingRun r -> Bool
(SnapPreExistingRun r -> SnapPreExistingRun r -> Bool)
-> (SnapPreExistingRun r -> SnapPreExistingRun r -> Bool)
-> Eq (SnapPreExistingRun r)
forall r.
Eq r =>
SnapPreExistingRun r -> SnapPreExistingRun r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r.
Eq r =>
SnapPreExistingRun r -> SnapPreExistingRun r -> Bool
== :: SnapPreExistingRun r -> SnapPreExistingRun r -> Bool
$c/= :: forall r.
Eq r =>
SnapPreExistingRun r -> SnapPreExistingRun r -> Bool
/= :: SnapPreExistingRun r -> SnapPreExistingRun r -> Bool
Eq, (forall a b.
 (a -> b) -> SnapPreExistingRun a -> SnapPreExistingRun b)
-> (forall a b. a -> SnapPreExistingRun b -> SnapPreExistingRun a)
-> Functor SnapPreExistingRun
forall a b. a -> SnapPreExistingRun b -> SnapPreExistingRun a
forall a b.
(a -> b) -> SnapPreExistingRun a -> SnapPreExistingRun b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> SnapPreExistingRun a -> SnapPreExistingRun b
fmap :: forall a b.
(a -> b) -> SnapPreExistingRun a -> SnapPreExistingRun b
$c<$ :: forall a b. a -> SnapPreExistingRun b -> SnapPreExistingRun a
<$ :: forall a b. a -> SnapPreExistingRun b -> SnapPreExistingRun a
Functor, (forall m. Monoid m => SnapPreExistingRun m -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapPreExistingRun a -> m)
-> (forall m a. Monoid m => (a -> m) -> SnapPreExistingRun a -> m)
-> (forall a b. (a -> b -> b) -> b -> SnapPreExistingRun a -> b)
-> (forall a b. (a -> b -> b) -> b -> SnapPreExistingRun a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapPreExistingRun a -> b)
-> (forall b a. (b -> a -> b) -> b -> SnapPreExistingRun a -> b)
-> (forall a. (a -> a -> a) -> SnapPreExistingRun a -> a)
-> (forall a. (a -> a -> a) -> SnapPreExistingRun a -> a)
-> (forall a. SnapPreExistingRun a -> [a])
-> (forall a. SnapPreExistingRun a -> Bool)
-> (forall a. SnapPreExistingRun a -> Int)
-> (forall a. Eq a => a -> SnapPreExistingRun a -> Bool)
-> (forall a. Ord a => SnapPreExistingRun a -> a)
-> (forall a. Ord a => SnapPreExistingRun a -> a)
-> (forall a. Num a => SnapPreExistingRun a -> a)
-> (forall a. Num a => SnapPreExistingRun a -> a)
-> Foldable SnapPreExistingRun
forall a. Eq a => a -> SnapPreExistingRun a -> Bool
forall a. Num a => SnapPreExistingRun a -> a
forall a. Ord a => SnapPreExistingRun a -> a
forall m. Monoid m => SnapPreExistingRun m -> m
forall a. SnapPreExistingRun a -> Bool
forall a. SnapPreExistingRun a -> Int
forall a. SnapPreExistingRun a -> [a]
forall a. (a -> a -> a) -> SnapPreExistingRun a -> a
forall m a. Monoid m => (a -> m) -> SnapPreExistingRun a -> m
forall b a. (b -> a -> b) -> b -> SnapPreExistingRun a -> b
forall a b. (a -> b -> b) -> b -> SnapPreExistingRun a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => SnapPreExistingRun m -> m
fold :: forall m. Monoid m => SnapPreExistingRun m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SnapPreExistingRun a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> SnapPreExistingRun a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SnapPreExistingRun a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> SnapPreExistingRun a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> SnapPreExistingRun a -> b
foldr :: forall a b. (a -> b -> b) -> b -> SnapPreExistingRun a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SnapPreExistingRun a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> SnapPreExistingRun a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SnapPreExistingRun a -> b
foldl :: forall b a. (b -> a -> b) -> b -> SnapPreExistingRun a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SnapPreExistingRun a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> SnapPreExistingRun a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> SnapPreExistingRun a -> a
foldr1 :: forall a. (a -> a -> a) -> SnapPreExistingRun a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SnapPreExistingRun a -> a
foldl1 :: forall a. (a -> a -> a) -> SnapPreExistingRun a -> a
$ctoList :: forall a. SnapPreExistingRun a -> [a]
toList :: forall a. SnapPreExistingRun a -> [a]
$cnull :: forall a. SnapPreExistingRun a -> Bool
null :: forall a. SnapPreExistingRun a -> Bool
$clength :: forall a. SnapPreExistingRun a -> Int
length :: forall a. SnapPreExistingRun a -> Int
$celem :: forall a. Eq a => a -> SnapPreExistingRun a -> Bool
elem :: forall a. Eq a => a -> SnapPreExistingRun a -> Bool
$cmaximum :: forall a. Ord a => SnapPreExistingRun a -> a
maximum :: forall a. Ord a => SnapPreExistingRun a -> a
$cminimum :: forall a. Ord a => SnapPreExistingRun a -> a
minimum :: forall a. Ord a => SnapPreExistingRun a -> a
$csum :: forall a. Num a => SnapPreExistingRun a -> a
sum :: forall a. Num a => SnapPreExistingRun a -> a
$cproduct :: forall a. Num a => SnapPreExistingRun a -> a
product :: forall a. Num a => SnapPreExistingRun a -> a
Foldable, Functor SnapPreExistingRun
Foldable SnapPreExistingRun
(Functor SnapPreExistingRun, Foldable SnapPreExistingRun) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> SnapPreExistingRun a -> f (SnapPreExistingRun b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SnapPreExistingRun (f a) -> f (SnapPreExistingRun a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SnapPreExistingRun a -> m (SnapPreExistingRun b))
-> (forall (m :: * -> *) a.
    Monad m =>
    SnapPreExistingRun (m a) -> m (SnapPreExistingRun a))
-> Traversable SnapPreExistingRun
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SnapPreExistingRun (m a) -> m (SnapPreExistingRun a)
forall (f :: * -> *) a.
Applicative f =>
SnapPreExistingRun (f a) -> f (SnapPreExistingRun a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapPreExistingRun a -> m (SnapPreExistingRun b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapPreExistingRun a -> f (SnapPreExistingRun b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapPreExistingRun a -> f (SnapPreExistingRun b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SnapPreExistingRun a -> f (SnapPreExistingRun b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapPreExistingRun (f a) -> f (SnapPreExistingRun a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
SnapPreExistingRun (f a) -> f (SnapPreExistingRun a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapPreExistingRun a -> m (SnapPreExistingRun b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SnapPreExistingRun a -> m (SnapPreExistingRun b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SnapPreExistingRun (m a) -> m (SnapPreExistingRun a)
sequence :: forall (m :: * -> *) a.
Monad m =>
SnapPreExistingRun (m a) -> m (SnapPreExistingRun a)
Traversable)

instance NFData r => NFData (SnapPreExistingRun r) where
  rnf :: SnapPreExistingRun r -> ()
rnf (SnapPreExistingRun r
a)        = r -> ()
forall a. NFData a => a -> ()
rnf r
a
  rnf (SnapPreExistingMergingRun SnapMergingRun LevelMergeType r
a) = SnapMergingRun LevelMergeType r -> ()
forall a. NFData a => a -> ()
rnf SnapMergingRun LevelMergeType r
a

{-------------------------------------------------------------------------------
  Opening from merging tree snapshot format
-------------------------------------------------------------------------------}

{-# SPECIALISE fromSnapMergingTree ::
     HasFS IO h
  -> HasBlockIO IO h
  -> UniqCounter IO
  -> ResolveSerialisedValue
  -> ActiveDir
  -> ActionRegistry IO
  -> SnapMergingTree (Ref (Run IO h))
  -> IO (Ref (MT.MergingTree IO h))
  #-}
-- | Converts a snapshot of a merging tree of runs to a real merging tree.
--
-- Returns a new reference. Input runs remain owned by the caller.
fromSnapMergingTree ::
     forall m h. (MonadMask m, MonadMVar m, MonadSTM m, MonadST m)
  => HasFS m h
  -> HasBlockIO m h
  -> UniqCounter m
  -> ResolveSerialisedValue
  -> ActiveDir
  -> ActionRegistry m
  -> SnapMergingTree (Ref (Run m h))
  -> m (Ref (MT.MergingTree m h))
fromSnapMergingTree :: forall (m :: * -> *) h.
(MonadMask m, MonadMVar m, MonadSTM m, MonadST m) =>
HasFS m h
-> HasBlockIO m h
-> UniqCounter m
-> ResolveSerialisedValue
-> ActiveDir
-> ActionRegistry m
-> SnapMergingTree (Ref (Run m h))
-> m (Ref (MergingTree m h))
fromSnapMergingTree HasFS m h
hfs HasBlockIO m h
hbio UniqCounter m
uc ResolveSerialisedValue
resolve ActiveDir
dir =
    ActionRegistry m
-> SnapMergingTree (Ref (Run m h)) -> m (Ref (MergingTree m h))
go
  where
    -- Reference strategy:
    -- * go returns a fresh reference
    -- * go ensures the returned reference will be cleaned up on failure,
    --   using withRollback
    -- * All results from recursive calls must be released locally on the
    --   happy path.
    go :: ActionRegistry m
       -> SnapMergingTree (Ref (Run m h))
       -> m (Ref (MT.MergingTree m h))

    go :: ActionRegistry m
-> SnapMergingTree (Ref (Run m h)) -> m (Ref (MergingTree m h))
go ActionRegistry m
reg (SnapMergingTree (SnapCompletedTreeMerge Ref (Run m h)
run)) =
      ActionRegistry m
-> m (Ref (MergingTree m h))
-> (Ref (MergingTree m h) -> m ())
-> m (Ref (MergingTree m h))
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> (a -> m ()) -> m a
withRollback ActionRegistry m
reg
        (Ref (Run m h) -> m (Ref (MergingTree m h))
forall (m :: * -> *) h.
(MonadMVar m, PrimMonad m, MonadMask m) =>
Ref (Run m h) -> m (Ref (MergingTree m h))
MT.newCompletedMerge Ref (Run m h)
run)
        Ref (MergingTree m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef

    go ActionRegistry m
reg (SnapMergingTree (SnapPendingTreeMerge
                              (SnapPendingLevelMerge [SnapPreExistingRun (Ref (Run m h))]
prs Maybe (SnapMergingTree (Ref (Run m h)))
mmt))) = do
      [PreExistingRun m h]
prs' <- (SnapPreExistingRun (Ref (Run m h)) -> m (PreExistingRun m h))
-> [SnapPreExistingRun (Ref (Run m h))] -> m [PreExistingRun m h]
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 (ActionRegistry m
-> SnapPreExistingRun (Ref (Run m h)) -> m (PreExistingRun m h)
fromSnapPreExistingRun ActionRegistry m
reg) [SnapPreExistingRun (Ref (Run m h))]
prs
      Maybe (Ref (MergingTree m h))
mmt' <- (SnapMergingTree (Ref (Run m h)) -> m (Ref (MergingTree m h)))
-> Maybe (SnapMergingTree (Ref (Run m h)))
-> m (Maybe (Ref (MergingTree m h)))
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) -> Maybe a -> f (Maybe b)
traverse (ActionRegistry m
-> SnapMergingTree (Ref (Run m h)) -> m (Ref (MergingTree m h))
go ActionRegistry m
reg) Maybe (SnapMergingTree (Ref (Run m h)))
mmt
      Ref (MergingTree m h)
mt   <- ActionRegistry m
-> m (Ref (MergingTree m h))
-> (Ref (MergingTree m h) -> m ())
-> m (Ref (MergingTree m h))
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> (a -> m ()) -> m a
withRollback ActionRegistry m
reg
                ([PreExistingRun m h]
-> Maybe (Ref (MergingTree m h)) -> m (Ref (MergingTree m 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 m h]
prs' Maybe (Ref (MergingTree m h))
mmt')
                Ref (MergingTree m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef
      (PreExistingRun m h -> m ()) -> [PreExistingRun m h] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ActionRegistry m -> m () -> m ()
forall (m :: * -> *).
(PrimMonad m, HasCallStack) =>
ActionRegistry m -> m () -> m ()
delayedCommit ActionRegistry m
reg (m () -> m ())
-> (PreExistingRun m h -> m ()) -> PreExistingRun m h -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreExistingRun m h -> m ()
forall {m :: * -> *} {h}.
(PrimMonad m, MonadMask m) =>
PreExistingRun m h -> m ()
releasePER) [PreExistingRun m h]
prs'
      (Ref (MergingTree m h) -> m ())
-> Maybe (Ref (MergingTree m h)) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ActionRegistry m -> m () -> m ()
forall (m :: * -> *).
(PrimMonad m, HasCallStack) =>
ActionRegistry m -> m () -> m ()
delayedCommit ActionRegistry m
reg (m () -> m ())
-> (Ref (MergingTree m h) -> m ()) -> Ref (MergingTree m h) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref (MergingTree m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef) Maybe (Ref (MergingTree m h))
mmt'
      Ref (MergingTree m h) -> m (Ref (MergingTree m h))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Ref (MergingTree m h)
mt

    go ActionRegistry m
reg (SnapMergingTree (SnapPendingTreeMerge
                              (SnapPendingUnionMerge [SnapMergingTree (Ref (Run m h))]
mts))) = do
      [Ref (MergingTree m h)]
mts' <- (SnapMergingTree (Ref (Run m h)) -> m (Ref (MergingTree m h)))
-> [SnapMergingTree (Ref (Run m h))] -> m [Ref (MergingTree m h)]
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 (ActionRegistry m
-> SnapMergingTree (Ref (Run m h)) -> m (Ref (MergingTree m h))
go ActionRegistry m
reg) [SnapMergingTree (Ref (Run m h))]
mts
      Ref (MergingTree m h)
mt   <- ActionRegistry m
-> m (Ref (MergingTree m h))
-> (Ref (MergingTree m h) -> m ())
-> m (Ref (MergingTree m h))
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> (a -> m ()) -> m a
withRollback ActionRegistry m
reg
                ([Ref (MergingTree m h)] -> m (Ref (MergingTree m h))
forall (m :: * -> *) h.
(MonadMVar m, MonadMask m, PrimMonad m) =>
[Ref (MergingTree m h)] -> m (Ref (MergingTree m h))
MT.newPendingUnionMerge [Ref (MergingTree m h)]
mts')
                Ref (MergingTree m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef
      (Ref (MergingTree m h) -> m ()) -> [Ref (MergingTree m h)] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ActionRegistry m -> m () -> m ()
forall (m :: * -> *).
(PrimMonad m, HasCallStack) =>
ActionRegistry m -> m () -> m ()
delayedCommit ActionRegistry m
reg (m () -> m ())
-> (Ref (MergingTree m h) -> m ()) -> Ref (MergingTree m h) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref (MergingTree m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef) [Ref (MergingTree m h)]
mts'
      Ref (MergingTree m h) -> m (Ref (MergingTree m h))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Ref (MergingTree m h)
mt

    go ActionRegistry m
reg (SnapMergingTree (SnapOngoingTreeMerge SnapMergingRun TreeMergeType (Ref (Run m h))
smrs)) = do
      Ref (MergingRun TreeMergeType m h)
mr <- ActionRegistry m
-> m (Ref (MergingRun TreeMergeType m h))
-> (Ref (MergingRun TreeMergeType m h) -> m ())
-> m (Ref (MergingRun TreeMergeType m h))
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> (a -> m ()) -> m a
withRollback ActionRegistry m
reg
               (HasFS m h
-> HasBlockIO m h
-> UniqCounter m
-> ResolveSerialisedValue
-> ActiveDir
-> SnapMergingRun TreeMergeType (Ref (Run m h))
-> m (Ref (MergingRun TreeMergeType m h))
forall (m :: * -> *) t h.
(MonadMask m, MonadMVar m, MonadSTM m, MonadST m, IsMergeType t) =>
HasFS m h
-> HasBlockIO m h
-> UniqCounter m
-> ResolveSerialisedValue
-> ActiveDir
-> SnapMergingRun t (Ref (Run m h))
-> m (Ref (MergingRun t m h))
fromSnapMergingRun HasFS m h
hfs HasBlockIO m h
hbio UniqCounter m
uc ResolveSerialisedValue
resolve ActiveDir
dir SnapMergingRun TreeMergeType (Ref (Run m h))
smrs)
               Ref (MergingRun TreeMergeType m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef
      Ref (MergingTree m h)
mt <- ActionRegistry m
-> m (Ref (MergingTree m h))
-> (Ref (MergingTree m h) -> m ())
-> m (Ref (MergingTree m h))
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> (a -> m ()) -> m a
withRollback ActionRegistry m
reg
              (Ref (MergingRun TreeMergeType m h) -> m (Ref (MergingTree m 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 m h)
mr)
              Ref (MergingTree m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef
      ActionRegistry m -> m () -> m ()
forall (m :: * -> *).
(PrimMonad m, HasCallStack) =>
ActionRegistry m -> m () -> m ()
delayedCommit ActionRegistry m
reg (Ref (MergingRun TreeMergeType m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef Ref (MergingRun TreeMergeType m h)
mr)
      Ref (MergingTree m h) -> m (Ref (MergingTree m h))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Ref (MergingTree m h)
mt

    -- Returns fresh refs, which must be released locally.
    fromSnapPreExistingRun :: ActionRegistry m
                           -> SnapPreExistingRun (Ref (Run m h))
                           -> m (MT.PreExistingRun m h)
    fromSnapPreExistingRun :: ActionRegistry m
-> SnapPreExistingRun (Ref (Run m h)) -> m (PreExistingRun m h)
fromSnapPreExistingRun ActionRegistry m
reg (SnapPreExistingRun Ref (Run m h)
run) =
      Ref (Run m h) -> PreExistingRun m h
forall (m :: * -> *) h. Ref (Run m h) -> PreExistingRun m h
MT.PreExistingRun (Ref (Run m h) -> PreExistingRun m h)
-> m (Ref (Run m h)) -> m (PreExistingRun m h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ActionRegistry m
-> m (Ref (Run m h))
-> (Ref (Run m h) -> m ())
-> m (Ref (Run m h))
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> (a -> m ()) -> m a
withRollback ActionRegistry m
reg (Ref (Run m h) -> m (Ref (Run m h))
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadThrow m, HasCallStack) =>
Ref obj -> m (Ref obj)
dupRef Ref (Run m h)
run) Ref (Run m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef
    fromSnapPreExistingRun ActionRegistry m
reg (SnapPreExistingMergingRun SnapMergingRun LevelMergeType (Ref (Run m h))
smrs) =
      Ref (MergingRun LevelMergeType m h) -> PreExistingRun m h
forall (m :: * -> *) h.
Ref (MergingRun LevelMergeType m h) -> PreExistingRun m h
MT.PreExistingMergingRun (Ref (MergingRun LevelMergeType m h) -> PreExistingRun m h)
-> m (Ref (MergingRun LevelMergeType m h))
-> m (PreExistingRun m h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ActionRegistry m
-> m (Ref (MergingRun LevelMergeType m h))
-> (Ref (MergingRun LevelMergeType m h) -> m ())
-> m (Ref (MergingRun LevelMergeType m h))
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> (a -> m ()) -> m a
withRollback ActionRegistry m
reg
          (HasFS m h
-> HasBlockIO m h
-> UniqCounter m
-> ResolveSerialisedValue
-> ActiveDir
-> SnapMergingRun LevelMergeType (Ref (Run m h))
-> m (Ref (MergingRun LevelMergeType m h))
forall (m :: * -> *) t h.
(MonadMask m, MonadMVar m, MonadSTM m, MonadST m, IsMergeType t) =>
HasFS m h
-> HasBlockIO m h
-> UniqCounter m
-> ResolveSerialisedValue
-> ActiveDir
-> SnapMergingRun t (Ref (Run m h))
-> m (Ref (MergingRun t m h))
fromSnapMergingRun HasFS m h
hfs HasBlockIO m h
hbio UniqCounter m
uc ResolveSerialisedValue
resolve ActiveDir
dir SnapMergingRun LevelMergeType (Ref (Run m h))
smrs)
          Ref (MergingRun LevelMergeType m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef

    releasePER :: PreExistingRun m h -> m ()
releasePER (MT.PreExistingRun         Ref (Run m h)
r) = Ref (Run m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef Ref (Run m h)
r
    releasePER (MT.PreExistingMergingRun Ref (MergingRun LevelMergeType m h)
mr) = Ref (MergingRun LevelMergeType m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef Ref (MergingRun LevelMergeType m h)
mr

{-------------------------------------------------------------------------------
  Conversion to merge tree snapshot format
-------------------------------------------------------------------------------}

{-# SPECIALISE toSnapMergingTree :: Ref (MT.MergingTree IO h) -> IO (SnapMergingTree (Ref (Run IO h))) #-}
toSnapMergingTree ::
     (PrimMonad m, MonadMVar m)
  => Ref (MT.MergingTree m h)
  -> m (SnapMergingTree (Ref (Run m h)))
toSnapMergingTree :: forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
Ref (MergingTree m h) -> m (SnapMergingTree (Ref (Run m h)))
toSnapMergingTree (DeRef (MT.MergingTree StrictMVar m (MergingTreeState m h)
mStateVar RefCounter m
_mCounter)) =
  StrictMVar m (MergingTreeState m h)
-> (MergingTreeState m h -> m (SnapMergingTree (Ref (Run m h))))
-> m (SnapMergingTree (Ref (Run m h)))
forall (m :: * -> *) a b.
MonadMVar m =>
StrictMVar m a -> (a -> m b) -> m b
withMVar StrictMVar m (MergingTreeState m h)
mStateVar ((MergingTreeState m h -> m (SnapMergingTree (Ref (Run m h))))
 -> m (SnapMergingTree (Ref (Run m h))))
-> (MergingTreeState m h -> m (SnapMergingTree (Ref (Run m h))))
-> m (SnapMergingTree (Ref (Run m h)))
forall a b. (a -> b) -> a -> b
$ \MergingTreeState m h
mState -> SnapMergingTreeState (Ref (Run m h))
-> SnapMergingTree (Ref (Run m h))
forall r. SnapMergingTreeState r -> SnapMergingTree r
SnapMergingTree (SnapMergingTreeState (Ref (Run m h))
 -> SnapMergingTree (Ref (Run m h)))
-> m (SnapMergingTreeState (Ref (Run m h)))
-> m (SnapMergingTree (Ref (Run m h)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MergingTreeState m h -> m (SnapMergingTreeState (Ref (Run m h)))
forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
MergingTreeState m h -> m (SnapMergingTreeState (Ref (Run m h)))
toSnapMergingTreeState MergingTreeState m h
mState

{-# SPECIALISE toSnapMergingTreeState :: MT.MergingTreeState IO h -> IO (SnapMergingTreeState (Ref (Run IO h))) #-}
toSnapMergingTreeState ::
     (PrimMonad m, MonadMVar m)
  => MT.MergingTreeState m h
  -> m (SnapMergingTreeState (Ref (Run m h)))
toSnapMergingTreeState :: forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
MergingTreeState m h -> m (SnapMergingTreeState (Ref (Run m h)))
toSnapMergingTreeState (MT.CompletedTreeMerge Ref (Run m h)
r) = SnapMergingTreeState (Ref (Run m h))
-> m (SnapMergingTreeState (Ref (Run m h)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapMergingTreeState (Ref (Run m h))
 -> m (SnapMergingTreeState (Ref (Run m h))))
-> SnapMergingTreeState (Ref (Run m h))
-> m (SnapMergingTreeState (Ref (Run m h)))
forall a b. (a -> b) -> a -> b
$ Ref (Run m h) -> SnapMergingTreeState (Ref (Run m h))
forall r. r -> SnapMergingTreeState r
SnapCompletedTreeMerge Ref (Run m h)
r
toSnapMergingTreeState (MT.PendingTreeMerge PendingMerge m h
p) = SnapPendingMerge (Ref (Run m h))
-> SnapMergingTreeState (Ref (Run m h))
forall r. SnapPendingMerge r -> SnapMergingTreeState r
SnapPendingTreeMerge (SnapPendingMerge (Ref (Run m h))
 -> SnapMergingTreeState (Ref (Run m h)))
-> m (SnapPendingMerge (Ref (Run m h)))
-> m (SnapMergingTreeState (Ref (Run m h)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PendingMerge m h -> m (SnapPendingMerge (Ref (Run m h)))
forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
PendingMerge m h -> m (SnapPendingMerge (Ref (Run m h)))
toSnapPendingMerge PendingMerge m h
p
toSnapMergingTreeState (MT.OngoingTreeMerge Ref (MergingRun TreeMergeType m h)
mergingRun) =
  SnapMergingRun TreeMergeType (Ref (Run m h))
-> SnapMergingTreeState (Ref (Run m h))
forall r. SnapMergingRun TreeMergeType r -> SnapMergingTreeState r
SnapOngoingTreeMerge (SnapMergingRun TreeMergeType (Ref (Run m h))
 -> SnapMergingTreeState (Ref (Run m h)))
-> m (SnapMergingRun TreeMergeType (Ref (Run m h)))
-> m (SnapMergingTreeState (Ref (Run m h)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref (MergingRun TreeMergeType m h)
-> m (SnapMergingRun TreeMergeType (Ref (Run m h)))
forall (m :: * -> *) t h.
(PrimMonad m, MonadMVar m) =>
Ref (MergingRun t m h) -> m (SnapMergingRun t (Ref (Run m h)))
toSnapMergingRun Ref (MergingRun TreeMergeType m h)
mergingRun

{-# SPECIALISE toSnapPendingMerge :: MT.PendingMerge IO h -> IO (SnapPendingMerge (Ref (Run IO h))) #-}
toSnapPendingMerge ::
     (PrimMonad m, MonadMVar m)
  => MT.PendingMerge m h
  -> m (SnapPendingMerge (Ref (Run m h)))
toSnapPendingMerge :: forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
PendingMerge m h -> m (SnapPendingMerge (Ref (Run m h)))
toSnapPendingMerge (MT.PendingUnionMerge Vector (Ref (MergingTree m h))
mts) =
  [SnapMergingTree (Ref (Run m h))]
-> SnapPendingMerge (Ref (Run m h))
forall r. [SnapMergingTree r] -> SnapPendingMerge r
SnapPendingUnionMerge ([SnapMergingTree (Ref (Run m h))]
 -> SnapPendingMerge (Ref (Run m h)))
-> m [SnapMergingTree (Ref (Run m h))]
-> m (SnapPendingMerge (Ref (Run m h)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ref (MergingTree m h) -> m (SnapMergingTree (Ref (Run m h))))
-> [Ref (MergingTree m h)] -> m [SnapMergingTree (Ref (Run m h))]
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 Ref (MergingTree m h) -> m (SnapMergingTree (Ref (Run m h)))
forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
Ref (MergingTree m h) -> m (SnapMergingTree (Ref (Run m h)))
toSnapMergingTree (Vector (Ref (MergingTree m h)) -> [Ref (MergingTree m h)]
forall a. Vector a -> [a]
V.toList Vector (Ref (MergingTree m h))
mts)
toSnapPendingMerge (MT.PendingLevelMerge Vector (PreExistingRun m h)
pes Maybe (Ref (MergingTree m h))
mmt) = do
  Vector (SnapPreExistingRun (Ref (Run m h)))
pes' <- (PreExistingRun m h -> m (SnapPreExistingRun (Ref (Run m h))))
-> Vector (PreExistingRun m h)
-> m (Vector (SnapPreExistingRun (Ref (Run m h))))
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) -> Vector a -> f (Vector b)
traverse PreExistingRun m h -> m (SnapPreExistingRun (Ref (Run m h)))
forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
PreExistingRun m h -> m (SnapPreExistingRun (Ref (Run m h)))
toSnapPreExistingRun Vector (PreExistingRun m h)
pes
  Maybe (SnapMergingTree (Ref (Run m h)))
mmt' <- (Ref (MergingTree m h) -> m (SnapMergingTree (Ref (Run m h))))
-> Maybe (Ref (MergingTree m h))
-> m (Maybe (SnapMergingTree (Ref (Run m h))))
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) -> Maybe a -> f (Maybe b)
traverse Ref (MergingTree m h) -> m (SnapMergingTree (Ref (Run m h)))
forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
Ref (MergingTree m h) -> m (SnapMergingTree (Ref (Run m h)))
toSnapMergingTree Maybe (Ref (MergingTree m h))
mmt
  SnapPendingMerge (Ref (Run m h))
-> m (SnapPendingMerge (Ref (Run m h)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapPendingMerge (Ref (Run m h))
 -> m (SnapPendingMerge (Ref (Run m h))))
-> SnapPendingMerge (Ref (Run m h))
-> m (SnapPendingMerge (Ref (Run m h)))
forall a b. (a -> b) -> a -> b
$ [SnapPreExistingRun (Ref (Run m h))]
-> Maybe (SnapMergingTree (Ref (Run m h)))
-> SnapPendingMerge (Ref (Run m h))
forall r.
[SnapPreExistingRun r]
-> Maybe (SnapMergingTree r) -> SnapPendingMerge r
SnapPendingLevelMerge (Vector (SnapPreExistingRun (Ref (Run m h)))
-> [SnapPreExistingRun (Ref (Run m h))]
forall a. Vector a -> [a]
V.toList Vector (SnapPreExistingRun (Ref (Run m h)))
pes') Maybe (SnapMergingTree (Ref (Run m h)))
mmt'

{-# SPECIALISE toSnapPreExistingRun :: MT.PreExistingRun IO h -> IO (SnapPreExistingRun (Ref (Run IO h))) #-}
toSnapPreExistingRun ::
     (PrimMonad m, MonadMVar m)
  => MT.PreExistingRun m h
  -> m (SnapPreExistingRun (Ref (Run m h)))
toSnapPreExistingRun :: forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
PreExistingRun m h -> m (SnapPreExistingRun (Ref (Run m h)))
toSnapPreExistingRun (MT.PreExistingRun Ref (Run m h)
run) = SnapPreExistingRun (Ref (Run m h))
-> m (SnapPreExistingRun (Ref (Run m h)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapPreExistingRun (Ref (Run m h))
 -> m (SnapPreExistingRun (Ref (Run m h))))
-> SnapPreExistingRun (Ref (Run m h))
-> m (SnapPreExistingRun (Ref (Run m h)))
forall a b. (a -> b) -> a -> b
$ Ref (Run m h) -> SnapPreExistingRun (Ref (Run m h))
forall r. r -> SnapPreExistingRun r
SnapPreExistingRun Ref (Run m h)
run
toSnapPreExistingRun (MT.PreExistingMergingRun Ref (MergingRun LevelMergeType m h)
peMergingRun) =
  SnapMergingRun LevelMergeType (Ref (Run m h))
-> SnapPreExistingRun (Ref (Run m h))
forall r. SnapMergingRun LevelMergeType r -> SnapPreExistingRun r
SnapPreExistingMergingRun (SnapMergingRun LevelMergeType (Ref (Run m h))
 -> SnapPreExistingRun (Ref (Run m h)))
-> m (SnapMergingRun LevelMergeType (Ref (Run m h)))
-> m (SnapPreExistingRun (Ref (Run m h)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref (MergingRun LevelMergeType m h)
-> m (SnapMergingRun LevelMergeType (Ref (Run m h)))
forall (m :: * -> *) t h.
(PrimMonad m, MonadMVar m) =>
Ref (MergingRun t m h) -> m (SnapMergingRun t (Ref (Run m h)))
toSnapMergingRun Ref (MergingRun LevelMergeType m h)
peMergingRun

{-------------------------------------------------------------------------------
  Conversion to levels snapshot format
-------------------------------------------------------------------------------}

--TODO: probably generally all the Ref (Run _) here ought to be fresh
-- references, created as we snapshot the levels, so that the runs don't
-- disappear under our feet during the process of making the snapshot durable.
-- At minimum the volatile runs are the inputs to merging runs, but it may be
-- simpler to duplicate them all, and release them all at the end.

{-# SPECIALISE toSnapLevels :: Levels IO h -> IO (SnapLevels (Ref (Run IO h))) #-}
toSnapLevels ::
     (PrimMonad m, MonadMVar m)
  => Levels m h
  -> m (SnapLevels (Ref (Run m h)))
toSnapLevels :: forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
Levels m h -> m (SnapLevels (Ref (Run m h)))
toSnapLevels Levels m h
levels = Vector (SnapLevel (Ref (Run m h))) -> SnapLevels (Ref (Run m h))
forall r. Vector (SnapLevel r) -> SnapLevels r
SnapLevels (Vector (SnapLevel (Ref (Run m h))) -> SnapLevels (Ref (Run m h)))
-> m (Vector (SnapLevel (Ref (Run m h))))
-> m (SnapLevels (Ref (Run m h)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Level m h -> m (SnapLevel (Ref (Run m h))))
-> Levels m h -> m (Vector (SnapLevel (Ref (Run m h))))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM Level m h -> m (SnapLevel (Ref (Run m h)))
forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
Level m h -> m (SnapLevel (Ref (Run m h)))
toSnapLevel Levels m h
levels

{-# SPECIALISE toSnapLevel :: Level IO h -> IO (SnapLevel (Ref (Run IO h))) #-}
toSnapLevel ::
     (PrimMonad m, MonadMVar m)
  => Level m h
  -> m (SnapLevel (Ref (Run m h)))
toSnapLevel :: forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
Level m h -> m (SnapLevel (Ref (Run m h)))
toSnapLevel Level{Vector (Ref (Run m h))
IncomingRun m h
incomingRun :: IncomingRun m h
residentRuns :: Vector (Ref (Run m h))
incomingRun :: forall (m :: * -> *) h. Level m h -> IncomingRun m h
residentRuns :: forall (m :: * -> *) h. Level m h -> Vector (Ref (Run m h))
..} = do
    SnapIncomingRun (Ref (Run m h))
sir <- IncomingRun m h -> m (SnapIncomingRun (Ref (Run m h)))
forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
IncomingRun m h -> m (SnapIncomingRun (Ref (Run m h)))
toSnapIncomingRun IncomingRun m h
incomingRun
    SnapLevel (Ref (Run m h)) -> m (SnapLevel (Ref (Run m h)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapIncomingRun (Ref (Run m h))
-> Vector (Ref (Run m h)) -> SnapLevel (Ref (Run m h))
forall r. SnapIncomingRun r -> Vector r -> SnapLevel r
SnapLevel SnapIncomingRun (Ref (Run m h))
sir Vector (Ref (Run m h))
residentRuns)

{-# SPECIALISE toSnapIncomingRun :: IncomingRun IO h -> IO (SnapIncomingRun (Ref (Run IO h))) #-}
toSnapIncomingRun ::
     (PrimMonad m, MonadMVar m)
  => IncomingRun m h
  -> m (SnapIncomingRun (Ref (Run m h)))
toSnapIncomingRun :: forall (m :: * -> *) h.
(PrimMonad m, MonadMVar m) =>
IncomingRun m h -> m (SnapIncomingRun (Ref (Run m h)))
toSnapIncomingRun IncomingRun m h
ir = do
    Either
  (Ref (Run m h))
  (MergePolicyForLevel, NominalDebt, NominalCredits,
   Ref (MergingRun LevelMergeType m h))
s <- IncomingRun m h
-> m (Either
        (Ref (Run m h))
        (MergePolicyForLevel, NominalDebt, NominalCredits,
         Ref (MergingRun LevelMergeType m h)))
forall (m :: * -> *) h.
PrimMonad m =>
IncomingRun m h
-> m (Either
        (Ref (Run m h))
        (MergePolicyForLevel, NominalDebt, NominalCredits,
         Ref (MergingRun LevelMergeType m h)))
snapshotIncomingRun IncomingRun m h
ir
    case Either
  (Ref (Run m h))
  (MergePolicyForLevel, NominalDebt, NominalCredits,
   Ref (MergingRun LevelMergeType m h))
s of
      Left Ref (Run m h)
r -> SnapIncomingRun (Ref (Run m h))
-> m (SnapIncomingRun (Ref (Run m h)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapIncomingRun (Ref (Run m h))
 -> m (SnapIncomingRun (Ref (Run m h))))
-> SnapIncomingRun (Ref (Run m h))
-> m (SnapIncomingRun (Ref (Run m h)))
forall a b. (a -> b) -> a -> b
$! Ref (Run m h) -> SnapIncomingRun (Ref (Run m h))
forall r. r -> SnapIncomingRun r
SnapIncomingSingleRun Ref (Run m h)
r
      Right (MergePolicyForLevel
mergePolicy,
             NominalDebt
nominalDebt,
             NominalCredits
nominalCredits,
             Ref (MergingRun LevelMergeType m h)
mergingRun) -> do
        -- We need to know how many credits were supplied so we can restore merge
        -- work on snapshot load.
        SnapMergingRun LevelMergeType (Ref (Run m h))
smrs <- Ref (MergingRun LevelMergeType m h)
-> m (SnapMergingRun LevelMergeType (Ref (Run m h)))
forall (m :: * -> *) t h.
(PrimMonad m, MonadMVar m) =>
Ref (MergingRun t m h) -> m (SnapMergingRun t (Ref (Run m h)))
toSnapMergingRun Ref (MergingRun LevelMergeType m h)
mergingRun
        SnapIncomingRun (Ref (Run m h))
-> m (SnapIncomingRun (Ref (Run m h)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapIncomingRun (Ref (Run m h))
 -> m (SnapIncomingRun (Ref (Run m h))))
-> SnapIncomingRun (Ref (Run m h))
-> m (SnapIncomingRun (Ref (Run m h)))
forall a b. (a -> b) -> a -> b
$! MergePolicyForLevel
-> NominalDebt
-> NominalCredits
-> SnapMergingRun LevelMergeType (Ref (Run m h))
-> SnapIncomingRun (Ref (Run m h))
forall r.
MergePolicyForLevel
-> NominalDebt
-> NominalCredits
-> SnapMergingRun LevelMergeType r
-> SnapIncomingRun r
SnapIncomingMergingRun MergePolicyForLevel
mergePolicy NominalDebt
nominalDebt NominalCredits
nominalCredits SnapMergingRun LevelMergeType (Ref (Run m h))
smrs

{-# SPECIALISE toSnapMergingRun ::
     Ref (MR.MergingRun t IO h)
  -> IO (SnapMergingRun t (Ref (Run IO h))) #-}
toSnapMergingRun ::
     (PrimMonad m, MonadMVar m)
  => Ref (MR.MergingRun t m h)
  -> m (SnapMergingRun t (Ref (Run m h)))
toSnapMergingRun :: forall (m :: * -> *) t h.
(PrimMonad m, MonadMVar m) =>
Ref (MergingRun t m h) -> m (SnapMergingRun t (Ref (Run m h)))
toSnapMergingRun !Ref (MergingRun t m h)
mr = do
    -- TODO: MR.snapshot needs to return duplicated run references, and we
    -- need to arrange to release them when the snapshotting is done.
    ( MergeDebt
mergeDebt, MergeCredits
mergeCredits, MergingRunState t m h
state) <- Ref (MergingRun t m h)
-> m (MergeDebt, MergeCredits, MergingRunState t m h)
forall (m :: * -> *) t h.
(PrimMonad m, MonadMVar m) =>
Ref (MergingRun t m h)
-> m (MergeDebt, MergeCredits, MergingRunState t m h)
MR.snapshot Ref (MergingRun t m h)
mr
    case MergingRunState t m h
state of
      MR.CompletedMerge Ref (Run m h)
r  ->
        SnapMergingRun t (Ref (Run m h))
-> m (SnapMergingRun t (Ref (Run m h)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapMergingRun t (Ref (Run m h))
 -> m (SnapMergingRun t (Ref (Run m h))))
-> SnapMergingRun t (Ref (Run m h))
-> m (SnapMergingRun t (Ref (Run m h)))
forall a b. (a -> b) -> a -> b
$! MergeDebt -> Ref (Run m h) -> SnapMergingRun t (Ref (Run m h))
forall t r. MergeDebt -> r -> SnapMergingRun t r
SnapCompletedMerge MergeDebt
mergeDebt Ref (Run m h)
r

      MR.OngoingMerge Vector (Ref (Run m h))
rs Merge t m h
m ->
          SnapMergingRun t (Ref (Run m h))
-> m (SnapMergingRun t (Ref (Run m h)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SnapMergingRun t (Ref (Run m h))
 -> m (SnapMergingRun t (Ref (Run m h))))
-> SnapMergingRun t (Ref (Run m h))
-> m (SnapMergingRun t (Ref (Run m h)))
forall a b. (a -> b) -> a -> b
$! RunParams
-> MergeCredits
-> Vector (Ref (Run m h))
-> t
-> SnapMergingRun t (Ref (Run m h))
forall t r.
RunParams -> MergeCredits -> Vector r -> t -> SnapMergingRun t r
SnapOngoingMerge RunParams
runParams MergeCredits
mergeCredits Vector (Ref (Run m h))
rs t
mergeType
        where
          runParams :: RunParams
runParams = Merge t m h -> RunParams
forall t (m :: * -> *) h. Merge t m h -> RunParams
Merge.mergeRunParams Merge t m h
m
          mergeType :: t
mergeType = Merge t m h -> t
forall t (m :: * -> *) h. Merge t m h -> t
Merge.mergeType Merge t m h
m

{-------------------------------------------------------------------------------
  Write Buffer
-------------------------------------------------------------------------------}

{-# SPECIALISE
  snapshotWriteBuffer ::
       HasFS IO h
    -> HasBlockIO IO h
    -> UniqCounter IO
    -> UniqCounter IO
    -> ActionRegistry IO
    -> ActiveDir
    -> NamedSnapshotDir
    -> WriteBuffer
    -> Ref (WriteBufferBlobs IO h)
    -> IO WriteBufferFsPaths
  #-}
snapshotWriteBuffer ::
     (MonadMVar m, MonadSTM m, MonadST m, MonadMask m)
  => HasFS m h
  -> HasBlockIO m h
  -> UniqCounter m
  -> UniqCounter m
  -> ActionRegistry m
  -> ActiveDir
  -> NamedSnapshotDir
  -> WriteBuffer
  -> Ref (WriteBufferBlobs m h)
  -> m WriteBufferFsPaths
snapshotWriteBuffer :: forall (m :: * -> *) h.
(MonadMVar m, MonadSTM m, MonadST m, MonadMask m) =>
HasFS m h
-> HasBlockIO m h
-> UniqCounter m
-> UniqCounter m
-> ActionRegistry m
-> ActiveDir
-> NamedSnapshotDir
-> WriteBuffer
-> Ref (WriteBufferBlobs m h)
-> m WriteBufferFsPaths
snapshotWriteBuffer HasFS m h
hfs HasBlockIO m h
hbio UniqCounter m
activeUc UniqCounter m
snapUc ActionRegistry m
reg ActiveDir
activeDir NamedSnapshotDir
snapDir WriteBuffer
wb Ref (WriteBufferBlobs m h)
wbb = do
  -- Write the write buffer and write buffer blobs to the active directory.
  RunNumber
activeWriteBufferNumber <- Unique -> RunNumber
uniqueToRunNumber (Unique -> RunNumber) -> m Unique -> m RunNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UniqCounter m -> m Unique
forall (m :: * -> *). PrimMonad m => UniqCounter m -> m Unique
incrUniqCounter UniqCounter m
activeUc
  let activeWriteBufferPaths :: WriteBufferFsPaths
activeWriteBufferPaths = FsPath -> RunNumber -> WriteBufferFsPaths
WriteBufferFsPaths (ActiveDir -> FsPath
getActiveDir ActiveDir
activeDir) RunNumber
activeWriteBufferNumber
  ActionRegistry m -> m () -> m () -> m ()
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> m () -> m a
withRollback_ ActionRegistry m
reg
    (HasFS m h
-> HasBlockIO m h
-> WriteBufferFsPaths
-> WriteBuffer
-> Ref (WriteBufferBlobs m h)
-> m ()
forall (m :: * -> *) h.
(MonadSTM m, MonadST m, MonadThrow m) =>
HasFS m h
-> HasBlockIO m h
-> WriteBufferFsPaths
-> WriteBuffer
-> Ref (WriteBufferBlobs m h)
-> m ()
WBW.writeWriteBuffer HasFS m h
hfs HasBlockIO m h
hbio WriteBufferFsPaths
activeWriteBufferPaths WriteBuffer
wb Ref (WriteBufferBlobs m h)
wbb)
    -- TODO: it should probably be the responsibility of writeWriteBuffer to do
    -- cleanup
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      -- TODO: check files exist before removing them
      HasFS m h -> HasCallStack => FsPath -> m ()
forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
FS.removeFile HasFS m h
hfs (WriteBufferFsPaths -> FsPath
writeBufferKOpsPath WriteBufferFsPaths
activeWriteBufferPaths)
      HasFS m h -> HasCallStack => FsPath -> m ()
forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
FS.removeFile HasFS m h
hfs (WriteBufferFsPaths -> FsPath
writeBufferBlobPath WriteBufferFsPaths
activeWriteBufferPaths)
  -- Hard link the write buffer and write buffer blobs to the snapshot directory.
  RunNumber
snapWriteBufferNumber <- Unique -> RunNumber
uniqueToRunNumber (Unique -> RunNumber) -> m Unique -> m RunNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UniqCounter m -> m Unique
forall (m :: * -> *). PrimMonad m => UniqCounter m -> m Unique
incrUniqCounter UniqCounter m
snapUc
  let snapWriteBufferPaths :: WriteBufferFsPaths
snapWriteBufferPaths = FsPath -> RunNumber -> WriteBufferFsPaths
WriteBufferFsPaths (NamedSnapshotDir -> FsPath
getNamedSnapshotDir NamedSnapshotDir
snapDir) RunNumber
snapWriteBufferNumber
  HasFS m h
-> HasBlockIO m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h
-> HasBlockIO m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
hardLink HasFS m h
hfs HasBlockIO m h
hbio ActionRegistry m
reg
    (WriteBufferFsPaths -> FsPath
writeBufferKOpsPath WriteBufferFsPaths
activeWriteBufferPaths)
    (WriteBufferFsPaths -> FsPath
writeBufferKOpsPath WriteBufferFsPaths
snapWriteBufferPaths)
  HasFS m h
-> HasBlockIO m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h
-> HasBlockIO m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
hardLink HasFS m h
hfs HasBlockIO m h
hbio ActionRegistry m
reg
    (WriteBufferFsPaths -> FsPath
writeBufferBlobPath WriteBufferFsPaths
activeWriteBufferPaths)
    (WriteBufferFsPaths -> FsPath
writeBufferBlobPath WriteBufferFsPaths
snapWriteBufferPaths)
  HasFS m h
-> HasBlockIO m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h
-> HasBlockIO m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
hardLink HasFS m h
hfs HasBlockIO m h
hbio ActionRegistry m
reg
    (WriteBufferFsPaths -> FsPath
writeBufferChecksumsPath WriteBufferFsPaths
activeWriteBufferPaths)
    (WriteBufferFsPaths -> FsPath
writeBufferChecksumsPath WriteBufferFsPaths
snapWriteBufferPaths)
  WriteBufferFsPaths -> m WriteBufferFsPaths
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WriteBufferFsPaths
snapWriteBufferPaths

{-# SPECIALISE
  openWriteBuffer ::
       ActionRegistry IO
    -> ResolveSerialisedValue
    -> HasFS IO h
    -> HasBlockIO IO h
    -> UniqCounter IO
    -> ActiveDir
    -> WriteBufferFsPaths
    -> IO (WriteBuffer, Ref (WriteBufferBlobs IO h))
  #-}
openWriteBuffer ::
     (MonadMVar m, MonadMask m, MonadSTM m, MonadST m)
  => ActionRegistry m
  -> ResolveSerialisedValue
  -> HasFS m h
  -> HasBlockIO m h
  -> UniqCounter m
  -> ActiveDir
  -> WriteBufferFsPaths
  -> m (WriteBuffer, Ref (WriteBufferBlobs m h))
openWriteBuffer :: forall (m :: * -> *) h.
(MonadMVar m, MonadMask m, MonadSTM m, MonadST m) =>
ActionRegistry m
-> ResolveSerialisedValue
-> HasFS m h
-> HasBlockIO m h
-> UniqCounter m
-> ActiveDir
-> WriteBufferFsPaths
-> m (WriteBuffer, Ref (WriteBufferBlobs m h))
openWriteBuffer ActionRegistry m
reg ResolveSerialisedValue
resolve HasFS m h
hfs HasBlockIO m h
hbio UniqCounter m
uc ActiveDir
activeDir WriteBufferFsPaths
snapWriteBufferPaths = do
  -- Check the checksums
  -- TODO: This reads the blobfile twice: once to check the CRC and once more
  --       to copy it from the snapshot directory to the active directory.
  (ForKOps CRC32C
expectedChecksumForKOps, ForBlob CRC32C
expectedChecksumForBlob) <-
    FsPath
-> FileFormat
-> Either String (ForKOps CRC32C, ForBlob CRC32C)
-> m (ForKOps CRC32C, ForBlob CRC32C)
forall (m :: * -> *) a.
MonadThrow m =>
FsPath -> FileFormat -> Either String a -> m a
CRC.expectValidFile (WriteBufferFsPaths -> FsPath
writeBufferChecksumsPath WriteBufferFsPaths
snapWriteBufferPaths) FileFormat
CRC.FormatWriteBufferFile (Either String (ForKOps CRC32C, ForBlob CRC32C)
 -> m (ForKOps CRC32C, ForBlob CRC32C))
-> (ChecksumsFile
    -> Either String (ForKOps CRC32C, ForBlob CRC32C))
-> ChecksumsFile
-> m (ForKOps CRC32C, ForBlob CRC32C)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChecksumsFile -> Either String (ForKOps CRC32C, ForBlob CRC32C)
fromChecksumsFileForWriteBufferFiles
      (ChecksumsFile -> m (ForKOps CRC32C, ForBlob CRC32C))
-> m ChecksumsFile -> m (ForKOps CRC32C, ForBlob CRC32C)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HasFS m h -> FsPath -> m ChecksumsFile
forall (m :: * -> *) h.
MonadThrow m =>
HasFS m h -> FsPath -> m ChecksumsFile
CRC.readChecksumsFile HasFS m h
hfs (WriteBufferFsPaths -> FsPath
writeBufferChecksumsPath WriteBufferFsPaths
snapWriteBufferPaths)
  HasFS m h -> HasBlockIO m h -> Bool -> CRC32C -> FsPath -> m ()
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h -> HasBlockIO m h -> Bool -> CRC32C -> FsPath -> m ()
checkCRC HasFS m h
hfs HasBlockIO m h
hbio Bool
False (ForKOps CRC32C -> CRC32C
forall a. ForKOps a -> a
unForKOps ForKOps CRC32C
expectedChecksumForKOps) (WriteBufferFsPaths -> FsPath
writeBufferKOpsPath WriteBufferFsPaths
snapWriteBufferPaths)
  HasFS m h -> HasBlockIO m h -> Bool -> CRC32C -> FsPath -> m ()
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h -> HasBlockIO m h -> Bool -> CRC32C -> FsPath -> m ()
checkCRC HasFS m h
hfs HasBlockIO m h
hbio Bool
False (ForBlob CRC32C -> CRC32C
forall a. ForBlob a -> a
unForBlob ForBlob CRC32C
expectedChecksumForBlob) (WriteBufferFsPaths -> FsPath
writeBufferBlobPath WriteBufferFsPaths
snapWriteBufferPaths)
  -- Copy the write buffer blobs file to the active directory and open it.
  Int
activeWriteBufferNumber <- Unique -> Int
uniqueToInt (Unique -> Int) -> m Unique -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UniqCounter m -> m Unique
forall (m :: * -> *). PrimMonad m => UniqCounter m -> m Unique
incrUniqCounter UniqCounter m
uc
  let activeWriteBufferBlobPath :: FsPath
activeWriteBufferBlobPath =
        ActiveDir -> FsPath
getActiveDir ActiveDir
activeDir FsPath -> FsPath -> FsPath
</> [String] -> FsPath
FS.mkFsPath [Int -> String
forall a. Show a => a -> String
show Int
activeWriteBufferNumber] FsPath -> String -> FsPath
<.> String
"wbblobs"
  HasFS m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
copyFile HasFS m h
hfs ActionRegistry m
reg (WriteBufferFsPaths -> FsPath
writeBufferBlobPath WriteBufferFsPaths
snapWriteBufferPaths) FsPath
activeWriteBufferBlobPath
  Ref (WriteBufferBlobs m h)
writeBufferBlobs <-
    ActionRegistry m
-> m (Ref (WriteBufferBlobs m h))
-> (Ref (WriteBufferBlobs m h) -> m ())
-> m (Ref (WriteBufferBlobs m h))
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> (a -> m ()) -> m a
withRollback ActionRegistry m
reg
      (HasFS m h
-> FsPath -> AllowExisting -> m (Ref (WriteBufferBlobs m h))
forall (m :: * -> *) h.
(PrimMonad m, MonadMask m) =>
HasFS m h
-> FsPath -> AllowExisting -> m (Ref (WriteBufferBlobs m h))
WBB.open HasFS m h
hfs FsPath
activeWriteBufferBlobPath AllowExisting
FS.AllowExisting)
      Ref (WriteBufferBlobs m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef
  -- Read write buffer key/ops
  let kOpsPath :: ForKOps FsPath
kOpsPath = FsPath -> ForKOps FsPath
forall a. a -> ForKOps a
ForKOps (WriteBufferFsPaths -> FsPath
writeBufferKOpsPath WriteBufferFsPaths
snapWriteBufferPaths)
  WriteBuffer
writeBuffer <-
    Ref (WriteBufferBlobs m h)
-> (WriteBufferBlobs m h -> m WriteBuffer) -> m WriteBuffer
forall (m :: * -> *) obj a.
(PrimMonad m, MonadThrow m, HasCallStack) =>
Ref obj -> (obj -> m a) -> m a
withRef Ref (WriteBufferBlobs m h)
writeBufferBlobs ((WriteBufferBlobs m h -> m WriteBuffer) -> m WriteBuffer)
-> (WriteBufferBlobs m h -> m WriteBuffer) -> m WriteBuffer
forall a b. (a -> b) -> a -> b
$ \WriteBufferBlobs m h
wbb ->
      ResolveSerialisedValue
-> HasFS m h
-> HasBlockIO m h
-> ForKOps FsPath
-> Ref (BlobFile m h)
-> m WriteBuffer
forall (m :: * -> *) h.
(MonadMVar m, MonadMask m, MonadSTM m, MonadST m) =>
ResolveSerialisedValue
-> HasFS m h
-> HasBlockIO m h
-> ForKOps FsPath
-> Ref (BlobFile m h)
-> m WriteBuffer
WBR.readWriteBuffer ResolveSerialisedValue
resolve HasFS m h
hfs HasBlockIO m h
hbio ForKOps FsPath
kOpsPath (WriteBufferBlobs m h -> Ref (BlobFile m h)
forall (m :: * -> *) h. WriteBufferBlobs m h -> Ref (BlobFile m h)
WBB.blobFile WriteBufferBlobs m h
wbb)
  (WriteBuffer, Ref (WriteBufferBlobs m h))
-> m (WriteBuffer, Ref (WriteBufferBlobs m h))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WriteBuffer
writeBuffer, Ref (WriteBufferBlobs m h)
writeBufferBlobs)

{-------------------------------------------------------------------------------
  Runs
-------------------------------------------------------------------------------}

-- | Information needed to open a 'Run' from disk using 'snapshotRun' and
-- 'openRun'.
--
-- TODO: one could imagine needing only the 'RunNumber' to identify the files
-- on disk, and the other parameters being stored with the run itself, rather
-- than needing to be supplied.
data SnapshotRun = SnapshotRun {
       SnapshotRun -> RunNumber
snapRunNumber  :: !RunNumber,
       SnapshotRun -> RunDataCaching
snapRunCaching :: !Run.RunDataCaching,
       SnapshotRun -> IndexType
snapRunIndex   :: !Run.IndexType
     }
  deriving stock SnapshotRun -> SnapshotRun -> Bool
(SnapshotRun -> SnapshotRun -> Bool)
-> (SnapshotRun -> SnapshotRun -> Bool) -> Eq SnapshotRun
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotRun -> SnapshotRun -> Bool
== :: SnapshotRun -> SnapshotRun -> Bool
$c/= :: SnapshotRun -> SnapshotRun -> Bool
/= :: SnapshotRun -> SnapshotRun -> Bool
Eq

instance NFData SnapshotRun where
  rnf :: SnapshotRun -> ()
rnf (SnapshotRun RunNumber
a RunDataCaching
b IndexType
c) = RunNumber -> ()
forall a. NFData a => a -> ()
rnf RunNumber
a () -> () -> ()
forall a b. a -> b -> b
`seq` RunDataCaching -> ()
forall a. NFData a => a -> ()
rnf RunDataCaching
b () -> () -> ()
forall a b. a -> b -> b
`seq` IndexType -> ()
forall a. NFData a => a -> ()
rnf IndexType
c

{-# SPECIALISE snapshotRun ::
     HasFS IO h
  -> HasBlockIO IO h
  -> UniqCounter IO
  -> ActionRegistry IO
  -> NamedSnapshotDir
  -> Ref (Run IO h)
  -> IO SnapshotRun #-}
-- | @'snapshotRun' _ _ snapUc _ targetDir run@ creates hard links for all files
-- associated with the @run@, and puts the new directory entries in the
-- @targetDir@ directory. The entries are renamed using @snapUc@.
snapshotRun ::
     (MonadMask m, PrimMonad m)
  => HasFS m h
  -> HasBlockIO m h
  -> UniqCounter m
  -> ActionRegistry m
  -> NamedSnapshotDir
  -> Ref (Run m h)
  -> m SnapshotRun
snapshotRun :: forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h
-> HasBlockIO m h
-> UniqCounter m
-> ActionRegistry m
-> NamedSnapshotDir
-> Ref (Run m h)
-> m SnapshotRun
snapshotRun HasFS m h
hfs HasBlockIO m h
hbio UniqCounter m
snapUc ActionRegistry m
reg (NamedSnapshotDir FsPath
targetDir) Ref (Run m h)
run = do
    RunNumber
rn <- Unique -> RunNumber
uniqueToRunNumber (Unique -> RunNumber) -> m Unique -> m RunNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UniqCounter m -> m Unique
forall (m :: * -> *). PrimMonad m => UniqCounter m -> m Unique
incrUniqCounter UniqCounter m
snapUc
    let sourcePaths :: RunFsPaths
sourcePaths = Ref (Run m h) -> RunFsPaths
forall (m :: * -> *) h. Ref (Run m h) -> RunFsPaths
Run.runFsPaths Ref (Run m h)
run
    let targetPaths :: RunFsPaths
targetPaths = RunFsPaths
sourcePaths { runDir = targetDir , runNumber = rn}
    HasFS m h
-> HasBlockIO m h
-> ActionRegistry m
-> RunFsPaths
-> RunFsPaths
-> m ()
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h
-> HasBlockIO m h
-> ActionRegistry m
-> RunFsPaths
-> RunFsPaths
-> m ()
hardLinkRunFiles HasFS m h
hfs HasBlockIO m h
hbio ActionRegistry m
reg RunFsPaths
sourcePaths RunFsPaths
targetPaths
    SnapshotRun -> m SnapshotRun
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SnapshotRun {
           snapRunNumber :: RunNumber
snapRunNumber  = RunFsPaths -> RunNumber
runNumber RunFsPaths
targetPaths,
           snapRunCaching :: RunDataCaching
snapRunCaching = Ref (Run m h) -> RunDataCaching
forall (m :: * -> *) h. Ref (Run m h) -> RunDataCaching
Run.runDataCaching Ref (Run m h)
run,
           snapRunIndex :: IndexType
snapRunIndex   = Ref (Run m h) -> IndexType
forall (m :: * -> *) h. Ref (Run m h) -> IndexType
Run.runIndexType Ref (Run m h)
run
         }

{-# SPECIALISE openRun ::
     HasFS IO h
  -> HasBlockIO IO h
  -> UniqCounter IO
  -> ActionRegistry IO
  -> NamedSnapshotDir
  -> ActiveDir
  -> SnapshotRun
  -> IO (Ref (Run IO h)) #-}
-- | @'openRun' _ _ uniqCounter _ sourceDir targetDir snaprun@ takes all run
-- files that are referenced by @snaprun@, and hard links them from @sourceDir@
-- into @targetDir@ with new, unique names (using @uniqCounter@). Each set of
-- (hard linked) files that represents a run is opened and verified, returning
-- 'Run' as a result.
--
-- The result must ultimately be released using 'releaseRef'.
openRun ::
     (MonadMask m, MonadSTM m, MonadST m)
  => HasFS m h
  -> HasBlockIO m h
  -> UniqCounter m
  -> ActionRegistry m
  -> NamedSnapshotDir
  -> ActiveDir
  -> SnapshotRun
  -> m (Ref (Run m h))
openRun :: forall (m :: * -> *) h.
(MonadMask m, MonadSTM m, MonadST m) =>
HasFS m h
-> HasBlockIO m h
-> UniqCounter m
-> ActionRegistry m
-> NamedSnapshotDir
-> ActiveDir
-> SnapshotRun
-> m (Ref (Run m h))
openRun HasFS m h
hfs HasBlockIO m h
hbio UniqCounter m
uc ActionRegistry m
reg
        (NamedSnapshotDir FsPath
sourceDir) (ActiveDir FsPath
targetDir)
        SnapshotRun {
          snapRunNumber :: SnapshotRun -> RunNumber
snapRunNumber  = RunNumber
runNum,
          snapRunCaching :: SnapshotRun -> RunDataCaching
snapRunCaching = RunDataCaching
caching,
          snapRunIndex :: SnapshotRun -> IndexType
snapRunIndex   = IndexType
indexType
        } = do
    let sourcePaths :: RunFsPaths
sourcePaths = FsPath -> RunNumber -> RunFsPaths
RunFsPaths FsPath
sourceDir RunNumber
runNum
    RunNumber
runNum' <- Unique -> RunNumber
uniqueToRunNumber (Unique -> RunNumber) -> m Unique -> m RunNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UniqCounter m -> m Unique
forall (m :: * -> *). PrimMonad m => UniqCounter m -> m Unique
incrUniqCounter UniqCounter m
uc
    let targetPaths :: RunFsPaths
targetPaths = FsPath -> RunNumber -> RunFsPaths
RunFsPaths FsPath
targetDir RunNumber
runNum'
    HasFS m h
-> HasBlockIO m h
-> ActionRegistry m
-> RunFsPaths
-> RunFsPaths
-> m ()
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h
-> HasBlockIO m h
-> ActionRegistry m
-> RunFsPaths
-> RunFsPaths
-> m ()
hardLinkRunFiles HasFS m h
hfs HasBlockIO m h
hbio ActionRegistry m
reg RunFsPaths
sourcePaths RunFsPaths
targetPaths

    ActionRegistry m
-> m (Ref (Run m h))
-> (Ref (Run m h) -> m ())
-> m (Ref (Run m h))
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> (a -> m ()) -> m a
withRollback ActionRegistry m
reg
      (HasFS m h
-> HasBlockIO m h
-> RunDataCaching
-> IndexType
-> RunFsPaths
-> m (Ref (Run m h))
forall (m :: * -> *) h.
(MonadSTM m, MonadMask m, PrimMonad m) =>
HasFS m h
-> HasBlockIO m h
-> RunDataCaching
-> IndexType
-> RunFsPaths
-> m (Ref (Run m h))
Run.openFromDisk HasFS m h
hfs HasBlockIO m h
hbio RunDataCaching
caching IndexType
indexType RunFsPaths
targetPaths)
      Ref (Run m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef

{-------------------------------------------------------------------------------
  Opening from levels snapshot format
-------------------------------------------------------------------------------}

{-# SPECIALISE fromSnapLevels ::
     HasFS IO h
  -> HasBlockIO IO h
  -> UniqCounter IO
  -> TableConfig
  -> ResolveSerialisedValue
  -> ActionRegistry IO
  -> ActiveDir
  -> SnapLevels (Ref (Run IO h))
  -> IO (Levels IO h)
  #-}
-- | Duplicates runs and re-creates merging runs.
fromSnapLevels ::
     forall m h. (MonadMask m, MonadMVar m, MonadSTM m, MonadST m)
  => HasFS m h
  -> HasBlockIO m h
  -> UniqCounter m
  -> TableConfig
  -> ResolveSerialisedValue
  -> ActionRegistry m
  -> ActiveDir
  -> SnapLevels (Ref (Run m h))
  -> m (Levels m h)
fromSnapLevels :: forall (m :: * -> *) h.
(MonadMask m, MonadMVar m, MonadSTM m, MonadST m) =>
HasFS m h
-> HasBlockIO m h
-> UniqCounter m
-> TableConfig
-> ResolveSerialisedValue
-> ActionRegistry m
-> ActiveDir
-> SnapLevels (Ref (Run m h))
-> m (Levels m h)
fromSnapLevels HasFS m h
hfs HasBlockIO m h
hbio UniqCounter m
uc TableConfig
conf ResolveSerialisedValue
resolve ActionRegistry m
reg ActiveDir
dir (SnapLevels Vector (SnapLevel (Ref (Run m h)))
levels) =
    Vector (SnapLevel (Ref (Run m h)))
-> (Int -> SnapLevel (Ref (Run m h)) -> m (Level m h))
-> m (Vector (Level m h))
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (Int -> a -> m b) -> m (Vector b)
V.iforM Vector (SnapLevel (Ref (Run m h)))
levels ((Int -> SnapLevel (Ref (Run m h)) -> m (Level m h))
 -> m (Vector (Level m h)))
-> (Int -> SnapLevel (Ref (Run m h)) -> m (Level m h))
-> m (Vector (Level m h))
forall a b. (a -> b) -> a -> b
$ \Int
i -> LevelNo -> SnapLevel (Ref (Run m h)) -> m (Level m h)
fromSnapLevel (Int -> LevelNo
LevelNo (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
  where
    -- TODO: we may wish to trace the merges created during snapshot restore:

    fromSnapLevel :: LevelNo -> SnapLevel (Ref (Run m h)) -> m (Level m h)
    fromSnapLevel :: LevelNo -> SnapLevel (Ref (Run m h)) -> m (Level m h)
fromSnapLevel LevelNo
ln SnapLevel{SnapIncomingRun (Ref (Run m h))
snapIncoming :: forall r. SnapLevel r -> SnapIncomingRun r
snapIncoming :: SnapIncomingRun (Ref (Run m h))
snapIncoming, Vector (Ref (Run m h))
snapResidentRuns :: forall r. SnapLevel r -> Vector r
snapResidentRuns :: Vector (Ref (Run m h))
snapResidentRuns} = do
        IncomingRun m h
incomingRun <- ActionRegistry m
-> m (IncomingRun m h)
-> (IncomingRun m h -> m ())
-> m (IncomingRun m h)
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> (a -> m ()) -> m a
withRollback ActionRegistry m
reg
                         (LevelNo -> SnapIncomingRun (Ref (Run m h)) -> m (IncomingRun m h)
fromSnapIncomingRun LevelNo
ln SnapIncomingRun (Ref (Run m h))
snapIncoming)
                         IncomingRun m h -> m ()
forall (m :: * -> *) h.
(PrimMonad m, MonadMask m) =>
IncomingRun m h -> m ()
releaseIncomingRun
        Vector (Ref (Run m h))
residentRuns <- Vector (Ref (Run m h))
-> (Ref (Run m h) -> m (Ref (Run m h)))
-> m (Vector (Ref (Run m h)))
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector (Ref (Run m h))
snapResidentRuns ((Ref (Run m h) -> m (Ref (Run m h)))
 -> m (Vector (Ref (Run m h))))
-> (Ref (Run m h) -> m (Ref (Run m h)))
-> m (Vector (Ref (Run m h)))
forall a b. (a -> b) -> a -> b
$ \Ref (Run m h)
r ->
                          ActionRegistry m
-> m (Ref (Run m h))
-> (Ref (Run m h) -> m ())
-> m (Ref (Run m h))
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> (a -> m ()) -> m a
withRollback ActionRegistry m
reg
                            (Ref (Run m h) -> m (Ref (Run m h))
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadThrow m, HasCallStack) =>
Ref obj -> m (Ref obj)
dupRef Ref (Run m h)
r)
                            Ref (Run m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef
        Level m h -> m (Level m h)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Level {IncomingRun m h
incomingRun :: IncomingRun m h
incomingRun :: IncomingRun m h
incomingRun , Vector (Ref (Run m h))
residentRuns :: Vector (Ref (Run m h))
residentRuns :: Vector (Ref (Run m h))
residentRuns}

    fromSnapIncomingRun ::
         LevelNo
      -> SnapIncomingRun (Ref (Run m h))
      -> m (IncomingRun m h)
    fromSnapIncomingRun :: LevelNo -> SnapIncomingRun (Ref (Run m h)) -> m (IncomingRun m h)
fromSnapIncomingRun LevelNo
_ln (SnapIncomingSingleRun Ref (Run m h)
run) =
        Ref (Run m h) -> m (IncomingRun m h)
forall (m :: * -> *) h.
(PrimMonad m, MonadThrow m) =>
Ref (Run m h) -> m (IncomingRun m h)
newIncomingSingleRun Ref (Run m h)
run

    fromSnapIncomingRun LevelNo
ln (SnapIncomingMergingRun MergePolicyForLevel
mergePolicy NominalDebt
nominalDebt
                                                   NominalCredits
nominalCredits SnapMergingRun LevelMergeType (Ref (Run m h))
smrs) =
      m (Ref (MergingRun LevelMergeType m h))
-> (Ref (MergingRun LevelMergeType m h) -> m ())
-> (Ref (MergingRun LevelMergeType m h) -> m (IncomingRun m h))
-> m (IncomingRun m h)
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
        (HasFS m h
-> HasBlockIO m h
-> UniqCounter m
-> ResolveSerialisedValue
-> ActiveDir
-> SnapMergingRun LevelMergeType (Ref (Run m h))
-> m (Ref (MergingRun LevelMergeType m h))
forall (m :: * -> *) t h.
(MonadMask m, MonadMVar m, MonadSTM m, MonadST m, IsMergeType t) =>
HasFS m h
-> HasBlockIO m h
-> UniqCounter m
-> ResolveSerialisedValue
-> ActiveDir
-> SnapMergingRun t (Ref (Run m h))
-> m (Ref (MergingRun t m h))
fromSnapMergingRun HasFS m h
hfs HasBlockIO m h
hbio UniqCounter m
uc ResolveSerialisedValue
resolve ActiveDir
dir SnapMergingRun LevelMergeType (Ref (Run m h))
smrs)
        Ref (MergingRun LevelMergeType m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef ((Ref (MergingRun LevelMergeType m h) -> m (IncomingRun m h))
 -> m (IncomingRun m h))
-> (Ref (MergingRun LevelMergeType m h) -> m (IncomingRun m h))
-> m (IncomingRun m h)
forall a b. (a -> b) -> a -> b
$ \Ref (MergingRun LevelMergeType m h)
mr -> do

        IncomingRun m h
ir <- MergePolicyForLevel
-> NominalDebt
-> Ref (MergingRun LevelMergeType m h)
-> m (IncomingRun m h)
forall (m :: * -> *) h.
(PrimMonad m, MonadThrow m) =>
MergePolicyForLevel
-> NominalDebt
-> Ref (MergingRun LevelMergeType m h)
-> m (IncomingRun m h)
newIncomingMergingRun MergePolicyForLevel
mergePolicy NominalDebt
nominalDebt Ref (MergingRun LevelMergeType m h)
mr
        -- This will set the correct nominal credits, but it will not do any
        -- more merging work because fromSnapMergingRun already supplies
        -- all the merging credits already.
        TableConfig -> LevelNo -> IncomingRun m h -> NominalCredits -> m ()
forall (m :: * -> *) h.
(MonadSTM m, MonadST m, MonadMVar m, MonadMask m) =>
TableConfig -> LevelNo -> IncomingRun m h -> NominalCredits -> m ()
supplyCreditsIncomingRun TableConfig
conf LevelNo
ln IncomingRun m h
ir NominalCredits
nominalCredits
        IncomingRun m h -> m (IncomingRun m h)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return IncomingRun m h
ir

{-# SPECIALISE fromSnapMergingRun ::
     MR.IsMergeType t
  => HasFS IO h
  -> HasBlockIO IO h
  -> UniqCounter IO
  -> ResolveSerialisedValue
  -> ActiveDir
  -> SnapMergingRun t (Ref (Run IO h))
  -> IO (Ref (MR.MergingRun t IO h)) #-}
fromSnapMergingRun ::
     (MonadMask m, MonadMVar m, MonadSTM m, MonadST m, MR.IsMergeType t)
  => HasFS m h
  -> HasBlockIO m h
  -> UniqCounter m
  -> ResolveSerialisedValue
  -> ActiveDir
  -> SnapMergingRun t (Ref (Run m h))
  -> m (Ref (MR.MergingRun t m h))
fromSnapMergingRun :: forall (m :: * -> *) t h.
(MonadMask m, MonadMVar m, MonadSTM m, MonadST m, IsMergeType t) =>
HasFS m h
-> HasBlockIO m h
-> UniqCounter m
-> ResolveSerialisedValue
-> ActiveDir
-> SnapMergingRun t (Ref (Run m h))
-> m (Ref (MergingRun t m h))
fromSnapMergingRun HasFS m h
_ HasBlockIO m h
_ UniqCounter m
_ ResolveSerialisedValue
_ ActiveDir
_ (SnapCompletedMerge MergeDebt
mergeDebt Ref (Run m h)
r) =
    MergeDebt -> Ref (Run m h) -> m (Ref (MergingRun t m 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
mergeDebt Ref (Run m h)
r

fromSnapMergingRun HasFS m h
hfs HasBlockIO m h
hbio UniqCounter m
uc ResolveSerialisedValue
resolve ActiveDir
dir
                   (SnapOngoingMerge RunParams
runParams MergeCredits
mergeCredits Vector (Ref (Run m h))
rs t
mergeType) = do
    m (Ref (MergingRun t m h))
-> (Ref (MergingRun t m h) -> m ())
-> (Ref (MergingRun t m h) -> m (Ref (MergingRun t m h)))
-> m (Ref (MergingRun t m h))
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError
      (do Unique
uniq <- UniqCounter m -> m Unique
forall (m :: * -> *). PrimMonad m => UniqCounter m -> m Unique
incrUniqCounter UniqCounter m
uc
          let runPaths :: RunFsPaths
runPaths = ActiveDir -> RunNumber -> RunFsPaths
runPath ActiveDir
dir (Unique -> RunNumber
uniqueToRunNumber Unique
uniq)
          HasFS m h
-> HasBlockIO m h
-> ResolveSerialisedValue
-> RunParams
-> t
-> RunFsPaths
-> Vector (Ref (Run m h))
-> m (Ref (MergingRun t m 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 m h
hfs HasBlockIO m h
hbio ResolveSerialisedValue
resolve RunParams
runParams t
mergeType RunFsPaths
runPaths Vector (Ref (Run m h))
rs)
      Ref (MergingRun t m h) -> m ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef ((Ref (MergingRun t m h) -> m (Ref (MergingRun t m h)))
 -> m (Ref (MergingRun t m h)))
-> (Ref (MergingRun t m h) -> m (Ref (MergingRun t m h)))
-> m (Ref (MergingRun t m h))
forall a b. (a -> b) -> a -> b
$ \Ref (MergingRun t m h)
mr -> do
        -- When a snapshot is created, merge progress is lost, so we have to
        -- redo merging work here. The MergeCredits in SnapMergingRun tracks
        -- how many credits were supplied before the snapshot was taken.

        --TODO: the threshold should be stored with the MergingRun
        -- here we want to supply the credits now, so we can use a threshold of 1
        let thresh :: CreditThreshold
thresh = UnspentCredits -> CreditThreshold
MR.CreditThreshold (MergeCredits -> UnspentCredits
MR.UnspentCredits MergeCredits
1)
        (MergeCredits, MergeCredits)
_ <- Ref (MergingRun t m h)
-> CreditThreshold
-> MergeCredits
-> m (MergeCredits, MergeCredits)
forall t (m :: * -> *) h.
(MonadSTM m, MonadST m, MonadMVar m, MonadMask m) =>
Ref (MergingRun t m h)
-> CreditThreshold
-> MergeCredits
-> m (MergeCredits, MergeCredits)
MR.supplyCreditsAbsolute Ref (MergingRun t m h)
mr CreditThreshold
thresh MergeCredits
mergeCredits
        Ref (MergingRun t m h) -> m (Ref (MergingRun t m h))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Ref (MergingRun t m h)
mr

{-------------------------------------------------------------------------------
  Hard links
-------------------------------------------------------------------------------}

{-# SPECIALISE hardLinkRunFiles ::
     HasFS IO h
  -> HasBlockIO IO h
  -> ActionRegistry IO
  -> RunFsPaths
  -> RunFsPaths
  -> IO () #-}
-- | @'hardLinkRunFiles' _ _ _ sourcePaths targetPaths@ creates a hard link for
-- each @sourcePaths@ path using the corresponding @targetPaths@ path as the
-- name for the new directory entry.
hardLinkRunFiles ::
     (MonadMask m, PrimMonad m)
  => HasFS m h
  -> HasBlockIO m h
  -> ActionRegistry m
  -> RunFsPaths
  -> RunFsPaths
  -> m ()
hardLinkRunFiles :: forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h
-> HasBlockIO m h
-> ActionRegistry m
-> RunFsPaths
-> RunFsPaths
-> m ()
hardLinkRunFiles HasFS m h
hfs HasBlockIO m h
hbio ActionRegistry m
reg RunFsPaths
sourceRunFsPaths RunFsPaths
targetRunFsPaths = do
    let sourcePaths :: ForRunFiles FsPath
sourcePaths = RunFsPaths -> ForRunFiles FsPath
pathsForRunFiles RunFsPaths
sourceRunFsPaths
        targetPaths :: ForRunFiles FsPath
targetPaths = RunFsPaths -> ForRunFiles FsPath
pathsForRunFiles RunFsPaths
targetRunFsPaths
    ForRunFiles (m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ (HasFS m h
-> HasBlockIO m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h
-> HasBlockIO m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
hardLink HasFS m h
hfs HasBlockIO m h
hbio ActionRegistry m
reg (FsPath -> FsPath -> m ())
-> ForRunFiles FsPath -> ForRunFiles (FsPath -> m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ForRunFiles FsPath
sourcePaths ForRunFiles (FsPath -> m ())
-> ForRunFiles FsPath -> ForRunFiles (m ())
forall a b. ForRunFiles (a -> b) -> ForRunFiles a -> ForRunFiles b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ForRunFiles FsPath
targetPaths)
    HasFS m h
-> HasBlockIO m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h
-> HasBlockIO m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
hardLink HasFS m h
hfs HasBlockIO m h
hbio ActionRegistry m
reg (RunFsPaths -> FsPath
runChecksumsPath RunFsPaths
sourceRunFsPaths) (RunFsPaths -> FsPath
runChecksumsPath RunFsPaths
targetRunFsPaths)

{-# SPECIALISE
  hardLink ::
       HasFS IO h
    -> HasBlockIO IO h
    -> ActionRegistry IO
    -> FS.FsPath
    -> FS.FsPath
    -> IO ()
  #-}
-- | @'hardLink' hfs hbio reg sourcePath targetPath@ creates a hard link from
-- @sourcePath@ to @targetPath@.
hardLink ::
     (MonadMask m, PrimMonad m)
  => HasFS m h
  -> HasBlockIO m h
  -> ActionRegistry m
  -> FS.FsPath
  -> FS.FsPath
  -> m ()
hardLink :: forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h
-> HasBlockIO m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
hardLink HasFS m h
hfs HasBlockIO m h
hbio ActionRegistry m
reg FsPath
sourcePath FsPath
targetPath = do
    ActionRegistry m -> m () -> m () -> m ()
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> m () -> m a
withRollback_ ActionRegistry m
reg
      (HasBlockIO m h -> FsPath -> FsPath -> m ()
forall (m :: * -> *) h. HasBlockIO m h -> FsPath -> FsPath -> m ()
FS.createHardLink HasBlockIO m h
hbio FsPath
sourcePath FsPath
targetPath)
      (HasFS m h -> HasCallStack => FsPath -> m ()
forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
FS.removeFile HasFS m h
hfs FsPath
targetPath)

{-------------------------------------------------------------------------------
  Copy file
-------------------------------------------------------------------------------}

{-# SPECIALISE
  copyFile ::
       HasFS IO h
    -> ActionRegistry IO
    -> FS.FsPath
    -> FS.FsPath
    -> IO ()
  #-}
-- | @'copyFile' hfs reg source target@ copies the @source@ path to the @target@ path.
copyFile ::
     (MonadMask m, PrimMonad m)
  => HasFS m h
  -> ActionRegistry m
  -> FS.FsPath
  -> FS.FsPath
  -> m ()
copyFile :: forall (m :: * -> *) h.
(MonadMask m, PrimMonad m) =>
HasFS m h -> ActionRegistry m -> FsPath -> FsPath -> m ()
copyFile HasFS m h
hfs ActionRegistry m
reg FsPath
sourcePath FsPath
targetPath =
    (m () -> m () -> m ()) -> m () -> m () -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ActionRegistry m -> m () -> m () -> m ()
forall (m :: * -> *) a.
(PrimMonad m, MonadMask m, HasCallStack) =>
ActionRegistry m -> m a -> m () -> m a
withRollback_ ActionRegistry m
reg) (HasFS m h -> HasCallStack => FsPath -> m ()
forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
FS.removeFile HasFS m h
hfs FsPath
targetPath) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      HasFS m h -> FsPath -> OpenMode -> (Handle h -> m ()) -> m ()
forall (m :: * -> *) h a.
(HasCallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
FS.withFile HasFS m h
hfs FsPath
sourcePath OpenMode
FS.ReadMode ((Handle h -> m ()) -> m ()) -> (Handle h -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Handle h
sourceHandle ->
        HasFS m h -> FsPath -> OpenMode -> (Handle h -> m ()) -> m ()
forall (m :: * -> *) h a.
(HasCallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
FS.withFile HasFS m h
hfs FsPath
targetPath (AllowExisting -> OpenMode
FS.WriteMode AllowExisting
FS.MustBeNew) ((Handle h -> m ()) -> m ()) -> (Handle h -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Handle h
targetHandle -> do
          ByteString
bs <- HasFS m h -> Handle h -> m ByteString
forall (m :: * -> *) h.
Monad m =>
HasFS m h -> Handle h -> m ByteString
FSL.hGetAll HasFS m h
hfs Handle h
sourceHandle
          m Word64 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Word64 -> m ()) -> m Word64 -> m ()
forall a b. (a -> b) -> a -> b
$ HasFS m h -> Handle h -> ByteString -> m Word64
forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> Handle h -> ByteString -> m Word64
FSL.hPutAll HasFS m h
hfs Handle h
targetHandle ByteString
bs