diff --git a/guix/packages.scm b/guix/packages.scm index d3fa72fd09..26e82050f8 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -108,6 +108,7 @@ package-superseded deprecated-package package-field-location + package-argument-location this-package-input this-package-native-input @@ -515,9 +516,9 @@ object." (name old-name) (properties `((superseded . ,p))))) -(define (package-field-location package field) - "Return the source code location of the definition of FIELD for PACKAGE, or -#f if it could not be determined." +(define (package-part-location package proc) + "Return the source code location of the part of PACKAGE returned by (PROC +PACKAGE), or #f if it could not be determined." (match (package-location package) (($ file line column) (match (search-path %load-path file) @@ -530,17 +531,16 @@ object." (go-to-location port line column) (match (read port) (('package inits ...) - (let ((field (assoc field inits))) - (match field - ((_ value) - (let ((loc (and=> (source-properties value) - source-properties->location))) - (and loc - ;; Preserve the original file name, which may be a - ;; relative file name. - (set-field loc (location-file) file)))) - (_ - #f)))) + (match (proc inits) + (#f + #f) + (value + (let ((loc (and=> (source-properties value) + source-properties->location))) + (and loc + ;; Preserve the original file name, which may be a + ;; relative file name. + (set-field loc (location-file) file)))))) (_ #f))))) (lambda _ @@ -550,6 +550,29 @@ object." #f))) (_ #f))) +(define (package-field-location package field) + "Return the source code location of the definition of FIELD for PACKAGE, or +#f if it could not be determined." + (package-part-location + package + (lambda (p) + (match (assoc field p) + ((_ value) value) + (_ #f))))) + +(define (package-argument-location package argument) + "Return the source code location of the definition of keyword ARGUMENT for +PACKAGE, or #f if it could not be determined." + (package-part-location + package + (lambda (p) + (match (assoc 'arguments p) + ((_ ('quasiquote (arguments ..1))) + (match (member argument arguments eq?) + ((_ value . _) value) + (_ #f))) + (_ #f))))) + (define (package-input package name) "Return the package input NAME of PACKAGE--i.e., an input from the ‘inputs’ or ‘propagated-inputs’ field. Native inputs are not diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm index 3c100197a7..19185d924e 100644 --- a/guix/scripts/style.scm +++ b/guix/scripts/style.scm @@ -371,7 +371,7 @@ bailing out~%") (delete ,@to-delete) (prepend ,@things))) (location-column location)))) - (('quasiquote (exp ...)) + ((or ('quasiquote (exp ...)) ((or (exp ...) (? comment? exp)) ...)) (let/ec return (object->string* `(list ,@(simplify-expressions exp inputs return)) @@ -389,6 +389,33 @@ 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!)." + (define (package-argument package argument) + (match (member argument (package-arguments package) eq?) + ((_ value . _) value) + (_ #f))) + + ;; We know that the cargo build system does not use its special input labels, + ;; so it is always safe to simplify, but it will change the derivation. Only + ;; proceed if POLICY is 'safe or 'always. + (when (member policy '(safe always)) + (for-each (lambda (argument) + (match (package-argument package argument) + (#f + #f) + (inputs + (match (package-argument-location package argument) + (#f + #f) + (location + (edit-expression + (location->source-properties location) + (lambda (str) + (simplify-inputs location + (package-name package) + str inputs + #:label-matches? (const #t))))))))) + (list #:cargo-inputs #:cargo-development-inputs))) + (for-each (lambda (field-name field) (match (field package) (()