diff options
Diffstat (limited to 'guix/ci.scm')
-rw-r--r-- | guix/ci.scm | 38 |
1 files changed, 37 insertions, 1 deletions
diff --git a/guix/ci.scm b/guix/ci.scm index f429bf198f..95325b4bfe 100644 --- a/guix/ci.scm +++ b/guix/ci.scm @@ -19,9 +19,11 @@ (define-module (guix ci) #:use-module (guix http-client) + #:use-module (guix utils) #:use-module (json) #:use-module (srfi srfi-1) #:use-module (ice-9 match) + #:autoload (guix channels) (channel) #:export (build-product? build-product-id build-product-type @@ -52,7 +54,9 @@ latest-builds evaluation latest-evaluations - evaluations-for-commit)) + evaluations-for-commit + + channel-with-substitutes-available)) ;;; Commentary: ;;; @@ -165,3 +169,35 @@ as one of their inputs." (string=? (checkout-commit checkout) commit)) (evaluation-checkouts evaluation))) (latest-evaluations url limit))) + +(define (find-latest-commit-with-substitutes url) + "Return the latest commit with available substitutes for the Guix package +definitions at URL. Return false if no commit were found." + (let* ((job-name (string-append "guix." (%current-system))) + (build (match (latest-builds url 1 + #:job job-name + #:status 0) ;success + ((build) build) + (_ #f))) + (evaluation (and build + (evaluation url (build-evaluation build)))) + (commit (and evaluation + (match (evaluation-checkouts evaluation) + ((checkout) + (checkout-commit checkout)))))) + commit)) + +(define (channel-with-substitutes-available chan url) + "Return a channel inheriting from CHAN but which commit field is set to the +latest commit with available substitutes for the Guix package definitions at +URL. The current system is taken into account. + +If no commit with available substitutes were found, the commit field is set to +false and a warning message is printed." + (let ((commit (find-latest-commit-with-substitutes url))) + (unless commit + (warning (G_ "could not find available substitutes at ~a~%") + url)) + (channel + (inherit chan) + (commit commit)))) |