From f03ec8ec1e0aed28c046024a2131ea7484037b55 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 22 May 2022 11:05:36 +0100 Subject: Refactor build-for-output-already-exists? to only call read-drv once This should have effectively happened due to caching, but make it explicit. --- guix-build-coordinator/coordinator.scm | 39 ++++++++++++++++++++++------------ 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 0456542..16ac81d 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -306,19 +306,32 @@ (define (build-for-output-already-exists?) ;; Handle the derivation not existing in the database here, so that adding ;; it to the database isn't required for this code to work - (let ((system (or (datastore-find-derivation-system datastore - derivation-file) - (derivation-system - (read-drv derivation-file)))) - (outputs (or (datastore-find-derivation-outputs datastore - derivation-file) - (map - (match-lambda - ((name . output) - `((name . ,name) - (output . ,(derivation-output-path output))))) - (derivation-outputs - (read-drv derivation-file)))))) + (let* ((system-from-database (datastore-find-derivation-system datastore + derivation-file)) + + (derivation-exists-in-database? (not (eq? #f system-from-database))) + + (derivation + (if derivation-exists-in-database? + #f ; unnecessary to fetch derivation + (call-with-delay-logging read-drv + #:threshold 10 + #:args (list derivation-file)))) + + (system + (or system-from-database + (derivation-system derivation))) + + (outputs + (if derivation-exists-in-database? + (datastore-find-derivation-outputs datastore + derivation-file) + (map + (match-lambda + ((name . output) + `((name . ,name) + (output . ,(derivation-output-path output))))) + (derivation-outputs derivation))))) (any (lambda (output-details) (let ((builds-for-output -- cgit v1.2.3