aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2024-01-30 10:05:07 +0000
committerChristopher Baines <mail@cbaines.net>2024-01-30 10:05:07 +0000
commitd9fa7947c25d0624c568f744ad2a2683a43e5644 (patch)
treec3dc0aa1155700cd90400f0e324ef5c34664f2ca
parentdc04b747048638a753bd044646306fcdd33c241a (diff)
downloadbuild-coordinator-d9fa7947c25d0624c568f744ad2a2683a43e5644.tar
build-coordinator-d9fa7947c25d0624c568f744ad2a2683a43e5644.tar.gz
Expose the derived priorities for builds
-rw-r--r--guix-build-coordinator/client-communication.scm3
-rw-r--r--guix-build-coordinator/datastore.scm1
-rw-r--r--guix-build-coordinator/datastore/sqlite.scm30
-rw-r--r--scripts/guix-build-coordinator.in12
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")