diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | doc/guix.texi | 33 | ||||
| -rw-r--r-- | guix/channels.scm | 122 | ||||
| -rw-r--r-- | tests/channels.scm | 139 |
4 files changed, 279 insertions, 16 deletions
diff --git a/Makefile.am b/Makefile.am index a7a67e81cf..4a190c4095 100644 --- a/Makefile.am +++ b/Makefile.am @@ -329,6 +329,7 @@ SCM_TESTS = \ tests/base16.scm \ tests/base32.scm \ tests/base64.scm \ + tests/channels.scm \ tests/cpan.scm \ tests/cpio.scm \ tests/crate.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 4ef2601579..20b5013fd9 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3037,6 +3037,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. +@cindex dependencies, channels +@cindex meta-data, channels +@subsection 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: + +@lisp +(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")))) +@end 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 e57da68149..75503bb0ae 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 <ludo@gnu.org> +;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; 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) @@ -73,7 +75,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. @@ -93,6 +94,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'." @@ -100,20 +107,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* (checkout->channel-instance checkout #:key commit @@ -235,8 +312,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) diff --git a/tests/channels.scm b/tests/channels.scm new file mode 100644 index 0000000000..f3fc383ac3 --- /dev/null +++ b/tests/channels.scm @@ -0,0 +1,139 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (test-channels) + #:use-module (guix channels) + #:use-module ((guix build syscalls) #:select (mkdtemp!)) + #:use-module (guix tests) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +(test-begin "channels") + +(define* (make-instance #:key + (name 'fake) + (commit "cafebabe") + (spec #f)) + (define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX")) + (and spec + (with-output-to-file (string-append instance-dir "/.guix-channel") + (lambda _ (format #t "~a" spec)))) + ((@@ (guix channels) channel-instance) + name commit instance-dir)) + +(define instance--boring (make-instance)) +(define instance--no-deps + (make-instance #:spec + '(channel + (version 0) + (dependencies + (channel + (name test-channel) + (url "https://example.com/test-channel")))))) +(define instance--simple + (make-instance #:spec + '(channel + (version 0) + (dependencies + (channel + (name test-channel) + (url "https://example.com/test-channel")))))) +(define instance--with-dupes + (make-instance #:spec + '(channel + (version 0) + (dependencies + (channel + (name test-channel) + (url "https://example.com/test-channel")) + (channel + (name test-channel) + (url "https://example.com/test-channel") + (commit "abc1234")) + (channel + (name test-channel) + (url "https://example.com/test-channel-elsewhere")))))) + +(define read-channel-metadata + (@@ (guix channels) read-channel-metadata)) + + +(test-equal "read-channel-metadata returns #f if .guix-channel does not exist" + #f + (read-channel-metadata instance--boring)) + +(test-assert "read-channel-metadata returns <channel-metadata>" + (every (@@ (guix channels) channel-metadata?) + (map read-channel-metadata + (list instance--no-deps + instance--simple + instance--with-dupes)))) + +(test-assert "read-channel-metadata dependencies are channels" + (let ((deps ((@@ (guix channels) channel-metadata-dependencies) + (read-channel-metadata instance--simple)))) + (match deps + (((? channel? dep)) #t) + (_ #f)))) + +(test-assert "latest-channel-instances includes channel dependencies" + (let* ((channel (channel + (name 'test) + (url "test"))) + (test-dir (channel-instance-checkout instance--simple))) + (mock ((guix git) latest-repository-commit + (lambda* (store url #:key ref) + (match url + ("test" (values test-dir 'whatever)) + (_ (values "/not-important" 'not-important))))) + (let ((instances (latest-channel-instances #f (list channel)))) + (and (eq? 2 (length instances)) + (lset= eq? + '(test test-channel) + (map (compose channel-name channel-instance-channel) + instances))))))) + +(test-assert "latest-channel-instances excludes duplicate channel dependencies" + (let* ((channel (channel + (name 'test) + (url "test"))) + (test-dir (channel-instance-checkout instance--with-dupes))) + (mock ((guix git) latest-repository-commit + (lambda* (store url #:key ref) + (match url + ("test" (values test-dir 'whatever)) + (_ (values "/not-important" 'not-important))))) + (let ((instances (latest-channel-instances #f (list channel)))) + (and (eq? 2 (length instances)) + (lset= eq? + '(test test-channel) + (map (compose channel-name channel-instance-channel) + instances)) + ;; only the most specific channel dependency should remain, + ;; i.e. the one with a specified commit. + (find (lambda (instance) + (and (eq? (channel-name + (channel-instance-channel instance)) + 'test-channel) + (eq? (channel-commit + (channel-instance-channel instance)) + 'abc1234))) + instances)))))) + +(test-end "channels") |