From: Richard Sent <richard@freakingpenguin.com>
To: 70829@debbugs.gnu.org
Cc: "Richard Sent" <richard@freakingpenguin.com>,
"Christopher Baines" <guix@cbaines.net>,
"Florian Pelz" <pelzflorian@pelzflorian.de>,
"Josselin Poiret" <dev@jpoiret.xyz>,
"Ludovic Courtès" <ludo@gnu.org>,
"Mathieu Othacehe" <othacehe@gnu.org>,
"Ricardo Wurmus" <rekado@elephly.net>,
"Simon Tournier" <zimon.toutoune@gmail.com>,
"Tobias Geerinckx-Rice" <me@tobias.gr>
Subject: [bug#70829] [PATCH v2 2/2] guix: gexp: Add assume-source-relative-file-name
Date: Wed, 8 May 2024 14:32:47 -0400 [thread overview]
Message-ID: <822a1c5009d33b5e994fac9e21f087cbb3255972.1715193167.git.richard@freakingpenguin.com> (raw)
In-Reply-To: <23ca145e6087ea18559fdd71d0c92db572abc8a3.1715193167.git.richard@freakingpenguin.com>
guix/gexp.scm (assume-source-relative-file-name): Create syntax rule
(local-file): Use assume-source-relative-file-name to look up a non-literal
file relative to the current source directory.
doc/guix.texi (G-expressions): Document it.
tests: gexp.scm: Test it.
---
doc/guix.texi | 5 +++++
guix/gexp.scm | 15 ++++++++++++++-
tests/gexp.scm | 6 ++++++
3 files changed, 25 insertions(+), 1 deletion(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 221db5c022..1fc7be7cd8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12166,6 +12166,11 @@ G-Expressions
(local-file (assume-valid-file-name alice-key-file-path))
@end lisp
+@var{file} can be wrapped in the @code{assume-source-relative-file-name}
+syntactic keyword. When this is done, the file name will be looked up
+relative to the source file where it appears even when it is not a
+string literal.
+
This is the declarative counterpart of the @code{interned-file} monadic
procedure (@pxref{The Store Monad, @code{interned-file}}).
@end deffn
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 74b4c49f90..871e59cfdc 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -52,6 +52,7 @@ (define-module (guix gexp)
gexp-input-native?
assume-valid-file-name
+ assume-source-relative-file-name
local-file
local-file?
local-file-file
@@ -485,6 +486,12 @@ (define-syntax-rule (assume-valid-file-name file)
warn about it."
file)
+(define-syntax-rule (assume-source-relative-file-name file)
+ "This is a syntactic keyword to tell 'local-file' that it can assume that
+the given file is relative to the source directory, even if it's not a string
+literal."
+ file)
+
(define-syntax local-file
(lambda (s)
"Return an object representing local file FILE to add to the store; this
@@ -503,13 +510,19 @@ (define-syntax local-file
This is the declarative counterpart of the 'interned-file' monadic procedure.
It is implemented as a macro to capture the current source directory where it
appears."
- (syntax-case s (assume-valid-file-name)
+ (syntax-case s (assume-valid-file-name assume-source-relative-file-name)
((_ file rest ...)
(string? (syntax->datum #'file))
;; FILE is a literal, so resolve it relative to the source directory.
#'(%local-file file
(delay (absolute-file-name file (current-source-directory)))
rest ...))
+ ((_ (assume-source-relative-file-name file) rest ...)
+ ;; FILE is not a literal, but the user requested we look it up
+ ;; relative to the current source directory.
+ #'(%local-file file
+ (delay (absolute-file-name file (current-source-directory)))
+ rest ...))
((_ (assume-valid-file-name file) rest ...)
;; FILE is not a literal, so resolve it relative to the current
;; directory. Since the user declared FILE is valid, do not pass
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 905009caee..8774097bd0 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -244,6 +244,12 @@ (define %extension-package
(let ((file (local-file (string-copy "../base32.scm"))))
(local-file-absolute-file-name file)))))
+(test-equal "local-file, non-literal source relative file name"
+ (current-filename)
+ (let ((file (local-file (assume-source-relative-file-name
+ (string-append "gexp" ".scm")))))
+ (local-file-absolute-file-name file)))
+
(test-assert "local-file, relative file name, within gexp"
(let* ((file (search-path %load-path "guix/base32.scm"))
(interned (add-to-store %store "base32.scm" #f "sha256" file)))
--
2.41.0
next prev parent reply other threads:[~2024-05-08 18:35 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-05-08 12:15 [bug#70829] [PATCH] guix: gexp: Add assume-source-relative-file-name Richard Sent
2024-05-08 18:32 ` [bug#70829] [PATCH v2 1/2] doc: Document assume-valid-file-name in local-file Richard Sent
2024-05-08 18:32 ` Richard Sent [this message]
2024-05-08 18:45 ` [bug#70829] [PATCH v3 " Richard Sent
2024-05-08 18:45 ` [bug#70829] [PATCH v3 2/2] guix: gexp: Add assume-source-relative-file-name Richard Sent
2024-06-02 19:44 ` [bug#70829] [PATCH v4] " Richard Sent
2024-09-04 13:43 ` bug#70829: " Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=822a1c5009d33b5e994fac9e21f087cbb3255972.1715193167.git.richard@freakingpenguin.com \
--to=richard@freakingpenguin.com \
--cc=70829@debbugs.gnu.org \
--cc=dev@jpoiret.xyz \
--cc=guix@cbaines.net \
--cc=ludo@gnu.org \
--cc=me@tobias.gr \
--cc=othacehe@gnu.org \
--cc=pelzflorian@pelzflorian.de \
--cc=rekado@elephly.net \
--cc=zimon.toutoune@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).