Skip to content

Commit

Permalink
Merge pull request #452 from IntersectMBO/jdral/rename-table-union
Browse files Browse the repository at this point in the history
Rename table merge to table union in the public API
  • Loading branch information
jorisdral authored Nov 6, 2024
2 parents 637fec5 + 6876398 commit 49c234d
Show file tree
Hide file tree
Showing 7 changed files with 44 additions and 41 deletions.
23 changes: 13 additions & 10 deletions src/Database/LSMTree/Monoidal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -100,8 +100,8 @@ module Database.LSMTree.Monoidal (
-- * Persistence
, duplicate

-- * Merging tables
, merge
-- * Table union
, union

-- * Concurrency
-- $concurrency
Expand Down Expand Up @@ -652,30 +652,33 @@ duplicate :: forall m k v.
duplicate (Internal.MonoidalTable t) = Internal.MonoidalTable <$> Internal.duplicate t

{-------------------------------------------------------------------------------
Merging tables
Table union
-------------------------------------------------------------------------------}

{-# SPECIALISE merge ::
{-# SPECIALISE union ::
ResolveValue v
=> Table IO k v
-> Table IO k v
-> IO (Table IO k v) #-}
-- | Merge full tables, creating a new table.
-- | 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@.
--
-- Multiple tables of the same type but with different configuration parameters
-- can live in the same session. However, 'merge' only works for tables that
-- can live in the same session. However, 'union' only works for tables that
-- have the same key\/value types and configuration parameters.
--
-- NOTE: merging tables creates a new table, but does not close
-- the tables that were used as inputs.
merge :: forall m k v.
-- NOTE: unioning tables creates a new table, but does not close the tables that
-- were used as inputs.
union :: forall m k v.
( IOLike m
, ResolveValue v
)
=> Table m k v
-> Table m k v
-> m (Table m k v)
merge = undefined
union = undefined

{-------------------------------------------------------------------------------
Monoidal value resolution
Expand Down
10 changes: 5 additions & 5 deletions test/Database/LSMTree/Class/Monoidal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ module Database.LSMTree.Class.Monoidal (
, withTableNew
, withTableOpen
, withTableDuplicate
, withTableMerge
, withTableUnion
, withCursor
, module Types
) where
Expand Down Expand Up @@ -183,7 +183,7 @@ class (IsSession (Session h)) => IsTable h where
=> h m k v
-> m (h m k v)

merge ::
union ::
( IOLike m
, ResolveValue v
, SerialiseValue v
Expand Down Expand Up @@ -229,7 +229,7 @@ withTableDuplicate :: forall h m k v a.
-> m a
withTableDuplicate table = bracket (duplicate table) close

withTableMerge :: forall h m k v a.
withTableUnion :: forall h m k v a.
( IOLike m
, IsTable h
, SerialiseValue v
Expand All @@ -240,7 +240,7 @@ withTableMerge :: forall h m k v a.
-> h m k v
-> (h m k v -> m a)
-> m a
withTableMerge table1 table2 = bracket (merge table1 table2) close
withTableUnion table1 table2 = bracket (table1 `union` table2) close

withCursor :: forall h m k v a.
( IOLike m
Expand Down Expand Up @@ -281,4 +281,4 @@ instance IsTable R.Table where
open sesh snap = R.open sesh R.configNoOverride snap

duplicate = R.duplicate
merge = R.merge
union = R.union
4 changes: 2 additions & 2 deletions test/Database/LSMTree/Model/IO/Monoidal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -72,8 +72,8 @@ instance Class.IsTable Table where

duplicate (Table s t) = Table s <$> runInOpenSession s (Model.duplicate t)

merge (Table s1 t1) (Table _s2 t2) =
Table s1 <$> runInOpenSession s1 (Model.merge Model.getResolve t1 t2)
union (Table s1 t1) (Table _s2 t2) =
Table s1 <$> runInOpenSession s1 (Model.union Model.getResolve t1 t2)

convLookupResult :: Model.LookupResult v b -> Class.LookupResult v
convLookupResult = \case
Expand Down
12 changes: 6 additions & 6 deletions test/Database/LSMTree/Model/Session.hs
Original file line number Diff line number Diff line change
Expand Up @@ -71,8 +71,8 @@ module Database.LSMTree.Model.Session (
, listSnapshots
-- * Multiple writable tables
, duplicate
-- * Table merge
, merge
-- * Table union
, union
) where

import Control.Monad (when)
Expand Down Expand Up @@ -602,10 +602,10 @@ guardCursorIsOpen Cursor{..} =
pure (fromJust $ fromSomeCursor c)

{-------------------------------------------------------------------------------
Merging tables
Table union
-------------------------------------------------------------------------------}

merge ::
union ::
( MonadState Model m
, MonadError Err m
, C k v b
Expand All @@ -614,7 +614,7 @@ merge ::
-> Table k v b
-> Table k v b
-> m (Table k v b)
merge r th1 th2 = do
union r th1 th2 = do
(_, t1) <- guardTableIsOpen th1
(_, t2) <- guardTableIsOpen th2
newTableWith TableConfig $ Model.merge r t1 t2
newTableWith TableConfig $ Model.union r t1 t2
8 changes: 4 additions & 4 deletions test/Database/LSMTree/Model/Table.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,8 +36,8 @@ module Database.LSMTree.Model.Table (
, snapshot
-- * Multiple writable tables
, duplicate
-- * Table merge
, merge
-- * Table union
, union
-- * Testing
, size
) where
Expand Down Expand Up @@ -343,12 +343,12 @@ readCursor n c =
--
-- Multiple tables of the same type but with different configuration parameters
-- can live in the same session. However, some operations, like
merge ::
union ::
ResolveSerialisedValue v
-> Table k v b
-> Table k v b
-> Table k v b
merge r (Table xs) (Table ys) =
union r (Table xs) (Table ys) =
Table (Map.unionWith f xs ys)
where
f (v1, bMay1) (v2, bMay2) =
Expand Down
26 changes: 13 additions & 13 deletions test/Test/Database/LSMTree/Class/Monoidal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -98,7 +98,7 @@ tests = testGroup "Test.Database.LSMTree.Class.Monoidal"
, testProperty' "snapshot-nochanges" $ prop_snapshotNoChanges tbl
, testProperty' "snapshot-nochanges2" $ prop_snapshotNoChanges2 tbl
, testProperty' "lookup-mupsert" $ prop_lookupUpdate tbl
, testProperty' "merge" $ prop_merge tbl
, testProperty' "merge" $ prop_union tbl
]

-------------------------------------------------------------------------------
Expand Down Expand Up @@ -450,33 +450,33 @@ prop_lookupUpdate h ups k v1 v2 = ioProperty $ do
return $ res === V.singleton (Found (resolve v2 v1))

-------------------------------------------------------------------------------
-- implement classic QC tests for monoidal table merges
-- implement classic QC tests for monoidal table unions
-------------------------------------------------------------------------------

prop_merge :: forall h.
prop_union :: forall h.
IsTable h
=> Proxy h -> [(Key, Update Value)] -> [(Key, Update Value)]
-> [Key] -> Property
prop_merge h ups1 ups2 (V.fromList -> testKeys) = ioProperty $ do
prop_union h ups1 ups2 (V.fromList -> testKeys) = ioProperty $ do
withTableNew h ups1 $ \s hdl1 -> do
Class.withTableNew s (testTableConfig h) $ \hdl2 -> do
updates hdl2 $ V.fromList ups2

-- merge them.
Class.withTableMerge hdl1 hdl2 $ \hdl3 -> do
-- union them.
Class.withTableUnion hdl1 hdl2 $ \hdl3 -> do

-- results in parts and the merge table
-- results in parts and the union table
res1 <- lookups hdl1 testKeys
res2 <- lookups hdl2 testKeys
res3 <- lookups hdl3 testKeys

let mergeResult :: LookupResult Value -> LookupResult Value -> LookupResult Value
mergeResult r@NotFound NotFound = r
mergeResult NotFound r@(Found _) = r
mergeResult r@(Found _) NotFound = r
mergeResult (Found v1) (Found v2) = Found (resolve v1 v2)
let unionResult :: LookupResult Value -> LookupResult Value -> LookupResult Value
unionResult r@NotFound NotFound = r
unionResult NotFound r@(Found _) = r
unionResult r@(Found _) NotFound = r
unionResult (Found v1) (Found v2) = Found (resolve v1 v2)

return $ V.zipWith mergeResult res1 res2 == res3
return $ V.zipWith unionResult res1 res2 == res3

-------------------------------------------------------------------------------
-- implement classic QC tests for snapshots
Expand Down
2 changes: 1 addition & 1 deletion test/Test/Database/LSMTree/Class/Normal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -559,7 +559,7 @@ prop_updatesMayInvalidateBlobRefs h ups k1 v1 blob1 ups' = monadicIO $ do
{- Not applicable -}

-------------------------------------------------------------------------------
-- implement classic QC tests for monoidal table merges
-- implement classic QC tests for monoidal table unions
-------------------------------------------------------------------------------

{- Not applicable -}
Expand Down

0 comments on commit 49c234d

Please sign in to comment.