[bug#70829] [PATCH] guix: gexp: Add assume-source-relative-file-name

[bug#70829] [PATCH] guix: gexp: Add assume-source-relative-file-name

[Richard Sent]

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.
---
Hi Guix!

In the current local file setup is it is impossible to use
(local-file) with a non-literal source-relative file name. With this
patch, it is possible.

 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)))

base-commit: da41a8f5e85774e2a507d821b5d52e600fb9d1d7
prerequisite-patch-id: 5c8bedc278ab541b86ee4af63042a5893109639e
-- 
2.41.0

[bug#70829] [PATCH v2 1/2] doc: Document assume-valid-file-name in local-file

[Richard Sent]

doc/guix.texi (G-Expressions): Document the use of assume-valid-file-name with
local-file.
---

Missed a commit that my original revision depended on. I initially
submitted that previous commit to https://qa.guix.gnu.org/issue/70830,
but since both commits change the same guix.texi section on similar
subject matter, I'm resubmitting as a series.

 doc/guix.texi | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 1c1e0164e7..221db5c022 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12154,6 +12154,18 @@ G-Expressions
 absolute file name and @var{stat} is the result of @code{lstat}; exclude
 entries for which @var{select?} does not return true.
 
+@var{file} can be wrapped in the @code{assume-valid-file-name} syntactic
+keyword. When this is done, there will not be a warning when
+@code{local-file} is used with a non-literal path.  The path is still
+looked up relative to the current working directory at run time.
+Wrapping is done like this:
+
+@lisp
+(define alice-key-file-path "alice.pub")
+;; ...
+(local-file (assume-valid-file-name alice-key-file-path))
+@end lisp
+
 This is the declarative counterpart of the @code{interned-file} monadic
 procedure (@pxref{The Store Monad, @code{interned-file}}).
 @end deffn

base-commit: 7b7f299bb493e485c5534b8c554e51d4f3a8c026
-- 
2.41.0

[bug#70829] [PATCH v2 2/2] guix: gexp: Add assume-source-relative-file-name

[Richard Sent]

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

[bug#70829] [PATCH v3 1/2] doc: Document assume-valid-file-name in local-file

[Richard Sent]

doc/guix.texi (G-Expressions): Document the use of assume-valid-file-name with
local-file.
---
 doc/guix.texi | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 1c1e0164e7..221db5c022 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12154,6 +12154,18 @@ G-Expressions
 absolute file name and @var{stat} is the result of @code{lstat}; exclude
 entries for which @var{select?} does not return true.
 
+@var{file} can be wrapped in the @code{assume-valid-file-name} syntactic
+keyword. When this is done, there will not be a warning when
+@code{local-file} is used with a non-literal path.  The path is still
+looked up relative to the current working directory at run time.
+Wrapping is done like this:
+
+@lisp
+(define alice-key-file-path "alice.pub")
+;; ...
+(local-file (assume-valid-file-name alice-key-file-path))
+@end lisp
+
 This is the declarative counterpart of the @code{interned-file} monadic
 procedure (@pxref{The Store Monad, @code{interned-file}}).
 @end deffn

base-commit: 7b7f299bb493e485c5534b8c554e51d4f3a8c026
-- 
2.41.0

[bug#70829] [PATCH v3 2/2] guix: gexp: Add assume-source-relative-file-name

[Richard Sent]

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.

Change-Id: Ibc24239ad201797c151b01e0b4fec43b07b4a02f
---

Typo in the previous commit message. Sorry for the noise!

 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

[bug#70829] [PATCH v4] guix: gexp: Add assume-source-relative-file-name

[Richard Sent]

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.
---
Hi all,

Since #70830 wound up being merged, I'm resubmitting this patch
rebased on master and without the documentation for
assume-valid-file-name.

 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 8cc01b2e65..d291da4b98 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12204,6 +12204,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)))

base-commit: 2e53fa5346bf52f6d6d26e035bc905ebd410dabb
-- 
2.45.1