Skip to content

Commit 04e58c7

Browse files
jeltschjeltsch
authored
Merge pull request #638 from IntersectMBO/jeltsch/no-default-run-params
Make run parameters explicit
2 parents cc51280 + 7f0631e commit 04e58c7

File tree

13 files changed

+175
-88
lines changed

13 files changed

+175
-88
lines changed

Diff for: ‎bench/micro/Bench/Database/LSMTree/Internal/Lookup.hs

+12-2
Original file line numberDiff line numberDiff line change
@@ -19,15 +19,17 @@ import qualified Data.Vector as V
1919
import Database.LSMTree.Extras.Orphans ()
2020
import Database.LSMTree.Extras.Random (frequency, randomByteStringR,
2121
sampleUniformWithReplacement, uniformWithoutReplacement)
22-
import Database.LSMTree.Extras.RunData (defaultRunParams)
2322
import Database.LSMTree.Extras.UTxO
2423
import Database.LSMTree.Internal.Entry (Entry (..), NumEntries (..))
24+
import Database.LSMTree.Internal.Index as Index
2525
import Database.LSMTree.Internal.Lookup (bloomQueries, indexSearches,
2626
intraPageLookups, lookupsIO, prepLookups)
2727
import Database.LSMTree.Internal.Page (getNumPages)
2828
import Database.LSMTree.Internal.Paths (RunFsPaths (..))
2929
import Database.LSMTree.Internal.Run (Run)
3030
import qualified Database.LSMTree.Internal.Run as Run
31+
import qualified Database.LSMTree.Internal.RunAcc as RunAcc
32+
import Database.LSMTree.Internal.RunBuilder as RunBuilder
3133
import Database.LSMTree.Internal.RunNumber
3234
import Database.LSMTree.Internal.Serialise
3335
import qualified Database.LSMTree.Internal.WriteBuffer as WB
@@ -191,7 +193,7 @@ lookupsInBatchesEnv Config {..} = do
191193
wbblobs <- WBB.new hasFS (FS.mkFsPath ["0.wbblobs"])
192194
wb <- WB.fromMap <$> traverse (traverse (WBB.addBlob hasFS wbblobs)) storedKeys
193195
let fsps = RunFsPaths (FS.mkFsPath []) (RunNumber 0)
194-
r <- Run.fromWriteBuffer hasFS hasBlockIO defaultRunParams fsps wb wbblobs
196+
r <- Run.fromWriteBuffer hasFS hasBlockIO runParams fsps wb wbblobs
195197
let NumEntries nentriesReal = Run.size r
196198
assertEqual nentriesReal nentries $ pure ()
197199
-- 42 to 43 entries per page
@@ -204,6 +206,14 @@ lookupsInBatchesEnv Config {..} = do
204206
, V.singleton r
205207
, lookupKeys
206208
)
209+
where
210+
runParams :: RunBuilder.RunParams
211+
runParams =
212+
RunBuilder.RunParams {
213+
runParamCaching = RunBuilder.CacheRunData,
214+
runParamAlloc = RunAcc.RunAllocFixed 10,
215+
runParamIndex = Index.Compact
216+
}
207217

