database: Add 'db-get-pending-derivations'.

* src/cuirass/database.scm (db-get-pending-derivations): New procedure.
* tests/database.scm ("database")["db-get-pending-derivations"]: New test.

src/cuirass/database.scm

@@ -39,6 +39,7 @@
             db-add-evaluation
             db-add-derivation
             db-get-derivation
+            db-get-pending-derivations
             build-status
             db-add-build
             db-update-build-status!
@@ -508,6 +509,22 @@ ORDER BY ~a, Builds.id ASC LIMIT :nr;" order))
      build)
     (() #f)))
 
+(define (db-get-pending-derivations db)
+  "Return the list of derivation file names corresponding to pending builds in
+DB.  The returned list is guaranteed to not have any duplicates."
+  ;; This is of course much more efficient than calling 'delete-duplicates' on
+  ;; a list of results obtained without DISTINCT, both in space and time.
+  ;;
+  ;; Here we use a subquery so that sqlite can use two indexes instead of
+  ;; creating a "TEMP B-TREE" when doing a single flat query, as "EXPLAIN
+  ;; QUERY PLAN" shows.
+  (map (match-lambda (#(drv) drv))
+       (sqlite-exec db "
+SELECT DISTINCT derivation FROM (
+  SELECT Derivations.derivation FROM Derivations INNER JOIN Builds
+  WHERE Derivations.derivation = Builds.derivation AND Builds.status < 0
+);")))
+
 (define (db-get-stamp db spec)
   "Return a stamp corresponding to specification SPEC in database DB."
   (let ((res (sqlite-exec db "SELECT * FROM Stamps WHERE specification="

tests/database.scm

@@ -192,6 +192,29 @@ INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
                 (map summarize
                      (db-get-builds db '((order status+submission-time))))))))
 
+  (test-equal "db-get-pending-derivations"
+    '("/bar.drv" "/foo.drv")
+    (with-temporary-database db
+      ;; Populate the 'Builds', 'Derivations', 'Evaluations', and
+      ;; 'Specifications' tables.  Here, two builds map to the same derivation
+      ;; but the result of 'db-get-pending-derivations' must not contain any
+      ;; duplicate.
+      (db-add-build db (make-dummy-build 1 #:drv "/foo.drv"
+                                         #:outputs `(("out" . "/foo"))))
+      (db-add-build db (make-dummy-build 2 #:drv "/bar.drv"
+                                         #:outputs `(("out" . "/bar"))))
+      (db-add-build db (make-dummy-build 3 #:drv "/foo.drv"
+                                         #:outputs `(("out" . "/foo"))))
+      (db-add-derivation db (make-dummy-derivation "/foo.drv" 1))
+      (db-add-derivation db (make-dummy-derivation "/bar.drv" 2))
+      (db-add-derivation db (make-dummy-derivation "/foo.drv" 3))
+      (db-add-evaluation db (make-dummy-eval))
+      (db-add-evaluation db (make-dummy-eval))
+      (db-add-evaluation db (make-dummy-eval))
+      (db-add-specification db example-spec)
+
+      (sort (db-get-pending-derivations db) string<?)))
+
   (test-assert "db-close"
     (db-close (%db)))