From 53f21642729e4786141c072dd835b04cb85dfe28 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 13 Jul 2019 16:31:50 +0200 Subject: channels: Add optional directory to channel metadata. * guix/channels.scm (): 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. --- doc/guix.texi | 13 ++++++++ guix/channels.scm | 93 +++++++++++++++++++++++++++++++------------------------ 2 files changed, 65 insertions(+), 41 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 5a8ad7ebda..458fca20af 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 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 @cindex pinning, channels diff --git a/guix/channels.scm b/guix/channels.scm index e6bb9b891b..615ff14565 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2019 Ludovic Courtès ;;; Copyright © 2018 Ricardo Wurmus +;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -107,9 +108,10 @@ (checkout channel-instance-checkout)) (define-record-type - (channel-metadata version dependencies) + (channel-metadata version directory dependencies) channel-metadata? (version channel-metadata-version) + (directory channel-metadata-directory) (dependencies channel-metadata-dependencies)) (define (channel-reference channel) @@ -119,18 +121,18 @@ (#f `(branch . ,(channel-branch channel))) (commit `(commit . ,(channel-commit channel))))) -(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"))) +(define (read-channel-metadata-from-source source) + "Return a channel-metadata record read from channel's SOURCE/.guix-channel +description file, or return #F if SOURCE/.guix-channel does not exist." + (let ((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) '()))) + (let* ((raw (call-with-input-file meta-file read)) + (version (and=> (assoc-ref raw 'version) first)) + (directory (and=> (assoc-ref raw 'directory) first)) + (dependencies (or (assoc-ref raw 'dependencies) '()))) (channel-metadata version + directory (map (lambda (item) (let ((get (lambda* (key #:optional default) (or (and=> (assoc-ref item key) first) default)))) @@ -144,12 +146,18 @@ file." (commit (get 'commit)))))) 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) "Return the list of channels that are declared as dependencies for the given channel INSTANCE." (match (read-channel-metadata instance) (#f '()) - (($ version dependencies) + (($ version directory dependencies) dependencies))) (define* (latest-channel-instances store channels #:optional (previous-channels '())) @@ -230,36 +238,39 @@ of COMMIT at URL. Use NAME as the channel name." modules in SOURCE and that depend on DEPENDENCIES, a list of lowerable objects. The assumption is that SOURCE contains package modules to be added 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 - ;; files live, files to exclude from the channel, preferred substitute URLs, - ;; etc. - - (define build - ;; This is code that we'll run in CORE, a Guix instance, with its own - ;; modules and so on. That way, we make sure these modules are built for - ;; the right Guile version, with the right dependencies, and that they get - ;; to see the right (gnu packages …) modules. - (with-extensions dependencies - #~(begin - (use-modules (guix build compile) - (guix build utils) - (srfi srfi-26)) - - (define go - (string-append #$output "/lib/guile/" (effective-version) - "/site-ccache")) - (define scm - (string-append #$output "/share/guile/site/" - (effective-version))) - - (compile-files #$source go - (find-files #$source "\\.scm$")) - (mkdir-p (dirname scm)) - (symlink #$source scm) - scm))) - - (gexp->derivation-in-inferior name build core)) + + (let* ((metadata (read-channel-metadata-from-source source)) + (directory (and=> metadata channel-metadata-directory))) + + (define build + ;; This is code that we'll run in CORE, a Guix instance, with its own + ;; modules and so on. That way, we make sure these modules are built for + ;; the right Guile version, with the right dependencies, and that they get + ;; to see the right (gnu packages …) modules. + (with-extensions dependencies + #~(begin + (use-modules (guix build compile) + (guix build utils) + (srfi srfi-26)) + + (define go + (string-append #$output "/lib/guile/" (effective-version) + "/site-ccache")) + (define scm + (string-append #$output "/share/guile/site/" + (effective-version))) + + (let* ((subdir (if #$directory + (string-append "/" #$directory) + "")) + (source (string-append #$source subdir))) + (compile-files source go (find-files source "\\.scm$")) + (mkdir-p (dirname scm)) + (symlink (string-append #$source subdir) scm)) + + scm))) + + (gexp->derivation-in-inferior name build core))) (define* (build-from-source name source #:key core verbose? commit -- cgit v1.2.3