Guarantee the order of related derivations when listing them

Since I believe this is important when inserting builds, as for the derived
priorities to be computed correctly, the derivations closet in the graph need
to be processed first, so that their derived priority informs that of builds
that depend on them.

1 files changed, 62 insertions, 34 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index ccf2848..70982db 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -786,28 +786,18 @@ INSERT INTO agent_tags (agent_id, tag_id) VALUES (:agent_id, :tag_id)"
 (define-method (datastore-list-related-derivations-with-no-build-for-outputs
                 (datastore <sqlite-datastore>)
                 derivation)
-  (call-with-worker-thread
-   (slot-ref datastore 'worker-reader-thread-channel)
-   (lambda (db)
-     (let ((statement
-            (sqlite-prepare
-             db
-             "
-WITH RECURSIVE related_derivations(id) AS (
-  VALUES(:derivation_id)
-UNION
-  SELECT derivation_outputs.derivation_id
-  FROM derivation_outputs
-  INNER JOIN derivation_inputs
-    ON derivation_outputs.id = derivation_inputs.derivation_output_id
-  INNER JOIN related_derivations
-    ON related_derivations.id = derivation_inputs.derivation_id
-)
-SELECT derivations.name
-FROM related_derivations
+  (define (get-input-derivations-with-no-builds db derivation-id)
+    (let ((statement
+           (sqlite-prepare
+            db
+            "
+SELECT derivations.id
+FROM derivation_inputs
+INNER JOIN derivation_outputs
+  ON derivation_inputs.derivation_output_id = derivation_outputs.id
 INNER JOIN derivations
-  ON related_derivations.id = derivations.id
-WHERE related_derivations.id != :derivation_id
+  ON derivations.id = derivation_outputs.derivation_id
+WHERE derivation_inputs.derivation_id = :derivation_id
   AND NOT EXISTS (
     SELECT 1
     FROM builds
@@ -817,27 +807,65 @@ WHERE related_derivations.id != :derivation_id
     INNER JOIN derivations AS other_derivations
       ON other_derivation_derivation_outputs.derivation_id =
          other_derivations.id
-    INNER JOIN derivation_outputs
-      ON derivation_outputs.output_id =
+    INNER JOIN derivation_outputs AS all_other_derivation_derivation_outputs
+      ON all_other_derivation_derivation_outputs.output_id =
          other_derivation_derivation_outputs.output_id
-    WHERE derivation_outputs.derivation_id = related_derivations.id
+    WHERE all_other_derivation_derivation_outputs.derivation_id = derivations.id
       AND other_derivations.system_id = derivations.system_id
       AND builds.canceled = 0
   )
 "
-             #:cache? #t)))
+            #:cache? #t)))
 
-       (sqlite-bind-arguments
-        statement
-        #:derivation_id (db-find-derivation-id db derivation))
+      (sqlite-bind-arguments
+       statement
+       #:derivation_id derivation-id)
 
-       (let ((result (sqlite-map
-                      (match-lambda
-                        (#(derivation) derivation))
-                      statement)))
-         (sqlite-reset statement)
+      (let ((result (sqlite-map
+                     (match-lambda
+                       (#(derivation-id) derivation-id))
+                     statement)))
+        (sqlite-reset statement)
 
-         result)))))
+        result)))
+
+  (define (get-derivation-name db derivation-id)
+    (let ((statement
+           (sqlite-prepare
+            db
+            "
+SELECT name FROM derivations WHERE id = :id"
+            #:cache? #t)))
+
+      (sqlite-bind-arguments
+       statement
+       #:id derivation-id)
+
+      (let ((result (match (sqlite-step statement)
+                      (#(name) name))))
+        (sqlite-reset statement)
+
+        result)))
+
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-reader-thread-channel)
+   (lambda (db)
+     (let loop ((derivation-ids (list (db-find-derivation-id db derivation)))
+                (result '()))
+       (let ((new-ids
+              (delete-duplicates!
+               (append-map! (lambda (derivation-id)
+                              (get-input-derivations-with-no-builds
+                               db
+                               derivation-id))
+                            derivation-ids))))
+
+         (if (null? new-ids)
+             (map (lambda (derivation-id)
+                    (get-derivation-name db derivation-id))
+                  (delete-duplicates! result))
+             (loop new-ids
+                   (append! result new-ids))))))))
 
 (define-method (datastore-list-failed-builds-with-blocking-count
                 (datastore <sqlite-datastore>)