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".
* tests/channels.scm: New file.
* Makefile.am (SCM_TESTS): Add it.
This commit is contained in:
Ricardo Wurmus 2018-10-13 08:39:23 +02:00
parent d7e2465242
commit af12790bdd
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
4 changed files with 279 additions and 16 deletions

View File

@ -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 \

View File

@ -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

View File

@ -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,10 +107,60 @@
(#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)
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)
@ -112,8 +169,28 @@ CHANNELS."
(latest-repository-commit store (channel-url channel)
#:ref (channel-reference
channel))))
(channel-instance channel commit checkout)))
channels))
(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)
(match (channel-instance-dependencies instance)
(()
(build-channel-instance instance
(cons core dependencies))))
(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)

139
tests/channels.scm Normal file
View File

@ -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")