diff options
author | Leo Famulari <leo@famulari.name> | 2021-02-09 15:09:43 -0500 |
---|---|---|
committer | Leo Famulari <leo@famulari.name> | 2021-02-09 15:09:43 -0500 |
commit | 388bd35dd0df2d231bc2cce3746d7d5fd15df23a (patch) | |
tree | 82e7cc45b8279f83439214c7c79dc7161ffda94d /guix/ci.scm | |
parent | f1c7c2f697877fcb68b53ea062ff8a88f274a2fe (diff) | |
parent | d00380b0077b0df2a0b790bb115d07c1533b8863 (diff) | |
download | guix-patches-388bd35dd0df2d231bc2cce3746d7d5fd15df23a.tar guix-patches-388bd35dd0df2d231bc2cce3746d7d5fd15df23a.tar.gz |
Merge branch 'master' into staging-next
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)))) |