{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_HADDOCK not-home #-}

-- Definitions for override table config options.
module Database.LSMTree.Internal.Config.Override (
    -- $override-policy

    -- * Override disk cache policy
    OverrideDiskCachePolicy (..)
  , overrideDiskCachePolicy
  ) where

import qualified Data.Vector as V
import           Database.LSMTree.Internal.Config
import           Database.LSMTree.Internal.MergeSchedule (MergePolicyForLevel,
                     NominalCredits, NominalDebt)
import           Database.LSMTree.Internal.MergingRun (LevelMergeType,
                     MergeCredits, MergeDebt, TreeMergeType)
import           Database.LSMTree.Internal.Run
import           Database.LSMTree.Internal.RunAcc (RunBloomFilterAlloc)
import           Database.LSMTree.Internal.RunNumber (RunNumber)
import           Database.LSMTree.Internal.Snapshot

-- $override-policy
--
-- === Limitations
--
-- Overriding config options should in many cases be possible as long as there
-- is a mitigation strategy to ensure that a change in options does not cause
-- the database state of a table to become inconsistent. But what does this
-- strategy look like? And if we allow a config option to be overridden on a
-- live table (one that a user has access to), how should we apply these new
-- options to shared data like merging runs? Moreover, would we answer these
-- questions differently for each type of config option?
--
-- For now, it seems to be the most straightforward to limit the config options
-- we allow to be overridden, and that we only change the config options
-- offline. That is, we override the config option just before opening a
-- snapshot from disk. At that point, there is no sharing because the table is
-- not live yet, which simplifies how changing a config option is handled.
--
-- Another complicating factor is that we have thought about the possibility of
-- restoring sharing of ongoing merges between live tables and newly opened
-- snapshots. At that point, we run into the same challenges again... But for
-- now, changing only the disk cache policy offline should work fine.

{-------------------------------------------------------------------------------
  Override disk cache policy
-------------------------------------------------------------------------------}

{- |
The 'OverrideDiskCachePolicy' can be used to override the 'DiskCachePolicy'
when opening a table from a snapshot.
-}
data OverrideDiskCachePolicy =
    NoOverrideDiskCachePolicy
  | OverrideDiskCachePolicy DiskCachePolicy
  deriving stock (Int -> OverrideDiskCachePolicy -> ShowS
[OverrideDiskCachePolicy] -> ShowS
OverrideDiskCachePolicy -> String
(Int -> OverrideDiskCachePolicy -> ShowS)
-> (OverrideDiskCachePolicy -> String)
-> ([OverrideDiskCachePolicy] -> ShowS)
-> Show OverrideDiskCachePolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OverrideDiskCachePolicy -> ShowS
showsPrec :: Int -> OverrideDiskCachePolicy -> ShowS
$cshow :: OverrideDiskCachePolicy -> String
show :: OverrideDiskCachePolicy -> String
$cshowList :: [OverrideDiskCachePolicy] -> ShowS
showList :: [OverrideDiskCachePolicy] -> ShowS
Show, OverrideDiskCachePolicy -> OverrideDiskCachePolicy -> Bool
(OverrideDiskCachePolicy -> OverrideDiskCachePolicy -> Bool)
-> (OverrideDiskCachePolicy -> OverrideDiskCachePolicy -> Bool)
-> Eq OverrideDiskCachePolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OverrideDiskCachePolicy -> OverrideDiskCachePolicy -> Bool
== :: OverrideDiskCachePolicy -> OverrideDiskCachePolicy -> Bool
$c/= :: OverrideDiskCachePolicy -> OverrideDiskCachePolicy -> Bool
/= :: OverrideDiskCachePolicy -> OverrideDiskCachePolicy -> Bool
Eq)

-- | Override the disk cache policy that is stored in snapshot metadata.
--
-- Tables opened from the new 'SnapshotMetaData' will use the new value for the
-- disk cache policy.
overrideDiskCachePolicy :: OverrideDiskCachePolicy -> SnapshotMetaData -> SnapshotMetaData
overrideDiskCachePolicy :: OverrideDiskCachePolicy -> SnapshotMetaData -> SnapshotMetaData
overrideDiskCachePolicy (OverrideDiskCachePolicy DiskCachePolicy
dcp) = DiskCachePolicy -> SnapshotMetaData -> SnapshotMetaData
forall o a. Override o a => o -> a -> a
override DiskCachePolicy
dcp
overrideDiskCachePolicy OverrideDiskCachePolicy
NoOverrideDiskCachePolicy     = SnapshotMetaData -> SnapshotMetaData
forall a. a -> a
id

-- | This class is only here so that we can recursively call 'override' on all
-- fields of a datatype, instead of having to invent a new name for each type
-- that the function is called on such as 'overrideTableConfig',
-- 'overrideSnapshotRun', etc.
class Override o a where
  override :: o -> a -> a

-- NOTE: the instances below explicitly pattern match on the types of
-- constructor fields. This makes the code more verbose, but it also makes the
-- code a little more future proof. It should help us not to forget to update
-- the instances when new fields are added or existing fields change. In
-- particular, if anything changes about the constructor or its fields (and
-- their types), then we will see a compiler error, and then we are forced to
-- look at the code and make adjustments.

instance Override DiskCachePolicy SnapshotMetaData where
  override :: DiskCachePolicy -> SnapshotMetaData -> SnapshotMetaData
override DiskCachePolicy
dcp
    (SnapshotMetaData (SnapshotLabel
sl :: SnapshotLabel)
      (TableConfig
tc :: TableConfig) (RunNumber
rn :: RunNumber)
      (SnapLevels SnapshotRun
sls :: (SnapLevels SnapshotRun))
      (Maybe (SnapMergingTree SnapshotRun)
smt :: (Maybe (SnapMergingTree SnapshotRun))))
    = SnapshotLabel
-> TableConfig
-> RunNumber
-> SnapLevels SnapshotRun
-> Maybe (SnapMergingTree SnapshotRun)
-> SnapshotMetaData
SnapshotMetaData SnapshotLabel
sl (DiskCachePolicy -> TableConfig -> TableConfig
forall o a. Override o a => o -> a -> a
override DiskCachePolicy
dcp TableConfig
tc) RunNumber
rn (DiskCachePolicy -> SnapLevels SnapshotRun -> SnapLevels SnapshotRun
forall o a. Override o a => o -> a -> a
override DiskCachePolicy
dcp SnapLevels SnapshotRun
sls) (Maybe (SnapMergingTree SnapshotRun) -> SnapshotMetaData)
-> Maybe (SnapMergingTree SnapshotRun) -> SnapshotMetaData
forall a b. (a -> b) -> a -> b
$
        let rdc :: RunDataCaching
rdc = DiskCachePolicy -> RunLevelNo -> RunDataCaching
diskCachePolicyForLevel DiskCachePolicy
dcp RunLevelNo
UnionLevel
        in  (SnapMergingTree SnapshotRun -> SnapMergingTree SnapshotRun)
-> Maybe (SnapMergingTree SnapshotRun)
-> Maybe (SnapMergingTree SnapshotRun)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RunDataCaching
-> SnapMergingTree SnapshotRun -> SnapMergingTree SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc) Maybe (SnapMergingTree SnapshotRun)
smt

