me
/
guix
Archived
1
0
Fork 0

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.
master
Ludovic Courtès 2023-05-05 17:34:01 +02:00
parent c1007786fd
commit ba5da5125a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 359 additions and 1 deletions

View File

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

View File

@ -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]...

View File

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