Merge pull request #459 from IntersectMBO/mheinzel/add-normal-union

Add table union to normal API

Author: mheinzel

src/Database/LSMTree/Monoidal.hs

@@ -669,8 +669,8 @@ duplicate (Internal.MonoidalTable t) = Internal.MonoidalTable <$> Internal.dupli
   -> IO (Table IO k v) #-}
 -- | Union two full tables, creating a new table.
 --
--- A good mental model of this operation is @'Data.Map.unionWith' (<>)@ on
--- @'Data.Map.Map' k v@.
+-- A good mental model of this operation is @'Data.Map.Lazy.unionWith' (<>)@ on
+-- @'Data.Map.Lazy.Map' k v@.
 --
 -- Multiple tables of the same type but with different configuration parameters
 -- can live in the same session. However, 'union' only works for tables that

src/Database/LSMTree/Normal.hs

@@ -101,6 +101,9 @@ module Database.LSMTree.Normal (
     -- * Persistence
   , duplicate
 
+    -- * Table union
+  , union
+
     -- * Concurrency #concurrency#
     -- $concurrency
 
@@ -778,3 +781,29 @@ duplicate ::
   => Table m k v blob
   -> m (Table m k v blob)
 duplicate (Internal.NormalTable t) = Internal.NormalTable <$!> Internal.duplicate t
+
+{-------------------------------------------------------------------------------
+  Table union
+-------------------------------------------------------------------------------}
+
+{-# SPECIALISE union ::
+     Table IO k v blob
+  -> Table IO k v blob
+  -> IO (Table IO k v blob) #-}
+-- | Union two full tables, creating a new table.
+--
+-- A good mental model of this operation is @'Data.Map.Lazy.union'@ on
+-- @'Data.Map.Lazy.Map' k v@.
+--
+-- Multiple tables of the same type but with different configuration parameters
+-- can live in the same session. However, 'union' only works for tables that
+-- have the same key\/value types and configuration parameters.
+--
+-- NOTE: unioning tables creates a new table, but does not close the tables that
+-- were used as inputs.
+union :: forall m k v blob.
+     IOLike m
+  => Table m k v blob
+  -> Table m k v blob
+  -> m (Table m k v blob)
+union = undefined

test/Database/LSMTree/Class/Normal.hs

@@ -211,6 +211,15 @@ class (IsSession (Session h)) => IsTable h where
         => h m k v blob
         -> m (h m k v blob)
 
+    union ::
+           ( IOLike m
+           , SerialiseValue v
+           , C k v blob
+           )
+        => h m k v blob
+        -> h m k v blob
+        -> m (h m k v blob)
+
 withTableNew :: forall h m k v blob a.
     ( IOLike m
     , IsTable h
@@ -296,3 +305,4 @@ instance IsTable R.Table where
     open sesh snap = R.open sesh R.configNoOverride snap
 
     duplicate = R.duplicate
+    union = R.union

test/Database/LSMTree/Model/IO/Normal.hs

@@ -91,6 +91,9 @@ instance Class.IsTable Table where
 
     duplicate (Table s t) = Table s <$> runInOpenSession s (Model.duplicate t)
 
+    union (Table s1 t1) (Table _s2 t2) =
+        Table s1 <$> runInOpenSession s1 (Model.union Model.noResolve t1 t2)
+
 convLookupResult :: Model.LookupResult v b -> Class.LookupResult v b
 convLookupResult = \case
     Model.NotFound -> Class.NotFound