Channel dependencies

[Ricardo Wurmus]

Hi,

the attached patch allows channel authors to declare other channels as
dependencies of their own channel.  In addition to explicitly requested
channels, “guix pull” will now also download and build channels that
have been declared as dependencies in the file ‘.guix-channel’ in the
repository root.

An example of a simple .guix-channel file is this:

--8<---------------cut here---------------start------------->8---
(channel
 (version 0)
 (dependencies
  (channel
   (name guix-bimsb)
   (url "https://github.com/BIMSBbioinfo/guix-bimsb";))))
--8<---------------cut here---------------end--------------->8---

What do you think?

--
Ricardo

>From 1783c17582906df970c7e68e89d761619a35caeb Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <address@hidden>
Date: Sat, 13 Oct 2018 08:39:23 +0200
Subject: [PATCH] guix: Add support for channel dependencies.

* guix/channels.scm (%channel-meta-file): New variable.
(channel-meta, channel-instance-dependencies): New procedures.
(latest-channel-instances): Include channel dependencies.
(channel-instance-derivations): Build derivation for additional channels and
add it as dependency to the channel instance derivation.
* doc/guix.texi (Channels): Add subsection "Declaring Channel Dependencies".
---
 doc/guix.texi     | 33 ++++++++++++++++++++
 guix/channels.scm | 79 ++++++++++++++++++++++++++++++++++++++---------
 2 files changed, 97 insertions(+), 15 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 5ae80917a..a4d5477f6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3020,6 +3020,39 @@ the new and upgraded packages that are listed, some like 
@code{my-gimp} and
 @code{my-emacs-with-cool-features} might come from
 @code{my-personal-packages}, while others come from the Guix default channel.
 
address@hidden dependencies, channels
address@hidden meta-data, channels
address@hidden Declaring Channel Dependencies
+
+Channel authors may decide to augment a package collection provided by other
+channels.  They can declare their channel to be dependent on other channels in
+a meta-data file @file{.guix-channel}, which is to be placed in the root of
+the channel repository.
+
+The meta-data file should contain a simple S-expression like this:
+
address@hidden
+(channel
+ (version 0)
+ (dependencies
+  (channel
+   (name 'some-collection)
+   (url "https://example.org/first-collection.git";))
+  (channel
+   (name 'some-other-collection)
+   (url "https://example.org/second-collection.git";)
+   (branch "testing"))))
address@hidden lisp
+
+In the above example this channel is declared to depend on two other channels,
+which will both be fetched automatically.  The modules provided by the channel
+will be compiled in an environment where the modules of all these declared
+channels are available.
+
+For the sake of reliability and maintainability, you should avoid dependencies
+on channels that you don't control, and you should aim to keep the number of
+dependencies to a minimum.
+
 @subsection Replicating Guix
 
 @cindex pinning, channels
diff --git a/guix/channels.scm b/guix/channels.scm
index 82389eb58..fbe1b62bb 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Ludovic Courtès <address@hidden>
+;;; Copyright © 2018 Ricardo Wurmus <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -72,7 +73,6 @@
   (commit    channel-commit (default #f))
   (location  channel-location
              (default (current-source-location)) (innate)))
-;; TODO: Add a way to express dependencies among channels.
 
 (define %default-channels
   ;; Default list of channels.
@@ -81,6 +81,10 @@
          (branch "master")
          (url "https://git.savannah.gnu.org/git/guix.git";))))
 
+(define %channel-meta-file
+  ;; The file containing information about the channel.
+  ".guix-channel")
+
 (define (guix-channel? channel)
   "Return true if CHANNEL is the 'guix' channel."
   (eq? 'guix (channel-name channel)))
@@ -99,20 +103,52 @@
     (#f      `(branch . ,(channel-branch channel)))
     (commit  `(commit . ,(channel-commit channel)))))
 
+(define (channel-meta instance)
+  "Return an S-expression read from the channel INSTANCE's description file,
+or return #F if the channel instance does not include the file."
+  (let* ((source (channel-instance-checkout instance))
+         (meta-file (string-append source "/" %channel-meta-file)))
+    (and (file-exists? meta-file)
+         (call-with-input-file meta-file read))))
+
+(define (channel-instance-dependencies instance)
+  "Return the list of channels that are declared as dependencies for the given
+channel INSTANCE."
+  (or (and=> (assoc-ref (channel-meta instance) 'dependencies)
+             (lambda (dependencies)
+               (map (lambda (item)
+                      (let ((get (lambda* (key #:optional default)
+                                   (or (and=> (assoc-ref item key) car) 
default))))
+                        (let ((name (get 'name))
+                              (url (get 'url))
+                              (branch (get 'branch "master"))
+                              (commit (get 'commit)))
+                          (and name url branch
+                               (channel
+                                (name name)
+                                (branch branch)
+                                (url url)
+                                (commit commit))))))
+                    dependencies)))
+      '()))
+
 (define (latest-channel-instances store channels)
   "Return a list of channel instances corresponding to the latest checkouts of
-CHANNELS."
-  (map (lambda (channel)
-         (format (current-error-port)
-                 (G_ "Updating channel '~a' from Git repository at '~a'...~%")
-                 (channel-name channel)
-                 (channel-url channel))
-         (let-values (((checkout commit)
-                       (latest-repository-commit store (channel-url channel)
-                                                 #:ref (channel-reference
-                                                        channel))))
-           (channel-instance channel commit checkout)))
-       channels))
+CHANNELS and the channels on which they depend."
+  (append-map (lambda (channel)
+                (format (current-error-port)
+                        (G_ "Updating channel '~a' from Git repository at 
'~a'...~%")
+                        (channel-name channel)
+                        (channel-url channel))
+                (let-values (((checkout commit)
+                              (latest-repository-commit store (channel-url 
channel)
+                                                        #:ref 
(channel-reference
+                                                               channel))))
+                  (let ((instance (channel-instance channel commit checkout)))
+                    (cons instance (latest-channel-instances
+                                    store
+                                    (channel-instance-dependencies 
instance))))))
+              channels))
 
 (define %self-build-file
   ;; The file containing code to build Guix.  This serves the same purpose as
@@ -223,8 +259,21 @@ INSTANCES."
           (lambda (instance)
             (if (eq? instance core-instance)
                 (return core)
-                (build-channel-instance instance
-                                        (cons core dependencies))))
+                (match (channel-instance-dependencies instance)
+                  (()
+                   (build-channel-instance instance
+                                           (cons core dependencies)))
+                  (channels
+                   (mlet %store-monad ((dependencies-derivation
+                                        (latest-channel-derivation
+                                         ;; %default-channels is used here to
+                                         ;; ensure that the core channel is
+                                         ;; available for channels declared as
+                                         ;; dependencies.
+                                         (append channels %default-channels))))
+                     (build-channel-instance instance
+                                             (cons dependencies-derivation
+                                                   (cons core 
dependencies))))))))
           instances)))
 
 (define (whole-package-for-legacy name modules)
-- 
2.19.0