branch master updated: guix: channels: Introduce "channel-with-substitutes-available".

[guix-commits]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new 041a946  guix: channels: Introduce 
"channel-with-substitutes-available".
041a946 is described below

commit 041a9466ea23d6ae811491bcf529bf9487317b48
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Fri Jan 29 13:48:44 2021 +0100

    guix: channels: Introduce "channel-with-substitutes-available".
    
    * guix/channels.scm (find-latest-commit-with-substitutes,
    channel-with-substitutes-available): New procedures.
    * guix/scripts/pull.scm (guix-pull): Move "channel-list" call inside the
    %current-system parameter scope.
    * doc/guix.texi (Channels with substitutes): New section.
---
 doc/guix.texi         |  28 +++++++++++++-
 guix/channels.scm     |   1 +
 guix/ci.scm           |  38 ++++++++++++++++++-
 guix/scripts/pull.scm | 103 +++++++++++++++++++++++++-------------------------
 4 files changed, 117 insertions(+), 53 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 405b218..aca4657 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -40,7 +40,7 @@ Copyright @copyright{} 2016, 2017, 2018, 2019, 2020 Julien 
Lepiller@*
 Copyright @copyright{} 2016 Alex ter Weele@*
 Copyright @copyright{} 2016, 2017, 2018, 2019 Christopher Baines@*
 Copyright @copyright{} 2017, 2018, 2019 Clément Lassieur@*
-Copyright @copyright{} 2017, 2018, 2020 Mathieu Othacehe@*
+Copyright @copyright{} 2017, 2018, 2020, 2021 Mathieu Othacehe@*
 Copyright @copyright{} 2017 Federico Beffa@*
 Copyright @copyright{} 2017, 2018 Carlo Zancanaro@*
 Copyright @copyright{} 2017 Thomas Danckaert@*
@@ -245,6 +245,7 @@ Channels
 * Specifying Channel Authorizations::  Defining channel authors authorizations.
 * Primary URL::                 Distinguishing mirror to original.
 * Writing Channel News::        Communicating information to channel's users.
+* Channels with Substitutes::   Using channels with available substitutes.
 
 Development
 
@@ -4919,6 +4920,7 @@ updates.
 * Specifying Channel Authorizations::  Defining channel authors authorizations.
 * Primary URL::                 Distinguishing mirror to original.
 * Writing Channel News::        Communicating information to channel's users.
+* Channels with Substitutes::   Using channels with available substitutes.
 @end menu
 
 @node Specifying Additional Channels
@@ -5390,6 +5392,30 @@ xgettext -o news.po -l scheme -ken etc/news.txt
 To sum up, yes, you could use your channel as a blog.  But beware, this
 is @emph{not quite} what your users might expect.
 