208218
lookupsInBatchesCleanup ::
209219
( FilePath -- ^ Temporary directory

Diff for: ‎bench/micro/Bench/Database/LSMTree/Internal/Merge.hs

+12-2
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,8 @@ import qualified Database.LSMTree.Internal.Merge as Merge
2323
import Database.LSMTree.Internal.Paths (RunFsPaths (..))
2424
import Database.LSMTree.Internal.Run (Run)
2525
import qualified Database.LSMTree.Internal.Run as Run
26+
import qualified Database.LSMTree.Internal.RunAcc as RunAcc
27+
import qualified Database.LSMTree.Internal.RunBuilder as RunBuilder
2628
import Database.LSMTree.Internal.RunNumber
2729
import Database.LSMTree.Internal.Serialise
2830
import Database.LSMTree.Internal.UniqCounter
@@ -218,6 +220,14 @@ benchmarks = bgroup "Bench.Database.LSMTree.Internal.Merge" [
218220
| w <- weights
219221
]
220222

223+
runParams :: RunBuilder.RunParams
224+
runParams =
225+
RunBuilder.RunParams {
226+
runParamCaching = RunBuilder.CacheRunData,
227+
runParamAlloc = RunAcc.RunAllocFixed 10,
228+
runParamIndex = Index.Compact
229+
}
230+
221231
benchMerge :: Config -> Benchmark
222232
benchMerge conf@Config{name} =
223233
withEnv $ \ ~(_dir, hasFS, hasBlockIO, runs) ->
@@ -263,7 +273,7 @@ merge ::
263273
merge fs hbio Config {..} targetPaths runs = do
264274
let f = fromMaybe const mergeMappend
265275
m <- fromMaybe (error "empty inputs, no merge created") <$>
266-
Merge.new fs hbio defaultRunParams mergeType f targetPaths runs
276+
Merge.new fs hbio runParams mergeType f targetPaths runs
267277
Merge.stepsToCompletion m stepSize
268278

269279
fsPath :: FS.FsPath
@@ -388,7 +398,7 @@ randomRuns ::
388398
randomRuns hasFS hasBlockIO config@Config {..} rng0 = do
389399
counter <- inputRunPathsCounter
390400
fmap V.fromList $
391-
mapM (unsafeCreateRun hasFS hasBlockIO Index.Compact fsPath counter) $
401+
mapM (unsafeCreateRun hasFS hasBlockIO runParams fsPath counter) $
392402
zipWith
393403
(randomRunData config)
394404
nentries

Diff for: ‎src-extras/Database/LSMTree/Extras/MergingRunData.hs

+9-9
Original file line numberDiff line numberDiff line change
@@ -23,12 +23,12 @@ import qualified Data.Vector as V
2323
import Database.LSMTree.Extras (showPowersOf)
2424
import Database.LSMTree.Extras.Generators ()
2525
import Database.LSMTree.Extras.RunData
26-
import Database.LSMTree.Internal.Index (IndexType)
2726
import Database.LSMTree.Internal.Lookup (ResolveSerialisedValue)
2827
import Database.LSMTree.Internal.MergingRun (MergingRun)
2928
import qualified Database.LSMTree.Internal.MergingRun as MR
3029
import Database.LSMTree.Internal.Paths
3130
import qualified Database.LSMTree.Internal.Run as Run
31+
import qualified Database.LSMTree.Internal.RunBuilder as RunBuilder
3232
import Database.LSMTree.Internal.RunNumber
3333
import Database.LSMTree.Internal.Serialise
3434
import Database.LSMTree.Internal.UniqCounter
@@ -47,15 +47,15 @@ withMergingRun ::
4747
=> HasFS IO h
4848
-> HasBlockIO IO h
4949
-> ResolveSerialisedValue
50-
-> IndexType
50+
-> RunBuilder.RunParams
5151
-> FS.FsPath
5252
-> UniqCounter IO
5353
-> SerialisedMergingRunData t
5454
-> (Ref (MergingRun t IO h) -> IO a)
5555
-> IO a
56-
withMergingRun hfs hbio resolve indexType path counter mrd = do
56+
withMergingRun hfs hbio resolve runParams path counter mrd = do
5757
bracket
58-
(unsafeCreateMergingRun hfs hbio resolve indexType path counter mrd)
58+
(unsafeCreateMergingRun hfs hbio resolve runParams path counter mrd)
5959
releaseRef
6060

6161
-- | Flush serialised merging run data to disk.
@@ -69,24 +69,24 @@ unsafeCreateMergingRun ::
6969
=> HasFS IO h
7070
-> HasBlockIO IO h
7171
-> ResolveSerialisedValue
72-
-> IndexType
72+
-> RunBuilder.RunParams
7373
-> FS.FsPath
7474
-> UniqCounter IO
7575
-> SerialisedMergingRunData t
7676
-> IO (Ref (MergingRun t IO h))
77-
unsafeCreateMergingRun hfs hbio resolve indexType path counter = \case
77+
unsafeCreateMergingRun hfs hbio resolve runParams path counter = \case
7878
CompletedMergeData _ rd -> do
79-
withRun hfs hbio indexType path counter rd $ \run -> do
79+
withRun hfs hbio runParams path counter rd $ \run -> do
8080
-- slightly hacky, generally it's larger
8181
let totalDebt = MR.numEntriesToMergeDebt (Run.size run)
8282
MR.newCompleted totalDebt run
8383

8484
OngoingMergeData mergeType rds -> do
85-
withRuns hfs hbio indexType path counter (toRunData <$> rds)
85+
withRuns hfs hbio runParams path counter (toRunData <$> rds)
8686
$ \runs -> do
8787
n <- incrUniqCounter counter
8888
let fsPaths = RunFsPaths path (RunNumber (uniqueToInt n))
89-
MR.new hfs hbio resolve defaultRunParams mergeType
89+
MR.new hfs hbio resolve runParams mergeType
9090
fsPaths (V.fromList runs)
9191

9292
{-------------------------------------------------------------------------------

Diff for: ‎src-extras/Database/LSMTree/Extras/MergingTreeData.hs

+10-10
Original file line numberDiff line numberDiff line change
@@ -24,11 +24,11 @@ import Database.LSMTree.Extras (showPowersOf)
2424
import Database.LSMTree.Extras.Generators ()
2525
import Database.LSMTree.Extras.MergingRunData
2626
import Database.LSMTree.Extras.RunData
27-
import Database.LSMTree.Internal.Index (IndexType)
2827
import Database.LSMTree.Internal.Lookup (ResolveSerialisedValue)
2928
import qualified Database.LSMTree.Internal.MergingRun as MR
3029
import Database.LSMTree.Internal.MergingTree (MergingTree)
3130
import qualified Database.LSMTree.Internal.MergingTree as MT
31+
import Database.LSMTree.Internal.RunBuilder (RunParams)
3232
import Database.LSMTree.Internal.Serialise
3333
import Database.LSMTree.Internal.UniqCounter
3434
import qualified System.FS.API as FS
@@ -45,15 +45,15 @@ withMergingTree ::
4545
HasFS IO h
4646
-> HasBlockIO IO h
4747
-> ResolveSerialisedValue
48-
-> IndexType
48+
-> RunParams
4949
-> FS.FsPath
5050
-> UniqCounter IO
5151
-> SerialisedMergingTreeData
5252
-> (Ref (MergingTree IO h) -> IO a)
5353
-> IO a
54-
withMergingTree hfs hbio resolve indexType path counter mrd = do
54+
withMergingTree hfs hbio resolve runParams path counter mrd = do
5555
bracket
56-
(unsafeCreateMergingTree hfs hbio resolve indexType path counter mrd)
56+
(unsafeCreateMergingTree hfs hbio resolve runParams path counter mrd)
5757
releaseRef
5858

5959
-- | Flush serialised merging tree data to disk.
@@ -66,19 +66,19 @@ unsafeCreateMergingTree ::
6666
HasFS IO h
6767
-> HasBlockIO IO h
6868
-> ResolveSerialisedValue
69-
-> IndexType
69+
-> RunParams
7070
-> FS.FsPath
7171
-> UniqCounter IO
7272
-> SerialisedMergingTreeData
7373
-> IO (Ref (MergingTree IO h))
74-
unsafeCreateMergingTree hfs hbio resolve indexType path counter = go
74+
unsafeCreateMergingTree hfs hbio resolve runParams path counter = go
7575
where
7676
go = \case
7777
CompletedTreeMergeData rd ->
78-
withRun hfs hbio indexType path counter rd $ \run ->
78+
withRun hfs hbio runParams path counter rd $ \run ->
7979
MT.newCompletedMerge run
8080
OngoingTreeMergeData mrd ->
81-
withMergingRun hfs hbio resolve indexType path counter mrd $ \mr ->
81+
withMergingRun hfs hbio resolve runParams path counter mrd $ \mr ->
8282
MT.newOngoingMerge mr
8383
PendingLevelMergeData prds mtd ->
8484
withPreExistingRuns prds $ \prs ->
@@ -101,11 +101,11 @@ unsafeCreateMergingTree hfs hbio resolve indexType path counter = go
101101

102102
withPreExistingRuns [] act = act []
103103
withPreExistingRuns (PreExistingRunData rd : rest) act =
104-
withRun hfs hbio indexType path counter rd $ \r ->
104+
withRun hfs hbio runParams path counter rd $ \r ->
105105
withPreExistingRuns rest $ \prs ->
106106
act (MT.PreExistingRun r : prs)
107107
withPreExistingRuns (PreExistingMergingRunData mrd : rest) act =
108-
withMergingRun hfs hbio resolve indexType path counter mrd $ \mr ->
108+
withMergingRun hfs hbio resolve runParams path counter mrd $ \mr ->
109109
withPreExistingRuns rest $ \prs ->
110110
act (MT.PreExistingMergingRun mr : prs)
111111

Diff for: ‎src-extras/Database/LSMTree/Extras/RunData.hs

+18-33
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,8 @@
22
-- from them. Tests and benchmarks should preferably use these utilities instead
33
-- of (re-)defining their own.
44
module Database.LSMTree.Extras.RunData (
5-
-- * RunParams
6-
defaultRunParams
75
-- * Create runs
8-
, withRun
6+
withRun
97
, withRunAt
108
, withRuns
119
, unsafeCreateRun
@@ -50,16 +48,13 @@ import qualified Data.Vector as V
5048
import Database.LSMTree.Extras (showPowersOf10)
5149
import Database.LSMTree.Extras.Generators ()
5250
import Database.LSMTree.Internal.Entry
53-
import Database.LSMTree.Internal.Index (IndexType (..))
5451
import Database.LSMTree.Internal.Lookup (ResolveSerialisedValue)
5552
import Database.LSMTree.Internal.MergeSchedule (addWriteBufferEntries)
5653
import Database.LSMTree.Internal.Paths
5754
import qualified Database.LSMTree.Internal.Paths as Paths
58-
import Database.LSMTree.Internal.Run (Run, RunDataCaching (..),
59-
RunParams (..))
55+
import Database.LSMTree.Internal.Run (Run, RunParams (..))
6056
import qualified Database.LSMTree.Internal.Run as Run
61-
import Database.LSMTree.Internal.RunAcc (RunBloomFilterAlloc (..),
62-
entryWouldFitInPage)
57+
import Database.LSMTree.Internal.RunAcc (entryWouldFitInPage)
6358
import Database.LSMTree.Internal.RunNumber
6459
import Database.LSMTree.Internal.Serialise
6560
import Database.LSMTree.Internal.UniqCounter
@@ -73,14 +68,6 @@ import System.FS.BlockIO.API (HasBlockIO)
7368
import Test.QuickCheck
7469

7570

76-
defaultRunParams :: RunParams
77-
defaultRunParams =
78-
RunParams {
79-
runParamCaching = CacheRunData,
80-
runParamAlloc = RunAllocFixed 10,
81-
runParamIndex = Compact
82-
}
83-
8471
{-------------------------------------------------------------------------------
8572
Create runs
8673
-------------------------------------------------------------------------------}
@@ -89,47 +76,47 @@ defaultRunParams =
8976
withRun ::
9077
HasFS IO h
9178
-> HasBlockIO IO h
92-
-> IndexType
79+
-> RunParams
9380
-> FS.FsPath
9481
-> UniqCounter IO
9582
-> SerialisedRunData
9683
-> (Ref (Run IO h) -> IO a)
9784
-> IO a
98-
withRun hfs hbio indexType path counter rd = do
85+
withRun hfs hbio runParams path counter rd = do
9986
bracket
100-
(unsafeCreateRun hfs hbio indexType path counter rd)
87+
(unsafeCreateRun hfs hbio runParams path counter rd)
10188
releaseRef
10289

10390
-- | Create a temporary 'Run' using 'unsafeCreateRunAt'.
10491
withRunAt ::
10592
HasFS IO h
10693
-> HasBlockIO IO h
107-
-> IndexType
94+
-> RunParams
10895
-> RunFsPaths
10996
-> SerialisedRunData
11097
-> (Ref (Run IO h) -> IO a)
11198
-> IO a
112-
withRunAt hfs hbio indexType path rd = do
99+
withRunAt hfs hbio runParams path rd = do
113100
bracket
114-
(unsafeCreateRunAt hfs hbio indexType path rd)
101+
(unsafeCreateRunAt hfs hbio runParams path rd)
115102
releaseRef
116103

117104
{-# INLINABLE withRuns #-}
118105
-- | Create temporary 'Run's using 'unsafeCreateRun'.
119106
withRuns ::
120107
HasFS IO h
121108
-> HasBlockIO IO h
122-
-> IndexType
109+
-> RunParams
123110
-> FS.FsPath
124111
-> UniqCounter IO
125112
-> [SerialisedRunData]
126113
-> ([Ref (Run IO h)] -> IO a)
127114
-> IO a
128-
withRuns hfs hbio indexType path counter = go
115+
withRuns hfs hbio runParams path counter = go
129116
where
130117
go [] act = act []
131118
go (rd:rds) act =
132-
withRun hfs hbio indexType path counter rd $ \r ->
119+
withRun hfs hbio runParams path counter rd $ \r ->
133120
go rds $ \rs ->
134121
act (r:rs)
135122

@@ -138,15 +125,15 @@ withRuns hfs hbio indexType path counter = go
138125
unsafeCreateRun ::
139126
HasFS IO h
140127
-> HasBlockIO IO h
141-
-> IndexType
128+
-> RunParams
142129
-> FS.FsPath
143130
-> UniqCounter IO
144131
-> SerialisedRunData
145132
-> IO (Ref (Run IO h))
146-
unsafeCreateRun fs hbio indexType path counter rd = do
133+
unsafeCreateRun fs hbio runParams path counter rd = do
147134
n <- incrUniqCounter counter
148135
let fsPaths = RunFsPaths path (uniqueToRunNumber n)
149-
unsafeCreateRunAt fs hbio indexType fsPaths rd
136+
unsafeCreateRunAt fs hbio runParams fsPaths rd
150137

151138
-- | Flush serialised run data to disk as if it were a write buffer.
152139
--
@@ -157,17 +144,15 @@ unsafeCreateRun fs hbio indexType path counter rd = do
157144
unsafeCreateRunAt ::
158145
HasFS IO h
159146
-> HasBlockIO IO h
160-
-> IndexType
147+
-> RunParams
161148
-> RunFsPaths
162149
-> SerialisedRunData
163150
-> IO (Ref (Run IO h))
164-
unsafeCreateRunAt fs hbio indexType fsPaths (RunData m) = do
151+
unsafeCreateRunAt fs hbio runParams fsPaths (RunData m) = do
165152
let blobpath = FS.addExtension (runBlobPath fsPaths) ".wb"
166153
bracket (WBB.new fs blobpath) releaseRef $ \wbblobs -> do
167154
wb <- WB.fromMap <$> traverse (traverse (WBB.addBlob fs wbblobs)) m
168-
Run.fromWriteBuffer fs hbio
169-
defaultRunParams { runParamIndex = indexType }
170-
fsPaths wb wbblobs
155+
Run.fromWriteBuffer fs hbio runParams fsPaths wb wbblobs
171156

172157
-- | Create a 'RunFsPaths' using an empty 'FsPath'. The empty path corresponds
173158
-- to the "root" or "mount point" of a 'HasFS' instance.

0 commit comments

Comments
 (0)