style: Add 'arguments' styling rule.
* guix/scripts/style.scm (unquote->ungexp, gexpify-argument-value)
(quote-argument-value, gexpify-argument-tail)
(gexpify-package-arguments): New procedures.
(%gexp-keywords): New variable.
(%options): Add "arguments" case for 'styling-procedure.
(show-stylings): Update.
* tests/style.scm ("gexpify arguments, already gexpified")
("gexpify arguments, non-gexp arguments, margin comment")
("gexpify arguments, phases and flags")
("gexpify arguments, append arguments")
("gexpify arguments, substitute-keyword-arguments")
("gexpify arguments, append substitute-keyword-arguments"): New tests.
* doc/guix.texi (package Reference): For 'arguments', add compatibility
note and link to 'guix style'.
(Invoking guix style): Document the 'arguments' styling rule.
This commit is contained in:
Ludovic Courtès
parent
c1007786fd
commit
ba5da5125a
|
|
@ -7785,6 +7785,24 @@ The exact set of supported keywords depends on the build system
|
|||
@code{#:phases}. The @code{#:phases} keyword in particular lets you
|
||||
modify the set of build phases for your package (@pxref{Build Phases}).
|
||||
|
||||
@quotation Compatibility Note
|
||||
Until version 1.3.0, the @code{arguments} field would typically use
|
||||
@code{quote} (@code{'}) or @code{quasiquote} (@code{`}) and no
|
||||
G-expressions, like so:
|
||||
|
||||
@lisp
|
||||
(package
|
||||
;; several fields omitted
|
||||
(arguments ;old-style quoted arguments
|
||||
'(#:tests? #f
|
||||
#:configure-flags '("--enable-frobbing"))))
|
||||
@end lisp
|
||||
|
||||
To convert from that style to the one shown above, you can run
|
||||
@code{guix style -S arguments @var{package}} (@pxref{Invoking guix
|
||||
style}).
|
||||
@end quotation
|
||||
|
||||
@item @code{inputs} (default: @code{'()})
|
||||
@itemx @code{native-inputs} (default: @code{'()})
|
||||
@itemx @code{propagated-inputs} (default: @code{'()})
|
||||
|
|
@ -14709,6 +14727,39 @@ Rewriting is done in a conservative way: preserving comments and bailing
|
|||
out if it cannot make sense of the code that appears in an inputs field.
|
||||
The @option{--input-simplification} option described below provides
|
||||
fine-grain control over when inputs should be simplified.
|
||||
|
||||
@item arguments
|
||||
Rewrite package arguments to use G-expressions (@pxref{G-Expressions}).
|
||||
For example, consider this package definition:
|
||||
|
||||
@lisp
|
||||
(define-public my-package
|
||||
(package
|
||||
;; @dots{}
|
||||
(arguments ;old-style quoted arguments
|
||||
'(#:make-flags '("V=1")
|
||||
#:phases (modify-phases %standard-phases
|
||||
(delete 'build))))))
|
||||
@end lisp
|
||||
|
||||
@noindent
|
||||
Running @command{guix style -S arguments} on this package would rewrite
|
||||
its @code{arguments} field like to:
|
||||
|
||||
@lisp
|
||||
(define-public my-package
|
||||
(package
|
||||
;; @dots{}
|
||||
(arguments
|
||||
(list #:make-flags #~'("V=1")
|
||||
#:phases #~(modify-phases %standard-phases
|
||||
(delete 'build))))))
|
||||
@end lisp
|
||||
|
||||
Note that changes made by the @code{arguments} rule do not entail a
|
||||
rebuild of the affected packages. Furthermore, if a package definition
|
||||
happens to be using G-expressions already, @command{guix style} leaves
|
||||
it unchanged.
|
||||
@end table
|
||||
|
||||
@item --list-stylings
|
||||
|
|
|
|||
|
|
@ -41,6 +41,7 @@
|
|||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (srfi srfi-37)
|
||||
#:export (guix-style))
|
||||
|
|
@ -302,6 +303,174 @@ PACKAGE."
|
|||
(list package-inputs package-native-inputs
|
||||
package-propagated-inputs)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Gexpifying package arguments.
|
||||
;;;
|
||||
|
||||
(define (unquote->ungexp value)
|
||||
"Replace 'unquote' and 'unquote-splicing' in VALUE with their gexp
|
||||
counterpart."
|
||||
;; Replace 'unquote only on the first quasiquotation level.
|
||||
(let loop ((value value)
|
||||
(quotation 1))
|
||||
(match value
|
||||
(('unquote x)
|
||||
(if (= quotation 1)
|
||||
`(ungexp ,x)
|
||||
value))
|
||||
(('unquote-splicing x)
|
||||
(if (= quotation 1)
|
||||
`(ungexp-splicing x)
|
||||
value))
|
||||
(('quasiquote x)
|
||||
(list 'quasiquote (loop x (+ quotation 1))))
|
||||
(('quote x)
|
||||
(list 'quote (loop x (+ quotation 1))))
|
||||
((lst ...)
|
||||
(map (cut loop <> quotation) lst))
|
||||
(x x))))
|
||||
|
||||
(define (gexpify-argument-value value quotation)
|
||||
"Turn VALUE, an sexp, into its gexp equivalent. QUOTATION is a symbol that
|
||||
indicates in what quotation context VALUE is to be interpreted: 'quasiquote,
|
||||
'quote, or 'none."
|
||||
(match quotation
|
||||
('none
|
||||
(match value
|
||||
(('quasiquote value)
|
||||
(gexpify-argument-value value 'quasiquote))
|
||||
(('quote value)
|
||||
(gexpify-argument-value value 'quote))
|
||||
(value value)))
|
||||
('quote
|
||||
`(gexp ,value))
|
||||
('quasiquote
|
||||
`(gexp ,(unquote->ungexp value)))))
|
||||
|
||||
(define (quote-argument-value value quotation)
|
||||
"Quote VALUE, an sexp. QUOTATION is a symbol that indicates in what
|
||||
quotation context VALUE is to be interpreted: 'quasiquote, 'quote, or 'none."
|
||||
(define (self-quoting? x)
|
||||
(or (boolean? x) (number? x) (string? x) (char? x)
|
||||
(keyword? x)))
|
||||
|
||||
(match quotation
|
||||
('none
|
||||
(match value
|
||||
(('quasiquote value)
|
||||
(quote-argument-value value 'quasiquote))
|
||||
(('quote value)
|
||||
(quote-argument-value value 'quote))
|
||||
(value value)))
|
||||
('quote
|
||||
(if (self-quoting? value)
|
||||
value
|
||||
(list 'quote value)))
|
||||
('quasiquote
|
||||
(match value
|
||||
(('unquote x) x)
|
||||
((? self-quoting? x) x)
|
||||
(_ (list 'quasiquote value))))))
|
||||
|
||||
(define %gexp-keywords
|
||||
;; Package argument keywords that must be followed by a gexp.
|
||||
'(#:phases #:configure-flags #:make-flags #:strip-flags))
|
||||
|
||||
(define (gexpify-argument-tail sexp)
|
||||
"Gexpify SEXP, an unquoted argument tail."
|
||||
(match sexp
|
||||
(('substitute-keyword-arguments lst clauses ...)
|
||||
`(substitute-keyword-arguments ,lst
|
||||
,@(map (match-lambda
|
||||
((((? keyword? keyword) identifier) body)
|
||||
`((,keyword ,identifier)
|
||||
,(if (memq keyword %gexp-keywords)
|
||||
(gexpify-argument-value body 'none)
|
||||
(quote-argument-value body 'none))))
|
||||
((((? keyword? keyword) identifier default) body)
|
||||
`((,keyword ,identifier
|
||||
,(if (memq keyword %gexp-keywords)
|
||||
(gexpify-argument-value default 'none)
|
||||
(quote-argument-value default 'none)))
|
||||
,(if (memq keyword %gexp-keywords)
|
||||
(gexpify-argument-value body 'none)
|
||||
(quote-argument-value body 'none))))
|
||||
(clause clause))
|
||||
clauses)))
|
||||
(_ sexp)))
|
||||
|
||||
(define* (gexpify-package-arguments package
|
||||
#:key
|
||||
(policy 'none)
|
||||
(edit-expression edit-expression))
|
||||
"Rewrite the 'arguments' field of PACKAGE to use gexps where applicable."
|
||||
(define (gexpify location str)
|
||||
(match (call-with-input-string str read-with-comments)
|
||||
((rest ...)
|
||||
(let ((blanks (take-while blank? rest))
|
||||
(value (drop-while blank? rest)))
|
||||
(define-values (quotation arguments tail)
|
||||
(match value
|
||||
(('quote (arguments ...)) (values 'quote arguments '()))
|
||||
(('quasiquote (arguments ... ('unquote-splicing tail)))
|
||||
(values 'quasiquote arguments tail))
|
||||
(('quasiquote (arguments ...)) (values 'quasiquote arguments '()))
|
||||
(('list arguments ...) (values 'none arguments '()))
|
||||
(arguments (values 'none '() arguments))))
|
||||
|
||||
(define (append-tail sexp)
|
||||
(if (null? tail)
|
||||
sexp
|
||||
(let ((tail (gexpify-argument-tail tail)))
|
||||
(if (null? arguments)
|
||||
tail
|
||||
`(append ,sexp ,tail)))))
|
||||
|
||||
(let/ec return
|
||||
(object->string*
|
||||
(append-tail
|
||||
`(list ,@(let loop ((arguments arguments)
|
||||
(result '()))
|
||||
(match arguments
|
||||
(() (reverse result))
|
||||
(((? keyword? keyword) value rest ...)
|
||||
(when (eq? quotation 'none)
|
||||
(match value
|
||||
(('gexp _) ;already gexpified
|
||||
(return str))
|
||||
(_ #f)))
|
||||
|
||||
(loop rest
|
||||
(cons* (if (memq keyword %gexp-keywords)
|
||||
(gexpify-argument-value value
|
||||
quotation)
|
||||
(quote-argument-value value quotation))
|
||||
keyword result)))
|
||||
(((? blank? blank) rest ...)
|
||||
(loop rest (cons blank result)))
|
||||
(_
|
||||
;; Something like: ,@(package-arguments xyz).
|
||||
(warning location
|
||||
(G_ "unsupported argument style; \
|
||||
bailing out~%"))
|
||||
(return str))))))
|
||||
(location-column location)))))
|
||||
(_
|
||||
(warning location
|
||||
(G_ "unsupported argument field; bailing out~%"))
|
||||
str)))
|
||||
|
||||
(unless (null? (package-arguments package))
|
||||
(match (package-field-location package 'arguments)
|
||||
(#f
|
||||
#f)
|
||||
(location
|
||||
(edit-expression
|
||||
(location->source-properties (absolute-location location))
|
||||
(lambda (str)
|
||||
(gexpify location str)))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Formatting package definitions.
|
||||
|
|
@ -379,6 +548,7 @@ PACKAGE."
|
|||
(alist-cons 'styling-procedure
|
||||
(match arg
|
||||
("inputs" simplify-package-inputs)
|
||||
("arguments" gexpify-package-arguments)
|
||||
("format" format-package-definition)
|
||||
(_ (leave (G_ "~a: unknown styling~%")
|
||||
arg)))
|
||||
|
|
@ -407,7 +577,8 @@ PACKAGE."
|
|||
(define (show-stylings)
|
||||
(display (G_ "Available styling rules:\n"))
|
||||
(display (G_ "- format: Format the given package definition(s)\n"))
|
||||
(display (G_ "- inputs: Rewrite package inputs to the “new style”\n")))
|
||||
(display (G_ "- inputs: Rewrite package inputs to the “new style”\n"))
|
||||
(display (G_ "- arguments: Rewrite package arguments to G-expressions\n")))
|
||||
|
||||
(define (show-help)
|
||||
(display (G_ "Usage: guix style [OPTION]... [PACKAGE]...
|
||||
|
|
|
|||
136
tests/style.scm
136
tests/style.scm
|
|
@ -386,6 +386,142 @@
|
|||
(list (package-inputs (@ (my-packages) my-coreutils))
|
||||
(read-package-field (@ (my-packages) my-coreutils) 'inputs 4)))))
|
||||
|
||||
(test-assert "gexpify arguments, already gexpified"
|
||||
(call-with-test-package '((arguments
|
||||
(list #:configure-flags #~'("--help"))))
|
||||
(lambda (directory)
|
||||
(define file
|
||||
(string-append directory "/my-packages.scm"))
|
||||
(define (fingerprint file)
|
||||
(let ((stat (stat file)))
|
||||
(list (stat:mtime stat) (stat:size stat))))
|
||||
(define before
|
||||
(fingerprint file))
|
||||
|
||||
(system* "guix" "style" "-L" directory "my-coreutils"
|
||||
"-S" "arguments")
|
||||
|
||||
(equal? (fingerprint file) before))))
|
||||
|
||||
(test-equal "gexpify arguments, non-gexp arguments, margin comment"
|
||||
(list (list #:tests? #f #:test-target "check")
|
||||
"\
|
||||
(arguments (list #:tests? #f ;no tests
|
||||
#:test-target \"check\"))\n")
|
||||
(call-with-test-package '((arguments
|
||||
'(#:tests? #f
|
||||
#:test-target "check")))
|
||||
(lambda (directory)
|
||||
(define file
|
||||
(string-append directory "/my-packages.scm"))
|
||||
|
||||
(substitute* file
|
||||
(("#:tests\\? #f" all)
|
||||
(string-append all " ;no tests\n")))
|
||||
|
||||
(system* "guix" "style" "-L" directory "my-coreutils"
|
||||
"-S" "arguments")
|
||||
|
||||
(load file)
|
||||
(list (package-arguments (@ (my-packages) my-coreutils))
|
||||
(read-package-field (@ (my-packages) my-coreutils) 'arguments 2)))))
|
||||
|
||||
(test-equal "gexpify arguments, phases and flags"
|
||||
"\
|
||||
(list #:tests? #f
|
||||
#:configure-flags #~'(\"--fast\")
|
||||
#:make-flags #~(list (string-append \"CC=\"
|
||||
#$(cc-for-target)))
|
||||
#:phases #~(modify-phases %standard-phases
|
||||
;; Line comment.
|
||||
whatever)))\n"
|
||||
(call-with-test-package '((arguments
|
||||
`(#:tests? #f
|
||||
#:configure-flags '("--fast")
|
||||
#:make-flags
|
||||
(list (string-append "CC=" ,(cc-for-target)))
|
||||
#:phases (modify-phases %standard-phases
|
||||
whatever))))
|
||||
(lambda (directory)
|
||||
(define file
|
||||
(string-append directory "/my-packages.scm"))
|
||||
|
||||
(substitute* file
|
||||
(("whatever")
|
||||
"\n;; Line comment.
|
||||
whatever"))
|
||||
(system* "guix" "style" "-L" directory "my-coreutils"
|
||||
"-S" "arguments")
|
||||
|
||||
(load file)
|
||||
(read-package-field (@ (my-packages) my-coreutils) 'arguments 7))))
|
||||
|
||||
(test-equal "gexpify arguments, append arguments"
|
||||
"\
|
||||
(append (list #:tests? #f
|
||||
#:configure-flags #~'(\"--fast\"))
|
||||
(package-arguments coreutils)))\n"
|
||||
(call-with-test-package '((arguments
|
||||
`(#:tests? #f
|
||||
#:configure-flags '("--fast")
|
||||
,@(package-arguments coreutils))))
|
||||
(lambda (directory)
|
||||
(define file
|
||||
(string-append directory "/my-packages.scm"))
|
||||
|
||||
(system* "guix" "style" "-L" directory "my-coreutils"
|
||||
"-S" "arguments")
|
||||
|
||||
(load file)
|
||||
(read-package-field (@ (my-packages) my-coreutils) 'arguments 3))))
|
||||
|
||||
(test-equal "gexpify arguments, substitute-keyword-arguments"
|
||||
"\
|
||||
(substitute-keyword-arguments (package-arguments coreutils)
|
||||
((#:tests? _ #f)
|
||||
#t)
|
||||
((#:make-flags flags
|
||||
#~'())
|
||||
#~(cons \"-DXYZ=yes\"
|
||||
#$flags))))\n"
|
||||
(call-with-test-package '((arguments
|
||||
(substitute-keyword-arguments
|
||||
(package-arguments coreutils)
|
||||
((#:tests? _ #f) #t)
|
||||
((#:make-flags flags ''())
|
||||
`(cons "-DXYZ=yes" ,flags)))))
|
||||
(lambda (directory)
|
||||
(define file
|
||||
(string-append directory "/my-packages.scm"))
|
||||
|
||||
(system* "guix" "style" "-L" directory "my-coreutils"
|
||||
"-S" "arguments")
|
||||
|
||||
(load file)
|
||||
(read-package-field (@ (my-packages) my-coreutils) 'arguments 7))))
|
||||
|
||||
(test-equal "gexpify arguments, append substitute-keyword-arguments"
|
||||
"\
|
||||
(append (list #:tests? #f)
|
||||
(substitute-keyword-arguments (package-arguments coreutils)
|
||||
((#:make-flags flags)
|
||||
#~(append `(\"-n\" ,%output)
|
||||
#$flags)))))\n"
|
||||
(call-with-test-package '((arguments
|
||||
`(#:tests? #f
|
||||
,@(substitute-keyword-arguments
|
||||
(package-arguments coreutils)
|
||||
((#:make-flags flags)
|
||||
`(append `("-n" ,%output) ,flags))))))
|
||||
(lambda (directory)
|
||||
(define file
|
||||
(string-append directory "/my-packages.scm"))
|
||||
|
||||
(system* "guix" "style" "-L" directory "my-coreutils"
|
||||
"-S" "arguments")
|
||||
|
||||
(load file)
|
||||
(read-package-field (@ (my-packages) my-coreutils) 'arguments 5))))
|
||||
|
||||
(test-end)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue