mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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:
parent
d7e2465242
commit
af12790bdd
4 changed files with 279 additions and 16 deletions
|
@ -329,6 +329,7 @@ SCM_TESTS = \
|
||||||
tests/base16.scm \
|
tests/base16.scm \
|
||||||
tests/base32.scm \
|
tests/base32.scm \
|
||||||
tests/base64.scm \
|
tests/base64.scm \
|
||||||
|
tests/channels.scm \
|
||||||
tests/cpan.scm \
|
tests/cpan.scm \
|
||||||
tests/cpio.scm \
|
tests/cpio.scm \
|
||||||
tests/crate.scm \
|
tests/crate.scm \
|
||||||
|
|
|
@ -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-emacs-with-cool-features} might come from
|
||||||
@code{my-personal-packages}, while others come from the Guix default channel.
|
@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
|
@subsection Replicating Guix
|
||||||
|
|
||||||
@cindex pinning, channels
|
@cindex pinning, channels
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -27,6 +28,7 @@ (define-module (guix channels)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (guix i18n)
|
#:use-module (guix i18n)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-2)
|
||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:autoload (guix self) (whole-package)
|
#:autoload (guix self) (whole-package)
|
||||||
|
@ -73,7 +75,6 @@ (define-record-type* <channel> channel make-channel
|
||||||
(commit channel-commit (default #f))
|
(commit channel-commit (default #f))
|
||||||
(location channel-location
|
(location channel-location
|
||||||
(default (current-source-location)) (innate)))
|
(default (current-source-location)) (innate)))
|
||||||
;; TODO: Add a way to express dependencies among channels.
|
|
||||||
|
|
||||||
(define %default-channels
|
(define %default-channels
|
||||||
;; Default list of channels.
|
;; Default list of channels.
|
||||||
|
@ -93,6 +94,12 @@ (define-record-type <channel-instance>
|
||||||
(commit channel-instance-commit)
|
(commit channel-instance-commit)
|
||||||
(checkout channel-instance-checkout))
|
(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)
|
(define (channel-reference channel)
|
||||||
"Return the \"reference\" for CHANNEL, an sexp suitable for
|
"Return the \"reference\" for CHANNEL, an sexp suitable for
|
||||||
'latest-repository-commit'."
|
'latest-repository-commit'."
|
||||||
|
@ -100,10 +107,60 @@ (define (channel-reference channel)
|
||||||
(#f `(branch . ,(channel-branch channel)))
|
(#f `(branch . ,(channel-branch channel)))
|
||||||
(commit `(commit . ,(channel-commit 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
|
"Return a list of channel instances corresponding to the latest checkouts of
|
||||||
CHANNELS."
|
CHANNELS and the channels on which they depend. PREVIOUS-CHANNELS is a list
|
||||||
(map (lambda (channel)
|
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)
|
(format (current-error-port)
|
||||||
(G_ "Updating channel '~a' from Git repository at '~a'...~%")
|
(G_ "Updating channel '~a' from Git repository at '~a'...~%")
|
||||||
(channel-name channel)
|
(channel-name channel)
|
||||||
|
@ -112,8 +169,28 @@ (define (latest-channel-instances store channels)
|
||||||
(latest-repository-commit store (channel-url channel)
|
(latest-repository-commit store (channel-url channel)
|
||||||
#:ref (channel-reference
|
#:ref (channel-reference
|
||||||
channel))))
|
channel))))
|
||||||
(channel-instance channel commit checkout)))
|
(let ((instance (channel-instance channel commit checkout)))
|
||||||
channels))
|
(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
|
(define* (checkout->channel-instance checkout
|
||||||
#:key commit
|
#:key commit
|
||||||
|
@ -235,8 +312,21 @@ (define dependencies
|
||||||
(lambda (instance)
|
(lambda (instance)
|
||||||
(if (eq? instance core-instance)
|
(if (eq? instance core-instance)
|
||||||
(return core)
|
(return core)
|
||||||
|
(match (channel-instance-dependencies instance)
|
||||||
|
(()
|
||||||
(build-channel-instance 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)))
|
instances)))
|
||||||
|
|
||||||
(define (whole-package-for-legacy name modules)
|
(define (whole-package-for-legacy name modules)
|
||||||
|
|
139
tests/channels.scm
Normal file
139
tests/channels.scm
Normal 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")
|
Loading…
Reference in a new issue