instance Override DiskCachePolicy TableConfig where
  override :: DiskCachePolicy -> TableConfig -> TableConfig
override DiskCachePolicy
confDiskCachePolicy' TableConfig {DiskCachePolicy
FencePointerIndexType
BloomFilterAlloc
MergeSchedule
WriteBufferAlloc
SizeRatio
MergePolicy
confMergePolicy :: MergePolicy
confMergeSchedule :: MergeSchedule
confSizeRatio :: SizeRatio
confWriteBufferAlloc :: WriteBufferAlloc
confBloomFilterAlloc :: BloomFilterAlloc
confFencePointerIndex :: FencePointerIndexType
confDiskCachePolicy :: DiskCachePolicy
confMergePolicy :: TableConfig -> MergePolicy
confMergeSchedule :: TableConfig -> MergeSchedule
confSizeRatio :: TableConfig -> SizeRatio
confWriteBufferAlloc :: TableConfig -> WriteBufferAlloc
confBloomFilterAlloc :: TableConfig -> BloomFilterAlloc
confFencePointerIndex :: TableConfig -> FencePointerIndexType
confDiskCachePolicy :: TableConfig -> DiskCachePolicy
..}
    = TableConfig
        { MergePolicy
confMergePolicy :: MergePolicy
confMergePolicy :: MergePolicy
confMergePolicy,
          MergeSchedule
confMergeSchedule :: MergeSchedule
confMergeSchedule :: MergeSchedule
confMergeSchedule,
          SizeRatio
confSizeRatio :: SizeRatio
confSizeRatio :: SizeRatio
confSizeRatio,
          WriteBufferAlloc
confWriteBufferAlloc :: WriteBufferAlloc
confWriteBufferAlloc :: WriteBufferAlloc
confWriteBufferAlloc,
          BloomFilterAlloc
confBloomFilterAlloc :: BloomFilterAlloc
confBloomFilterAlloc :: BloomFilterAlloc
confBloomFilterAlloc,
          FencePointerIndexType
confFencePointerIndex :: FencePointerIndexType
confFencePointerIndex :: FencePointerIndexType
confFencePointerIndex,
          confDiskCachePolicy :: DiskCachePolicy
confDiskCachePolicy = DiskCachePolicy
confDiskCachePolicy'
        }

instance Override DiskCachePolicy (SnapLevels SnapshotRun) where
  override :: DiskCachePolicy -> SnapLevels SnapshotRun -> SnapLevels SnapshotRun
override DiskCachePolicy
dcp (SnapLevels (Vector (SnapLevel SnapshotRun)
vec :: V.Vector (SnapLevel SnapshotRun))) =
      Vector (SnapLevel SnapshotRun) -> SnapLevels SnapshotRun
forall r. Vector (SnapLevel r) -> SnapLevels r
SnapLevels (Vector (SnapLevel SnapshotRun) -> SnapLevels SnapshotRun)
-> Vector (SnapLevel SnapshotRun) -> SnapLevels SnapshotRun
forall a b. (a -> b) -> a -> b
$ (Int -> SnapLevel SnapshotRun -> SnapLevel SnapshotRun)
-> Vector (SnapLevel SnapshotRun) -> Vector (SnapLevel SnapshotRun)
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap Int -> SnapLevel SnapshotRun -> SnapLevel SnapshotRun
go Vector (SnapLevel SnapshotRun)
vec
    where
      go :: Int -> SnapLevel SnapshotRun -> SnapLevel SnapshotRun
go (Int -> LevelNo
LevelNo (Int -> LevelNo) -> (Int -> Int) -> Int -> LevelNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) -> LevelNo
ln) (SnapLevel SnapshotRun
x :: SnapLevel SnapshotRun) =
          let rdc :: RunDataCaching
rdc = DiskCachePolicy -> RunLevelNo -> RunDataCaching
diskCachePolicyForLevel DiskCachePolicy
dcp (LevelNo -> RunLevelNo
RegularLevel LevelNo
ln)
          in  RunDataCaching -> SnapLevel SnapshotRun -> SnapLevel SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc SnapLevel SnapshotRun
x

instance Override RunDataCaching (SnapLevel SnapshotRun) where
  override :: RunDataCaching -> SnapLevel SnapshotRun -> SnapLevel SnapshotRun
override RunDataCaching
rdc
    (SnapLevel (SnapIncomingRun SnapshotRun
sir :: SnapIncomingRun SnapshotRun) (Vector SnapshotRun
srs :: V.Vector SnapshotRun))
    = SnapIncomingRun SnapshotRun
-> Vector SnapshotRun -> SnapLevel SnapshotRun
forall r. SnapIncomingRun r -> Vector r -> SnapLevel r
SnapLevel (RunDataCaching
-> SnapIncomingRun SnapshotRun -> SnapIncomingRun SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc SnapIncomingRun SnapshotRun
sir) ((SnapshotRun -> SnapshotRun)
-> Vector SnapshotRun -> Vector SnapshotRun
forall a b. (a -> b) -> Vector a -> Vector b
V.map (RunDataCaching -> SnapshotRun -> SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc) Vector SnapshotRun
srs)

instance Override RunDataCaching (SnapIncomingRun SnapshotRun) where
  override :: RunDataCaching
-> SnapIncomingRun SnapshotRun -> SnapIncomingRun SnapshotRun
override RunDataCaching
rdc = \case
      SnapIncomingSingleRun (SnapshotRun
sr :: SnapshotRun) ->
        SnapshotRun -> SnapIncomingRun SnapshotRun
forall r. r -> SnapIncomingRun r
SnapIncomingSingleRun (SnapshotRun -> SnapIncomingRun SnapshotRun)
-> SnapshotRun -> SnapIncomingRun SnapshotRun
forall a b. (a -> b) -> a -> b
$ RunDataCaching -> SnapshotRun -> SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc SnapshotRun
sr
      SnapIncomingMergingRun
        (MergePolicyForLevel
mpfl :: MergePolicyForLevel) (NominalDebt
nd :: NominalDebt)
        (NominalCredits
nc :: NominalCredits) (SnapMergingRun LevelMergeType SnapshotRun
smr :: SnapMergingRun LevelMergeType SnapshotRun) ->
          MergePolicyForLevel
-> NominalDebt
-> NominalCredits
-> SnapMergingRun LevelMergeType SnapshotRun
-> SnapIncomingRun SnapshotRun
forall r.
MergePolicyForLevel
-> NominalDebt
-> NominalCredits
-> SnapMergingRun LevelMergeType r
-> SnapIncomingRun r
SnapIncomingMergingRun MergePolicyForLevel
mpfl NominalDebt
nd NominalCredits
nc (RunDataCaching
-> SnapMergingRun LevelMergeType SnapshotRun
-> SnapMergingRun LevelMergeType SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc SnapMergingRun LevelMergeType SnapshotRun
smr)

instance Override RunDataCaching (SnapMergingRun t SnapshotRun) where
  override :: RunDataCaching
-> SnapMergingRun t SnapshotRun -> SnapMergingRun t SnapshotRun
override RunDataCaching
rdc = \case
      SnapCompletedMerge (MergeDebt
md :: MergeDebt) (SnapshotRun
sr :: SnapshotRun) ->
        MergeDebt -> SnapshotRun -> SnapMergingRun t SnapshotRun
forall t r. MergeDebt -> r -> SnapMergingRun t r
SnapCompletedMerge MergeDebt
md (RunDataCaching -> SnapshotRun -> SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc SnapshotRun
sr)
      SnapOngoingMerge
        (RunParams
rp :: RunParams) (MergeCredits
mc :: MergeCredits)
        (Vector SnapshotRun
srs :: V.Vector SnapshotRun) (t
t :: t) ->
          RunParams
-> MergeCredits
-> Vector SnapshotRun
-> t
-> SnapMergingRun t SnapshotRun
forall t r.
RunParams -> MergeCredits -> Vector r -> t -> SnapMergingRun t r
SnapOngoingMerge (RunDataCaching -> RunParams -> RunParams
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc RunParams
rp) MergeCredits
mc ((SnapshotRun -> SnapshotRun)
-> Vector SnapshotRun -> Vector SnapshotRun
forall a b. (a -> b) -> Vector a -> Vector b
V.map (RunDataCaching -> SnapshotRun -> SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc) Vector SnapshotRun
srs) t
t

instance Override RunDataCaching RunParams where
  override :: RunDataCaching -> RunParams -> RunParams
override RunDataCaching
rdc
    (RunParams (RunDataCaching
_rdc :: RunDataCaching) (RunBloomFilterAlloc
rbfa :: RunBloomFilterAlloc) (IndexType
it :: IndexType))
    = RunDataCaching -> RunBloomFilterAlloc -> IndexType -> RunParams
RunParams RunDataCaching
rdc RunBloomFilterAlloc
rbfa IndexType
it

instance Override RunDataCaching SnapshotRun where
  override :: RunDataCaching -> SnapshotRun -> SnapshotRun
override RunDataCaching
rdc
    (SnapshotRun (RunNumber
rn :: RunNumber) (RunDataCaching
_rdc :: RunDataCaching) (IndexType
it ::IndexType))
    = RunNumber -> RunDataCaching -> IndexType -> SnapshotRun
SnapshotRun RunNumber
rn RunDataCaching
rdc IndexType
it

instance Override RunDataCaching (SnapMergingTree SnapshotRun) where
  override :: RunDataCaching
-> SnapMergingTree SnapshotRun -> SnapMergingTree SnapshotRun
override RunDataCaching
rdc (SnapMergingTree (SnapMergingTreeState SnapshotRun
smts ::  SnapMergingTreeState SnapshotRun))
    = SnapMergingTreeState SnapshotRun -> SnapMergingTree SnapshotRun
forall r. SnapMergingTreeState r -> SnapMergingTree r
SnapMergingTree (RunDataCaching
-> SnapMergingTreeState SnapshotRun
-> SnapMergingTreeState SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc SnapMergingTreeState SnapshotRun
smts)

instance Override RunDataCaching (SnapMergingTreeState SnapshotRun) where
  override :: RunDataCaching
-> SnapMergingTreeState SnapshotRun
-> SnapMergingTreeState SnapshotRun
override RunDataCaching
rdc = \case
      SnapCompletedTreeMerge (SnapshotRun
sr :: SnapshotRun) ->
        SnapshotRun -> SnapMergingTreeState SnapshotRun
forall r. r -> SnapMergingTreeState r
SnapCompletedTreeMerge (RunDataCaching -> SnapshotRun -> SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc SnapshotRun
sr)
      SnapPendingTreeMerge (SnapPendingMerge SnapshotRun
spm :: SnapPendingMerge SnapshotRun) ->
        SnapPendingMerge SnapshotRun -> SnapMergingTreeState SnapshotRun
