From cf85280211ff0060b5283dc5a53cb15ee09a7998 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
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 (<channel>): 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(-)
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; 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