deps: Try to print the dependency cycle in error message

Instead of:

*** error: function:wrap:6:0: adding fedora-rebuild ("ocaml-odoc") creates a dependency cycle

it now prints:

*** error: function:wrap:4:0: dependency cycle: fedora-rebuild ("ocaml-odoc") -> fedora-rebuild ("ocaml-mdx") -> fedora-rebuild ("ocaml-odoc-parser") -> fedora-rebuild ("ocaml-ppx-expect") -> fedora-rebuild ("ocaml-ppx-inline-test") -> fedora-rebuild ("ocaml-time-now") -> fedora-rebuild ("ocaml-ppx-base") -> fedora-rebuild ("ocaml-ppx-js-style") -> fedora-rebuild ("ocaml-octavius") -> fedora-rebuild ("ocaml-odoc")

diff --git a/src/deps.ml b/src/deps.ml
index c1c1474..088c64d 100644 (file)
--- a/src/deps.ml
+++ b/src/deps.ml
@@ -88,21 +88,33 @@ and add_node { nodes; edges } ?parent data =
           * ensure we don't make a cycle, check there is no path
           * already from node -> parent.
           *)
-         if exists_path node parent edges then (
-           let loc = loc_of_node data in
-           failwithf "%a: adding %s creates a dependency cycle"
-             Ast.string_loc loc (string_of_node data)
+         (match exists_path node parent edges with
+          | None -> ()
+          | Some nodes ->
+             let loc = loc_of_node data in
+             failwithf "%a: dependency cycle: %s -> %s"
+               Ast.string_loc loc
+               (String.concat " -> " (List.map string_of_node nodes))
+               (string_of_node data)
          );
          G.add parent (node :: children) edges
        ) in
   node, { nodes; edges }
 
-(* Is there a path from n1 to n2 in edges? *)
+(* Is there a path from n1 to n2 in edges?
+ * Returns [None] if no path, or [Some nodes] if there is a path.
+ *)
 and exists_path n1 n2 edges =
-  if compare_nodes n1 n2 = 0 then true
+  if compare_nodes n1 n2 = 0 then Some [n2]
   else (
     let children = try G.find n1 edges with Not_found -> [] in
-    List.exists (fun n -> exists_path n n2 edges) children
+    let path =
+      List.find_map (
+        fun n -> exists_path n n2 edges
+      ) children in
+    match path with
+    | None -> None
+    | Some nodes -> Some (n1 :: nodes)
   )
 
 (* This is Khan's algorithm. *)