Skip to content

Commit cc50eb7

Browse files
dcouttsjorisdral
authored andcommitted
Generalise OverrideDiskCachePolicy to TableConfigOverride
And add MergeBatchSize to TableConfigOverride.
1 parent 6d4610d commit cc50eb7

File tree

6 files changed

+97
-49
lines changed

6 files changed

+97
-49
lines changed

bench/macro/lsm-tree-bench-wp8.hs

Lines changed: 9 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -185,8 +185,11 @@ mkTableConfigRun GlobalOpts{diskCachePolicy} conf = conf {
185185
LSM.confDiskCachePolicy = diskCachePolicy
186186
}
187187

188-
mkOverrideDiskCachePolicy :: GlobalOpts -> LSM.OverrideDiskCachePolicy
189-
mkOverrideDiskCachePolicy GlobalOpts{diskCachePolicy} = LSM.OverrideDiskCachePolicy diskCachePolicy
188+
mkOverrideDiskCachePolicy :: GlobalOpts -> LSM.TableConfigOverride
189+
mkOverrideDiskCachePolicy GlobalOpts{diskCachePolicy} =
190+
LSM.noTableConfigOverride {
191+
LSM.overrideDiskCachePolicy = Just diskCachePolicy
192+
}
190193

191194
mkTracer :: GlobalOpts -> Tracer IO LSM.LSMTreeTrace
192195
mkTracer gopts
@@ -582,8 +585,10 @@ doRun gopts opts = do
582585
-- reference version starts with empty (as it's not practical or
583586
-- necessary for testing to load the whole snapshot).
584587
tbl <- if check opts
585-
then LSM.newTableWith @IO @K @V @B (mkTableConfigRun gopts benchTableConfig) session
586-
else LSM.openTableFromSnapshotWith @IO @K @V @B (mkOverrideDiskCachePolicy gopts) session name label
588+
then let conf = mkTableConfigRun gopts benchTableConfig
589+
in LSM.newTableWith @IO @K @V @B conf session
590+
else let conf = mkOverrideDiskCachePolicy gopts
591+
in LSM.openTableFromSnapshotWith @IO @K @V @B conf session name label
587592

588593
-- In checking mode, compare each output against a pure reference.
589594
checkvar <- newIORef $ pureReference

