Traverse full graph when searching for cycles

This fixes a bug where some edges would be skipped for certain graph
configurations resulting in missed cycles.

This would eventually result in runtime Stack Overflow exceptions when
attempting to operate on the graph.

This also improves the error reporting in the case of a cycle.
Previously we would just report whatever was on the path when a cycle
was detected. Now we report only the exact cycle path.

Author: julienvincent

packages/kmono-core/src/k16/kmono/core/graph.clj

@@ -7,32 +7,68 @@
 (def ^:no-doc ?ExecOrder
   [:vector [:vector :symbol]])
 
-(defn find-cycles
-  "Try find cyclic dependencies between packages in a given `packages` map"
+(defn- cycle-path
+  [parent-map from-node to-node]
+  (loop [node from-node
+         acc [from-node]]
+    (if (= node to-node)
+      (conj (vec (reverse acc)) to-node)
+      (recur (get parent-map node)
+             (conj acc (get parent-map node))))))
+
+(defn- find-cycle-path-from
+  [packages node visiting visited parent-map]
+  (let [visiting (conj visiting node)
+        neighbors (sort (get-in packages [node :depends-on]))]
+    (loop [neighbors neighbors
+           visited visited
+           parent-map parent-map]
+      (if-let [neighbor (first neighbors)]
+        (cond
+          (contains? visiting neighbor)
+          [(cycle-path parent-map node neighbor) visited parent-map]
+
+          (contains? visited neighbor)
+          (recur (rest neighbors) visited parent-map)
+
+          :else
+          (let [[cycle visited parent-map]
+                (find-cycle-path-from packages
+                                      neighbor
+                                      visiting
+                                      visited
+                                      (assoc parent-map neighbor node))]
+            (if cycle
+              [cycle visited parent-map]
+              (recur (rest neighbors) visited parent-map))))
+        [nil (conj visited node) parent-map]))))
+
+(defn find-cycle
+  "Find a dependency cycle in `packages` and returns it as a closed path.
+
+  Returns a vector like `[a b c a]` for a cycle `a -> b -> c -> a`, or nil if
+  no cycle is found."
   [packages]
-  (loop [nodes (keys packages)
-         node (first nodes)
-         path #{}]
-    (when node
-      (let [package (get packages node)]
-        (if (seq (:depends-on package))
-          (if (contains? path node)
-            (conj (set path) node)
-            (recur (:depends-on package)
-                   (first (:depends-on package))
-                   (conj path node)))
-          (recur (rest nodes)
-                 (first (rest nodes))
-                 (disj path node)))))))
+  (loop [nodes (sort (keys packages))
+         visited #{}
+         parent-map {}]
+    (when-let [node (first nodes)]
+      (if (contains? visited node)
+        (recur (rest nodes) visited parent-map)
+        (let [[cycle visited parent-map]
+              (find-cycle-path-from packages node #{} visited parent-map)]
+          (if cycle
+            cycle
+            (recur (rest nodes) visited parent-map)))))))
 
 (defn ensure-no-cycles!
   "Same as [[find-cycles]] but will throw an exception if any cycles are found."
   [packages]
-  (let [cycles (find-cycles packages)]
-    (when (seq cycles)
-      (throw (ex-info "Cicrlar dependencies found"
+  (let [cycle (find-cycle packages)]
+    (when cycle
+      (throw (ex-info "Circular dependencies found"
                       {:type :kmono/circular-dependencies
-                       :cycles cycles}))))
+                       :cycles [cycle]}))))
   packages)
 
 (defn parallel-topo-sort

packages/kmono-core/test/k16/kmono/core/graph_test.clj

@@ -1,7 +1,7 @@
 (ns k16.kmono.core.graph-test
   (:require
    [babashka.fs :as fs]
-   [clojure.test :refer [deftest is use-fixtures]]
+   [clojure.test :refer [deftest is testing use-fixtures]]
    [k16.kmono.core.config :as core.config]
    [k16.kmono.core.graph :as core.graph]
    [k16.kmono.core.packages :as core.packages]
@@ -14,7 +14,7 @@
   (let [config (core.config/resolve-workspace-config *repo*)
         packages (core.packages/resolve-packages *repo* config)]
 
-    (is (not (core.graph/find-cycles packages)))))
+    (is (not (core.graph/find-cycle packages)))))
 
 (deftest finds-cycles-test
   (fs/write-bytes (fs/file *repo* "packages/a/deps.edn")
@@ -26,9 +26,20 @@
     (is (thrown-match?
          clojure.lang.ExceptionInfo
          {:type :kmono/circular-dependencies
-          :cycles #{'com.kepler16/a 'com.kepler16/b}}
+          :cycles '[[com.kepler16/a com.kepler16/b com.kepler16/a]]}
          (core.packages/resolve-packages *repo* config)))))
 
+(deftest no-cycles-multi-paths-test
+  (testing "reproducing a bug where cycles were missed"
+    (is (= '[com.kepler16/a com.kepler16/b com.kepler16/c com.kepler16/a]
+           (core.graph/find-cycle
+            '{com.kepler16/a {:depends-on #{com.kepler16/b}}
+              com.kepler16/b {:depends-on #{com.kepler16/d
+                                            com.kepler16/c}}
+              com.kepler16/c {:depends-on #{com.kepler16/a}}
+
+              com.kepler16/d {:depends-on #{com.kepler16/e}}})))))
+
 (deftest topological-sort-test
   (fs/create-dirs (fs/file *repo* "packages/c"))
   (fs/write-bytes (fs/file *repo* "packages/c/deps.edn")