channels: Add optional directory to channel metadata.

* guix/channels.scm (<channel-metadata>): Add directory slot.  Update users.
(read-channel-metadata-from-source): New function.
(standard-module-derivation): Use it.
* doc/guix.texi (Package Modules in a Subdirectory): New subsection.
This commit is contained in:
Jan Nieuwenhuizen 2019-07-13 16:31:50 +02:00
parent bee9f97e0a
commit 53f2164272
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
2 changed files with 61 additions and 37 deletions

View File

@ -3921,6 +3921,19 @@ 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 on channels that you don't control, and you should aim to keep the number of
dependencies to a minimum. dependencies to a minimum.
@cindex subdirectory, channels
@subsection Package Modules in a Sub-directory
As a channel author, you may want to keep your channel modules in a
sub-directory. If your modules are in the sub-directory @file{guix}, you must
add a meta-data file @file{.guix-channel} that contains:
@lisp
(channel
(version 0)
(directory "guix"))
@end lisp
@subsection Replicating Guix @subsection Replicating Guix
@cindex pinning, channels @cindex pinning, channels

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -107,9 +108,10 @@
(checkout channel-instance-checkout)) (checkout channel-instance-checkout))
(define-record-type <channel-metadata> (define-record-type <channel-metadata>
(channel-metadata version dependencies) (channel-metadata version directory dependencies)
channel-metadata? channel-metadata?
(version channel-metadata-version) (version channel-metadata-version)
(directory channel-metadata-directory)
(dependencies channel-metadata-dependencies)) (dependencies channel-metadata-dependencies))
(define (channel-reference channel) (define (channel-reference channel)
@ -119,18 +121,18 @@
(#f `(branch . ,(channel-branch channel))) (#f `(branch . ,(channel-branch channel)))
(commit `(commit . ,(channel-commit channel))))) (commit `(commit . ,(channel-commit channel)))))
(define (read-channel-metadata instance) (define (read-channel-metadata-from-source source)
"Return a channel-metadata record read from the channel INSTANCE's "Return a channel-metadata record read from channel's SOURCE/.guix-channel
description file, or return #F if the channel instance does not include the description file, or return #F if SOURCE/.guix-channel does not exist."
file." (let ((meta-file (string-append source "/.guix-channel")))
(let* ((source (channel-instance-checkout instance))
(meta-file (string-append source "/.guix-channel")))
(and (file-exists? meta-file) (and (file-exists? meta-file)
(and-let* ((raw (call-with-input-file meta-file read)) (let* ((raw (call-with-input-file meta-file read))
(version (and=> (assoc-ref raw 'version) first)) (version (and=> (assoc-ref raw 'version) first))
(directory (and=> (assoc-ref raw 'directory) first))
(dependencies (or (assoc-ref raw 'dependencies) '()))) (dependencies (or (assoc-ref raw 'dependencies) '())))
(channel-metadata (channel-metadata
version version
directory
(map (lambda (item) (map (lambda (item)
(let ((get (lambda* (key #:optional default) (let ((get (lambda* (key #:optional default)
(or (and=> (assoc-ref item key) first) default)))) (or (and=> (assoc-ref item key) first) default))))
@ -144,12 +146,18 @@ file."
(commit (get 'commit)))))) (commit (get 'commit))))))
dependencies)))))) dependencies))))))
(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."
(read-channel-metadata-from-source (channel-instance-checkout instance)))
(define (channel-instance-dependencies instance) (define (channel-instance-dependencies instance)
"Return the list of channels that are declared as dependencies for the given "Return the list of channels that are declared as dependencies for the given
channel INSTANCE." channel INSTANCE."
(match (read-channel-metadata instance) (match (read-channel-metadata instance)
(#f '()) (#f '())
(($ <channel-metadata> version dependencies) (($ <channel-metadata> version directory dependencies)
dependencies))) dependencies)))
(define* (latest-channel-instances store channels #:optional (previous-channels '())) (define* (latest-channel-instances store channels #:optional (previous-channels '()))
@ -230,10 +238,9 @@ of COMMIT at URL. Use NAME as the channel name."
modules in SOURCE and that depend on DEPENDENCIES, a list of lowerable modules in SOURCE and that depend on DEPENDENCIES, a list of lowerable
objects. The assumption is that SOURCE contains package modules to be added objects. The assumption is that SOURCE contains package modules to be added
to '%package-module-path'." to '%package-module-path'."
;; FIXME: We should load, say SOURCE/.guix-channel.scm, which would allow
;; channel publishers to specify things such as the sub-directory where .scm (let* ((metadata (read-channel-metadata-from-source source))
;; files live, files to exclude from the channel, preferred substitute URLs, (directory (and=> metadata channel-metadata-directory)))
;; etc.
(define build (define build
;; This is code that we'll run in CORE, a Guix instance, with its own ;; This is code that we'll run in CORE, a Guix instance, with its own
@ -253,13 +260,17 @@ to '%package-module-path'."
(string-append #$output "/share/guile/site/" (string-append #$output "/share/guile/site/"
(effective-version))) (effective-version)))
(compile-files #$source go (let* ((subdir (if #$directory
(find-files #$source "\\.scm$")) (string-append "/" #$directory)
""))
(source (string-append #$source subdir)))
(compile-files source go (find-files source "\\.scm$"))
(mkdir-p (dirname scm)) (mkdir-p (dirname scm))
(symlink #$source scm) (symlink (string-append #$source subdir) scm))
scm))) scm)))
(gexp->derivation-in-inferior name build core)) (gexp->derivation-in-inferior name build core)))
(define* (build-from-source name source (define* (build-from-source name source
#:key core verbose? commit #:key core verbose? commit