diff options
| -rw-r--r-- | guix-build-coordinator/datastore/sqlite.scm | 96 |
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>) |