02/06: build-system/channel: Accept a channel or instance as the source.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit cf60a0a906440ccb007bae1243c3e0397c3a0aba
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Aug 8 23:06:11 2022 +0200

    build-system/channel: Accept a channel or instance as the source.
    
    * guix/build-system/channel.scm (latest-channel-instances*): New
    variable.
    (build-channels): New procedure, with code formerly in
    'channel-build-system', augmented with clauses for when SOURCE is a
    channel instance or a channel.
    * doc/guix.texi (Build Systems): Adjust accordingly.
---
 doc/guix.texi                 | 12 ++++++----
 guix/build-system/channel.scm | 53 +++++++++++++++++++++++++++----------------
 2 files changed, 41 insertions(+), 24 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 5dab9cf169..306c7b635b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9571,10 +9571,14 @@ with @code{build-expression->derivation} 
(@pxref{Derivations,
 @defvr {Scheme Variable} channel-build-system
 This variable is exported by @code{(guix build-system channel)}.
 
-This build system is meant primarily for internal use.  It requires two
-arguments, @code{#:commit} and @code{#:source}, and builds a Guix
-instance from that channel, in the same way @command{guix time-machine}
-would do it (@pxref{Channels}).
+This build system is meant primarily for internal use.  A package using
+this build system must have a channel specification as its @code{source}
+field (@pxref{Channels}); alternatively, its source can be a directory
+name, in which case an additional @code{#:commit} argument must be
+supplied to specify the commit being built (a hexadecimal string).
+
+The resulting package is a Guix instance of the given channel, similar
+to how @command{guix time-machine} would build it.
 @end defvr
 
 @node Build Phases
diff --git a/guix/build-system/channel.scm b/guix/build-system/channel.scm
index 227eb08373..b6ef3bfacf 100644
--- a/guix/build-system/channel.scm
+++ b/guix/build-system/channel.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019-2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,7 +17,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix build-system channel)
-  #:use-module ((guix store) #:select (%store-monad))
+  #:use-module ((guix store) #:select (%store-monad store-lift))
   #:use-module ((guix gexp) #:select (lower-object))
   #:use-module (guix monads)
   #:use-module (guix channels)
@@ -32,26 +32,39 @@
 ;;;
 ;;; Code:
 
+(define latest-channel-instances*
+  (store-lift latest-channel-instances))
+
+(define* (build-channels name inputs
+                         #:key source system commit
+                         (authenticate? #t)
+                         #:allow-other-keys)
+  (mlet* %store-monad ((instances
+                        (cond ((channel-instance? source)
+                               (return (list source)))
+                              ((channel? source)
+                               (latest-channel-instances*
+                                (list source)
+                                #:authenticate? authenticate?))
+                              (else
+                               (mlet %store-monad ((source
+                                                    (lower-object source)))
+                                 (return
+                                  (list (checkout->channel-instance
+                                         source #:commit commit))))))))
+    (channel-instances->derivation instances)))
+
 (define channel-build-system
   ;; Build system used to "convert" a channel instance to a package.
-  (let* ((build (lambda* (name inputs
-                               #:key source commit system
-                               #:allow-other-keys)
-                  (mlet* %store-monad ((source (if (string? source)
-                                                   (return source)
-                                                   (lower-object source)))
-                                       (instance
-                                        -> (checkout->channel-instance
-                                            source #:commit commit)))
-                    (channel-instances->derivation (list instance)))))
-         (lower (lambda* (name #:key system source commit
-                               #:allow-other-keys)
-                  (bag
-                    (name name)
-                    (system system)
-                    (build build)
-                    (arguments `(#:source ,source
-                                 #:commit ,commit))))))
+  (let ((lower (lambda* (name #:key system source commit (authenticate? #t)
+                              #:allow-other-keys)
+                 (bag
+                   (name name)
+                   (system system)
+                   (build build-channels)
+                   (arguments `(#:source ,source
+                                #:authenticate? ,authenticate?
+                                #:commit ,commit))))))
     (build-system (name 'channel)
                   (description "Turn a channel instance into a package.")
                   (lower lower))))