From cf85280211ff0060b5283dc5a53cb15ee09a7998 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Tue, 9 Jul 2019 21:01:11 +0200 Subject: [PATCH] guix: Add directory to channel. Typical use (cons* (channel (name 'mes) (url "https://git.savannah.gnu.org/git/mes.git") (directory "guix") (branch "wip")) %default-channels) * guix/channels.scm (): Add directory. (read-channel-metadata): Fill directory slot. (checkout->channel-instance): Add #:directory parameter. Update callers. (standard-module-derivation): Add directory parameter. Update callers. (build-channel-instance): Provide directory argument. --- guix/channels.scm | 58 ++++++++++++++++++++++++++++++----------------- 1 file changed, 37 insertions(+), 21 deletions(-) diff --git a/guix/channels.scm b/guix/channels.scm index e6bb9b891b..bd64906832 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. ;;; @@ -50,6 +51,7 @@ channel-branch channel-commit channel-location + channel-directory %default-channels guix-channel? @@ -86,7 +88,8 @@ (branch channel-branch (default "master")) (commit channel-commit (default #f)) (location channel-location - (default (current-source-location)) (innate))) + (default (current-source-location)) (innate)) + (directory channel-directory (default #f))) (define %default-channels ;; Default list of channels. @@ -141,7 +144,8 @@ file." (name name) (branch branch) (url url) - (commit (get 'commit)))))) + (commit (get 'commit)) + (directory (get 'directory)))))) dependencies)))))) (define (channel-instance-dependencies instance) @@ -205,13 +209,16 @@ of previously processed channels." (define* (checkout->channel-instance checkout #:key commit - (url checkout) (name 'guix)) + (url checkout) + (name 'guix) + directory) "Return a channel instance for CHECKOUT, which is assumed to be a checkout of COMMIT at URL. Use NAME as the channel name." (let* ((commit (or commit (make-string 40 #\0))) (channel (channel (name name) (commit commit) - (url url)))) + (url url) + (directory directory)))) (channel-instance channel commit checkout))) (define %self-build-file @@ -225,11 +232,12 @@ of COMMIT at URL. Use NAME as the channel name." ;; place a set of compiled Guile modules in ~/.config/guix/latest. 1) -(define (standard-module-derivation name source core dependencies) +(define (standard-module-derivation name source directory core dependencies) "Return a derivation that builds with CORE, a Guix instance, the Scheme -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'." +modules in SOURCE or if DIRECTORY in SOURCE/DIRECTORY and that depend on +DEPENDENCIES, a list of lowerable objects. The assumption is that SOURCE or +SOURCE/DIRECTORY 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, @@ -253,20 +261,27 @@ to '%package-module-path'." (string-append #$output "/share/guile/site/" (effective-version))) - (compile-files #$source go - (find-files #$source "\\.scm$")) - (mkdir-p (dirname scm)) - (symlink #$source scm) + (let* ((subdir (if #$directory + (string-append "/" #$directory) + "")) + (dir (string-append #$source subdir))) + (compile-files dir go + (warn 'files (find-files dir "\\.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 - (dependencies '())) + (dependencies '()) + directory) "Return a derivation to build Guix from SOURCE, using the self-build script contained therein; use COMMIT as the version string. When CORE is true, build -package modules under SOURCE using CORE, an instance of Guix." +package modules under SOURCE or if DIRECTORY under SOURCE/DIRECTORY using +CORE, an instance of Guix." ;; Running the self-build script makes it easier to update the build ;; procedure: the self-build script of the Guix-to-be-installed contains the ;; right dependencies, build procedure, etc., which the Guix-in-use may not @@ -293,19 +308,20 @@ package modules under SOURCE using CORE, an instance of Guix." #:pull-version %pull-version)) ;; Build a set of modules that extend Guix using the standard method. - (standard-module-derivation name source core dependencies))) + (standard-module-derivation name source directory core dependencies))) (define* (build-channel-instance instance #:optional core (dependencies '())) "Return, as a monadic value, the derivation for INSTANCE, a channel instance. DEPENDENCIES is a list of extensions providing Guile modules that INSTANCE depends on." - (build-from-source (symbol->string - (channel-name (channel-instance-channel instance))) - (channel-instance-checkout instance) - #:commit (channel-instance-commit instance) - #:core core - #:dependencies dependencies)) + (let ((channel (channel-instance-channel instance))) + (build-from-source (symbol->string (channel-name channel)) + (channel-instance-checkout instance) + #:commit (channel-instance-commit instance) + #:core core + #:dependencies dependencies + #:directory (channel-directory channel)))) (define (resolve-dependencies instances) "Return a procedure that, given one of the elements of INSTANCES, returns -- 2.21.0