[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
05/05: squash! Add 'guix style'.
|
From: |
guix-commits |
|
Subject: |
05/05: squash! Add 'guix style'. |
|
Date: |
Sun, 27 Jun 2021 16:47:16 -0400 (EDT) |
civodul pushed a commit to branch wip-simplified-packages
in repository guix.
commit 1c0b4dc989a786608161fac6403b27b292f173ff
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Jun 27 22:43:28 2021 +0200
squash! Add 'guix style'.
Add the '--input-simplification' option.
---
doc/guix.texi | 22 +++++++++++++
guix/scripts/style.scm | 85 ++++++++++++++++++++++++++++++++++++--------------
tests/style.scm | 38 ++++++++++++++++++++++
3 files changed, 121 insertions(+), 24 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 132c064..ddd7606 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12103,6 +12103,28 @@ guix style -e '(@@ (gnu packages gcc) gcc-5)'
@end example
styles the @code{gcc-5} package definition.
+
+@item --input-simplification=@var{policy}
+Specify the package input simplification policy for cases where an input
+label does not match the corresponding package name. @var{policy} may
+be one of the following:
+
+@table @code
+@item silent
+Simplify inputs only when the change is ``silent'', meaning that the
+package does not need to be rebuilt (its derivation is unchanged).
+
+@item safe
+Simplify inputs only when that is ``safe'' to do: the package might need
+to be rebuilt, but the change is known to have no observable effect.
+
+@item always
+Simplify inputs even when input labels do not match package names, and
+even if that might have an observable effect.
+@end table
+
+The default is @code{silent}, meaning that input simplifications do not
+trigger any package rebuild.
@end table
@node Invoking guix lint
diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 14b4439d..3c10019 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -217,18 +217,19 @@
;;; Simplifying input expressions.
;;;
-(define (simplify-inputs location package str inputs)
+(define (label-matches? label name)
+ "Return true if LABEL matches NAME, a package name."
+ (or (string=? label name)
+ (and (string-prefix? "python-" label)
+ (string-prefix? "python2-" name)
+ (string=? (string-drop label (string-length "python-"))
+ (string-drop name (string-length "python2-"))))))
+
+(define* (simplify-inputs location package str inputs
+ #:key (label-matches? label-matches?))
"Simplify the inputs field of PACKAGE (a string) at LOCATION; its current
value is INPUTS the corresponding source code is STR. Return a string to
replace STR."
- (define (label-matches? label name)
- ;; Return true if LABEL matches NAME, a package name.
- (or (string=? label name)
- (and (string-prefix? "python-" label)
- (string-prefix? "python2-" name)
- (string=? (string-drop label (string-length "python-"))
- (string-drop name (string-length "python2-"))))))
-
(define (simplify-input-expression return)
(match-lambda
((label ('unquote symbol)) symbol)
@@ -381,8 +382,13 @@ bailing out~%")
package)
str)))
-(define (simplify-package-inputs package)
- "Edit the source code of PACKAGE to simplify its inputs field if needed."
+(define* (simplify-package-inputs package
+ #:key (policy 'silent))
+ "Edit the source code of PACKAGE to simplify its inputs field if needed.
+POLICY is a symbol that defines whether to simplify inputs; it can one of
+'silent (change only if the resulting derivation is the same), 'safe (change
+only if semantics are known to be unaffected), and 'always (fearlessly
+simplify inputs!)."
(for-each (lambda (field-name field)
(match (field package)
(()
@@ -390,22 +396,39 @@ bailing out~%")
(inputs
(match (package-field-location package field-name)
(#f
- ;; (unless (null? (field package))
- ;; (warning (package-location package)
- ;; (G_ "source location not found for '~a' of
'~a'~%")
- ;; field-name (package-name package)))
+ ;; If the location of FIELD-NAME is not found, it may be
+ ;; that PACKAGE inherits from another package.
#f)
(location
- (edit-expression (location->source-properties location)
- (lambda (str)
- (simplify-inputs location
- (package-name package)
- str inputs))))))))
+ (edit-expression
+ (location->source-properties location)
+ (lambda (str)
+ (define matches?
+ (match policy
+ ('silent
+ ;; Simplify inputs only when the label matches
+ ;; perfectly, such that the resulting derivation
+ ;; is unchanged.
+ label-matches?)
+ ('safe
+ ;; If PACKAGE has no arguments, labels are known
+ ;; to have no effect: this is a "safe" change, but
+ ;; it may change the derivation.
+ (if (null? (package-arguments package))
+ (const #t)
+ label-matches?))
+ ('always
+ ;; Assume it's gonna be alright.
+ (const #f))))
+
+ (simplify-inputs location
+ (package-name package)
+ str inputs
+ #:label-matches? matches?))))))))
'(inputs native-inputs propagated-inputs)
(list package-inputs package-native-inputs
package-propagated-inputs)))
-
(define (package-location<? p1 p2)
"Return true if P1's location is \"before\" P2's."
(let ((loc1 (package-location p1))
@@ -429,6 +452,14 @@ bailing out~%")
(option '(#\e "expression") #t #f
(lambda (opt name arg result)
(alist-cons 'expression arg result)))
+ (option '("input-simplification") #t #f
+ (lambda (opt name arg result)
+ (let ((symbol (string->symbol arg)))
+ (unless (memq symbol '(silent safe always))
+ (leave (G_ "~a: invalid input simplification policy~%")
+ arg))
+ (alist-cons 'input-simplification-policy symbol
+ result))))
(option '(#\h "help") #f #f
(lambda args
@@ -445,6 +476,10 @@ Update package definitions to the latest style.\n"))
-L, --load-path=DIR prepend DIR to the package module search path"))
(display (G_ "
-e, --expression=EXPR consider the package EXPR evaluates to"))
+ (display (G_ "
+ --input-simplification=POLICY
+ follow POLICY for package input simplification, one
+ of 'silent', 'safe', or 'always'"))
(newline)
(display (G_ "
-h, --help display this help and exit"))
@@ -455,7 +490,7 @@ Update package definitions to the latest style.\n"))
(define %default-options
;; Alist of default option values.
- '())
+ '((input-simplification-policy . silent)))
;;;
@@ -478,8 +513,10 @@ Update package definitions to the latest style.\n"))
(('expression . str)
(read/eval str))
(_ #f))
- opts)))
- (for-each simplify-package-inputs
+ opts))
+ (policy (assoc-ref opts 'input-simplification-policy)))
+ (for-each (lambda (package)
+ (simplify-package-inputs package #:policy policy))
;; Sort package by source code location so that we start editing
;; files from the bottom and going upward. That way, the
;; 'location' field of <package> records is not invalidated as
diff --git a/tests/style.scm b/tests/style.scm
index 426ffc2..ada9197 100644
--- a/tests/style.scm
+++ b/tests/style.scm
@@ -214,6 +214,44 @@
(list (package-inputs (@ (my-packages) my-coreutils))
(read-package-field (@ (my-packages) my-coreutils) 'inputs 2))))
+(test-equal "input labels, 'safe' policy"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (inputs (list gmp acl))\n")
+ (call-with-test-package '((inputs `(("GMP" ,gmp) ("ACL" ,acl)))
+ (arguments '())) ;no build system arguments
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (system* "guix" "style" "-L" directory "my-coreutils"
+ "--input-simplification=safe")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs)))))
+
+(test-equal "input labels, 'safe' policy, nothing changed"
+ (list `(("GMP" ,gmp) ("ACL" ,acl))
+ "\
+ (inputs `((\"GMP\" ,gmp) (\"ACL\" ,acl)))\n")
+ (call-with-test-package '((inputs `(("GMP" ,gmp) ("ACL" ,acl)))
+ ;; Non-empty argument list, so potentially unsafe
+ ;; input simplification.
+ (arguments
+ '(#:configure-flags
+ (assoc-ref %build-inputs "GMP"))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (system* "guix" "style" "-L" directory "my-coreutils"
+ "--input-simplification=safe")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs)))))
+
(test-equal "input labels, margin comment"
(list `(("gmp" ,gmp))
`(("acl" ,acl))