diff options
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 8 | ||||
| -rw-r--r-- | guix-build-coordinator/datastore.scm | 2 | ||||
| -rw-r--r-- | guix-build-coordinator/datastore/sqlite.scm | 106 | ||||
| -rw-r--r-- | guix-build-coordinator/hooks.scm | 6 |
4 files changed, 70 insertions, 52 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 88bc85b..beb2d84 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -261,9 +261,10 @@ (define (build-for-derivation-exists?) (not - (null? (datastore-list-builds-for-derivation + (null? (datastore-count-builds-for-derivation datastore - derivation-file)))) + derivation-file + #:include-canceled? #f)))) (define (build-for-output-already-exists?) (let ((system (datastore-find-derivation-system datastore @@ -274,7 +275,8 @@ (datastore-list-builds-for-output-and-system datastore (assq-ref output-details 'output) - system))) + system + #:include-canceled? #f))) (not (null? builds-for-output)))) (datastore-find-derivation-outputs datastore derivation-file)))) diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm index f33f5ce..913d53a 100644 --- a/guix-build-coordinator/datastore.scm +++ b/guix-build-coordinator/datastore.scm @@ -43,7 +43,7 @@ (re-export datastore-fetch-build-tags) (re-export datastore-find-build-result) (re-export datastore-find-build-derivation-system) -(re-export datastore-list-builds-for-derivation) +(re-export datastore-count-builds-for-derivation) (re-export datastore-list-processed-builds) (re-export datastore-list-unprocessed-builds) (re-export datastore-fetch-build-ids-and-propagated-priorities-for-unprocessed-builds) 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>)) diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm index a4a8299..5790384 100644 --- a/guix-build-coordinator/hooks.scm +++ b/guix-build-coordinator/hooks.scm @@ -237,8 +237,10 @@ (let* ((build-details (datastore-find-build datastore build-id)) (derivation-name (assq-ref build-details 'derivation-name)) - (all-builds-for-derivation (datastore-list-builds-for-derivation - datastore derivation-name)) + (all-builds-for-derivation (datastore-count-builds-for-derivation + datastore + derivation-name + #:include-canceled? #f)) (all-builds-for-derivation-count (length all-builds-for-derivation))) (when (= 1 all-builds-for-derivation-count) |