[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/01: guix: Add support for channel dependencies.
|
From: |
guix-commits |
|
Subject: |
01/01: guix: Add support for channel dependencies. |
|
Date: |
Sun, 9 Dec 2018 08:21:06 -0500 (EST) |
rekado pushed a commit to branch master
in repository guix.
commit af12790bdd3805bbd7bca2b7c1d9045666f377eb
Author: Ricardo Wurmus <address@hidden>
Date: Sat Oct 13 08:39:23 2018 +0200
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.
---
Makefile.am | 1 +
doc/guix.texi | 33 +++++++++++++
guix/channels.scm | 122 ++++++++++++++++++++++++++++++++++++++++------
tests/channels.scm | 139 +++++++++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 279 insertions(+), 16 deletions(-)
diff --git a/Makefile.am b/Makefile.am
index a7a67e8..4a190c4 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 4ef2601..20b5013 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.
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 e57da68..75503bb 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)
@@ -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 0000000..f3fc383
--- /dev/null
+++ b/tests/channels.scm
@@ -0,0 +1,139 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ricardo Wurmus <address@hidden>
+;;;
+;;; 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")