+@node Channels with Substitutes
+@section Channels with Substitutes
+
+When running @command{guix pull}, Guix will first compile the
+definitions of every available package.  This is an expensive operation
+for which substitutes (@pxref{Substitutes}) may be available.  The
+following snippet in @file{channels.scm} will ensure that @command{guix
+pull} uses the latest commit with available substitutes for the package
+definitions: this is done by querying the continuous integration
+server at @url{https://ci.guix.gnu.org}.
+
+@lisp
+(use-modules (guix ci))
+
+(list (channel-with-substitutes-available
+       %default-guix-channel
+       "https://ci.guix.gnu.org";))
+@end lisp
+
+Note that this does not mean that all the packages that you will
+install after running @command{guix pull} will have available
+substitutes.  It only ensures that @command{guix pull} will not try to
+compile package definitions.  This is particularly useful when using
+machines with limited resources.
 
 @c *********************************************************************
 @node Development
diff --git a/guix/channels.scm b/guix/channels.scm
index 0c84eed..9ab8cd8 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -20,6 +20,7 @@
 
 (define-module (guix channels)
   #:use-module (git)
+  #:use-module (guix ci)
   #:use-module (guix git)
   #:use-module (guix git-authenticate)
   #:use-module ((guix openpgp)
diff --git a/guix/ci.scm b/guix/ci.scm
index f429bf1..95325b4 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))))
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 83cdc1d..4e0ab5d 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -765,60 +765,61 @@ Use '~/.config/guix/channels.scm' instead."))
                                               #:argument-handler no-arguments))
             (substitutes? (assoc-ref opts 'substitutes?))
             (dry-run?     (assoc-ref opts 'dry-run?))
-            (channels     (channel-list opts))
             (profile      (or (assoc-ref opts 'profile) %current-profile))
             (current-channels (profile-channels profile))
             (validate-pull    (assoc-ref opts 'validate-pull))
             (authenticate?    (assoc-ref opts 'authenticate-channels?)))
-       (cond ((assoc-ref opts 'query)
-              (process-query opts profile))
-             ((assoc-ref opts 'generation)
-              (process-generation-change opts profile))
-             (else
-              (with-store store
-                (with-status-verbosity (assoc-ref opts 'verbosity)
-                  (parameterize ((%current-system (assoc-ref opts 'system))
-                                 (%graft? (assoc-ref opts 'graft?)))
-                    (with-build-handler (build-notifier #:use-substitutes?
-                                                        substitutes?
-                                                        #:verbosity
-                                                        (assoc-ref opts 
'verbosity)
-                                                        #:dry-run? dry-run?)
-                      (set-build-options-from-command-line store opts)
-                      (ensure-default-profile)
-                      (honor-x509-certificates store)
-
-                      (let ((instances
-                             (latest-channel-instances store channels
-                                                       #:current-channels
-                                                       current-channels
-                                                       #:validate-pull
-                                                       validate-pull
-                                                       #:authenticate?
-                                                       authenticate?)))
-                        (format (current-error-port)
-                                (N_ "Building from this channel:~%"
-                                    "Building from these channels:~%"
-                                    (length instances)))
-                        (for-each (lambda (instance)
-                                    (let ((channel
-                                           (channel-instance-channel 
instance)))
-                                      (format (current-error-port)
-                                              "  ~10a~a\t~a~%"
-                                              (channel-name channel)
-                                              (channel-url channel)
-                                              (string-take
-                                               (channel-instance-commit 
instance)
-                                               7))))
-                                  instances)
-                        (parameterize ((%guile-for-build
-                                        (package-derivation
-                                         store
-                                         (if (assoc-ref opts 'bootstrap?)
-                                             %bootstrap-guile
-                                             (default-guile)))))
-                          (with-profile-lock profile
-                            (run-with-store store
-                              (build-and-install instances 
profile)))))))))))))))
+       (cond
+        ((assoc-ref opts 'query)
+         (process-query opts profile))
+        ((assoc-ref opts 'generation)
+         (process-generation-change opts profile))
+        (else
+         (with-store store
+           (with-status-verbosity (assoc-ref opts 'verbosity)
+             (parameterize ((%current-system (assoc-ref opts 'system))
+                            (%graft? (assoc-ref opts 'graft?)))
+               (with-build-handler (build-notifier #:use-substitutes?
+                                                   substitutes?
+                                                   #:verbosity
+                                                   (assoc-ref opts 'verbosity)
+                                                   #:dry-run? dry-run?)
+                 (set-build-options-from-command-line store opts)
+                 (ensure-default-profile)
+                 (honor-x509-certificates store)
+
+                 (let* ((channels (channel-list opts))
+                        (instances
+                         (latest-channel-instances store channels
+                                                   #:current-channels
+                                                   current-channels
+                                                   #:validate-pull
+                                                   validate-pull
+                                                   #:authenticate?
+                                                   authenticate?)))
+                   (format (current-error-port)
+                           (N_ "Building from this channel:~%"
+                               "Building from these channels:~%"
+                               (length instances)))
+                   (for-each (lambda (instance)
+                               (let ((channel
+                                      (channel-instance-channel instance)))
+                                 (format (current-error-port)
+                                         "  ~10a~a\t~a~%"
+                                         (channel-name channel)
+                                         (channel-url channel)
+                                         (string-take
+                                          (channel-instance-commit instance)
+                                          7))))
+                             instances)
+                   (parameterize ((%guile-for-build
+                                   (package-derivation
+                                    store
+                                    (if (assoc-ref opts 'bootstrap?)
+                                        %bootstrap-guile
+                                        (default-guile)))))
+                     (with-profile-lock profile
+                       (run-with-store store
+                         (build-and-install instances profile)))))))))))))))
 
 ;;; pull.scm ends here