diff options
Diffstat (limited to 'guix/ci.scm')
| -rw-r--r-- | guix/ci.scm | 42 |
1 files changed, 40 insertions, 2 deletions
diff --git a/guix/ci.scm b/guix/ci.scm index f429bf198f..f04109112c 100644 --- a/guix/ci.scm +++ b/guix/ci.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -19,9 +19,13 @@ (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) + #:use-module (guix i18n) + #:use-module (guix diagnostics) + #:autoload (guix channels) (channel) #:export (build-product? build-product-id build-product-type @@ -52,7 +56,9 @@ latest-builds evaluation latest-evaluations - evaluations-for-commit)) + evaluations-for-commit + + channel-with-substitutes-available)) ;;; Commentary: ;;; @@ -165,3 +171,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)))) |