diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2026-05-30 21:20:14 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2026-05-31 20:10:37 +0200 |
| commit | 78cb2c00fc45144fba7486bf7bd2f3f202d66037 (patch) | |
| tree | 18ca44d6d980ab276f75c04aad4aa9f9c79a6a05 /main/Test.hs | |
| parent | f9e1191842c2ceac3c9959c1736fe066ca2419ba (diff) | |
Graph: common ancestors search
Diffstat (limited to 'main/Test.hs')
| -rw-r--r-- | main/Test.hs | 15 |
1 files changed, 15 insertions, 0 deletions
diff --git a/main/Test.hs b/main/Test.hs index e67d0b5..ad4cb0b 100644 --- a/main/Test.hs +++ b/main/Test.hs @@ -51,6 +51,7 @@ import Erebos.Set import Erebos.State import Erebos.Storable import Erebos.Storage +import Erebos.Storage.Graph import Erebos.Storage.Head import Erebos.Storage.Merge import Erebos.Sync @@ -291,6 +292,7 @@ commands = , ( "stored-roots", cmdStoredRoots ) , ( "stored-set-add", cmdStoredSetAdd ) , ( "stored-set-list", cmdStoredSetList ) + , ( "stored-common-ancestors", cmdStoredCommonAncestors ) , ( "stored-difference", cmdStoredDifference ) , ( "head-create", cmdHeadCreate ) , ( "head-replace", cmdHeadReplace ) @@ -461,6 +463,19 @@ cmdStoredSetList = do cmdOut $ "stored-set-item" ++ concatMap ((' ':) . show . refDigest . storedRef) item cmdOut $ "stored-set-done" +cmdStoredCommonAncestors :: Command +cmdStoredCommonAncestors = 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_ (commonAncestors objs1 objs2) $ \item -> do + cmdOut $ "stored-common-ancestors-item " ++ (show $ refDigest $ storedRef item) + cmdOut $ "stored-common-ancestors-done" + cmdStoredDifference :: Command cmdStoredDifference = do st <- asks tiStorage |