civodul pushed a commit to branch wip-simplified-packages in repository guix.
commit 1c0b4dc989a786608161fac6403b27b292f173ff Author: Ludovic Courtès <[email protected]> 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))