src/Database/LSMTree.hs

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -123,7 +123,8 @@ module Database.LSMTree (
123123
MergeBatchSize (..),
124124

125125
-- ** Table Configuration Overrides #table_configuration_overrides#
126-
OverrideDiskCachePolicy (..),
126+
TableConfigOverride (..),
127+
noTableConfigOverride,
127128

128129
-- * Ranges #ranges#
129130
Range (..),
@@ -221,7 +222,7 @@ import Database.LSMTree.Internal.Config
221222
WriteBufferAlloc (..), defaultTableConfig,
222223
serialiseKeyMinimalSize)
223224
import Database.LSMTree.Internal.Config.Override
224-
(OverrideDiskCachePolicy (..))
225+
(TableConfigOverride (..), noTableConfigOverride)
225226
import Database.LSMTree.Internal.Entry (NumEntries (..))
226227
import qualified Database.LSMTree.Internal.Entry as Entry
227228
import Database.LSMTree.Internal.Merge (LevelMergeType (..))
@@ -2403,7 +2404,7 @@ Variant of 'withTableFromSnapshot' that accepts [table configuration overrides](
24032404
withTableFromSnapshotWith ::
24042405
forall k v b a.
24052406
(ResolveValue v) =>
2406-
OverrideDiskCachePolicy ->
2407+
TableConfigOverride ->
24072408
Session IO ->
24082409
SnapshotName ->
24092410
SnapshotLabel ->
@@ -2414,7 +2415,7 @@ withTableFromSnapshotWith ::
24142415
forall m k v b a.
24152416
(IOLike m) =>
24162417
(ResolveValue v) =>
2417-
OverrideDiskCachePolicy ->
2418+
TableConfigOverride ->
24182419
Session m ->
24192420
SnapshotName ->
24202421
SnapshotLabel ->
@@ -2478,7 +2479,7 @@ openTableFromSnapshot ::
24782479
SnapshotLabel ->
24792480
m (Table m k v b)
24802481
openTableFromSnapshot session snapName snapLabel =
2481-
openTableFromSnapshotWith NoOverrideDiskCachePolicy session snapName snapLabel
2482+
openTableFromSnapshotWith noTableConfigOverride session snapName snapLabel
24822483

24832484
{- |
24842485
Variant of 'openTableFromSnapshot' that accepts [table configuration overrides](#g:table_configuration_overrides).
@@ -2487,7 +2488,7 @@ Variant of 'openTableFromSnapshot' that accepts [table configuration overrides](
24872488
openTableFromSnapshotWith ::
24882489
forall k v b.
24892490
(ResolveValue v) =>
2490-
OverrideDiskCachePolicy ->
2491+
TableConfigOverride ->
24912492
Session IO ->
24922493
SnapshotName ->
24932494
SnapshotLabel ->
@@ -2497,7 +2498,7 @@ openTableFromSnapshotWith ::
24972498
forall m k v b.
24982499
(IOLike m) =>
24992500
(ResolveValue v) =>
2500-
OverrideDiskCachePolicy ->
2501+
TableConfigOverride ->
25012502
Session m ->
25022503
SnapshotName ->
25032504
SnapshotLabel ->

src/Database/LSMTree/Internal/Config/Override.hs

Lines changed: 61 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -5,9 +5,10 @@
55
module Database.LSMTree.Internal.Config.Override (
66
-- $override-policy
77

8-
-- * Override disk cache policy
9-
OverrideDiskCachePolicy (..)
10-
, overrideDiskCachePolicy
8+
-- * Override table config
9+
TableConfigOverride (..)
10+
, noTableConfigOverride
11+
, overrideTableConfig
1112
) where
1213

1314
import qualified Data.Vector as V
@@ -42,35 +43,75 @@ import Database.LSMTree.Internal.Snapshot
4243
-- Another complicating factor is that we have thought about the possibility of
4344
-- restoring sharing of ongoing merges between live tables and newly opened
4445
-- snapshots. At that point, we run into the same challenges again... But for
45-
-- now, changing only the disk cache policy offline should work fine.
46+
-- now, changing only the disk cache policy and merge batch size offline should
47+
-- work fine.
4648

4749
{-------------------------------------------------------------------------------
48-
Override disk cache policy
50+
Helper class
51+
-------------------------------------------------------------------------------}
52+
53+
-- | This class is only here so that we can recursively call 'override' on all
54+
-- fields of a datatype, instead of having to invent a new name for each type
55+
-- that the function is called on such as @overrideTableConfig@,
56+
-- @overrideSnapshotRun@, etc.
57+
class Override o a where
58+
override :: o -> a -> a
59+
60+
instance Override a c => Override (Maybe a) c where
61+
override = maybe id override
62+
63+
{-------------------------------------------------------------------------------
64+
Override table config
4965
-------------------------------------------------------------------------------}
5066

5167
{- |
52-
The 'OverrideDiskCachePolicy' can be used to override the 'DiskCachePolicy'
68+
The 'TableConfigOverride' can be used to override the 'TableConfig'
5369
when opening a table from a snapshot.
5470
-}
55-
data OverrideDiskCachePolicy =
56-
NoOverrideDiskCachePolicy
57-
| OverrideDiskCachePolicy DiskCachePolicy
71+
data TableConfigOverride = TableConfigOverride {
72+
overrideDiskCachePolicy :: Maybe DiskCachePolicy,
73+
overrideMergeBatchSize :: Maybe MergeBatchSize
74+
}
5875
deriving stock (Show, Eq)
5976

60-
-- | Override the disk cache policy that is stored in snapshot metadata.
77+
-- | No override of the 'TableConfig'. You can use this as a default value and
78+
-- record update to override some parameters, while being future-proof to new
79+
-- parameters, e.g.
80+
--
81+
-- > noTableConfigOverride { overrideDiskCachePolicy = DiskCacheNone }
82+
--
83+
noTableConfigOverride :: TableConfigOverride
84+
noTableConfigOverride = TableConfigOverride Nothing Nothing
85+
86+
-- | Override the a subset of the table configuration parameters that are
87+
-- stored in snapshot metadata.
6188
--
6289
-- Tables opened from the new 'SnapshotMetaData' will use the new value for the
63-
-- disk cache policy.
64-
overrideDiskCachePolicy :: OverrideDiskCachePolicy -> SnapshotMetaData -> SnapshotMetaData
65-
overrideDiskCachePolicy (OverrideDiskCachePolicy dcp) = override dcp
66-
overrideDiskCachePolicy NoOverrideDiskCachePolicy = id
90+
-- table configuration.
91+
overrideTableConfig :: TableConfigOverride
92+
-> SnapshotMetaData -> SnapshotMetaData
93+
overrideTableConfig = override
6794

68-
-- | This class is only here so that we can recursively call 'override' on all
69-
-- fields of a datatype, instead of having to invent a new name for each type
70-
-- that the function is called on such as 'overrideTableConfig',
71-
-- 'overrideSnapshotRun', etc.
72-
class Override o a where
73-
override :: o -> a -> a
95+
instance Override TableConfigOverride SnapshotMetaData where
96+
override TableConfigOverride {..} =
97+
override overrideMergeBatchSize
98+
. override overrideDiskCachePolicy
99+
100+
{-------------------------------------------------------------------------------
101+
Override merge batch size
102+
-------------------------------------------------------------------------------}
103+
104+
instance Override MergeBatchSize SnapshotMetaData where
105+
override mbs smd =
106+
smd { snapMetaConfig = override mbs (snapMetaConfig smd) }
107+
108+
instance Override MergeBatchSize TableConfig where
109+
override confMergeBatchSize' tc =
110+
tc { confMergeBatchSize = confMergeBatchSize' }
111+
112+
{-------------------------------------------------------------------------------
113+
Override disk cache policy
114+
-------------------------------------------------------------------------------}
74115

75116
-- NOTE: the instances below explicitly pattern match on the types of
76117
-- constructor fields. This makes the code more verbose, but it also makes the

src/Database/LSMTree/Internal/Unsafe.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -109,8 +109,8 @@ import Database.LSMTree.Internal.Arena (ArenaManager, newArenaManager)
109109
import Database.LSMTree.Internal.BlobRef (WeakBlobRef (..))
110110
import qualified Database.LSMTree.Internal.BlobRef as BlobRef
111111
import Database.LSMTree.Internal.Config
112-
import Database.LSMTree.Internal.Config.Override
113-
(OverrideDiskCachePolicy, overrideDiskCachePolicy)
112+
import Database.LSMTree.Internal.Config.Override (TableConfigOverride,
113+
overrideTableConfig)
114114
import Database.LSMTree.Internal.CRC32C (FileCorruptedError (..),
115115
FileFormat (..))
116116
import qualified Database.LSMTree.Internal.Cursor as Cursor
@@ -159,7 +159,7 @@ data LSMTreeTrace =
159159
| TraceCloseSession
160160
-- Table
161161
| TraceNewTable
162-
| TraceOpenTableFromSnapshot SnapshotName OverrideDiskCachePolicy
162+
| TraceOpenTableFromSnapshot SnapshotName TableConfigOverride
163163
| TraceTable TableId TableTrace
164164
| TraceDeleteSnapshot SnapshotName
165165
| TraceListSnapshots
@@ -1287,7 +1287,7 @@ data SnapshotNotCompatibleError
12871287
deriving anyclass (Exception)
12881288

12891289
{-# SPECIALISE openTableFromSnapshot ::
1290-
OverrideDiskCachePolicy
1290+
TableConfigOverride
12911291
-> Session IO h
12921292
-> SnapshotName
12931293
-> SnapshotLabel
@@ -1296,7 +1296,7 @@ data SnapshotNotCompatibleError
12961296
-- | See 'Database.LSMTree.openTableFromSnapshot'.
12971297
openTableFromSnapshot ::
12981298
(MonadMask m, MonadMVar m, MonadST m, MonadSTM m)
1299-
=> OverrideDiskCachePolicy
1299+
=> TableConfigOverride
13001300
-> Session m h
13011301
-> SnapshotName
13021302
-> SnapshotLabel -- ^ Expected label
@@ -1322,7 +1322,7 @@ openTableFromSnapshot policyOveride sesh snap label resolve =
13221322
snapMetaData <- readFileSnapshotMetaData hfs contentPath checksumPath
13231323

13241324
let SnapshotMetaData label' conf snapWriteBuffer snapLevels mTreeOpt
1325-
= overrideDiskCachePolicy policyOveride snapMetaData
1325+
= overrideTableConfig policyOveride snapMetaData
13261326

13271327
unless (label == label') $
13281328
throwIO (ErrSnapshotWrongLabel snap label label')

src/Database/LSMTree/Simple.hs

Lines changed: 11 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -114,7 +114,8 @@ module Database.LSMTree.Simple (
114114
MergeBatchSize (..),
115115

116116
-- ** Table Configuration Overrides #table_configuration_overrides#
117-
OverrideDiskCachePolicy (..),
117+
TableConfigOverride (..),
118+
noTableConfigOverride,
118119

119120
-- * Ranges #ranges#
120121
Range (..),
@@ -167,17 +168,17 @@ import Data.Void (Void)
167168
import Database.LSMTree (BloomFilterAlloc, CursorClosedError (..),
168169
DiskCachePolicy, FencePointerIndexType,
169170
InvalidSnapshotNameError (..), MergeBatchSize, MergePolicy,
170-
MergeSchedule, OverrideDiskCachePolicy (..), Range (..),
171-
RawBytes, ResolveAsFirst (..), SerialiseKey (..),
172-
SerialiseKeyOrderPreserving, SerialiseValue (..),
173-
SessionClosedError (..), SizeRatio,
171+
MergeSchedule, Range (..), RawBytes, ResolveAsFirst (..),
172+
SerialiseKey (..), SerialiseKeyOrderPreserving,
173+
SerialiseValue (..), SessionClosedError (..), SizeRatio,
174174
SnapshotCorruptedError (..),
175175
SnapshotDoesNotExistError (..), SnapshotExistsError (..),
176176
SnapshotLabel (..), SnapshotName,
177177
SnapshotNotCompatibleError (..), TableClosedError (..),
178-
TableConfig (..), TableCorruptedError (..),
179-
TableTooLargeError (..), UnionCredits (..), UnionDebt (..),
180-
WriteBufferAlloc, isValidSnapshotName, packSlice,
178+
TableConfig (..), TableConfigOverride (..),
179+
TableCorruptedError (..), TableTooLargeError (..),
180+
UnionCredits (..), UnionDebt (..), WriteBufferAlloc,
181+
isValidSnapshotName, noTableConfigOverride, packSlice,
181182
serialiseKeyIdentity, serialiseKeyIdentityUpToSlicing,
182183
serialiseKeyMinimalSize, serialiseKeyPreservesOrdering,
183184
serialiseValueIdentity, serialiseValueIdentityUpToSlicing,
@@ -1425,7 +1426,7 @@ Variant of 'withTableFromSnapshot' that accepts [table configuration overrides](
14251426
-}
14261427
withTableFromSnapshotWith ::
14271428
forall k v a.
1428-
OverrideDiskCachePolicy ->
1429+
TableConfigOverride ->
14291430
Session ->
14301431
SnapshotName ->
14311432
SnapshotLabel ->
@@ -1468,7 +1469,7 @@ Variant of 'openTableFromSnapshot' that accepts [table configuration overrides](
14681469
-}
14691470
openTableFromSnapshotWith ::
14701471
forall k v.
1471-
OverrideDiskCachePolicy ->
1472+
TableConfigOverride ->
14721473
Session ->
14731474
SnapshotName ->
14741475
SnapshotLabel ->

test/Test/Database/LSMTree/Internal/Snapshot/FS.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ import Database.LSMTree.Extras (showPowersOf10)
1313
import Database.LSMTree.Extras.Generators ()
1414
import Database.LSMTree.Internal.Config
1515
import Database.LSMTree.Internal.Config.Override
16-
(OverrideDiskCachePolicy (..))
16+
(noTableConfigOverride)
1717
import Database.LSMTree.Internal.Entry
1818
import Database.LSMTree.Internal.Paths
1919
import Database.LSMTree.Internal.Serialise
@@ -221,6 +221,6 @@ prop_flipSnapshotBit (Positive (Small bufferSize)) es pickFileBit =
221221
saveSnapshot snapName snapLabel t
222222

223223
openSnap s =
224-
openTableFromSnapshot NoOverrideDiskCachePolicy s snapName snapLabel resolve
224+
openTableFromSnapshot noTableConfigOverride s snapName snapLabel resolve
225225

226226
getConstructorName e = takeWhile (/= ' ') (show e)

0 commit comments

Comments
 (0)