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:
parent
bee9f97e0a
commit
53f2164272
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue