{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_HADDOCK not-home #-}
module Database.LSMTree.Internal.Config.Override (
TableConfigOverride (..)
, noTableConfigOverride
, overrideTableConfig
) 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
class Override o a where
override :: o -> a -> a
instance Override a c => Override (Maybe a) c where
override :: Maybe a -> c -> c
override = (c -> c) -> (a -> c -> c) -> Maybe a -> c -> c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe c -> c
forall a. a -> a
id a -> c -> c
forall o a. Override o a => o -> a -> a
override
data TableConfigOverride = TableConfigOverride {
TableConfigOverride -> Maybe DiskCachePolicy
overrideDiskCachePolicy :: Maybe DiskCachePolicy,
TableConfigOverride -> Maybe MergeBatchSize
overrideMergeBatchSize :: Maybe MergeBatchSize
}
deriving stock (Int -> TableConfigOverride -> ShowS
[TableConfigOverride] -> ShowS
TableConfigOverride -> String
(Int -> TableConfigOverride -> ShowS)
-> (TableConfigOverride -> String)
-> ([TableConfigOverride] -> ShowS)
-> Show TableConfigOverride
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableConfigOverride -> ShowS
showsPrec :: Int -> TableConfigOverride -> ShowS
$cshow :: TableConfigOverride -> String
show :: TableConfigOverride -> String
$cshowList :: [TableConfigOverride] -> ShowS
showList :: [TableConfigOverride] -> ShowS
Show, TableConfigOverride -> TableConfigOverride -> Bool
(TableConfigOverride -> TableConfigOverride -> Bool)
-> (TableConfigOverride -> TableConfigOverride -> Bool)
-> Eq TableConfigOverride
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableConfigOverride -> TableConfigOverride -> Bool
== :: TableConfigOverride -> TableConfigOverride -> Bool
$c/= :: TableConfigOverride -> TableConfigOverride -> Bool
/= :: TableConfigOverride -> TableConfigOverride -> Bool
Eq)
noTableConfigOverride :: TableConfigOverride
noTableConfigOverride :: TableConfigOverride
noTableConfigOverride = Maybe DiskCachePolicy
-> Maybe MergeBatchSize -> TableConfigOverride
TableConfigOverride Maybe DiskCachePolicy
forall a. Maybe a
Nothing Maybe MergeBatchSize
forall a. Maybe a
Nothing
overrideTableConfig :: TableConfigOverride
-> SnapshotMetaData -> SnapshotMetaData
overrideTableConfig :: TableConfigOverride -> SnapshotMetaData -> SnapshotMetaData
overrideTableConfig = TableConfigOverride -> SnapshotMetaData -> SnapshotMetaData
forall o a. Override o a => o -> a -> a
override
instance Override TableConfigOverride SnapshotMetaData where
override :: TableConfigOverride -> SnapshotMetaData -> SnapshotMetaData
override TableConfigOverride {Maybe MergeBatchSize
Maybe DiskCachePolicy
overrideDiskCachePolicy :: TableConfigOverride -> Maybe DiskCachePolicy
overrideMergeBatchSize :: TableConfigOverride -> Maybe MergeBatchSize
overrideDiskCachePolicy :: Maybe DiskCachePolicy
overrideMergeBatchSize :: Maybe MergeBatchSize
..} =
Maybe MergeBatchSize -> SnapshotMetaData -> SnapshotMetaData
forall o a. Override o a => o -> a -> a
override Maybe MergeBatchSize
overrideMergeBatchSize
(SnapshotMetaData -> SnapshotMetaData)
-> (SnapshotMetaData -> SnapshotMetaData)
-> SnapshotMetaData
-> SnapshotMetaData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe DiskCachePolicy -> SnapshotMetaData -> SnapshotMetaData
forall o a. Override o a => o -> a -> a
override Maybe DiskCachePolicy
overrideDiskCachePolicy
instance Override MergeBatchSize SnapshotMetaData where
override :: MergeBatchSize -> SnapshotMetaData -> SnapshotMetaData
override MergeBatchSize
mbs SnapshotMetaData
smd =
SnapshotMetaData
smd { snapMetaConfig = override mbs (snapMetaConfig smd) }
instance Override MergeBatchSize TableConfig where
override :: MergeBatchSize -> TableConfig -> TableConfig
override MergeBatchSize
confMergeBatchSize' TableConfig
tc =
TableConfig
tc { confMergeBatchSize = confMergeBatchSize' }
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
tc =
TableConfig
tc { confDiskCachePolicy = 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)