Merge pull request #546 from IntersectMBO/jdral/union-entry-semigroup

`Semigroup` and semantic tests for union and regular `Entry`s

Author: jorisdral

prototypes/ScheduledMerges.hs

@@ -470,7 +470,9 @@ combine new_ old = case new_ of
 --
 -- See 'MergeUnion'.
 combineUnion :: Op -> Op -> Op
+combineUnion Delete         (Mupsert v)  = Insert v Nothing
 combineUnion Delete         old          = old
+combineUnion (Mupsert u)    Delete       = Insert u Nothing
 combineUnion new_           Delete       = new_
 combineUnion (Mupsert v')   (Mupsert v ) = Insert (resolveValue v' v) Nothing
 combineUnion (Mupsert v')   (Insert v _) = Insert (resolveValue v' v) Nothing

src-extras/Database/LSMTree/Extras/Generators.hs

@@ -549,7 +549,7 @@ instance Arbitrary (Unsliced SerialisedKey) where
 
 instance Arbitrary BlobSpan where
   arbitrary = BlobSpan <$> arbitrary <*> arbitrary
-  shrink (BlobSpan x y) = BlobSpan <$> shrink x <*> shrink y
+  shrink (BlobSpan x y) = [ BlobSpan x' y' | (x', y') <- shrink (x, y) ]
 
 {-------------------------------------------------------------------------------
   Merge

src/Database/LSMTree/Internal/Entry.hs

@@ -92,12 +92,11 @@ unNumEntries (NumEntries x) = x
   Value resolution/merging
 -------------------------------------------------------------------------------}
 
--- | As long as values are a semigroup, an Entry is too
-instance Semigroup v => Semigroup (Entry v b) where
-  e1 <> e2 = combine (<>) e1 e2
-
 -- | Given a value-merge function, combine entries. Only take a blob from the
 -- left entry.
+--
+-- Note: 'Entry' is a semigroup with 'combine' if the @(v -> v -> v)@ argument
+-- is associative.
 combine :: (v -> v -> v) -> Entry v b -> Entry v b -> Entry v b
 combine _ e@Delete            _                    = e
 combine _ e@Insert {}         _                    = e
@@ -111,10 +110,15 @@ combine f   (Mupdate u)       (Mupdate v)          = Mupdate (f u v)
 -- has a value, the result should have a value (represented by 'Insert'). If
 -- both have a value, these values get combined monoidally. Only take a blob
 -- from the left entry.
+--
+-- Note: 'Entry' is a semigroup with 'combineUnion' if the @(v -> v -> v)@
+-- argument is associative.
 combineUnion :: (v -> v -> v) -> Entry v b -> Entry v b -> Entry v b
 combineUnion f = go
   where
+    go Delete               (Mupdate v)          = Insert v
     go Delete               e                    = e
+    go (Mupdate u)          Delete               = Insert u
     go e                    Delete               = e
     go (Insert u)           (Insert v)           = Insert (f u v)
     go (Insert u)           (InsertWithBlob v _) = Insert (f u v)