ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-11 21:59:08 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gexp: Add 'assume-valid-file-name' syntax for use with 'local-file'.

Browse source 
* guix/gexp.scm (assume-valid-file-name): New variable.
(local-file): Add clause with (assume-valid-file-name file).
This commit is contained in:
Ludovic Courtès 2020-10-16 14:55:00 +02:00
parent e39e8d97c1
commit 5d4ad8e1be
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 16 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
guix/gexp.scm
View file

@ -48,6 +48,7 @@ (define-module (guix gexp)
gexp-input-output gexp-input-output
gexp-input-native? gexp-input-native?
assume-valid-file-name
local-file local-file
local-file? local-file?
local-file-file local-file-file
@ -424,6 +425,12 @@ (define (absolute-file-name file directory)
(string-append directory "/" file)) (string-append directory "/" file))
(else file)))) (else file))))
(define-syntax-rule (assume-valid-file-name file)
"This is a syntactic keyword to tell 'local-file' that it can assume that
the given file name is valid, even if it's not a string literal, and thus not
warn about it."
file)
(define-syntax local-file (define-syntax local-file
(lambda (s) (lambda (s)
"Return an object representing local file FILE to add to the store; this "Return an object representing local file FILE to add to the store; this
@ -442,13 +449,20 @@ (define-syntax local-file
This is the declarative counterpart of the 'interned-file' monadic procedure. 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 It is implemented as a macro to capture the current source directory where it
appears." appears."
(syntax-case s () (syntax-case s (assume-valid-file-name)
((_ file rest ...) ((_ file rest ...)
(string? (syntax->datum #'file)) (string? (syntax->datum #'file))
;; FILE is a literal, so resolve it relative to the source directory. ;; FILE is a literal, so resolve it relative to the source directory.
#'(%local-file file #'(%local-file file
(delay (absolute-file-name file (current-source-directory))) (delay (absolute-file-name file (current-source-directory)))
rest ...)) rest ...))
((_ (assume-valid-file-name file) rest ...)
;; FILE is not a literal, so resolve it relative to the source
;; directory. Since the user declared FILE is valid, do not pass
;; #:literal? #f so that we do not warn about it later on.
#'(%local-file file
(delay (absolute-file-name file (current-source-directory)))
rest ...))
((_ file rest ...) ((_ file rest ...)
;; Resolve FILE relative to the current directory. ;; Resolve FILE relative to the current directory.
(with-syntax ((location (datum->syntax s (syntax-source s)))) (with-syntax ((location (datum->syntax s (syntax-source s))))
@ -456,7 +470,7 @@ (define-syntax local-file
(delay (absolute-file-name file (getcwd))) (delay (absolute-file-name file (getcwd)))
rest ... rest ...
#:location 'location #:location 'location
#:literal? #f))) #:literal? #f))) ;warn if FILE is relative
((_) ((_)
#'(syntax-error "missing file name")) #'(syntax-error "missing file name"))
(id (id