diff options
author | Christopher Baines <mail@cbaines.net> | 2024-01-30 10:05:07 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2024-01-30 10:05:07 +0000 |
commit | d9fa7947c25d0624c568f744ad2a2683a43e5644 (patch) | |
tree | c3dc0aa1155700cd90400f0e324ef5c34664f2ca | |
parent | dc04b747048638a753bd044646306fcdd33c241a (diff) | |
download | build-coordinator-d9fa7947c25d0624c568f744ad2a2683a43e5644.tar build-coordinator-d9fa7947c25d0624c568f744ad2a2683a43e5644.tar.gz |
Expose the derived priorities for builds
-rw-r--r-- | guix-build-coordinator/client-communication.scm | 3 | ||||
-rw-r--r-- | guix-build-coordinator/datastore.scm | 1 | ||||
-rw-r--r-- | guix-build-coordinator/datastore/sqlite.scm | 30 | ||||
-rw-r--r-- | scripts/guix-build-coordinator.in | 12 |
4 files changed, 42 insertions, 4 deletions
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index 4ce0bbf..094ab4e 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -150,6 +150,9 @@ (alist-delete 'end-time build-details)) + ,@(if (assq-ref build-details 'processed) + '() + (datastore-find-unprocessed-build-entry datastore uuid)) (created-at . ,(or (and=> (assq-ref build-details 'created-at) (lambda (time) diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm index ad143f4..a29a993 100644 --- a/guix-build-coordinator/datastore.scm +++ b/guix-build-coordinator/datastore.scm @@ -60,6 +60,7 @@ (re-export datastore-for-each-build) (re-export datastore-find-build) (re-export datastore-fold-builds) +(re-export datastore-find-unprocessed-build-entry) (re-export datastore-insert-build-tags) (re-export datastore-fetch-build-tags) (re-export datastore-find-build-result) diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index f10af88..e5ae519 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -39,6 +39,7 @@ datastore-for-each-build datastore-find-build datastore-fold-builds + datastore-find-unprocessed-build-entry datastore-insert-build-tags datastore-fetch-build-tags datastore-find-build-result @@ -1286,6 +1287,35 @@ INNER JOIN related_derivations result))))) +(define-method (datastore-find-unprocessed-build-entry + (datastore <sqlite-datastore>) + uuid) + (call-with-worker-thread/delay-logging + (slot-ref datastore 'worker-reader-thread-channel) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +SELECT derived_priority, all_inputs_built +FROM unprocessed_builds_with_derived_priorities +WHERE build_id = :build_id" + #:cache? #t))) + + (sqlite-bind-arguments + statement + #:build_id (db-find-build-id db uuid)) + + (match (sqlite-step-and-reset statement) + (#(derived-priority all-inputs-built) + `((derived-priority . ,derived-priority) + (all-inputs-build . ,(cond + ((= 0 all-inputs-built) #f) + ((= 1 all-inputs-built) #t) + (else + (error "unknown processed value")))))) + (#f #f)))))) + (define-method (datastore-insert-build-tags (datastore <sqlite-datastore>) build-uuid diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in index 23a356f..62b48e2 100644 --- a/scripts/guix-build-coordinator.in +++ b/scripts/guix-build-coordinator.in @@ -463,12 +463,16 @@ rest))) (define (display-build build-details) (simple-format #t "derivation name: ~A -priority: ~A -processed?: ~A -canceled?: ~A +priority: ~A +processed?: ~A +canceled?: ~A " (assoc-ref build-details "derivation-name") - (assoc-ref build-details "priority") + (if (assoc-ref build-details "processed") + (assoc-ref build-details "priority") + (simple-format #f "~A\nderived priority: ~A" + (assoc-ref build-details "priority") + (assoc-ref build-details "derived-priority"))) (if (assoc-ref build-details "processed") "yes" "no") |