forall r. SnapPendingMerge r -> SnapMergingTreeState r
SnapPendingTreeMerge (RunDataCaching
-> SnapPendingMerge SnapshotRun -> SnapPendingMerge SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc SnapPendingMerge SnapshotRun
spm)
      SnapOngoingTreeMerge (SnapMergingRun TreeMergeType SnapshotRun
smr :: SnapMergingRun TreeMergeType SnapshotRun) ->
        SnapMergingRun TreeMergeType SnapshotRun
-> SnapMergingTreeState SnapshotRun
forall r. SnapMergingRun TreeMergeType r -> SnapMergingTreeState r
SnapOngoingTreeMerge (RunDataCaching
-> SnapMergingRun TreeMergeType SnapshotRun
-> SnapMergingRun TreeMergeType SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc SnapMergingRun TreeMergeType SnapshotRun
smr)

instance Override RunDataCaching (SnapPendingMerge SnapshotRun) where
  override :: RunDataCaching
-> SnapPendingMerge SnapshotRun -> SnapPendingMerge SnapshotRun
override RunDataCaching
rdc = \case
      SnapPendingLevelMerge
        ([SnapPreExistingRun SnapshotRun]
spers :: [SnapPreExistingRun SnapshotRun])
        (Maybe (SnapMergingTree SnapshotRun)
msmt :: Maybe (SnapMergingTree SnapshotRun)) ->
          [SnapPreExistingRun SnapshotRun]
-> Maybe (SnapMergingTree SnapshotRun)
-> SnapPendingMerge SnapshotRun
forall r.
[SnapPreExistingRun r]
-> Maybe (SnapMergingTree r) -> SnapPendingMerge r
SnapPendingLevelMerge ((SnapPreExistingRun SnapshotRun -> SnapPreExistingRun SnapshotRun)
-> [SnapPreExistingRun SnapshotRun]
-> [SnapPreExistingRun SnapshotRun]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RunDataCaching
-> SnapPreExistingRun SnapshotRun -> SnapPreExistingRun SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc) [SnapPreExistingRun SnapshotRun]
spers) ((SnapMergingTree SnapshotRun -> SnapMergingTree SnapshotRun)
-> Maybe (SnapMergingTree SnapshotRun)
-> Maybe (SnapMergingTree SnapshotRun)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RunDataCaching
-> SnapMergingTree SnapshotRun -> SnapMergingTree SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc) Maybe (SnapMergingTree SnapshotRun)
msmt)
      SnapPendingUnionMerge ([SnapMergingTree SnapshotRun]
smts :: [SnapMergingTree SnapshotRun]) ->
        [SnapMergingTree SnapshotRun] -> SnapPendingMerge SnapshotRun
forall r. [SnapMergingTree r] -> SnapPendingMerge r
SnapPendingUnionMerge ((SnapMergingTree SnapshotRun -> SnapMergingTree SnapshotRun)
-> [SnapMergingTree SnapshotRun] -> [SnapMergingTree SnapshotRun]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RunDataCaching
-> SnapMergingTree SnapshotRun -> SnapMergingTree SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc) [SnapMergingTree SnapshotRun]
smts)

instance Override RunDataCaching (SnapPreExistingRun SnapshotRun) where
  override :: RunDataCaching
-> SnapPreExistingRun SnapshotRun -> SnapPreExistingRun SnapshotRun
override RunDataCaching
rdc = \case
      SnapPreExistingRun (SnapshotRun
sr :: SnapshotRun) -> SnapshotRun -> SnapPreExistingRun SnapshotRun
forall r. r -> SnapPreExistingRun r
SnapPreExistingRun (RunDataCaching -> SnapshotRun -> SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc SnapshotRun
sr)
      SnapPreExistingMergingRun (SnapMergingRun LevelMergeType SnapshotRun
smr :: SnapMergingRun LevelMergeType SnapshotRun) ->
        SnapMergingRun LevelMergeType SnapshotRun
-> SnapPreExistingRun SnapshotRun
forall r. SnapMergingRun LevelMergeType r -> SnapPreExistingRun r
SnapPreExistingMergingRun (RunDataCaching
-> SnapMergingRun LevelMergeType SnapshotRun
-> SnapMergingRun LevelMergeType SnapshotRun
forall o a. Override o a => o -> a -> a
override RunDataCaching
rdc SnapMergingRun LevelMergeType SnapshotRun
smr)