1 files changed, 60 insertions, 46 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 2ce039c..2988de3 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -33,7 +33,7 @@
             datastore-fetch-build-tags
             datastore-find-build-result
             datastore-find-build-derivation-system
-            datastore-list-builds-for-derivation
+            datastore-count-builds-for-derivation
             datastore-count-build-results
             datastore-store-build-result
             datastore-list-build-outputs
@@ -1464,15 +1464,18 @@ WHERE derivation_outputs.output = :output"
 
 (define-method (datastore-list-builds-for-output-and-system
                 (datastore <sqlite-datastore>)
-                output
-                system)
-  (call-with-worker-thread
-   (slot-ref datastore 'worker-reader-thread-channel)
-   (lambda (db)
-     (let ((statement
-            (sqlite-prepare
-             db
-             "
+                .
+                rest)
+  (apply
+   (lambda* (output system #:key include-canceled?)
+     (call-with-worker-thread
+      (slot-ref datastore 'worker-reader-thread-channel)
+      (lambda (db)
+        (let ((statement
+               (sqlite-prepare
+                db
+                (string-append
+                 "
 SELECT uuid, builds.derivation_name
 FROM builds
 INNER JOIN derivation_outputs
@@ -1481,50 +1484,61 @@ INNER JOIN derivations
   ON builds.derivation_name = derivations.name
 WHERE derivation_outputs.output = :output
   AND derivations.system = :system"
-             #:cache? #t)))
+                 (if include-canceled?
+                     ""
+                     "
+  AND builds.canceled = 0"))
+                #:cache? #t)))
 
-       (sqlite-bind-arguments
-        statement
-        #:output output
-        #:system system)
+          (sqlite-bind-arguments
+           statement
+           #:output output
+           #:system system)
 
-       (let ((result
-              (sqlite-map
-               (match-lambda
-                 (#(uuid derivation)
-                  `((uuid            . ,uuid)
-                    (derivation      . ,derivation))))
-               statement)))
-         (sqlite-reset statement)
+          (let ((result
+                 (sqlite-map
+                  (match-lambda
+                    (#(uuid derivation)
+                     `((uuid            . ,uuid)
+                       (derivation      . ,derivation))))
+                  statement)))
+            (sqlite-reset statement)
 
-         result)))))
+            result)))))
+   rest))
 
-(define-method (datastore-list-builds-for-derivation
+(define-method (datastore-count-builds-for-derivation
                 (datastore <sqlite-datastore>)
-                derivation)
-  (call-with-worker-thread
-   (slot-ref datastore 'worker-reader-thread-channel)
-   (lambda (db)
-     (let ((statement
-            (sqlite-prepare
-             db
-             "
-SELECT uuid FROM builds WHERE derivation_name = :derivation"
-             #:cache? #t)))
+                .
+                rest)
+  (apply
+   (lambda* (derivation #:key (include-canceled? #t))
+     (call-with-worker-thread
+      (slot-ref datastore 'worker-reader-thread-channel)
+      (lambda (db)
+        (let ((statement
+               (sqlite-prepare
+                db
+                (string-append
+                 "
+SELECT COUNT(*)
+FROM builds
+WHERE derivation_name = :derivation"
+                 (if include-canceled?
+                     ""
+                     "
+  AND canceled = 0"))
+                #:cache? #t)))
 
-       (sqlite-bind-arguments
-        statement
-        #:derivation derivation)
+          (sqlite-bind-arguments
+           statement
+           #:derivation derivation)
 
-       (let ((result
-              (sqlite-map
-               (match-lambda
-                 (#(uuid)
-                  `((uuid            . ,uuid))))
-               statement)))
-         (sqlite-reset statement)
+          (let ((result (sqlite-step statement)))
+            (sqlite-reset statement)
 
-         result)))))
+            result)))))
+   rest))
 
 (define-method (datastore-update
                 (datastore <sqlite-datastore>))