fix LCA query

Author: mitchellwrosen

codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs

@@ -2863,32 +2863,45 @@ before x y =
     selectAncestorsOfY = ancestorSql y
 
 lca :: CausalHashId -> CausalHashId -> Transaction (Maybe CausalHashId)
-lca x y =
-  queryStreamCol (ancestorSql x) \nextX ->
-    queryStreamCol (ancestorSql y) \nextY -> do
-      let getNext = (,) <$> nextX <*> nextY
-          loop2 seenX seenY =
-            getNext >>= \case
-              (Just px, Just py) ->
-                let seenX' = Set.insert px seenX
-                    seenY' = Set.insert py seenY
-                 in if Set.member px seenY'
-                      then pure (Just px)
-                      else
-                        if Set.member py seenX'
-                          then pure (Just py)
-                          else loop2 seenX' seenY'
-              (Nothing, Nothing) -> pure Nothing
-              (Just px, Nothing) -> loop1 nextX seenY px
-              (Nothing, Just py) -> loop1 nextY seenX py
-          loop1 getNext matches v =
-            if Set.member v matches
-              then pure (Just v)
-              else
-                getNext >>= \case
-                  Just v -> loop1 getNext matches v
-                  Nothing -> pure Nothing
-      loop2 (Set.singleton x) (Set.singleton y)
+lca alice bob =
+  queryMaybeCol
+    [sql|
+      WITH RECURSIVE history_one (causal_id) AS (
+        SELECT :alice
+        UNION
+        SELECT causal_parent.parent_id
+        FROM history_one
+          JOIN causal_parent ON history_one.causal_id = causal_parent.causal_id
+      ),
+      history_two (causal_id) AS (
+        SELECT :bob
+        UNION
+        SELECT causal_parent.parent_id
+        FROM history_two
+          JOIN causal_parent ON history_two.causal_id = causal_parent.causal_id
+      ),
+      common_ancestors (causal_id) AS (
+        SELECT causal_id
+        FROM history_one
+        INTERSECT
+        SELECT causal_id
+        FROM history_two
+        ORDER BY causal_id DESC
+      )
+      SELECT causal_id
+      FROM common_ancestors
+      WHERE NOT EXISTS (
+        SELECT 1
+        FROM causal_parent
+        WHERE causal_parent.parent_id = common_ancestors.causal_id
+          AND EXISTS (
+            SELECT 1
+            FROM common_ancestors c
+            WHERE c.causal_id = causal_parent.causal_id
+          )
+      )
+      LIMIT 1
+    |]
 
 ancestorSql :: CausalHashId -> Sql
 ancestorSql h =

unison-src/transcripts/fix-5326.md

@@ -105,12 +105,12 @@ F - D - C - B - A
               foo
 ```
 
-```ucm:error
+```ucm
 scratch/main> merge /bar
 ```
 
-This should be a fast-forward, but we get this shape instead (which fails due to conflicts), because we incorrectly
-compute `LCA(main, bar)` as `A`, not `B`.
+This should be a fast-forward, but we used to get this shape instead (which fails due to conflicts), because we
+incorrectly computed `LCA(main, bar)` as `A`, not `B`.
 
 ```
 main

unison-src/transcripts/fix-5326.output.md

@@ -214,36 +214,13 @@ F - D - C - B - A
 ``` ucm
 scratch/main> merge /bar
 
-  I couldn't automatically merge scratch/bar into scratch/main.
-  However, I've added the definitions that need attention to the
-  top of scratch.u.
+  😶
   
-  When you're done, you can run
-  
-    merge.commit
-  
-  to merge your changes back into main and delete the temporary
-  branch. Or, if you decide to cancel the merge instead, you can
-  run
-  
-    delete.branch /merge-bar-into-main
-  
-  to delete the temporary branch and switch back to main.
-
-```
-``` unison:added-by-ucm scratch.u
--- scratch/main
-x : Nat
-x = 4
-
--- scratch/bar
-x : Nat
-x = 2
+  scratch/main was already up-to-date with scratch/bar.
 
 ```
-
-This should be a fast-forward, but we get this shape instead (which fails due to conflicts), because we incorrectly
-compute `LCA(main, bar)` as `A`, not `B`.
+This should be a fast-forward, but we used to get this shape instead (which fails due to conflicts), because we
+incorrectly computed `LCA(main, bar)` as `A`, not `B`.
 
 ``` 
 main