Re: Channel dependencies

[Ricardo Wurmus]

Hi Ludo,

thanks for your helpful comments!

>> +(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))))
>
> As a general pattern, I’d suggest declaring <channel-metadata> record
> type along with a ‘read-channel-metadata’ procedure that takes care of
> “parsing” and metadata version handling.  That way parsing code is in
> just one place and the rest of the code can happily deal with
> well-formed records.

Yes, that’s a good idea.  I added a record <channel-metadata> and a
procedure “read-channel-metadata” that produces values of this type
given a channel instance (or #F).

>> +(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)))
>> +      '()))
>
> I’d recommend ‘match’ for the outer sexp, and then something like the
> ‘alist-let*’ macro from (gnu services herd) in places where you’d like
> to leave field ordering unspecified.

I keep forgetting about alist-let* (from srfi-2, not herd), even though
it’s so useful!  “channel-instance-dependencies” now uses the
<channel-metadata> record via “read-channel-metadata” and uses match.

> Then I think it would make sense to add the ‘dependencies’ field to
> <channel-instance> directly (and keep <channel-metadata> internal.)
> Each element of the ‘dependencies’ field would be another
> <channel-instance>.
>
> Actually ‘dependencies’ could be a promise that reads channel meta-data
> and looks up the channel instances for the given dependencies.
> Something like that.

This sounds good, but I don’t know how to make it work well, because
there’s a circular relationship here if we want to keep the abstractions
pretty.  I can’t simply define the “dependencies” field of
<channel-instance> to have a default thunked procedure like this:

   (match (read-channel-metadata checkout)
     (#f '())
     (($ <channel-metadata> _ dependencies)
      dependencies))

Because record fields cannot access other record fields such as
“checkout”.  This makes the code look rather silly as we’re creating an
instance with an explicit dependencies value only to read it from that
same record in the next expression.

In light of these complications I’d prefer to have a procedure
“channel-instance-dependencies” that handles this for us, and do without
a “dependencies” field on the <channel-instance> record.

What do you think?

> Chris raises interesting issues.  I think it’s OK to first come up with
> an implementation that has some limitations but works with the simple
> use cases we have in mind.

I’ve fixed this according to what we’ve discussed: when more than one of
the user-provided or channel-required channels have the same name we
ignore the more recent specification unless it is more specific
(i.e. the new channel specification mentions a commit while the former
did not).

This is a little verbose because I replaced the simple “append-map” with
a more complex “fold” with a composite accumulator to avoid mutation.

Suggestions on how to simplify this are welcome!

--
Ricardo

>From e23225640e723988de215d110e377c93c8108245 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-metadata>): New record.
(read-channel-metadata, channel-instance-dependencies): New procedures.
(latest-channel-instances): Include channel dependencies; add optional
argument PREVIOUS-CHANNELS.
(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 | 122 ++++++++++++++++++++++++++++++++++++++++------
 2 files changed, 139 insertions(+), 16 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index f4f19949f..7291a88ba 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..6393179a4 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.
 ;;;
@@ -27,6 +28,7 @@
   #:use-module (guix store)
   #:use-module (guix i18n)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:autoload   (guix self) (whole-package)
@@ -72,7 +74,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.
@@ -92,6 +93,12 @@
   (commit    channel-instance-commit)
   (checkout  channel-instance-checkout))
 
+(define-record-type <channel-metadata>
+  (channel-metadata version dependencies)
+  channel-metadata?
+  (version       channel-metadata-version)
+  (dependencies  channel-metadata-dependencies))
+
 (define (channel-reference channel)
   "Return the \"reference\" for CHANNEL, an sexp suitable for
 'latest-repository-commit'."
@@ -99,20 +106,90 @@
     (#f      `(branch . ,(channel-branch channel)))
     (commit  `(commit . ,(channel-commit channel)))))
 
-(define (latest-channel-instances store channels)
+(define (read-channel-metadata instance)
+  "Return a channel-metadata record 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 "/.guix-channel")))
+    (and (file-exists? meta-file)
+         (and-let* ((raw (call-with-input-file meta-file read))
+                    (version (and=> (assoc-ref raw 'version) first))
+                    (dependencies (or (assoc-ref raw 'dependencies) '())))
+           (channel-metadata
+            version
+            (map (lambda (item)
+                   (let ((get (lambda* (key #:optional default)
+                                (or (and=> (assoc-ref item key) first) 
default))))
+                     (and-let* ((name (get 'name))
+                                (url (get 'url))
+                                (branch (get 'branch "master")))
+                       (channel
+                        (name name)
+                        (branch branch)
+                        (url url)
+                        (commit (get 'commit))))))
+                 dependencies))))))
+
+(define (channel-instance-dependencies instance)
+  "Return the list of channels that are declared as dependencies for the given
+channel INSTANCE."
+  (match (read-channel-metadata instance)
+    (#f '())
+    (($ <channel-metadata> version dependencies)
+     dependencies)))
+
+(define* (latest-channel-instances store channels #:optional 
(previous-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.  PREVIOUS-CHANNELS is a list
+of previously processed channels."
+  ;; Only process channels that are unique, or that are more specific than a
+  ;; previous channel specification.
+  (define (ignore? channel others)
+    (member channel others
+            (lambda (a b)
+              (and (eq? (channel-name a) (channel-name b))
+                   (or (channel-commit b)
+                       (not (or (channel-commit a)
+                                (channel-commit b))))))))
+  ;; Accumulate a list of instances.  A list of processed channels is also
+  ;; accumulated to decide on duplicate channel specifications.
+  (match (fold (lambda (channel acc)
+                 (match acc
+                   ((#:channels previous-channels #:instances instances)
+                    (if (ignore? channel previous-channels)
+                        acc
+                        (begin
+                          (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)))
+                              (let-values (((new-instances new-channels)
+                                            (latest-channel-instances
+                                             store
+                                             (channel-instance-dependencies 
instance)
+                                             previous-channels)))
+                                `(#:channels
+                                  ,(append (cons channel new-channels)
+                                           previous-channels)
+                                  #:instances
+                                  ,(append (cons instance new-instances)
+                                           instances))))))))))
+               `(#:channels ,previous-channels #:instances ())
+               channels)
+    ((#:channels channels #:instances instances)
+     (let ((instance-name (compose channel-name channel-instance-channel)))
+       ;; Remove all earlier channel specifications if they are followed by a
+       ;; more specific one.
+       (values (delete-duplicates instances
+                                  (lambda (a b)
+                                    (eq? (instance-name a) (instance-name b))))
+               channels)))))
 
 (define %self-build-file
   ;; The file containing code to build Guix.  This serves the same purpose as
@@ -223,8 +300,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