Inline Update injection/projection functions at use sites.

That is, inline the injection/projections from the `D.L.I.Entry` module at their
use sites.

Author: jorisdral

src/Database/LSMTree/Internal/Entry.hs

@@ -5,11 +5,6 @@ module Database.LSMTree.Internal.Entry (
   , onBlobRef
   , NumEntries (..)
   , unNumEntries
-    -- * Injections/projections
-  , updateToEntryNormal
-  , updateToEntryMonoidal
-  , entryToUpdateNormal
-  , entryToUpdateMonoidal
     -- * Value resolution/merging
   , combine
   , combineMaybe
@@ -89,36 +84,6 @@ newtype NumEntries = NumEntries Int
 unNumEntries :: NumEntries -> Int
 unNumEntries (NumEntries x) = x
 
-{-------------------------------------------------------------------------------
-  Injections/projections
--------------------------------------------------------------------------------}
-
-updateToEntryNormal :: Normal.Update v blob -> Entry v blob
-updateToEntryNormal = \case
-    Normal.Insert v Nothing  -> Insert v
-    Normal.Insert v (Just b) -> InsertWithBlob v b
-    Normal.Delete            -> Delete
-
-entryToUpdateNormal :: Entry v blob -> Maybe (Normal.Update v blob)
-entryToUpdateNormal = \case
-    Insert v           -> Just (Normal.Insert v Nothing)
-    InsertWithBlob v b -> Just (Normal.Insert v (Just b))
-    Mupdate _          -> Nothing
-    Delete             -> Just Normal.Delete
-
-updateToEntryMonoidal :: Monoidal.Update v -> Entry v blob
-updateToEntryMonoidal = \case
-    Monoidal.Insert v  -> Insert v
-    Monoidal.Mupsert v -> Mupdate v
-    Monoidal.Delete    -> Delete
-
-entryToUpdateMonoidal :: Entry v blob -> Maybe (Monoidal.Update v)
-entryToUpdateMonoidal = \case
-    Insert v           -> Just (Monoidal.Insert v)
-    InsertWithBlob _ _ -> Nothing
-    Mupdate v          -> Just (Monoidal.Mupsert v)
-    Delete             -> Just Monoidal.Delete
-
 {-------------------------------------------------------------------------------
   Value resolution/merging
 -------------------------------------------------------------------------------}
@@ -149,12 +114,12 @@ combinesNormal = NE.head
 resolveEntriesNormal ::
      NonEmpty (Entry v blob)
   -> Maybe (Normal.Update v blob)
-resolveEntriesNormal es = entryToUpdateNormal (combinesNormal es)
+resolveEntriesNormal _ = error "about to be removed"
 
 -- | Returns 'Nothing' if the combined entries can not be mapped to an
 -- 'Monoidal.Update'.
 resolveEntriesMonoidal ::
      (v -> v -> v)
   -> NonEmpty (Entry v blob)
   -> Maybe (Monoidal.Update v)
-resolveEntriesMonoidal f es = entryToUpdateMonoidal (combinesMonoidal f es)
+resolveEntriesMonoidal _ _ = error "about to be removed"

src/Database/LSMTree/Monoidal.hs

@@ -424,7 +424,13 @@ updates es (Internal.MonoidalTable th) = do
       th
   where
     serialiseEntry = bimap Internal.serialiseKey serialiseOp
-    serialiseOp = first Internal.serialiseValue . Entry.updateToEntryMonoidal
+    serialiseOp = first Internal.serialiseValue . updateToEntry
+
+    updateToEntry :: Update v -> Entry.Entry v blob
+    updateToEntry = \case
+        Insert v  -> Entry.Insert v
+        Mupsert v -> Entry.Mupdate v
+        Delete    -> Entry.Delete
 
 {-# SPECIALISE inserts ::
      (SerialiseKey k, SerialiseValue v, ResolveValue v)

src/Database/LSMTree/Normal.hs

@@ -513,7 +513,13 @@ updates es (Internal.NormalTable th) = do
   where
     serialiseEntry = bimap Internal.serialiseKey serialiseOp
     serialiseOp = bimap Internal.serialiseValue Internal.serialiseBlob
-                . Entry.updateToEntryNormal
+                . updateToEntry
+
+    updateToEntry :: Update v blob -> Entry.Entry v blob
+    updateToEntry = \case
+        Insert v Nothing  -> Entry.Insert v
+        Insert v (Just b) -> Entry.InsertWithBlob v b
+        Delete            -> Entry.Delete
 
 {-# SPECIALISE inserts ::
      (SerialiseKey k, SerialiseValue v, SerialiseValue blob)

test/Test/Database/LSMTree/Internal/Entry.hs

@@ -116,3 +116,33 @@ newtype BlobSpanSG = BlobSpanSG BlobSpan
 instance Arbitrary BlobSpanSG where
   arbitrary = coerce (BlobSpan <$> arbitrary <*> arbitrary)
   shrink = coerce $ \(BlobSpan x y)  -> [ BlobSpan x' y' | (x', y') <- shrink2 (x, y) ]
+
+{-------------------------------------------------------------------------------
+  Injections/projections
+-------------------------------------------------------------------------------}
+
+updateToEntryNormal :: Normal.Update v blob -> Entry v blob
+updateToEntryNormal = \case
+    Normal.Insert v Nothing  -> Insert v
+    Normal.Insert v (Just b) -> InsertWithBlob v b
+    Normal.Delete            -> Delete
+
+_entryToUpdateNormal :: Entry v blob -> Maybe (Normal.Update v blob)
+_entryToUpdateNormal = \case
+    Insert v           -> Just (Normal.Insert v Nothing)
+    InsertWithBlob v b -> Just (Normal.Insert v (Just b))
+    Mupdate _          -> Nothing
+    Delete             -> Just Normal.Delete
+
+updateToEntryMonoidal :: Monoidal.Update v -> Entry v blob
+updateToEntryMonoidal = \case
+    Monoidal.Insert v  -> Insert v
+    Monoidal.Mupsert v -> Mupdate v
+    Monoidal.Delete    -> Delete
+
+_entryToUpdateMonoidal :: Entry v blob -> Maybe (Monoidal.Update v)
+_entryToUpdateMonoidal = \case
+    Insert v           -> Just (Monoidal.Insert v)
+    InsertWithBlob _ _ -> Nothing
+    Mupdate v          -> Just (Monoidal.Mupsert v)
+    Delete             -> Just Monoidal.Delete

test/Test/Database/LSMTree/Internal/Run.hs

@@ -28,7 +28,6 @@ import           Database.LSMTree.Extras.RunData
 import           Database.LSMTree.Internal.BlobRef (BlobSpan (..))
 import qualified Database.LSMTree.Internal.CRC32C as CRC
 import           Database.LSMTree.Internal.Entry
-import qualified Database.LSMTree.Internal.Normal as N
 import qualified Database.LSMTree.Internal.RawBytes as RB
 import           Database.LSMTree.Internal.RawPage
 import           Database.LSMTree.Internal.Run as Run
@@ -80,7 +79,8 @@ testSingleInsert sessionRoot key val mblob =
     let fs = FsIO.ioHasFS (FS.MountPoint sessionRoot) in
     FS.withIOHasBlockIO fs FS.defaultIOCtxParams $ \hbio -> do
     -- flush write buffer
-    let wb = Map.singleton key (updateToEntryNormal (N.Insert val mblob))
+    let e = case mblob of Nothing -> Insert val; Just blob -> InsertWithBlob val blob
+        wb = Map.singleton key e
     withRun fs hbio (simplePath 42) (RunData wb) $ \_ -> do
       -- check all files have been written
       let activeDir = sessionRoot