From d9fa7947c25d0624c568f744ad2a2683a43e5644 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Tue, 30 Jan 2024 10:05:07 +0000
Subject: Expose the derived priorities for builds

---
 guix-build-coordinator/client-communication.scm |  3 +++
 guix-build-coordinator/datastore.scm            |  1 +
 guix-build-coordinator/datastore/sqlite.scm     | 30 +++++++++++++++++++++++++
 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")
-- 
cgit v1.2.3