Merge pull request #708 from IntersectMBO/wenkokke/move-conf-merge-schedule

fix: move confMergeSchedule next to confMergePolicy

Author: wenkokke

src/Database/LSMTree/Internal/Config.hs

@@ -58,6 +58,7 @@ newtype LevelNo = LevelNo Int
 -- * Size ratio: 4
 data TableConfig = TableConfig {
     confMergePolicy       :: !MergePolicy
+  , confMergeSchedule     :: !MergeSchedule
     -- Size ratio between the capacities of adjacent levels.
   , confSizeRatio         :: !SizeRatio
     -- | Total number of bytes that the write buffer can use.
@@ -69,7 +70,6 @@ data TableConfig = TableConfig {
   , confFencePointerIndex :: !FencePointerIndexType
     -- | The policy for caching key\/value data from disk in memory.
   , confDiskCachePolicy   :: !DiskCachePolicy
-  , confMergeSchedule     :: !MergeSchedule
   }
   deriving stock (Show, Eq)
 
@@ -86,12 +86,12 @@ defaultTableConfig :: TableConfig
 defaultTableConfig =
     TableConfig
       { confMergePolicy       = LazyLevelling
+      , confMergeSchedule     = defaultMergeSchedule
       , confSizeRatio         = Four
       , confWriteBufferAlloc  = AllocNumEntries 20_000
       , confBloomFilterAlloc  = defaultBloomFilterAlloc
       , confFencePointerIndex = OrdinaryIndex
       , confDiskCachePolicy   = DiskCacheAll
-      , confMergeSchedule     = defaultMergeSchedule
       }
 
 data RunLevelNo = RegularLevel LevelNo | UnionLevel

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE NamedFieldPuns #-}
 {-# OPTIONS_HADDOCK not-home #-}
 
 -- Definitions for override table config options.
@@ -87,12 +88,16 @@ instance Override DiskCachePolicy SnapshotMetaData where
         in  fmap (override rdc) smt
 
 instance Override DiskCachePolicy TableConfig where
-  override dcp
-    (TableConfig (cmp :: MergePolicy) (csz :: SizeRatio)
-      (cwba :: WriteBufferAlloc) (cbfa :: BloomFilterAlloc)
-      (cfit :: FencePointerIndexType) (_dcp :: DiskCachePolicy)
-      (cfs :: MergeSchedule))
-    = TableConfig cmp csz cwba cbfa cfit dcp cfs
+  override confDiskCachePolicy' TableConfig {..}
+    = TableConfig
+        { confMergePolicy,
+          confMergeSchedule,
+          confSizeRatio,
+          confWriteBufferAlloc,
+          confBloomFilterAlloc,
+          confFencePointerIndex,
+          confDiskCachePolicy = confDiskCachePolicy'
+        }
 
 instance Override DiskCachePolicy (SnapLevels SnapshotRun) where
   override dcp (SnapLevels (vec :: V.Vector (SnapLevel SnapshotRun))) =

src/Database/LSMTree/Internal/Snapshot/Codec.hs

@@ -267,33 +267,37 @@ instance DecodeVersioned SnapshotRun where
 -- TableConfig
 
 instance Encode TableConfig where
-  encode config =
-         encodeListLen 7
-      <> encode mergePolicy
-      <> encode sizeRatio
-      <> encode writeBufferAlloc
-      <> encode bloomFilterAlloc
-      <> encode fencePointerIndex
-      <> encode diskCachePolicy
-      <> encode mergeSchedule
-    where
-      TableConfig
-        mergePolicy
-        sizeRatio
-        writeBufferAlloc
-        bloomFilterAlloc
-        fencePointerIndex
-        diskCachePolicy
-        mergeSchedule
-        = config
+  encode
+    ( TableConfig
+        { confMergePolicy = mergePolicy
+        , confMergeSchedule = mergeSchedule
+        , confSizeRatio = sizeRatio
+        , confWriteBufferAlloc = writeBufferAlloc
+        , confBloomFilterAlloc = bloomFilterAlloc
+        , confFencePointerIndex = fencePointerIndex
+        , confDiskCachePolicy = diskCachePolicy
+        }
+      ) =
+      encodeListLen 7
+        <> encode mergePolicy
+        <> encode mergeSchedule
+        <> encode sizeRatio
+        <> encode writeBufferAlloc
+        <> encode bloomFilterAlloc
+        <> encode fencePointerIndex
+        <> encode diskCachePolicy
 
 instance DecodeVersioned TableConfig where
   decodeVersioned v@V0 = do
       _ <- decodeListLenOf 7
-      TableConfig
-        <$> decodeVersioned v <*> decodeVersioned v <*> decodeVersioned v
-        <*> decodeVersioned v <*> decodeVersioned v <*> decodeVersioned v
-        <*> decodeVersioned v
+      confMergePolicy <- decodeVersioned v
+      confMergeSchedule <- decodeVersioned v
+      confSizeRatio <- decodeVersioned v
+      confWriteBufferAlloc <- decodeVersioned v
+      confBloomFilterAlloc <- decodeVersioned v
+      confFencePointerIndex <- decodeVersioned v
+      confDiskCachePolicy <- decodeVersioned v
+      pure TableConfig {..}
 
 -- MergePolicy
 

test/Test/Database/LSMTree/Internal/Snapshot/Codec/Golden.hs

@@ -175,22 +175,15 @@ enumerateSnapshotLabel =
 enumerateTableConfig :: [(ComponentAnnotation, TableConfig)]
 enumerateTableConfig =
     [  ( fuseAnnotations [ "T1", d, e, f, g ]
-      , TableConfig
-        policy
-        ratio
-        allocs
-        bloom
-        fence
-        cache
-        merge
+      , TableConfig {..}
       )
-    | (_, policy) <- [(blank, LazyLevelling)]
-    , (_, ratio ) <- [(blank, Four)]
-    , (_, allocs) <- fmap AllocNumEntries <$> [(blank, magicNumber1)]
-    , (d, bloom ) <- enumerateBloomFilterAlloc
-    , (e, fence ) <- [("I0", CompactIndex), ("I1", OrdinaryIndex)]
-    , (f, cache ) <- enumerateDiskCachePolicy
-    , (g, merge ) <- [("G0", OneShot), ("G1", Incremental)]
+    | (_, confMergePolicy) <- [(blank, LazyLevelling)]
+    , (g, confMergeSchedule) <- [("G0", OneShot), ("G1", Incremental)]
+    , (_, confSizeRatio) <- [(blank, Four)]
+    , (_, confWriteBufferAlloc) <- fmap AllocNumEntries <$> [(blank, magicNumber1)]
+    , (d, confBloomFilterAlloc) <- enumerateBloomFilterAlloc
+    , (e, confFencePointerIndex) <- [("I0", CompactIndex), ("I1", OrdinaryIndex)]
+    , (f, confDiskCachePolicy) <- enumerateDiskCachePolicy
     ]
 
 enumerateSnapLevels :: [(ComponentAnnotation, SnapLevels SnapshotRun)]