diff options
| -rw-r--r-- | main/Test.hs | 14 | ||||
| -rw-r--r-- | src/Erebos/Storage/Merge.hs | 17 | ||||
| -rw-r--r-- | test/graph.et | 111 |
3 files changed, 142 insertions, 0 deletions
diff --git a/main/Test.hs b/main/Test.hs index ac76494..fd6258d 100644 --- a/main/Test.hs +++ b/main/Test.hs @@ -271,6 +271,7 @@ commands = , ( "stored-roots", cmdStoredRoots ) , ( "stored-set-add", cmdStoredSetAdd ) , ( "stored-set-list", cmdStoredSetList ) + , ( "stored-difference", cmdStoredDifference ) , ( "head-create", cmdHeadCreate ) , ( "head-replace", cmdHeadReplace ) , ( "head-watch", cmdHeadWatch ) @@ -388,6 +389,19 @@ cmdStoredSetList = do cmdOut $ "stored-set-item" ++ concatMap ((' ':) . show . refDigest . storedRef) item cmdOut $ "stored-set-done" +cmdStoredDifference :: Command +cmdStoredDifference = do + st <- asks tiStorage + ( trefs1, "|" : trefs2 ) <- span (/= "|") <$> asks tiParams + + let loadObjs = mapM (maybe (fail "invalid ref") (return . wrappedLoad @Object) <=< liftIO . readRef st . encodeUtf8) + objs1 <- loadObjs trefs1 + objs2 <- loadObjs trefs2 + + forM_ (storedDifference objs1 objs2) $ \item -> do + cmdOut $ "stored-difference-item " ++ (show $ refDigest $ storedRef item) + cmdOut $ "stored-difference-done" + cmdHeadCreate :: Command cmdHeadCreate = do [ ttid, tref ] <- asks tiParams diff --git a/src/Erebos/Storage/Merge.hs b/src/Erebos/Storage/Merge.hs index 873a6b1..8221e91 100644 --- a/src/Erebos/Storage/Merge.hs +++ b/src/Erebos/Storage/Merge.hs @@ -17,6 +17,8 @@ module Erebos.Storage.Merge ( findProperty, findPropertyFirst, + + storedDifference, ) where import Control.Concurrent.MVar @@ -172,3 +174,18 @@ findPropertyFirst sel = fmap (fromJust . sel . fromStored) . listToMaybe . filte findPropHeads :: forall a b. Storable a => (a -> Maybe b) -> Stored a -> [Stored a] findPropHeads sel sobj | Just _ <- sel $ fromStored sobj = [sobj] | otherwise = findPropHeads sel =<< previous sobj + + +-- | Compute symmetrict difference between two stored histories. In other +-- words, return all 'Stored a' objects reachable (via 'previous') from first +-- given set, but not from the second; and vice versa. +storedDifference :: Storable a => [ Stored a ] -> [ Stored a ] -> [ Stored a ] +storedDifference xs' ys' = + let xs = filterAncestors xs' + ys = filterAncestors ys' + + filteredPrevious blocked zs = filterAncestors (previous zs ++ blocked) `diffSorted` blocked + xg = S.toAscList $ NE.last $ generationsBy (filteredPrevious ys) $ filterAncestors (xs ++ ys) `diffSorted` ys + yg = S.toAscList $ NE.last $ generationsBy (filteredPrevious xs) $ filterAncestors (ys ++ xs) `diffSorted` xs + + in xg `mergeUniq` yg diff --git a/test/graph.et b/test/graph.et new file mode 100644 index 0000000..38ec3c4 --- /dev/null +++ b/test/graph.et @@ -0,0 +1,111 @@ +module graph + +test StoredDifference: + spawn as p1 + with p1: + # ref names: r<level>_<num> + + send: + "store rec" + "num:i 1" + "" + expect /store-done (blake2#[0-9a-f]*)/ capture r1_1 + + send: + "store rec" + "PREV:r $r1_1" + "" + expect /store-done (blake2#[0-9a-f]*)/ capture r2_1 + + send "stored-difference $r2_1 |" + expect /stored-difference-item $r1_1/ + expect /stored-difference-item $r2_1/ + local: + expect /stored-difference-(.*)/ capture done + guard (done == "done") + + send: + "store rec" + "PREV:r $r2_1" + "num:i 1" + "" + expect /store-done (blake2#[0-9a-f]*)/ capture r3_1 + + send "stored-difference $r1_1 | $r3_1" + expect /stored-difference-item $r2_1/ + expect /stored-difference-item $r3_1/ + local: + expect /stored-difference-(.*)/ capture done + guard (done == "done") + + send: + "store rec" + "PREV:r $r2_1" + "num:i 2" + "" + expect /store-done (blake2#[0-9a-f]*)/ capture r3_2 + + send: + "store rec" + "PREV:r $r3_1" + "num:i 1" + "" + expect /store-done (blake2#[0-9a-f]*)/ capture r4_1 + + send: + "store rec" + "PREV:r $r3_2" + "num:i 2" + "" + expect /store-done (blake2#[0-9a-f]*)/ capture r4_2 + + send "stored-difference $r4_1 | $r4_2" + expect /stored-difference-item $r3_1/ + expect /stored-difference-item $r3_2/ + expect /stored-difference-item $r4_1/ + expect /stored-difference-item $r4_2/ + local: + expect /stored-difference-(.*)/ capture done + guard (done == "done") + + + send: + "store rec" + "PREV:r $r2_1" + "num:i 3" + "" + expect /store-done (blake2#[0-9a-f]*)/ capture r3_3 + + send: + "store rec" + "PREV:r $r3_2" + "PREV:r $r3_3" + "num:i 3" + "" + expect /store-done (blake2#[0-9a-f]*)/ capture r4_3 + + send: + "store rec" + "PREV:r $r3_3" + "num:i 4" + "" + expect /store-done (blake2#[0-9a-f]*)/ capture r4_4 + + send "stored-difference $r4_1 $r4_2 | $r4_3 $r4_4" + expect /stored-difference-item $r3_1/ + expect /stored-difference-item $r3_3/ + expect /stored-difference-item $r4_1/ + expect /stored-difference-item $r4_2/ + expect /stored-difference-item $r4_3/ + expect /stored-difference-item $r4_4/ + local: + expect /stored-difference-(.*)/ capture done + guard (done == "done") + + send "stored-difference $r1_1 $r2_1 $r3_2 $r3_3 | $r4_1 $r4_3" + expect /stored-difference-item $r3_1/ + expect /stored-difference-item $r4_1/ + expect /stored-difference-item $r4_3/ + local: + expect /stored-difference-(.*)/ capture done + guard (done == "done") |