* [bug#49169] [PATCH 00/11] Removing input labels from package definitions
@ 2021-06-22 9:02 Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
` (3 more replies)
0 siblings, 4 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-22 9:02 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
Hello Guix!
This patch series does the ground work to remove input labels
from package definitions. In other words:
(package
;; …
(inputs `(("libunistring" ,libunistring)
("libffi" ,libffi))))
becomes:
(package
;; …
(inputs (list libunistring libffi)))
Note that it does not change the value returned by ‘package-inputs’
& co.: that still includes input labels. Likewise, build-side code
does not see any difference (there are still input alists).
Previous discussions at:
https://lists.gnu.org/archive/html/guix-devel/2021-05/msg00343.html
https://lists.gnu.org/archive/html/guix-devel/2021-06/msg00072.html
The main change is the addition of ‘guix style’, based on the script
I posted earlier. ‘guix style’ is able to systematically preserve
comments (margin comments and line comments). It recognizes and
“translates” several common idioms.
In the long term, the goal is to remove input labels also from
APIs like ‘package-inputs’. With an eye on this, I introduced the
‘modify-inputs’ macro as a replacement for idioms such as:
`(("guile" ,guile-2.2)
,@(alist-delete "guile" (package-inputs foo)))
which becomes:
(modify-inputs (package-inputs foo)
(replace "guile" guile-2.2))
Code that uses ‘modify-inputs’ does not assume that ‘package-inputs’
returns an alist. Thus, when we eventually change that, that code
won’t need to be changed. (‘guix style’ performs this translation,
too.)
‘guix style’ processes all 17K packages in ~3mn, leading to this:
447 files changed, 33385 insertions(+), 44079 deletions(-)
This does not incur a single rebuild. Some packages are not
handled by ‘guix style’ because the code pattern is not
recognized or because input labels don’t match package names
(often for no good reason). I don’t know what fraction of
the packages is left behind; I’d guess less than a third of them.
At this stage we have everything to start the migration and to
even complete it rather quickly. What’s needed now is to look
at corner cases and idioms that have no obvious translation in
the new style. But you can help!
1. Check out the ‘wip-simplified-packages’ branch (based
on ‘core-updates’).
2. Run ‘./pre-inst-env guix style’ (you can also list package
names) and see whether your favorite packages are handled.
3. If you see packages not handled by ‘guix style’, try to
convert them by hand. If you find an idiom that you don’t
know how to “translate”, let’s discuss it!
Thanks in advance! :-)
Ludo’.
Ludovic Courtès (11):
records: Support field sanitizers.
packages: Allow inputs to be plain package lists.
lint: Add 'input-labels' checker.
packages: Add 'lookup-package-input' & co.
packages: Add 'modify-inputs'.
gnu: Change inputs of core packages to plain lists.
utils: 'edit-expression' no longer leaks file ports.
utils: Add 'go-to-location' with source location caching.
utils: 'edit-expression' modifies the file only if necessary.
utils: 'edit-expression' copies part of the original source map.
Add 'guix style'.
Makefile.am | 2 +
doc/guix.texi | 174 +++++++++++++--
gnu/packages/base.scm | 48 ++---
gnu/packages/guile.scm | 103 +++------
gnu/packages/mes.scm | 25 +--
guix/lint.scm | 36 ++++
guix/packages.scm | 145 ++++++++++++-
guix/records.scm | 65 ++++--
guix/scripts/style.scm | 475 +++++++++++++++++++++++++++++++++++++++++
guix/utils.scm | 151 ++++++++++---
po/guix/POTFILES.in | 1 +
tests/lint.scm | 14 ++
tests/packages.scm | 86 ++++----
tests/records.scm | 38 ++++
tests/style.scm | 328 ++++++++++++++++++++++++++++
15 files changed, 1455 insertions(+), 236 deletions(-)
create mode 100644 guix/scripts/style.scm
create mode 100644 tests/style.scm
base-commit: d1827d5c636adb395153a4ed6064629ed5b7664b
--
2.32.0
^ permalink raw reply [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 01/11] records: Support field sanitizers.
2021-06-22 9:02 [bug#49169] [PATCH 00/11] Removing input labels from package definitions Ludovic Courtès
@ 2021-06-22 9:08 ` Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 02/11] packages: Allow inputs to be plain package lists Ludovic Courtès
` (9 more replies)
2021-06-22 9:09 ` [bug#49169] [PATCH 00/11] Removing input labels from package definitions Ludovic Courtès
` (2 subsequent siblings)
3 siblings, 10 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-22 9:08 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/records.scm (make-syntactic-constructor): Add #:sanitizers.
[field-sanitizer]: New procedure.
[wrap-field-value]: Honor F's sanitizer.
(define-record-type*)[field-sanitizer]: New procedure.
Pass #:sanitizer to 'make-syntactic-constructor'.
* tests/records.scm ("define-record-type* & sanitize")
("define-record-type* & sanitize & thunked"): New tests.
---
guix/records.scm | 65 +++++++++++++++++++++++++++++++++++++----------
tests/records.scm | 38 +++++++++++++++++++++++++++
2 files changed, 89 insertions(+), 14 deletions(-)
diff --git a/guix/records.scm b/guix/records.scm
index 3d54a51956..ed94c83dac 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
@@ -120,7 +120,8 @@ context of the definition of a thunked field."
"Make the syntactic constructor NAME for TYPE, that calls CTOR, and
expects all of EXPECTED fields to be initialized. DEFAULTS is the list of
FIELD/DEFAULT-VALUE tuples, THUNKED is the list of identifiers of thunked
-fields, and DELAYED is the list of identifiers of delayed fields.
+fields, DELAYED is the list of identifiers of delayed fields, and SANITIZERS
+is the list of FIELD/SANITIZER tuples.
ABI-COOKIE is the cookie (an integer) against which to check the run-time ABI
of TYPE matches the expansion-time ABI."
@@ -130,6 +131,7 @@ of TYPE matches the expansion-time ABI."
#:this-identifier this-identifier
#:delayed delayed
#:innate innate
+ #:sanitizers sanitizers
#:defaults defaults)
(define-syntax name
(lambda (s)
@@ -169,19 +171,30 @@ of TYPE matches the expansion-time ABI."
(define (innate-field? f)
(memq (syntax->datum f) 'innate))
+ (define field-sanitizer
+ (let ((lst (map (match-lambda
+ ((f p)
+ (list (syntax->datum f) p)))
+ #'sanitizers)))
+ (lambda (f)
+ (or (and=> (assoc-ref lst (syntax->datum f)) car)
+ #'(lambda (x) x)))))
+
(define (wrap-field-value f value)
- (cond ((thunked-field? f)
- #`(lambda (x)
- (syntax-parameterize ((#,this-identifier
- (lambda (s)
- (syntax-case s ()
- (id
- (identifier? #'id)
- #'x)))))
- #,value)))
- ((delayed-field? f)
- #`(delay #,value))
- (else value)))
+ (let* ((sanitizer (field-sanitizer f))
+ (value #`(#,sanitizer #,value)))
+ (cond ((thunked-field? f)
+ #`(lambda (x)
+ (syntax-parameterize ((#,this-identifier
+ (lambda (s)
+ (syntax-case s ()
+ (id
+ (identifier? #'id)
+ #'x)))))
+ #,value)))
+ ((delayed-field? f)
+ #`(delay #,value))
+ (else value))))
(define default-values
;; List of symbol/value tuples.
@@ -291,6 +304,19 @@ can access the record it belongs to via the 'this-thing' identifier.
A field can also be marked as \"delayed\" instead of \"thunked\", in which
case its value is effectively wrapped in a (delay …) form.
+A field can also have an associated \"sanitizer\", which is a procedure that
+takes a user-supplied field value and returns a \"sanitized\" value for the
+field:
+
+ (define-record-type* <thing> thing make-thing
+ thing?
+ this-thing
+ (name thing-name
+ (sanitize (lambda (value)
+ (cond ((string? value) value)
+ ((symbol? value) (symbol->string value))
+ (else (throw 'bad! value)))))))
+
It is possible to copy an object 'x' created with 'thing' like this:
(thing (inherit x) (name \"bar\"))
@@ -307,6 +333,14 @@ inherited."
(field-default-value #'(field properties ...)))
(_ #f)))
+ (define (field-sanitizer s)
+ (syntax-case s (sanitize)
+ ((field (sanitize proc) _ ...)
+ (list #'field #'proc))
+ ((field _ properties ...)
+ (field-sanitizer #'(field properties ...)))
+ (_ #f)))
+
(define-field-property-predicate delayed-field? delayed)
(define-field-property-predicate thunked-field? thunked)
(define-field-property-predicate innate-field? innate)
@@ -376,6 +410,8 @@ inherited."
(innate (filter-map innate-field? field-spec))
(defaults (filter-map field-default-value
#'((field properties ...) ...)))
+ (sanitizers (filter-map field-sanitizer
+ #'((field properties ...) ...)))
(cookie (compute-abi-cookie field-spec)))
(with-syntax (((field-spec* ...)
(map field-spec->srfi-9 field-spec))
@@ -421,6 +457,7 @@ of a record instantiation"
#:this-identifier #'this-identifier
#:delayed #,delayed
#:innate #,innate
+ #:sanitizers #,sanitizers
#:defaults #,defaults)))))
((_ type syntactic-ctor ctor pred
(field get properties ...) ...)
diff --git a/tests/records.scm b/tests/records.scm
index 706bb3dbfd..d014e7a995 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -283,6 +283,44 @@
(equal? (foo-bar y) 1)) ;promise was already forced
(eq? (foo-baz y) 'b)))))
+(test-assert "define-record-type* & sanitize"
+ (begin
+ (define-record-type* <foo> foo make-foo
+ foo?
+ (bar foo-bar
+ (default "bar")
+ (sanitize (lambda (x) (string-append x "!")))))
+
+ (let* ((p (foo))
+ (q (foo (inherit p)))
+ (r (foo (inherit p) (bar "baz")))
+ (s (foo (bar "baz"))))
+ (and (string=? (foo-bar p) "bar!")
+ (equal? q p)
+ (string=? (foo-bar r) "baz!")
+ (equal? s r)))))
+
+(test-assert "define-record-type* & sanitize & thunked"
+ (let ((sanitized 0))
+ (define-record-type* <foo> foo make-foo
+ foo?
+ (bar foo-bar
+ (default "bar")
+ (sanitize (lambda (x)
+ (set! sanitized (+ 1 sanitized))
+ (string-append x "!")))))
+
+ (let ((p (foo)))
+ (and (string=? (foo-bar p) "bar!")
+ (string=? (foo-bar p) "bar!") ;twice
+ (= sanitized 1) ;sanitizer was called at init time only
+ (let ((q (foo (bar "baz"))))
+ (and (string=? (foo-bar q) "baz!")
+ (string=? (foo-bar q) "baz!") ;twice
+ (= sanitized 2)
+ (let ((r (foo (inherit q))))
+ (and (string=? (foo-bar r) "baz!")
+ (= sanitized 2))))))))) ;no re-sanitization
(test-assert "define-record-type* & wrong field specifier"
(let ((exp '(begin
(define-record-type* <foo> foo make-foo
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 02/11] packages: Allow inputs to be plain package lists.
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
@ 2021-06-22 9:08 ` Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 03/11] lint: Add 'input-labels' checker Ludovic Courtès
` (8 subsequent siblings)
9 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-22 9:08 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/packages.scm (add-input-label, sanitize-inputs): New procedures.
(<package>)[inputs, propagated-inputs, native-inputs]: Add 'sanitize' property.
* doc/guix.texi (Defining Packages, package Reference):
(Defining Package Variants): Adjust examples accordingly.
* tests/packages.scm ("transaction-upgrade-entry, zero upgrades, propagated inputs")
("transaction-upgrade-entry, grafts")
("package-transitive-inputs")
("package-transitive-supported-systems")
("package-closure")
("supported-package?")
("package-derivation, inputs deduplicated")
("package-transitive-native-search-paths")
("package-grafts, indirect grafts")
("package-grafts, indirect grafts, propagated inputs")
("package-grafts, same replacement twice")
("package-grafts, dependency on several outputs")
("replacement also grafted")
("package->bag, sensitivity to %current-target-system")
("package->bag, propagated inputs")
("package->bag, sensitivity to %current-system")
("package-input-rewriting/spec, identity")
("package-input-rewriting, identity"): Use the label-less input style.
---
doc/guix.texi | 44 +++++++++++++++++-------
guix/packages.scm | 35 +++++++++++++++++--
tests/packages.scm | 86 ++++++++++++++++++++++------------------------
3 files changed, 106 insertions(+), 59 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 3557c977e1..1a3ac85e58 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6462,7 +6462,7 @@ package looks like this:
"0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
(build-system gnu-build-system)
(arguments '(#:configure-flags '("--enable-silent-rules")))
- (inputs `(("gawk" ,gawk)))
+ (inputs (list gawk))
(synopsis "Hello, GNU world: An example GNU package")
(description "Guess what GNU Hello prints!")
(home-page "https://www.gnu.org/software/hello/")
@@ -6550,8 +6550,8 @@ Reference Manual}).
@item
The @code{inputs} field specifies inputs to the build process---i.e.,
-build-time or run-time dependencies of the package. Here, we define an
-input called @code{"gawk"} whose value is that of the @code{gawk}
+build-time or run-time dependencies of the package. Here, we add
+an input, a reference to the @code{gawk}
variable; @code{gawk} is itself bound to a @code{<package>} object.
@cindex backquote (quasiquote)
@@ -6675,20 +6675,41 @@ list, typically containing sequential keyword-value pairs.
@itemx @code{native-inputs} (default: @code{'()})
@itemx @code{propagated-inputs} (default: @code{'()})
@cindex inputs, of packages
-These fields list dependencies of the package. Each one is a list of
-tuples, where each tuple has a label for the input (a string) as its
+These fields list dependencies of the package. Each element of these
+lists is either a package, origin, or other ``file-like object''
+(@pxref{G-Expressions}); to specify the output of that file-like object
+that should be used, pass a two-element list where the second element is
+the output (@pxref{Packages with Multiple Outputs}, for more on package
+outputs). For example, the list below specifies three inputs:
+
+@lisp
+(list libffi libunistring
+ `(,glib "bin")) ;the "bin" output of GLib
+@end lisp
+
+In the example above, the @code{"out"} output of @code{libffi} and
+@code{libunistring} is used.
+
+@quotation Compatibility Note
+Until version 1.3.0, input lists were a list of tuples,
+where each tuple has a label for the input (a string) as its
first element, a package, origin, or derivation as its second element,
and optionally the name of the output thereof that should be used, which
-defaults to @code{"out"} (@pxref{Packages with Multiple Outputs}, for
-more on package outputs). For example, the list below specifies three
-inputs:
+defaults to @code{"out"}. For example, the list below is equivalent to
+the one above, but using the @dfn{old input style}:
@lisp
+;; Old input style (deprecated).
`(("libffi" ,libffi)
("libunistring" ,libunistring)
- ("glib:bin" ,glib "bin")) ;the "bin" output of Glib
+ ("glib:bin" ,glib "bin")) ;the "bin" output of GLib
@end lisp
+This style is now deprecated; it is still supported but support will be
+removed in a future version. It should not be used for new package
+definitions.
+@end quotation
+
@cindex cross compilation, package dependencies
The distinction between @code{native-inputs} and @code{inputs} is
necessary when considering cross-compilation. When cross-compiling,
@@ -6774,7 +6795,7 @@ cross-compiling:
;; When cross-compiled, Guile, for example, depends on
;; a native version of itself. Add it here.
(native-inputs (if (%current-target-system)
- `(("self" ,this-package))
+ (list this-package)
'())))
@end lisp
@@ -7090,8 +7111,7 @@ depends on it:
(name name)
(version "3.0")
;; several fields omitted
- (inputs
- `(("lua" ,lua)))
+ (inputs (list lua))
(synopsis "Socket library for Lua")))
(define-public lua5.1-socket
diff --git a/guix/packages.scm b/guix/packages.scm
index a66dbea1b7..087e6e6a4a 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -366,6 +366,14 @@ name of its URI."
;; <https://lists.gnu.org/archive/html/guix-devel/2017-03/msg00790.html>.
(fold delete %supported-systems '("mips64el-linux" "powerpc-linux")))
+(define-inlinable (sanitize-inputs inputs)
+ "Sanitize INPUTS by turning it into a list of name/package tuples if it's
+not already the case."
+ (cond ((null? inputs) inputs)
+ ((and (pair? (car inputs))
+ (string? (caar inputs)))
+ inputs)
+ (else (map add-input-label inputs))))
;; A package.
(define-record-type* <package>
@@ -380,11 +388,14 @@ name of its URI."
(default '()) (thunked))
(inputs package-inputs ; input packages or derivations
- (default '()) (thunked))
+ (default '()) (thunked)
+ (sanitize sanitize-inputs))
(propagated-inputs package-propagated-inputs ; same, but propagated
- (default '()) (thunked))
+ (default '()) (thunked)
+ (sanitize sanitize-inputs))
(native-inputs package-native-inputs ; native input packages/derivations
- (default '()) (thunked))
+ (default '()) (thunked)
+ (sanitize sanitize-inputs))
(outputs package-outputs ; list of strings
(default '("out")))
@@ -415,6 +426,24 @@ name of its URI."
source-properties->location))
(innate)))
+(define (add-input-label input)
+ "Add an input label to INPUT."
+ (match input
+ ((? package? package)
+ (list (package-name package) package))
+ (((? package? package) output) ;XXX: ugly?
+ (list (package-name package) package output))
+ ((? gexp-input?) ;XXX: misplaced because 'native?' field is ignored?
+ (let ((obj (gexp-input-thing input))
+ (output (gexp-input-output input)))
+ `(,(if (package? obj)
+ (package-name obj)
+ "_")
+ ,obj
+ ,@(if (string=? output "out") '() (list output)))))
+ (x
+ `("_" ,x))))
+
(set-record-type-printer! <package>
(lambda (package port)
(let ((loc (package-location package))
diff --git a/tests/packages.scm b/tests/packages.scm
index 47d10af5bc..936aede4ff 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -137,7 +137,7 @@
;; inputs. See <https://bugs.gnu.org/35872>.
(let* ((dep (dummy-package "dep" (version "2")))
(old (dummy-package "foo" (version "1")
- (propagated-inputs `(("dep" ,dep)))))
+ (propagated-inputs (list dep))))
(drv (package-derivation %store old))
(tx (mock ((gnu packages) find-best-packages-by-name
(const (list old)))
@@ -225,7 +225,7 @@
(bar (dummy-package "bar" (version "0")
(replacement old)))
(new (dummy-package "foo" (version "1")
- (inputs `(("bar" ,bar)))))
+ (inputs (list bar))))
(tx (mock ((gnu packages) find-best-packages-by-name
(const (list new)))
(transaction-upgrade-entry
@@ -275,13 +275,13 @@
(test-assert "package-transitive-inputs"
(let* ((a (dummy-package "a"))
(b (dummy-package "b"
- (propagated-inputs `(("a" ,a)))))
+ (propagated-inputs (list a))))
(c (dummy-package "c"
- (inputs `(("a" ,a)))))
+ (inputs (list a))))
(d (dummy-package "d"
(propagated-inputs `(("x" "something.drv")))))
(e (dummy-package "e"
- (inputs `(("b" ,b) ("c" ,c) ("d" ,d))))))
+ (inputs (list b c d)))))
(and (null? (package-transitive-inputs a))
(equal? `(("a" ,a)) (package-transitive-inputs b))
(equal? `(("a" ,a)) (package-transitive-inputs c))
@@ -327,19 +327,19 @@
(b (dummy-package "b"
(build-system trivial-build-system)
(supported-systems '("x" "y"))
- (inputs `(("a" ,a)))))
+ (inputs (list a))))
(c (dummy-package "c"
(build-system trivial-build-system)
(supported-systems '("y" "z"))
- (inputs `(("b" ,b)))))
+ (inputs (list b))))
(d (dummy-package "d"
(build-system trivial-build-system)
(supported-systems '("x" "y" "z"))
- (inputs `(("b" ,b) ("c" ,c)))))
+ (inputs (list b c))))
(e (dummy-package "e"
(build-system trivial-build-system)
(supported-systems '("x" "y" "z"))
- (inputs `(("d" ,d))))))
+ (inputs (list d)))))
(list (package-transitive-supported-systems a)
(package-transitive-supported-systems b)
(package-transitive-supported-systems c)
@@ -355,13 +355,13 @@
(build-system trivial-build-system))))))
(let* ((a (dummy-package/no-implicit "a"))
(b (dummy-package/no-implicit "b"
- (propagated-inputs `(("a" ,a)))))
+ (propagated-inputs (list a))))
(c (dummy-package/no-implicit "c"
- (inputs `(("a" ,a)))))
+ (inputs (list a))))
(d (dummy-package/no-implicit "d"
- (native-inputs `(("b" ,b)))))
+ (native-inputs (list b))))
(e (dummy-package/no-implicit "e"
- (inputs `(("c" ,c) ("d" ,d))))))
+ (inputs (list c d)))))
(lset= eq?
(list a b c d e)
(package-closure (list e))
@@ -384,12 +384,11 @@
(u (dummy-origin))
(i (dummy-origin))
(a (dummy-package "a"))
- (b (dummy-package "b"
- (inputs `(("a" ,a) ("i" ,i)))))
+ (b (dummy-package "b" (inputs (list a i))))
(c (package (inherit b) (source o)))
(d (dummy-package "d"
(build-system trivial-build-system)
- (source u) (inputs `(("c" ,c))))))
+ (source u) (inputs (list c)))))
(test-assert "package-direct-sources, no source"
(null? (package-direct-sources a)))
(test-equal "package-direct-sources, #f source"
@@ -457,7 +456,7 @@
(supported-systems '("x86_64-linux"))))
(p (dummy-package "foo"
(build-system gnu-build-system)
- (inputs `(("d" ,d)))
+ (inputs (list d))
(supported-systems '("x86_64-linux" "armhf-linux")))))
(and (supported-package? p "x86_64-linux")
(not (supported-package? p "i686-linux"))
@@ -706,7 +705,7 @@
(test-assert "package-derivation, inputs deduplicated"
(let* ((dep (dummy-package "dep"))
- (p0 (dummy-package "p" (inputs `(("dep" ,dep)))))
+ (p0 (dummy-package "p" (inputs (list dep))))
(p1 (package (inherit p0)
(inputs `(("dep" ,(package (inherit dep)))
,@(package-inputs p0))))))
@@ -755,7 +754,7 @@
(parameterize ((%graft? #f))
(let* ((dep (dummy-package "dep"))
(p (dummy-package "p"
- (inputs `(("dep" ,dep "non-existent"))))))
+ (inputs (list `(,dep "non-existent"))))))
(guard (c ((derivation-missing-output-error? c)
(and (string=? (derivation-missing-output c) "non-existent")
(equal? (package-derivation %store dep)
@@ -913,12 +912,12 @@
(p1 (dummy-package "p1" (native-search-paths (sp "PATH1"))))
(p2 (dummy-package "p2"
(native-search-paths (sp "PATH2"))
- (inputs `(("p0" ,p0)))
- (propagated-inputs `(("p1" ,p1)))))
+ (inputs (list p0))
+ (propagated-inputs (list p1))))
(p3 (dummy-package "p3"
(native-search-paths (sp "PATH3"))
- (native-inputs `(("p0" ,p0)))
- (propagated-inputs `(("p2" ,p2))))))
+ (native-inputs (list p0))
+ (propagated-inputs (list p2)))))
(lset= string=?
'("PATH1" "PATH2" "PATH3")
(map search-path-specification-variable
@@ -972,7 +971,7 @@
(dep* (package (inherit dep) (replacement new)))
(dummy (dummy-package "dummy"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("dep" ,dep*))))))
+ (inputs (list dep*)))))
(equal? (package-grafts %store dummy)
(list (graft
(origin (package-derivation %store dep))
@@ -1004,11 +1003,11 @@
(dep (package (inherit new) (version "0.0")))
(dep* (package (inherit dep) (replacement new)))
(prop (dummy-package "propagated"
- (propagated-inputs `(("dep" ,dep*)))
+ (propagated-inputs (list dep*))
(arguments '(#:implicit-inputs? #f))))
(dummy (dummy-package "dummy"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("prop" ,prop))))))
+ (inputs (list prop)))))
(equal? (package-grafts %store dummy)
(list (graft
(origin (package-derivation %store dep))
@@ -1021,16 +1020,16 @@
(dep (package (inherit new) (version "0") (replacement new)))
(p1 (dummy-package "intermediate1"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("dep" ,dep)))))
+ (inputs (list dep))))
(p2 (dummy-package "intermediate2"
(arguments '(#:implicit-inputs? #f))
;; Here we copy DEP to have an equivalent package that is not
;; 'eq?' to DEP. This is similar to what happens with
;; 'package-with-explicit-inputs' & co.
- (inputs `(("dep" ,(package (inherit dep)))))))
+ (inputs (list (package (inherit dep))))))
(p3 (dummy-package "final"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("p1" ,p1) ("p2" ,p2))))))
+ (inputs (list p1 p2)))))
(equal? (package-grafts %store p3)
(list (graft
(origin (package-derivation %store
@@ -1048,8 +1047,7 @@
(p0* (package (inherit p0) (version "1.1")))
(p1 (dummy-package "p1"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("p0" ,p0)
- ("p0:lib" ,p0 "lib"))))))
+ (inputs (list p0 `(,p0 "lib"))))))
(lset= equal? (pk (package-grafts %store p1))
(list (graft
(origin (package-derivation %store p0))
@@ -1097,7 +1095,7 @@
#t)))))
(p2r (dummy-package "P2"
(build-system trivial-build-system)
- (inputs `(("p1" ,p1)))
+ (inputs (list p1))
(arguments
`(#:guile ,%bootstrap-guile
#:builder (let ((out (assoc-ref %outputs "out")))
@@ -1118,7 +1116,7 @@
#t)))))
(p3 (dummy-package "p3"
(build-system trivial-build-system)
- (inputs `(("p2" ,p2)))
+ (inputs (list p2))
(arguments
`(#:guile ,%bootstrap-guile
#:builder (let ((out (assoc-ref %outputs "out")))
@@ -1187,7 +1185,7 @@
(lower lower)))
(dep (dummy-package "dep" (build-system bs)))
(pkg (dummy-package "example"
- (native-inputs `(("dep" ,dep)))))
+ (native-inputs (list dep))))
(do-not-build (lambda (continue store lst . _) lst)))
(equal? (with-build-handler do-not-build
(parameterize ((%current-target-system "powerpc64le-linux-gnu")
@@ -1214,9 +1212,9 @@
(test-assert "package->bag, propagated inputs"
(let* ((dep (dummy-package "dep"))
(prop (dummy-package "prop"
- (propagated-inputs `(("dep" ,dep)))))
+ (propagated-inputs (list dep))))
(dummy (dummy-package "dummy"
- (inputs `(("prop" ,prop)))))
+ (inputs (list prop))))
(inputs (bag-transitive-inputs (package->bag dummy #:graft? #f))))
(match (assoc "dep" inputs)
(("dep" package)
@@ -1229,7 +1227,7 @@
`(("libxml2" ,libxml2))
'()))))
(pkg (dummy-package "foo"
- (native-inputs `(("dep" ,dep)))))
+ (native-inputs (list dep))))
(bag (package->bag pkg (%current-system) "i586-gnu")))
(equal? (parameterize ((%current-system "x86_64-linux"))
(bag-transitive-inputs bag))
@@ -1242,7 +1240,7 @@
`(("libxml2" ,libxml2))
'()))))
(pkg (dummy-package "foo"
- (native-inputs `(("dep" ,dep)))))
+ (native-inputs (list dep))))
(bag (package->bag pkg (%current-system) "foo86-hurd")))
(equal? (parameterize ((%current-target-system "foo64-gnu"))
(bag-transitive-inputs bag))
@@ -1548,11 +1546,11 @@
(build-system trivial-build-system)))
(glib (dummy-package "glib"
(build-system trivial-build-system)
- (propagated-inputs `(("libffi" ,libffi)))))
+ (propagated-inputs (list libffi))))
(gobject (dummy-package "gobject-introspection"
(build-system trivial-build-system)
- (inputs `(("glib" ,glib)))
- (propagated-inputs `(("libffi" ,libffi)))))
+ (inputs (list glib))
+ (propagated-inputs (list libffi))))
(rewrite (package-input-rewriting/spec
`(("glib" . ,identity)))))
(and (= (length (package-transitive-inputs gobject))
@@ -1569,11 +1567,11 @@
(build-system trivial-build-system)))
(glib (dummy-package "glib"
(build-system trivial-build-system)
- (propagated-inputs `(("libffi" ,libffi)))))
+ (propagated-inputs (list libffi))))
(gobject (dummy-package "gobject-introspection"
(build-system trivial-build-system)
- (inputs `(("glib" ,glib)))
- (propagated-inputs `(("libffi" ,libffi)))))
+ (inputs (list glib))
+ (propagated-inputs (list libffi))))
(rewrite (package-input-rewriting `((,glib . ,glib)))))
(and (= (length (package-transitive-inputs gobject))
(length (package-transitive-inputs (rewrite gobject))))
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 03/11] lint: Add 'input-labels' checker.
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 02/11] packages: Allow inputs to be plain package lists Ludovic Courtès
@ 2021-06-22 9:08 ` Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 04/11] packages: Add 'lookup-package-input' & co Ludovic Courtès
` (7 subsequent siblings)
9 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-22 9:08 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/lint.scm (check-input-labels): New procedure.
(%local-checkers): Add 'input-labels' checker.
* tests/lint.scm ("input labels: no warnings")
("input labels: one warning"): New tests.
* doc/guix.texi (Invoking guix lint): Mention it.
---
doc/guix.texi | 6 ++++++
guix/lint.scm | 36 ++++++++++++++++++++++++++++++++++++
tests/lint.scm | 14 ++++++++++++++
3 files changed, 56 insertions(+)
diff --git a/doc/guix.texi b/doc/guix.texi
index 1a3ac85e58..5ff3898ff1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12114,6 +12114,12 @@ declare them as in this example:
@item formatting
Warn about obvious source code formatting issues: trailing white space,
use of tabulations, etc.
+
+@item input-labels
+Report old-style input labels that do not match the name of the
+corresponding package. This aims to help migrate from the ``old input
+style''. @xref{package Reference}, for more information on package
+inputs and input styles.
@end table
The general syntax is:
diff --git a/guix/lint.scm b/guix/lint.scm
index 1bebfe03d3..7b73dffa19 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -77,6 +77,7 @@
#:export (check-description-style
check-inputs-should-be-native
check-inputs-should-not-be-an-input-at-all
+ check-input-labels
check-patch-file-names
check-patch-headers
check-synopsis-style
@@ -383,6 +384,37 @@ of a package, and INPUT-NAMES, a list of package specifications such as
(package-input-intersection (package-direct-inputs package)
input-names))))
+(define (check-input-labels package)
+ "Emit a warning for labels that differ from the corresponding package name."
+ (define (check input-kind package-inputs)
+ (define (warning label name)
+ (make-warning package
+ (G_ "label '~a' does not match package name '~a'")
+ (list label name)
+ #:field input-kind))
+
+ (append-map (match-lambda
+ (((? string? label) (? package? dependency))
+ (if (string=? label (package-name dependency))
+ '()
+ (list (warning label (package-name dependency)))))
+ (((? string? label) (? package? dependency) output)
+ (let ((expected (string-append (package-name dependency)
+ ":" output)))
+ (if (string=? label expected)
+ '()
+ (list (warning label expected)))))
+ (_
+ '()))
+ (package-inputs package)))
+
+ (append-map (match-lambda
+ ((kind proc)
+ (check kind proc)))
+ `((native-inputs ,package-native-inputs)
+ (inputs ,package-inputs)
+ (propagated-inputs ,package-propagated-inputs))))
+
(define (package-name-regexp package)
"Return a regexp that matches PACKAGE's name as a word at the beginning of a
line."
@@ -1493,6 +1525,10 @@ them for PACKAGE."
(name 'inputs-should-not-be-input)
(description "Identify inputs that shouldn't be inputs at all")
(check check-inputs-should-not-be-an-input-at-all))
+ (lint-checker
+ (name 'input-labels)
+ (description "Identify input labels that do not match package names")
+ (check check-input-labels))
(lint-checker
(name 'license)
;; TRANSLATORS: <license> is the name of a data type and must not be
diff --git a/tests/lint.scm b/tests/lint.scm
index 02ffb19d78..f247012c09 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -319,6 +319,20 @@
`(("python-setuptools" ,python-setuptools))))))
(check-inputs-should-not-be-an-input-at-all pkg))))
+(test-assert "input labels: no warnings"
+ (let ((pkg (dummy-package "x"
+ (inputs `(("glib" ,glib)
+ ("pkg-config" ,pkg-config))))))
+ (null? (check-input-labels pkg))))
+
+(test-equal "input labels: one warning"
+ "label 'pkgkonfig' does not match package name 'pkg-config'"
+ (single-lint-warning-message
+ (let ((pkg (dummy-package "x"
+ (inputs `(("glib" ,glib)
+ ("pkgkonfig" ,pkg-config))))))
+ (check-input-labels pkg))))
+
(test-equal "file patches: different file name -> warning"
"file names of patches should start with the package name"
(single-lint-warning-message
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 04/11] packages: Add 'lookup-package-input' & co.
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 02/11] packages: Allow inputs to be plain package lists Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 03/11] lint: Add 'input-labels' checker Ludovic Courtès
@ 2021-06-22 9:08 ` Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 05/11] packages: Add 'modify-inputs' Ludovic Courtès
` (6 subsequent siblings)
9 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-22 9:08 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/packages.scm (lookup-input, lookup-package-input)
(lookup-package-native-input, lookup-package-propagated-input)
(lookup-package-direct-input): New procedures.
* doc/guix.texi (package Reference): Document them.
---
doc/guix.texi | 24 ++++++++++++++++++++++++
guix/packages.scm | 34 ++++++++++++++++++++++++++++++++++
2 files changed, 58 insertions(+)
diff --git a/doc/guix.texi b/doc/guix.texi
index 5ff3898ff1..aeb0b2160a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6802,6 +6802,30 @@ cross-compiling:
It is an error to refer to @code{this-package} outside a package definition.
@end deffn
+The following helper procedures are provided to help deal with package
+inputs.
+
+@deffn {Scheme Procedure} lookup-package-input @var{package} @var{name}
+@deffnx {Scheme Procedure} lookup-package-native-input @var{package} @var{name}
+@deffnx {Scheme Procedure} lookup-package-propagated-input @var{package} @var{name}
+@deffnx {Scheme Procedure} lookup-package-direct-input @var{package} @var{name}
+Look up @var{name} among @var{package}'s inputs (or native, propagated,
+or direct inputs). Return it if found, @code{#f} otherwise.
+
+@var{name} is the name of a package depended on. Here's how you might
+use it:
+
+@lisp
+(use-modules (guix packages) (gnu packages base))
+
+(lookup-package-direct-input coreutils "gmp")
+@result{} #<package gmp@@6.2.1 @dots{}>
+@end lisp
+
+In this example we obtain the @code{gmp} package that is among the
+direct inputs of @code{coreutils}.
+@end deffn
+
Because packages are regular Scheme objects that capture a complete
dependency graph and associated build procedures, it is often useful to
write procedures that take a package and return a modified version
diff --git a/guix/packages.scm b/guix/packages.scm
index 087e6e6a4a..c845026827 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -108,6 +108,11 @@
deprecated-package
package-field-location
+ lookup-package-input
+ lookup-package-native-input
+ lookup-package-propagated-input
+ lookup-package-direct-input
+
package-direct-sources
package-transitive-sources
package-direct-inputs
@@ -889,6 +894,35 @@ preserved, and only duplicate propagated inputs are removed."
((input rest ...)
(loop rest (cons input result) propagated first? seen)))))
+(define (lookup-input inputs name)
+ "Lookup NAME among INPUTS, an input list."
+ ;; Note: Currently INPUTS is assumed to be an input list that contains input
+ ;; labels. In the future, input labels will be gone and this procedure will
+ ;; check package names.
+ (match (assoc-ref inputs name)
+ ((obj) obj)
+ ((obj _) obj)
+ (#f #f)))
+
+(define (lookup-package-input package name)
+ "Look up NAME among PACKAGE's inputs. Return it if found, #f otherwise."
+ (lookup-input (package-inputs package) name))
+
+(define (lookup-package-native-input package name)
+ "Look up NAME among PACKAGE's native inputs. Return it if found, #f
+otherwise."
+ (lookup-input (package-native-inputs package) name))
+
+(define (lookup-package-propagated-input package name)
+ "Look up NAME among PACKAGE's propagated inputs. Return it if found, #f
+otherwise."
+ (lookup-input (package-propagated-inputs package) name))
+
+(define (lookup-package-direct-input package name)
+ "Look up NAME among PACKAGE's direct inputs. Return it if found, #f
+otherwise."
+ (lookup-input (package-direct-inputs package) name))
+
(define (package-direct-sources package)
"Return all source origins associated with PACKAGE; including origins in
PACKAGE's inputs."
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 05/11] packages: Add 'modify-inputs'.
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
` (2 preceding siblings ...)
2021-06-22 9:08 ` [bug#49169] [PATCH 04/11] packages: Add 'lookup-package-input' & co Ludovic Courtès
@ 2021-06-22 9:08 ` Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 06/11] gnu: Change inputs of core packages to plain lists Ludovic Courtès
` (5 subsequent siblings)
9 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-22 9:08 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/packages.scm (inputs-sans-labels, replace-input): New procedures.
(prepend, replace, modify-inputs): New macros.
* doc/guix.texi (Defining Package Variants): Document 'modify-inputs'.
---
doc/guix.texi | 38 ++++++++++++++++++++------
guix/packages.scm | 68 +++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 98 insertions(+), 8 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index aeb0b2160a..b16a2c48a8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7105,20 +7105,42 @@ optional dependency, you can define a variant that removes that
dependency like so:
@lisp
-(use-modules (gnu packages gdb) ;for 'gdb'
- (srfi srfi-1)) ;for 'alist-delete'
+(use-modules (gnu packages gdb)) ;for 'gdb'
(define gdb-sans-guile
(package
(inherit gdb)
- (inputs (alist-delete "guile"
- (package-inputs gdb)))))
+ (inputs (modify-inputs (package-inputs gdb)
+ (delete "guile")))))
@end lisp
-The @code{alist-delete} call above removes the tuple from the
-@code{inputs} field that has @code{"guile"} as its first element
-(@pxref{SRFI-1 Association Lists,,, guile, GNU Guile Reference
-Manual}).
+The @code{modify-inputs} form above removes the @code{"guile"} package
+from the @code{inputs} field of @code{gdb}. The @code{modify-inputs}
+macro is a helper that can prove useful anytime you want to remove, add,
+or replace package inputs.
+
+@deffn {Scheme Syntax} modify-inputs @var{inputs} @var{clauses}
+Modify the given package inputs, as returned by @code{package-inputs} & co.,
+according to the given clauses. The example below removes the GMP and ACL
+inputs of Coreutils and adds libcap to the back of the input list:
+
+@lisp
+(modify-inputs (package-inputs coreutils)
+ (delete "gmp" "acl")
+ (append libcap))
+@end lisp
+
+The example below replaces the @code{guile} package from the inputs of
+@code{guile-redis} with @code{guile-2.2}:
+
+@lisp
+(modify-inputs (package-inputs guile-redis)
+ (replace "guile" guile-2.2))
+@end lisp
+
+The last type of clause is @code{prepend}, to add inputs to the front of
+the list.
+@end deffn
In some cases, you may find it useful to write functions
(``procedures'', in Scheme parlance) that return a package based on some
diff --git a/guix/packages.scm b/guix/packages.scm
index c845026827..4ac1624ce2 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -55,6 +55,7 @@
#:re-export (%current-system
%current-target-system
search-path-specification) ;for convenience
+ #:re-export-and-replace (delete) ;used as syntactic keyword
#:export (content-hash
content-hash?
content-hash-algorithm
@@ -113,6 +114,10 @@
lookup-package-propagated-input
lookup-package-direct-input
+ prepend ;syntactic keyword
+ replace ;syntactic keyword
+ modify-inputs
+
package-direct-sources
package-transitive-sources
package-direct-inputs
@@ -923,6 +928,69 @@ otherwise."
otherwise."
(lookup-input (package-direct-inputs package) name))
+(define (inputs-sans-labels inputs)
+ "Return INPUTS stripped of any input labels."
+ (map (match-lambda
+ ((label obj) obj)
+ ((label obj output) `(,obj ,output)))
+ inputs))
+
+(define (replace-input name replacement inputs)
+ "Replace input NAME by REPLACEMENT within INPUTS."
+ (map (lambda (input)
+ (match input
+ (((? string? label) . _)
+ (if (string=? label name)
+ (match replacement ;does REPLACEMENT specify an output?
+ ((_ _) (cons label replacement))
+ (_ (list label replacement)))
+ input))))
+ inputs))
+
+(define-syntax prepend
+ (lambda (s)
+ (syntax-violation 'prepend
+ "'prepend' may only be used within 'modify-inputs'"
+ s)))
+
+(define-syntax replace
+ (lambda (s)
+ (syntax-violation 'replace
+ "'replace' may only be used within 'modify-inputs'"
+ s)))
+
+(define-syntax modify-inputs
+ (syntax-rules (delete prepend append replace)
+ "Modify the given package inputs, as returned by 'package-inputs' & co.,
+according to the given clauses. The example below removes the GMP and ACL
+inputs of Coreutils and adds libcap:
+
+ (modify-inputs (package-inputs coreutils)
+ (delete \"gmp\" \"acl\")
+ (append libcap))
+
+Other types of clauses include 'prepend' and 'replace'."
+ ;; Note: This macro hides the fact that INPUTS, as returned by
+ ;; 'package-inputs' & co., is actually an alist with labels. Eventually,
+ ;; it will operate on list of inputs without labels.
+ ((_ inputs (delete name) clauses ...)
+ (modify-inputs (alist-delete name inputs)
+ clauses ...))
+ ((_ inputs (delete names ...) clauses ...)
+ (modify-inputs (fold alist-delete inputs (list names ...))
+ clauses ...))
+ ((_ inputs (prepend lst ...) clauses ...)
+ (modify-inputs (append (list lst ...) (inputs-sans-labels inputs))
+ clauses ...))
+ ((_ inputs (append lst ...) clauses ...)
+ (modify-inputs (append (inputs-sans-labels inputs) (list lst ...))
+ clauses ...))
+ ((_ inputs (replace name replacement) clauses ...)
+ (modify-inputs (replace-input name replacement inputs)
+ clauses ...))
+ ((_ inputs)
+ inputs)))
+
(define (package-direct-sources package)
"Return all source origins associated with PACKAGE; including origins in
PACKAGE's inputs."
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 06/11] gnu: Change inputs of core packages to plain lists.
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
` (3 preceding siblings ...)
2021-06-22 9:08 ` [bug#49169] [PATCH 05/11] packages: Add 'modify-inputs' Ludovic Courtès
@ 2021-06-22 9:08 ` Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 07/11] utils: 'edit-expression' no longer leaks file ports Ludovic Courtès
` (4 subsequent siblings)
9 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-22 9:08 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
This is transparent: the resulting derivations are unchanged.
* gnu/packages/base.scm (grep, sed, tar, patch, diffutils, glibc/hurd-headers)
(coreutils, gnu-make, make-glibc-utf8-locales): Change input fields to
plain package lists and use 'modify-inputs'.
* gnu/packages/guile.scm (guile-1.8, guile-json-1, guile-json-3)
(guile-gdbm-ffi, guile-sqlite3, guile-bytestructures)
(guile-git, guile-zlib, guile-lzlib, guile-zstd, guile-next): Likewise.
* gnu/packages/mes.scm (nyacc-0.86, nyacc-0.99)
(nyacc, nyacc-1.00.2, mes-0.19, mes, m2-planet): Likewise.
---
gnu/packages/base.scm | 48 +++++++++----------
gnu/packages/guile.scm | 103 ++++++++++++-----------------------------
gnu/packages/mes.scm | 25 ++++------
3 files changed, 59 insertions(+), 117 deletions(-)
diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index d30299a7b6..b0ba565d3b 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -109,8 +109,8 @@ command-line arguments, multiple languages, and so on.")
"0gipv6bzkm1aihj0ncqpyh164xrzgcxcv9r1kwzyk2g1mzl1azk6"))
(patches (search-patches "grep-timing-sensitive-test.patch"))))
(build-system gnu-build-system)
- (native-inputs `(("perl" ,perl))) ;some of the tests require it
- (inputs `(("pcre" ,pcre)))
+ (native-inputs (list perl)) ;some of the tests require it
+ (inputs (list pcre))
(arguments
`(#:phases
(modify-phases %standard-phases
@@ -161,8 +161,7 @@ including, for example, recursive directory searching.")
(modules '((guix build utils)))))
(build-system gnu-build-system)
(synopsis "Stream editor")
- (native-inputs
- `(("perl" ,perl))) ;for tests
+ (native-inputs (list perl)) ;for tests
(description
"Sed is a non-interactive, text stream editor. It receives a text
input from a file or from standard input and it then applies a series of text
@@ -215,7 +214,7 @@ implementation offers several extensions over the standard utility.")
;; When cross-compiling, the 'set-shell-file-name' phase needs to be able
;; to refer to the target Bash.
(inputs (if (%current-target-system)
- `(("bash" ,bash))
+ (list bash)
'()))
(synopsis "Managing tar archives")
@@ -248,7 +247,7 @@ standard utility.")
(if (%current-target-system)
`(#:configure-flags '("gl_cv_func_working_mktime=yes"))
'()))
- (native-inputs `(("ed" ,ed)))
+ (native-inputs (list ed))
(synopsis "Apply differences to originals, with optional backups")
(description
"Patch is a program that applies changes to files based on differences
@@ -271,7 +270,7 @@ differences.")
(base32
"09isrg0isjinv8c535nxsi1s86wfdfzml80dbw41dj9x3hiad9xk"))))
(build-system gnu-build-system)
- (native-inputs `(("perl" ,perl)))
+ (native-inputs (list perl))
(synopsis "Comparing and merging files")
(description
"GNU Diffutils is a package containing tools for finding the
@@ -330,16 +329,16 @@ used to apply commands with arbitrarily long arguments.")
"1yjcrh5hw70c0yn8zw55pd6j51dj90anpq8mmg649ps9g3gdhn24"))
(patches (search-patches "coreutils-ls.patch"))))
(build-system gnu-build-system)
- (inputs `(("acl" ,acl) ; TODO: add SELinux
- ("attr" ,attr) ;for xattrs in ls, mv, etc
- ("gmp" ,gmp) ;bignums in 'expr', yay!
+ (inputs `(,acl ;TODO: add SELinux
+ ,attr ;for xattrs in ls, mv, etc
+ ,gmp ;bignums in 'expr', yay!
;; Do not use libcap when cross-compiling since it's not quite
;; cross-compilable; and use it only for supported systems.
,@(if (and (not (%current-target-system))
(member (%current-system)
(package-supported-systems libcap)))
- `(("libcap" ,libcap)) ;capability support in 'ls', etc.
+ `(,libcap) ;capability support in 'ls', etc.
'())))
(native-inputs
;; Perl is needed to run tests in native builds, and to run the bundled
@@ -348,7 +347,7 @@ used to apply commands with arbitrarily long arguments.")
;; for help2man.
(if (%current-target-system)
'()
- `(("perl" ,perl))))
+ (list perl)))
(outputs '("out" "debug"))
(arguments
`(#:parallel-build? #f ; help2man may be called too early
@@ -443,8 +442,8 @@ standard.")
"06cfqzpqsvdnsxbysl5p2fgdgxgl9y4p7scpnrfa8z2zgkjdspz0"))
(patches (search-patches "make-impure-dirs.patch"))))
(build-system gnu-build-system)
- (native-inputs `(("pkg-config" ,pkg-config))) ; to detect Guile
- (inputs `(("guile" ,guile-3.0)))
+ (native-inputs (list pkg-config)) ;to detect Guile
+ (inputs (list guile-3.0))
(outputs '("out" "debug"))
(arguments
`(,@(if (hurd-target?)
@@ -1148,8 +1147,7 @@ to the @code{share/locale} sub-directory of this package.")
locale ".UTF-8")))
',locales)
#t))))
- (native-inputs `(("glibc" ,glibc)
- ("gzip" ,gzip)))
+ (native-inputs (list glibc gzip))
(synopsis (if default-locales?
(P_ "Small sample of UTF-8 locales")
(P_ "Customized sample of UTF-8 locales")))
@@ -1202,17 +1200,15 @@ command.")
(package (inherit glibc)
(name "glibc-hurd-headers")
(outputs '("out"))
- (propagated-inputs `(("gnumach-headers" ,gnumach-headers)
- ("hurd-headers" ,hurd-headers)))
+ (propagated-inputs (list gnumach-headers hurd-headers))
(native-inputs
- `(("mig" ,(if (%current-target-system)
- ;; XXX: When targeting i586-pc-gnu, we need a 32-bit MiG,
- ;; hence this hack.
- (package
- (inherit mig)
- (arguments `(#:system "i686-linux")))
- mig))
- ,@(package-native-inputs glibc)))
+ (modify-inputs (package-native-inputs glibc)
+ (prepend (if (%current-target-system)
+ ;; XXX: When targeting i586-pc-gnu, we need a 32-bit MiG,
+ ;; hence this hack.
+ (package (inherit mig)
+ (arguments `(#:system "i686-linux")))
+ mig))))
(arguments
(substitute-keyword-arguments (package-arguments glibc)
;; We just pass the flags really needed to build the headers.
diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index 68ee7bddf5..33736cdbc6 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -112,13 +112,11 @@
`(("self" ,this-package))
'()))
- (inputs `(("gawk" ,gawk)
- ("readline" ,readline)))
+ (inputs (list gawk readline))
;; Since `guile-1.8.pc' has "Libs: ... -lgmp -lltdl", these must be
;; propagated.
- (propagated-inputs `(("gmp" ,gmp)
- ("libltdl" ,libltdl)))
+ (propagated-inputs (list gmp libltdl))
(native-search-paths
(list (search-path-specification
@@ -403,14 +401,14 @@ without requiring the source code to be rewritten.")
(delete-file "test-suite/tests/version.test")
#t))))))
(native-inputs
- `(("autoconf" ,autoconf)
- ("automake" ,automake)
- ("libtool" ,libtool)
- ("flex" ,flex)
- ("gettext" ,gnu-gettext)
- ("texinfo" ,texinfo)
- ("gperf" ,gperf)
- ,@(package-native-inputs guile-3.0)))
+ (modify-inputs (package-native-inputs guile-3.0)
+ (prepend autoconf
+ automake
+ libtool
+ flex
+ gnu-gettext
+ texinfo
+ gperf)))
(synopsis "Development version of GNU Guile"))))
(define* (make-guile-readline guile #:optional (name "guile-readline"))
@@ -596,9 +594,8 @@ GNU@tie{}Guile. Use the @code{(ice-9 readline)} module and call its
(build-system gnu-build-system)
(arguments
`(#:make-flags '("GUILE_AUTO_COMPILE=0"))) ;to prevent guild warnings
- (native-inputs `(("pkg-config" ,pkg-config)
- ("guile" ,guile-2.2)))
- (inputs `(("guile" ,guile-2.2)))
+ (native-inputs (list pkg-config guile-2.2))
+ (inputs (list guile-2.2))
(synopsis "JSON module for Guile")
(description
"Guile-JSON supports parsing and building JSON documents according to the
@@ -636,9 +633,8 @@ specification. These are the main features:
(sha256
(base32
"0nj0684qgh6ppkbdyxqfyjwsv2qbyairxpi8fzrhsi3xnc7jn4im"))))
- (native-inputs `(("pkg-config" ,pkg-config)
- ("guile" ,guile-3.0)))
- (inputs `(("guile" ,guile-3.0)))))
+ (native-inputs (list pkg-config guile-3.0))
+ (inputs (list guile-3.0))))
(define-public guile3.0-json
(deprecated-package "guile3.0-json" guile-json-3))
@@ -697,10 +693,8 @@ specification. These are the main features:
(format #f "(dynamic-link \"~a/lib/libgdbm.so\")"
(assoc-ref inputs "gdbm"))))
#t)))))
- (native-inputs
- `(("guile" ,guile-3.0)))
- (inputs
- `(("gdbm" ,gdbm)))
+ (native-inputs (list guile-3.0))
+ (inputs (list gdbm))
(home-page "https://github.com/ijp/guile-gdbm")
(synopsis "Guile bindings to the GDBM library via Guile's FFI")
(description
@@ -731,14 +725,8 @@ Guile's foreign function interface.")
"1nryy9j3bk34i0alkmc9bmqsm0ayz92k1cdf752mvhyjjn8nr928"))
(file-name (string-append name "-" version "-checkout"))))
(build-system gnu-build-system)
- (native-inputs
- `(("autoconf" ,autoconf)
- ("automake" ,automake)
- ("guile" ,guile-3.0)
- ("pkg-config" ,pkg-config)))
- (inputs
- `(("guile" ,guile-3.0)
- ("sqlite" ,sqlite)))
+ (native-inputs (list autoconf automake guile-3.0 pkg-config))
+ (inputs (list guile-3.0 sqlite))
(synopsis "Access SQLite databases from Guile")
(description
"This package provides Guile bindings to the SQLite database system.")
@@ -778,13 +766,8 @@ Guile's foreign function interface.")
(doc (string-append out "/share/doc/" package)))
(install-file "README.md" doc)
#t))))))
- (native-inputs
- `(("autoconf" ,autoconf)
- ("automake" ,automake)
- ("pkg-config" ,pkg-config)
- ("guile" ,guile-3.0)))
- (inputs
- `(("guile" ,guile-3.0)))
+ (native-inputs (list autoconf automake pkg-config guile-3.0))
+ (inputs (list guile-3.0))
(synopsis "Structured access to bytevector contents for Guile")
(description
"Guile bytestructures offers a system imitating the type system
@@ -821,17 +804,11 @@ type system, elevating types to first-class status.")
(arguments
`(#:make-flags '("GUILE_AUTO_COMPILE=0"))) ; to prevent guild warnings
(native-inputs
- `(("pkg-config" ,pkg-config)
- ("autoconf" ,autoconf)
- ("automake" ,automake)
- ("texinfo" ,texinfo)
- ("guile" ,guile-3.0)
- ("guile-bytestructures" ,guile-bytestructures)))
+ (list pkg-config autoconf automake texinfo guile-3.0 guile-bytestructures))
(inputs
- `(("guile" ,guile-3.0)
- ("libgit2" ,libgit2)))
+ (list guile-3.0 libgit2))
(propagated-inputs
- `(("guile-bytestructures" ,guile-bytestructures)))
+ (list guile-bytestructures))
(synopsis "Guile bindings for libgit2")
(description
"This package provides Guile bindings to libgit2, a library to
@@ -868,16 +845,8 @@ manipulate repositories of the Git version control system.")
(arguments
'(#:make-flags
'("GUILE_AUTO_COMPILE=0"))) ;to prevent guild warnings
- (native-inputs
- `(("autoconf" ,autoconf)
- ("automake" ,automake)
- ("pkg-config" ,pkg-config)
- ,@(if (%current-target-system)
- `(("guile" ,guile-3.0)) ;for 'guild compile' and 'guile-3.0.pc'
- '())))
- (inputs
- `(("guile" ,guile-3.0)
- ("zlib" ,zlib)))
+ (native-inputs (list autoconf automake pkg-config guile-3.0))
+ (inputs (list guile-3.0 zlib))
(synopsis "Guile bindings to zlib")
(description
"This package provides Guile bindings for zlib, a lossless
@@ -907,16 +876,8 @@ Guile's foreign function interface.")
(arguments
'(#:make-flags
'("GUILE_AUTO_COMPILE=0"))) ;to prevent guild warnings
- (native-inputs
- `(("autoconf" ,autoconf)
- ("automake" ,automake)
- ("pkg-config" ,pkg-config)
- ,@(if (%current-target-system)
- `(("guile" ,guile-3.0)) ;for 'guild compile' and 'guile-3.0.pc'
- '())))
- (inputs
- `(("guile" ,guile-3.0)
- ("lzlib" ,lzlib)))
+ (native-inputs (list autoconf automake pkg-config guile-3.0))
+ (inputs (list guile-3.0 lzlib))
(synopsis "Guile bindings to lzlib")
(description
"This package provides Guile bindings for lzlib, a C library for
@@ -942,14 +903,8 @@ pure Scheme by using Guile's foreign function interface.")
(base32
"1c8l7829b5yx8wdc0mrhzjfwb6h9hb7cd8dfxcr71a7vlsi86310"))))
(build-system gnu-build-system)
- (native-inputs
- `(("autoconf" ,autoconf)
- ("automake" ,automake)
- ("pkg-config" ,pkg-config)
- ("guile" ,guile-3.0)))
- (inputs
- `(("zstd" ,zstd "lib")
- ("guile" ,guile-3.0)))
+ (native-inputs (list autoconf automake pkg-config guile-3.0))
+ (inputs (list `(,zstd "lib") guile-3.0))
(synopsis "GNU Guile bindings to the zstd compression library")
(description
"This package provides a GNU Guile interface to the zstd (``zstandard'')
diff --git a/gnu/packages/mes.scm b/gnu/packages/mes.scm
index 750ec2e67a..bad4ce49b3 100644
--- a/gnu/packages/mes.scm
+++ b/gnu/packages/mes.scm
@@ -55,8 +55,7 @@
(base32
"0lkd9lyspvhxlfs0496gsllwinh62jk9wij6gpadvx9gwz6yavd9"))))
(build-system gnu-build-system)
- (native-inputs
- `(("guile" ,guile-2.2)))
+ (native-inputs (list guile-2.2))
(synopsis "LALR(1) Parser Generator in Guile")
(description
"NYACC is an LALR(1) parser generator implemented in Guile.
@@ -91,10 +90,8 @@ extensive examples, including parsers for the Javascript and C99 languages.")
(("^DOCDIR =.*")
"DOCDIR = @prefix@/share/doc/$(PACKAGE_TARNAME)\n"))
#t))))
- (native-inputs
- `(("pkg-config" ,pkg-config)))
- (inputs
- `(("guile" ,guile-2.2)))))
+ (native-inputs (list pkg-config))
+ (inputs (list guile-2.2))))
(define-public nyacc
(package
@@ -115,8 +112,7 @@ extensive examples, including parsers for the Javascript and C99 languages.")
"GUILE_GLOBAL_SITE=\
$prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION\n"))
#t))))
- (inputs
- `(("guile" ,guile-3.0)))))
+ (inputs (list guile-3.0))))
(define-public nyacc-1.00.2
(package
@@ -144,8 +140,7 @@ $prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION\n"))
(sha256
(base32
"065ksalfllbdrzl12dz9d9dcxrv97wqxblslngsc6kajvnvlyvpk"))))
- (inputs
- `(("guile" ,guile-2.2)))))
+ (inputs (list guile-2.2))))
(define-public mes-0.19
;; Mes used for bootstrap.
@@ -161,9 +156,7 @@ $prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION\n"))
"15h4yhaywdc0djpjlin2jz1kzahpqxfki0r0aav1qm9nxxmnp1l0"))))
(build-system gnu-build-system)
(supported-systems '("i686-linux" "x86_64-linux"))
- (propagated-inputs
- `(("mescc-tools" ,mescc-tools-0.5.2)
- ("nyacc" ,nyacc-0.86)))
+ (propagated-inputs (list mescc-tools-0.5.2 nyacc-0.86))
(native-inputs
`(("guile" ,guile-2.2)
,@(let ((target-system (or (%current-target-system)
@@ -204,9 +197,7 @@ Guile.")
(base32
"0mnryfkl0dwbr5gxp16j5s95gw7z1vm1fqa1pxabp0aiar1hw53s"))))
(supported-systems '("armhf-linux" "i686-linux" "x86_64-linux"))
- (propagated-inputs
- `(("mescc-tools" ,mescc-tools)
- ("nyacc" ,nyacc-1.00.2)))
+ (propagated-inputs (list mescc-tools nyacc-1.00.2))
(native-search-paths
(list (search-path-specification
(variable "C_INCLUDE_PATH")
@@ -376,7 +367,7 @@ get_machine.")
(base32
"0yyc0fcbbxi9jqa1n76x0rwspdrwmc8g09jlmsw9c35nflrhmz8q"))))
(native-inputs
- `(("mescc-tools" ,mescc-tools)))
+ (list mescc-tools))
(build-system gnu-build-system)
(arguments
`(#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")))
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 07/11] utils: 'edit-expression' no longer leaks file ports.
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
` (4 preceding siblings ...)
2021-06-22 9:08 ` [bug#49169] [PATCH 06/11] gnu: Change inputs of core packages to plain lists Ludovic Courtès
@ 2021-06-22 9:08 ` Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 08/11] utils: Add 'go-to-location' with source location caching Ludovic Courtès
` (3 subsequent siblings)
9 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-22 9:08 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/utils.scm (edit-expression): Use 'call-with-input-file' to make
sure IN gets closed.
---
guix/utils.scm | 64 ++++++++++++++++++++++++++------------------------
1 file changed, 33 insertions(+), 31 deletions(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index 19990ceb8a..a13b13c4fa 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -342,38 +342,40 @@ a list of command-line arguments passed to the compression program."
be a procedure that takes the original expression in string and returns a new
one. ENCODING will be used to interpret all port I/O, it default to UTF-8.
This procedure returns #t on success."
+ (define file (assq-ref source-properties 'filename))
+ (define line (assq-ref source-properties 'line))
+ (define column (assq-ref source-properties 'column))
+
(with-fluids ((%default-port-encoding encoding))
- (let* ((file (assq-ref source-properties 'filename))
- (line (assq-ref source-properties 'line))
- (column (assq-ref source-properties 'column))
- (in (open-input-file file))
- ;; The start byte position of the expression.
- (start (begin (while (not (and (= line (port-line in))
- (= column (port-column in))))
- (when (eof-object? (read-char in))
- (error (format #f "~a: end of file~%" in))))
- (ftell in)))
- ;; The end byte position of the expression.
- (end (begin (read in) (ftell in))))
- (seek in 0 SEEK_SET) ; read from the beginning of the file.
- (let* ((pre-bv (get-bytevector-n in start))
- ;; The expression in string form.
- (str (iconv:bytevector->string
- (get-bytevector-n in (- end start))
- (port-encoding in)))
- (post-bv (get-bytevector-all in))
- (str* (proc str)))
- ;; Verify the edited expression is still a scheme expression.
- (call-with-input-string str* read)
- ;; Update the file with edited expression.
- (with-atomic-file-output file
- (lambda (out)
- (put-bytevector out pre-bv)
- (display str* out)
- ;; post-bv maybe the end-of-file object.
- (when (not (eof-object? post-bv))
- (put-bytevector out post-bv))
- #t))))))
+ (call-with-input-file file
+ (lambda (in)
+ (let* ( ;; The start byte position of the expression.
+ (start (begin (while (not (and (= line (port-line in))
+ (= column (port-column in))))
+ (when (eof-object? (read-char in))
+ (error (format #f "~a: end of file~%" in))))
+ (ftell in)))
+ ;; The end byte position of the expression.
+ (end (begin (read in) (ftell in))))
+ (seek in 0 SEEK_SET) ; read from the beginning of the file.
+ (let* ((pre-bv (get-bytevector-n in start))
+ ;; The expression in string form.
+ (str (iconv:bytevector->string
+ (get-bytevector-n in (- end start))
+ (port-encoding in)))
+ (post-bv (get-bytevector-all in))
+ (str* (proc str)))
+ ;; Verify the edited expression is still a scheme expression.
+ (call-with-input-string str* read)
+ ;; Update the file with edited expression.
+ (with-atomic-file-output file
+ (lambda (out)
+ (put-bytevector out pre-bv)
+ (display str* out)
+ ;; post-bv maybe the end-of-file object.
+ (when (not (eof-object? post-bv))
+ (put-bytevector out post-bv))
+ #t))))))))
\f
;;;
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 08/11] utils: Add 'go-to-location' with source location caching.
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
` (5 preceding siblings ...)
2021-06-22 9:08 ` [bug#49169] [PATCH 07/11] utils: 'edit-expression' no longer leaks file ports Ludovic Courtès
@ 2021-06-22 9:08 ` Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 09/11] utils: 'edit-expression' modifies the file only if necessary Ludovic Courtès
` (2 subsequent siblings)
9 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-22 9:08 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/utils.scm (%source-location-map): New variable.
(go-to-location): New procedure.
(edit-expression): Use it instead of custom loop.
* guix/packages.scm (package-field-location)[goto]: Remove.
Use 'go-to-location' instead of 'goto'.
---
guix/packages.scm | 8 +-----
guix/utils.scm | 66 ++++++++++++++++++++++++++++++++++++++++++++---
2 files changed, 63 insertions(+), 11 deletions(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index 4ac1624ce2..d15a17edc0 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -514,12 +514,6 @@ object."
(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 (goto port line column)
- (unless (and (= (port-column port) (- column 1))
- (= (port-line port) (- line 1)))
- (unless (eof-object? (read-char port))
- (goto port line column))))
-
(match (package-location package)
(($ <location> file line column)
(match (search-path %load-path file)
@@ -529,7 +523,7 @@ object."
;; In general we want to keep relative file names for modules.
(call-with-input-file file-found
(lambda (port)
- (goto port line column)
+ (go-to-location port line column)
(match (read port)
(('package inits ...)
(let ((field (assoc field inits)))
diff --git a/guix/utils.scm b/guix/utils.scm
index a13b13c4fa..f8f6672bb1 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -49,6 +49,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module ((ice-9 iconv) #:prefix iconv:)
+ #:use-module (ice-9 vlist)
#:autoload (zlib) (make-zlib-input-port make-zlib-output-port)
#:use-module (system foreign)
#:re-export (<location> ;for backwards compatibility
@@ -117,6 +118,7 @@
cache-directory
readlink*
+ go-to-location
edit-expression
filtered-port
@@ -337,6 +339,65 @@ a list of command-line arguments passed to the compression program."
(unless (every (compose zero? cdr waitpid) pids)
(error "compressed-output-port failure" pids))))))
+(define %source-location-map
+ ;; Maps inode/device tuples to "source location maps" used by
+ ;; 'go-to-location'.
+ (make-hash-table))
+
+(define (go-to-location port line column)
+ "Jump to LINE and COLUMN (both one-indexed) in PORT. Maintain a source
+location map such that this can boil down to seek(2) and a few read(2) calls,
+which can drastically speed up repetitive operations on large files."
+ (let* ((stat (stat port))
+ (key (list (stat:ino stat) (stat:dev stat)))
+ (stamp (list (stat:mtime stat) (stat:mtimensec stat)
+ (stat:size stat)))
+
+ ;; Look for an up-to-date source map for KEY. The map is a vlist
+ ;; where each entry gives the byte offset of the beginning of a line:
+ ;; element 0 is the offset of the first line, element 1 the offset of
+ ;; the second line, etc. The map is filled lazily.
+ (source-map (match (hash-ref %source-location-map key)
+ (#f
+ (vlist-cons 0 vlist-null))
+ ((cache-stamp ... map)
+ (if (equal? cache-stamp stamp) ;invalidate?
+ map
+ (vlist-cons 0 vlist-null)))))
+ (last (vlist-length source-map)))
+ ;; Jump to LINE, ideally via SOURCE-MAP.
+ (if (<= line last)
+ (seek port (vlist-ref source-map (- line 1)) SEEK_SET)
+ (let ((target line)
+ (offset (vlist-ref source-map (- last 1))))
+ (seek port offset SEEK_SET)
+ (let loop ((source-map (vlist-reverse source-map))
+ (line last))
+ (if (< line target)
+ (match (read-char port)
+ (#\newline
+ (loop (vlist-cons (ftell port) source-map)
+ (+ 1 line)))
+ ((? eof-object?)
+ (error "unexpected end of file" port line))
+ (chr (loop source-map line)))
+ (hash-set! %source-location-map key
+ `(,@stamp
+ ,(vlist-reverse source-map)))))))
+
+ ;; Read up to COLUMN.
+ (let ((target column))
+ (let loop ((column 1))
+ (when (< column target)
+ (match (read-char port)
+ (#\newline (error "unexpected end of line" port))
+ (#\tab (loop (+ 8 column)))
+ (chr (loop (+ 1 column)))))))
+
+ ;; Update PORT's position info.
+ (set-port-line! port (- line 1))
+ (set-port-column! port (- column 1))))
+
(define* (edit-expression source-properties proc #:key (encoding "UTF-8"))
"Edit the expression specified by SOURCE-PROPERTIES using PROC, which should
be a procedure that takes the original expression in string and returns a new
@@ -350,10 +411,7 @@ This procedure returns #t on success."
(call-with-input-file file
(lambda (in)
(let* ( ;; The start byte position of the expression.
- (start (begin (while (not (and (= line (port-line in))
- (= column (port-column in))))
- (when (eof-object? (read-char in))
- (error (format #f "~a: end of file~%" in))))
+ (start (begin (go-to-location in (+ 1 line) (+ 1 column))
(ftell in)))
;; The end byte position of the expression.
(end (begin (read in) (ftell in))))
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 09/11] utils: 'edit-expression' modifies the file only if necessary.
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
` (6 preceding siblings ...)
2021-06-22 9:08 ` [bug#49169] [PATCH 08/11] utils: Add 'go-to-location' with source location caching Ludovic Courtès
@ 2021-06-22 9:08 ` Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 10/11] utils: 'edit-expression' copies part of the original source map Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 11/11] Add 'guix style' Ludovic Courtès
9 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-22 9:08 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/utils.scm (edit-expression): Check whether STR* equals STR.
---
guix/utils.scm | 24 +++++++++++++-----------
1 file changed, 13 insertions(+), 11 deletions(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index f8f6672bb1..e6d0761679 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -423,17 +423,19 @@ This procedure returns #t on success."
(port-encoding in)))
(post-bv (get-bytevector-all in))
(str* (proc str)))
- ;; Verify the edited expression is still a scheme expression.
- (call-with-input-string str* read)
- ;; Update the file with edited expression.
- (with-atomic-file-output file
- (lambda (out)
- (put-bytevector out pre-bv)
- (display str* out)
- ;; post-bv maybe the end-of-file object.
- (when (not (eof-object? post-bv))
- (put-bytevector out post-bv))
- #t))))))))
+ ;; Modify FILE only if there are changes.
+ (unless (string=? str* str)
+ ;; Verify the edited expression is still a scheme expression.
+ (call-with-input-string str* read)
+ ;; Update the file with edited expression.
+ (with-atomic-file-output file
+ (lambda (out)
+ (put-bytevector out pre-bv)
+ (display str* out)
+ ;; post-bv maybe the end-of-file object.
+ (when (not (eof-object? post-bv))
+ (put-bytevector out post-bv))
+ #t)))))))))
\f
;;;
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 10/11] utils: 'edit-expression' copies part of the original source map.
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
` (7 preceding siblings ...)
2021-06-22 9:08 ` [bug#49169] [PATCH 09/11] utils: 'edit-expression' modifies the file only if necessary Ludovic Courtès
@ 2021-06-22 9:08 ` Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 11/11] Add 'guix style' Ludovic Courtès
9 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-22 9:08 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/utils.scm (source-location-key/stamp): New procedure.
(go-to-location): Use it.
(move-source-location-map!): New procedure.
(edit-expression): Call it.
---
guix/utils.scm | 37 ++++++++++++++++++++++++++++++++-----
1 file changed, 32 insertions(+), 5 deletions(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index e6d0761679..65d709a01f 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -34,6 +34,7 @@
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-39)
+ #:use-module (srfi srfi-71)
#:use-module (ice-9 ftw)
#:use-module (rnrs io ports) ;need 'port-position' etc.
#:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
@@ -344,14 +345,20 @@ a list of command-line arguments passed to the compression program."
;; 'go-to-location'.
(make-hash-table))
-(define (go-to-location port line column)
+(define (source-location-key/stamp stat)
+ "Return two values: the key for STAT in %SOURCE-LOCATION-MAP, and a stamp
+used to invalidate corresponding entries."
+ (let ((key (list (stat:ino stat) (stat:dev stat)))
+ (stamp (list (stat:mtime stat) (stat:mtimensec stat)
+ (stat:size stat))))
+ (values key stamp)))
+
+(define* (go-to-location port line column)
"Jump to LINE and COLUMN (both one-indexed) in PORT. Maintain a source
location map such that this can boil down to seek(2) and a few read(2) calls,
which can drastically speed up repetitive operations on large files."
(let* ((stat (stat port))
- (key (list (stat:ino stat) (stat:dev stat)))
- (stamp (list (stat:mtime stat) (stat:mtimensec stat)
- (stat:size stat)))
+ (key stamp (source-location-key/stamp stat))
;; Look for an up-to-date source map for KEY. The map is a vlist
;; where each entry gives the byte offset of the beginning of a line:
@@ -398,6 +405,20 @@ which can drastically speed up repetitive operations on large files."
(set-port-line! port (- line 1))
(set-port-column! port (- column 1))))
+(define (move-source-location-map! source target line)
+ "Move the source location map from SOURCE up to LINE to TARGET. SOURCE and
+TARGET must be stat buffers as returned by 'stat'."
+ (let* ((source-key (source-location-key/stamp source))
+ (target-key target-stamp (source-location-key/stamp target)))
+ (match (hash-ref %source-location-map source-key)
+ (#f #t)
+ ((_ ... source-map)
+ ;; Strip the source map and update the associated stamp.
+ (let ((source-map (vlist-take source-map (max line 1))))
+ (hash-remove! %source-location-map source-key)
+ (hash-set! %source-location-map target-key
+ `(,@target-stamp ,source-map)))))))
+
(define* (edit-expression source-properties proc #:key (encoding "UTF-8"))
"Edit the expression specified by SOURCE-PROPERTIES using PROC, which should
be a procedure that takes the original expression in string and returns a new
@@ -435,7 +456,13 @@ This procedure returns #t on success."
;; post-bv maybe the end-of-file object.
(when (not (eof-object? post-bv))
(put-bytevector out post-bv))
- #t)))))))))
+ #t))
+
+ ;; Due to 'with-atomic-file-output', IN and FILE no longer share
+ ;; the same inode, but we can reassign the source map up to LINE
+ ;; to the new file.
+ (move-source-location-map! (stat in) (stat file)
+ (+ 1 line)))))))))
\f
;;;
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 11/11] Add 'guix style'.
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
` (8 preceding siblings ...)
2021-06-22 9:08 ` [bug#49169] [PATCH 10/11] utils: 'edit-expression' copies part of the original source map Ludovic Courtès
@ 2021-06-22 9:08 ` Ludovic Courtès
9 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-22 9:08 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/scripts/style.scm, tests/style.scm: New files.
* Makefile.am (MODULES, SCM_TESTS): Add them.
* po/guix/POTFILES.in: Add 'guix/scripts/style.scm'.
* doc/guix.texi (Invoking guix style): New node.
(package Reference): Reference it.
(Invoking guix lint): Likewise.
---
Makefile.am | 2 +
doc/guix.texi | 66 +++++-
guix/scripts/style.scm | 475 +++++++++++++++++++++++++++++++++++++++++
po/guix/POTFILES.in | 1 +
tests/style.scm | 328 ++++++++++++++++++++++++++++
5 files changed, 870 insertions(+), 2 deletions(-)
create mode 100644 guix/scripts/style.scm
create mode 100644 tests/style.scm
diff --git a/Makefile.am b/Makefile.am
index a10e06e5a7..d2eb60ecd6 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -285,6 +285,7 @@ MODULES = \
guix/scripts/refresh.scm \
guix/scripts/repl.scm \
guix/scripts/describe.scm \
+ guix/scripts/style.scm \
guix/scripts/system.scm \
guix/scripts/system/search.scm \
guix/scripts/system/reconfigure.scm \
@@ -497,6 +498,7 @@ SCM_TESTS = \
tests/swh.scm \
tests/syscalls.scm \
tests/system.scm \
+ tests/style.scm \
tests/texlive.scm \
tests/transformations.scm \
tests/ui.scm \
diff --git a/doc/guix.texi b/doc/guix.texi
index b16a2c48a8..e1fd43201d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -284,6 +284,7 @@ Utilities
* Invoking guix hash:: Computing the cryptographic hash of a file.
* Invoking guix import:: Importing package definitions.
* Invoking guix refresh:: Updating package definitions.
+* Invoking guix style:: Styling package definitions.
* Invoking guix lint:: Finding errors in package definitions.
* Invoking guix size:: Profiling disk usage.
* Invoking guix graph:: Visualizing the graph of packages.
@@ -6707,7 +6708,8 @@ the one above, but using the @dfn{old input style}:
This style is now deprecated; it is still supported but support will be
removed in a future version. It should not be used for new package
-definitions.
+definitions. @xref{Invoking guix style}, on how to migrate to the new
+style.
@end quotation
@cindex cross compilation, package dependencies
@@ -10234,6 +10236,7 @@ the Scheme programming interface of Guix in a convenient way.
* Invoking guix hash:: Computing the cryptographic hash of a file.
* Invoking guix import:: Importing package definitions.
* Invoking guix refresh:: Updating package definitions.
+* Invoking guix style:: Styling package definitions.
* Invoking guix lint:: Finding errors in package definitions.
* Invoking guix size:: Profiling disk usage.
* Invoking guix graph:: Visualizing the graph of packages.
@@ -12032,6 +12035,64 @@ token procured from @uref{https://github.com/settings/tokens} or
otherwise.
+@node Invoking guix style
+@section Invoking @command{guix style}
+
+The @command{guix style} command helps packagers style their package
+definitions according to the latest fashionable trends. The command
+currently focuses on one aspect: the style of package inputs. It may
+eventually be extended to handle other stylistic matters.
+
+The way package inputs are written is going through a transition
+(@pxref{package Reference}, for more on package inputs). Until version
+1.3.0, package inputs were written using the ``old style'', where each
+input was given an explicit label, most of the time the package name:
+
+@lisp
+(package
+ ;; @dots{}
+ ;; The "old style" (deprecated).
+ (inputs `(("libunistring" ,libunistring)
+ ("libffi" ,libffi))))
+@end lisp
+
+Today, the old style is deprecated and the preferred style looks like
+this:
+
+@lisp
+(package
+ ;; @dots{}
+ ;; The "new style".
+ (inputs (list libunistring libffi)))
+@end lisp
+
+Likewise, uses of @code{alist-delete} and friends to manipulate inputs
+is now deprecated in favor of @code{modify-inputs} (@pxref{Defining
+Package Variants}, for more info on @code{modify-inputs}).
+
+In the vast majority of cases, this is a purely mechanical change on the
+surface syntax that does not even incur a package rebuild. Running
+@command{guix style} can do that for you, whether you're working on
+packages in Guix proper or in an external channel.
+
+The general syntax is:
+
+@example
+guix style [@var{options}] @var{package}@dots{}
+@end example
+
+This causes @command{guix style} to analyze and rewrite the definition
+of @var{package}@dots{}. It does so in a conservative way: preserving
+comments and bailing out if it cannot make sense of the code that
+appears in an inputs field. The available options are listed below.
+
+@table @code
+@item --load-path=@var{directory}
+@itemx -L @var{directory}
+Add @var{directory} to the front of the package module search path
+(@pxref{Package Modules}).
+@end table
+
@node Invoking guix lint
@section Invoking @command{guix lint}
@@ -12165,7 +12226,8 @@ use of tabulations, etc.
Report old-style input labels that do not match the name of the
corresponding package. This aims to help migrate from the ``old input
style''. @xref{package Reference}, for more information on package
-inputs and input styles.
+inputs and input styles. @xref{Invoking guix style}, on how to migrate
+to the new style.
@end table
The general syntax is:
diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
new file mode 100644
index 0000000000..c75b86081e
--- /dev/null
+++ b/guix/scripts/style.scm
@@ -0,0 +1,475 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;;
+;;; This script updates package definitions so they use the "simplified" style
+;;; for input lists, as in:
+;;;
+;;; (package
+;;; ;; ...
+;;; (inputs (list foo bar baz)))
+;;;
+;;; Code:
+
+(define-module (guix scripts style)
+ #:autoload (gnu packages) (specification->package fold-packages)
+ #:use-module (guix scripts)
+ #:use-module ((guix scripts build) #:select (%standard-build-options))
+ #:use-module (guix combinators)
+ #:use-module (guix ui)
+ #:use-module (guix packages)
+ #:use-module (guix utils)
+ #:use-module (guix i18n)
+ #:use-module (guix diagnostics)
+ #:use-module (ice-9 control)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 rdelim)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-37)
+ #:export (guix-style))
+
+\f
+;;;
+;;; Comment-preserving reader.
+;;;
+
+;; A comment.
+(define-record-type <comment>
+ (comment str margin?)
+ comment?
+ (str comment->string)
+ (margin? comment-margin?))
+
+(define (read-with-comments port)
+ "Like 'read', but include <comment> objects when they're encountered."
+ ;; Note: Instead of implementing this functionality in 'read' proper, which
+ ;; is the best approach long-term, this code is a later on top of 'read',
+ ;; such that we don't have to rely on a specific Guile version.
+ (let loop ((blank-line? #t)
+ (return (const 'unbalanced)))
+ (match (read-char port)
+ ((? eof-object? eof)
+ eof) ;oops!
+ (chr
+ (cond ((eqv? chr #\newline)
+ (loop #t return))
+ ((char-set-contains? char-set:whitespace chr)
+ (loop blank-line? return))
+ ((memv chr '(#\( #\[))
+ (let/ec return
+ (let liip ((lst '()))
+ (liip (cons (loop #f (lambda ()
+ (return (reverse lst))))
+ lst)))))
+ ((memv chr '(#\) #\]))
+ (return))
+ ((eq? chr #\')
+ (list 'quote (loop #f return)))
+ ((eq? chr #\`)
+ (list 'quasiquote (loop #f return)))
+ ((eq? chr #\,)
+ (list (match (peek-char port)
+ (#\@
+ (read-char port)
+ 'unquote-splicing)
+ (_
+ 'unquote))
+ (loop #f return)))
+ ((eqv? chr #\;)
+ (unread-char chr port)
+ (comment (read-line port 'concat)
+ (not blank-line?)))
+ (else
+ (unread-char chr port)
+ (read port)))))))
+
+\f
+;;;
+;;; Comment-preserving pretty-printer.
+;;;
+
+(define* (pretty-print-with-comments port obj
+ #:key
+ (indent 0)
+ (max-width 78)
+ (long-list 5))
+ (let loop ((indent indent)
+ (column indent)
+ (delimited? #t) ;true if comes after a delimiter
+ (obj obj))
+ (match obj
+ ((? comment? comment)
+ (if (comment-margin? comment)
+ (begin
+ (display " " port)
+ (display (comment->string comment) port))
+ (begin
+ (newline port)
+ (display (make-string indent #\space) port)
+ (display (comment->string comment) port)))
+ (display (make-string indent #\space) port)
+ indent)
+ (('quote lst)
+ (unless delimited? (display " " port))
+ (display "'" port)
+ (loop indent (+ column (if delimited? 1 2)) #t lst))
+ (('quasiquote lst)
+ (unless delimited? (display " " port))
+ (display "`" port)
+ (loop indent (+ column (if delimited? 1 2)) #t lst))
+ (('unquote lst)
+ (unless delimited? (display " " port))
+ (display "," port)
+ (loop indent (+ column (if delimited? 1 2)) #t lst))
+ (('modify-inputs inputs clauses ...)
+ ;; Special-case 'modify-inputs' to have one clause per line and custom
+ ;; indentation.
+ (let ((head "(modify-inputs "))
+ (display head port)
+ (loop (+ indent 4)
+ (+ column (string-length head))
+ #t
+ inputs)
+ (let* ((indent (+ indent 2))
+ (column (fold (lambda (clause column)
+ (newline port)
+ (display (make-string indent #\space)
+ port)
+ (loop indent indent #t clause))
+ indent
+ clauses)))
+ (display ")" port)
+ (+ column 1))))
+ ((head tail ...)
+ (unless delimited? (display " " port))
+ (display "(" port)
+ (let* ((new-column (loop indent (+ 1 column) #t head))
+ (indent (+ indent (- new-column column)))
+ (long? (> (length tail) long-list)))
+ (define column
+ (fold2 (lambda (item column first?)
+ (define newline?
+ ;; Insert a newline if ITEM is itself a list, or if TAIL
+ ;; is long, but only if ITEM is not the first item.
+ (and (or (pair? item) long?)
+ (not first?) (not (comment? item))))
+
+ (when newline?
+ (newline port)
+ (display (make-string indent #\space) port))
+ (let ((column (if newline? indent column)))
+ (values (loop indent
+ column
+ (= column indent)
+ item)
+ (comment? item))))
+ (+ 1 new-column)
+ #t ;first
+ tail))
+ (display ")" port)
+ (+ column 1)))
+ (_
+ (let* ((str (object->string obj))
+ (len (string-length str)))
+ (if (> (+ column 1 len) max-width)
+ (begin
+ (newline port)
+ (display (make-string indent #\space) port)
+ (display str port)
+ (+ indent len))
+ (begin
+ (unless delimited? (display " " port))
+ (display str port)
+ (+ column (if delimited? 1 2) len))))))))
+
+(define (object->string* obj indent)
+ (call-with-output-string
+ (lambda (port)
+ (pretty-print-with-comments port obj
+ #:indent indent))))
+
+\f
+;;;
+;;; Simplifying input expressions.
+;;;
+
+(define (simplify-inputs location package str inputs)
+ "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)
+ ((label ('unquote symbol) output)
+ (list 'quasiquote
+ (list (list 'unquote symbol) output)))
+ (_
+ ;; Expression doesn't look like a simple input.
+ (warning location (G_ "~a: complex expression, \
+bailing out~%")
+ package)
+ (return str))))
+
+ (define (simplify-input exp input return)
+ (define package* package)
+
+ (match input
+ ((or ((? string? label) (? package? package))
+ ((? string? label) (? package? package)
+ (? string?)))
+ ;; If LABEL doesn't match PACKAGE's name, then simplifying would incur
+ ;; a rebuild, and perhaps it would break build-side code relying on
+ ;; this specific label.
+ (if (label-matches? label (package-name package))
+ ((simplify-input-expression return) exp)
+ (begin
+ (warning location (G_ "~a: input label \
+'~a' does not match package name, bailing out~%")
+ package* label)
+ (return str))))
+ (_
+ (warning location (G_ "~a: non-trivial input, \
+bailing out~%")
+ package*)
+ (return str))))
+
+ (define (simplify-expressions exp inputs return)
+ ;; Simplify the expressions in EXP, which correspond to INPUTS, and return
+ ;; a list of expressions. Call RETURN with a string when bailing out.
+ (let loop ((result '())
+ (exp exp)
+ (inputs inputs))
+ (match exp
+ (((? comment? head) . rest)
+ (loop (cons head result) rest inputs))
+ ((head . rest)
+ (match inputs
+ ((input . inputs)
+ ;; HEAD (an sexp) and INPUT (an input tuple) are correlated.
+ (loop (cons (simplify-input head input return) result)
+ rest inputs))
+ (()
+ ;; If EXP and INPUTS have a different length, that
+ ;; means EXP is a non-trivial input list, for example
+ ;; with input-splicing, conditionals, etc.
+ (warning location (G_ "~a: input expression is too short~%")
+ package)
+ (return str))))
+ (()
+ ;; It's possible for EXP to contain fewer elements than INPUTS, for
+ ;; example in the case of input splicing. No bailout here. (XXX)
+ (reverse result)))))
+
+ (define inputs-exp
+ (call-with-input-string str read-with-comments))
+
+ (match inputs-exp
+ (('list _ ...) ;already done
+ str)
+ (('modify-inputs _ ...) ;already done
+ str)
+ (('quasiquote ;prepending inputs
+ (exp ...
+ ('unquote-splicing
+ ((and symbol (or 'package-inputs 'package-native-inputs
+ 'package-propagated-inputs))
+ arg))))
+ (let/ec return
+ (object->string*
+ (let ((things (simplify-expressions exp inputs return)))
+ `(modify-inputs (,symbol ,arg)
+ (prepend ,@things)))
+ (location-column location))))
+ (('quasiquote ;replacing an input
+ ((and exp ((? string? to-delete) ('unquote replacement)))
+ ('unquote-splicing
+ ('alist-delete (? string? to-delete)
+ ((and symbol
+ (or 'package-inputs 'package-native-inputs
+ 'package-propagated-inputs))
+ arg)))))
+ (let/ec return
+ (object->string*
+ (let ((things (simplify-expressions (list exp)
+ (list (car inputs))
+ return)))
+ `(modify-inputs (,symbol ,arg)
+ (replace ,to-delete ,replacement)))
+ (location-column location))))
+
+ (('quasiquote ;removing an input
+ (exp ...
+ ('unquote-splicing
+ ('alist-delete (? string? to-delete)
+ ((and symbol
+ (or 'package-inputs 'package-native-inputs
+ 'package-propagated-inputs))
+ arg)))))
+ (let/ec return
+ (object->string*
+ (let ((things (simplify-expressions exp inputs return)))
+ `(modify-inputs (,symbol ,arg)
+ (delete ,to-delete)
+ (prepend ,@things)))
+ (location-column location))))
+ (('fold 'alist-delete ;removing several inputs
+ ((and symbol
+ (or 'package-inputs 'package-native-inputs
+ 'package-propagated-inputs))
+ arg)
+ ('quote ((? string? to-delete) ...)))
+ (object->string*
+ `(modify-inputs (,symbol ,arg)
+ (delete ,@to-delete))
+ (location-column location)))
+ (('quasiquote ;removing several inputs and adding others
+ (exp ...
+ ('unquote-splicing
+ ('fold 'alist-delete
+ ((and symbol
+ (or 'package-inputs 'package-native-inputs
+ 'package-propagated-inputs))
+ arg)
+ ('quote ((? string? to-delete) ...))))))
+ (let/ec return
+ (object->string*
+ (let ((things (simplify-expressions exp inputs return)))
+ `(modify-inputs (,symbol ,arg)
+ (delete ,@to-delete)
+ (prepend ,@things)))
+ (location-column location))))
+ (('quasiquote (exp ...))
+ (let/ec return
+ (object->string*
+ `(list ,@(simplify-expressions exp inputs return))
+ (location-column location))))
+ (_
+ (warning location (G_ "~a: unsupported input style, \
+bailing out~%")
+ package)
+ str)))
+
+(define (simplify-package-inputs package)
+ "Edit the source code of PACKAGE to simplify its inputs field if needed."
+ (for-each (lambda (field-name field)
+ (match (field package)
+ (()
+ #f)
+ (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)))
+ #f)
+ (location
+ (edit-expression (location->source-properties location)
+ (lambda (str)
+ (simplify-inputs location
+ (package-name package)
+ str inputs))))))))
+ '(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))
+ (loc2 (package-location p2)))
+ (and loc1 loc2
+ (if (string=? (location-file loc1) (location-file loc2))
+ (< (location-line loc1) (location-line loc2))
+ (string<? (location-file loc1) (location-file loc2))))))
+
+\f
+;;;
+;;; Options.
+;;;
+
+(define %options
+ ;; Specification of the command-line options.
+ (list (find (lambda (option)
+ (member "load-path" (option-names option)))
+ %standard-build-options)
+
+ (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (show-version-and-exit "guix style")))))
+
+(define (show-help)
+ (display (G_ "Usage: guix style [OPTION]... [PACKAGE]...
+Update package definitions to the latest style.\n"))
+ (display (G_ "
+ -L, --load-path=DIR prepend DIR to the package module search path"))
+ (newline)
+ (display (G_ "
+ -h, --help display this help and exit"))
+ (display (G_ "
+ -V, --version display version information and exit"))
+ (newline)
+ (show-bug-report-information))
+
+(define %default-options
+ ;; Alist of default option values.
+ '())
+
+\f
+;;;
+;;; Entry point.
+;;;
+
+(define-command (guix-style . args)
+ (category packaging)
+ (synopsis "update the style of package definitions")
+
+ (define (parse-options)
+ ;; Return the alist of option values.
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
+
+ (let* ((opts (parse-options))
+ (specs (filter-map (match-lambda
+ (('argument . spec) spec)
+ (_ #f))
+ opts)))
+ (for-each simplify-package-inputs
+ ;; 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
+ ;; we modify files.
+ (sort (if (null? specs)
+ (fold-packages cons '() #:select? (const #t))
+ (map specification->package specs))
+ (negate package-location<?)))))
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index 74cc5ebf9a..51a4845c15 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -112,5 +112,6 @@ guix/scripts/offload.scm
guix/scripts/perform-download.scm
guix/scripts/refresh.scm
guix/scripts/repl.scm
+guix/scripts/style.scm
guix/scripts/system/reconfigure.scm
nix/nix-daemon/guix-daemon.cc
diff --git a/tests/style.scm b/tests/style.scm
new file mode 100644
index 0000000000..426ffc2233
--- /dev/null
+++ b/tests/style.scm
@@ -0,0 +1,328 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (tests-style)
+ #:use-module (guix packages)
+ #:use-module (guix scripts style)
+ #:use-module ((guix utils) #:select (call-with-temporary-directory))
+ #:use-module ((guix build utils) #:select (substitute*))
+ #:use-module (guix diagnostics)
+ #:use-module (gnu packages acl)
+ #:use-module (gnu packages multiprecision)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-64)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 rdelim)
+ #:use-module (ice-9 pretty-print))
+
+(define (call-with-test-package inputs proc)
+ (call-with-temporary-directory
+ (lambda (directory)
+ (call-with-output-file (string-append directory "/my-packages.scm")
+ (lambda (port)
+ (pretty-print
+ `(begin
+ (define-module (my-packages)
+ #:use-module (guix)
+ #:use-module (guix licenses)
+ #:use-module (gnu packages acl)
+ #:use-module (gnu packages base)
+ #:use-module (gnu packages multiprecision)
+ #:use-module (srfi srfi-1))
+
+ (define base
+ (package
+ (inherit coreutils)
+ (inputs '())
+ (native-inputs '())
+ (propagated-inputs '())))
+
+ (define (sdl-union . lst)
+ (package
+ (inherit base)
+ (name "sdl-union")))
+
+ (define-public my-coreutils
+ (package
+ (inherit base)
+ ,@inputs
+ (name "my-coreutils"))))
+ port)))
+
+ (proc directory))))
+
+(define test-directory
+ ;; Directory where the package definition lives.
+ (make-parameter #f))
+
+(define-syntax-rule (with-test-package fields exp ...)
+ (call-with-test-package fields
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ ;; Run as a separate process to make sure FILE is reloaded.
+ (system* "guix" "style" "-L" directory "my-coreutils")
+ (system* "cat" file)
+
+ (load file)
+ (parameterize ((test-directory directory))
+ exp ...))))
+
+(define* (read-lines port line #:optional (count 1))
+ "Read COUNT lines from PORT, starting from LINE."
+ (let loop ((lines '())
+ (count count))
+ (cond ((< (port-line port) (- line 1))
+ (read-char port)
+ (loop lines count))
+ ((zero? count)
+ (string-concatenate-reverse lines))
+ (else
+ (match (read-line port 'concat)
+ ((? eof-object?)
+ (loop lines 0))
+ (line
+ (loop (cons line lines) (- count 1))))))))
+
+(define* (read-package-field package field #:optional (count 1))
+ (let* ((location (package-field-location package field))
+ (file (location-file location))
+ (line (location-line location)))
+ (call-with-input-file (if (string-prefix? "/" file)
+ file
+ (string-append (test-directory) "/"
+ file))
+ (lambda (port)
+ (read-lines port line count)))))
+
+\f
+(test-begin "style")
+
+(test-equal "nothing to rewrite"
+ '()
+ (with-test-package '()
+ (package-direct-inputs (@ (my-packages) my-coreutils))))
+
+(test-equal "input labels, mismatch"
+ (list `(("foo" ,gmp) ("bar" ,acl))
+ " (inputs `((\"foo\" ,gmp) (\"bar\" ,acl)))\n")
+ (with-test-package '((inputs `(("foo" ,gmp) ("bar" ,acl))))
+ (list (package-direct-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs))))
+
+(test-equal "input labels, simple"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ " (inputs (list gmp acl))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl))))
+ (list (package-direct-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs))))
+
+(test-equal "input labels, long list with one item per line"
+ (list (concatenate (make-list 4 `(("gmp" ,gmp) ("acl" ,acl))))
+ "\
+ (list gmp
+ acl
+ gmp
+ acl
+ gmp
+ acl
+ gmp
+ acl))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl))))
+ (list (package-direct-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 8))))
+
+(test-equal "input labels, sdl-union"
+ "\
+ (list gmp acl
+ (sdl-union 1 2 3 4)))\n"
+ (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
+ ("sdl-union" ,(sdl-union 1 2 3 4)))))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 2)))
+
+(test-equal "input labels, output"
+ (list `(("gmp" ,gmp "debug") ("acl" ,acl))
+ " (inputs (list `(,gmp \"debug\") acl))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp "debug") ("acl" ,acl))))
+ (list (package-direct-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs))))
+
+(test-equal "input labels, prepend"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (prepend gmp acl)))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
+ ,@(package-propagated-inputs coreutils))))
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 2))))
+
+(test-equal "input labels, prepend + delete"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (delete \"gmp\")
+ (prepend gmp acl)))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp)
+ ("acl" ,acl)
+ ,@(alist-delete "gmp"
+ (package-propagated-inputs coreutils)))))
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 3))))
+
+(test-equal "input labels, prepend + delete multiple"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (delete \"foo\" \"bar\" \"baz\")
+ (prepend gmp acl)))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp)
+ ("acl" ,acl)
+ ,@(fold alist-delete
+ (package-propagated-inputs coreutils)
+ '("foo" "bar" "baz")))))
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 3))))
+
+(test-equal "input labels, replace"
+ (list '() ;there's no "gmp" input to replace
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (replace \"gmp\" gmp)))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp)
+ ,@(alist-delete "gmp"
+ (package-propagated-inputs coreutils)))))
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 2))))
+
+(test-equal "input labels, margin comment"
+ (list `(("gmp" ,gmp))
+ `(("acl" ,acl))
+ " (inputs (list gmp)) ;margin comment\n"
+ " (native-inputs (list acl)) ;another one\n")
+ (call-with-test-package '((inputs `(("gmp" ,gmp)))
+ (native-inputs `(("acl" ,acl))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (substitute* file
+ (("\"gmp\"(.*)$" _ rest)
+ (string-append "\"gmp\"" (string-trim-right rest)
+ " ;margin comment\n"))
+ (("\"acl\"(.*)$" _ rest)
+ (string-append "\"acl\"" (string-trim-right rest)
+ " ;another one\n")))
+ (system* "cat" file)
+
+ (system* "guix" "style" "-L" directory "my-coreutils")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (package-native-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs)
+ (read-package-field (@ (my-packages) my-coreutils) 'native-inputs)))))
+
+(test-equal "input labels, margin comment on long list"
+ (list (concatenate (make-list 4 `(("gmp" ,gmp) ("acl" ,acl))))
+ "\
+ (list gmp ;margin comment
+ acl
+ gmp ;margin comment
+ acl
+ gmp ;margin comment
+ acl
+ gmp ;margin comment
+ acl))\n")
+ (call-with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (substitute* file
+ (("\"gmp\"(.*)$" _ rest)
+ (string-append "\"gmp\"" (string-trim-right rest)
+ " ;margin comment\n")))
+ (system* "cat" file)
+
+ (system* "guix" "style" "-L" directory "my-coreutils")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 8)))))
+
+(test-equal "input labels, line comment"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (inputs (list gmp
+ ;; line comment!
+ acl))\n")
+ (call-with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (substitute* file
+ ((",gmp\\)(.*)$" _ rest)
+ (string-append ",gmp)\n ;; line comment!\n" rest)))
+
+ (system* "guix" "style" "-L" directory "my-coreutils")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 3)))))
+
+(test-equal "input labels, modify-inputs and margin comment"
+ (list `(("gmp" ,gmp) ("acl" ,acl) ("mpfr" ,mpfr))
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (prepend gmp ;margin comment
+ acl ;another one
+ mpfr)))\n")
+ (call-with-test-package '((inputs
+ `(("gmp" ,gmp) ("acl" ,acl) ("mpfr" ,mpfr)
+ ,@(package-propagated-inputs coreutils))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (substitute* file
+ ((",gmp\\)(.*)$" _ rest)
+ (string-append ",gmp) ;margin comment\n" rest))
+ ((",acl\\)(.*)$" _ rest)
+ (string-append ",acl) ;another one\n" rest)))
+
+ (system* "guix" "style" "-L" directory "my-coreutils")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 4)))))
+
+(test-end)
+
+;; Local Variables:
+;; eval: (put 'with-test-package 'scheme-indent-function 1)
+;; eval: (put 'call-with-test-package 'scheme-indent-function 1)
+;; End:
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 00/11] Removing input labels from package definitions
2021-06-22 9:02 [bug#49169] [PATCH 00/11] Removing input labels from package definitions Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
@ 2021-06-22 9:09 ` Ludovic Courtès
2021-06-27 18:37 ` Christopher Baines
2021-06-27 11:00 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
3 siblings, 1 reply; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-22 9:09 UTC (permalink / raw)
To: 49169
[-- Attachment #1: Type: text/plain, Size: 368 bytes --]
Ludovic Courtès <ludo@gnu.org> skribis:
> The main change is the addition of ‘guix style’, based on the script
> I posted earlier. ‘guix style’ is able to systematically preserve
> comments (margin comments and line comments). It recognizes and
> “translates” several common idioms.
Here’s a couple of diffs generated by ‘guix style’:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 907 bytes --]
@@ -171,9 +170,9 @@ engine programmable using Lua.")
(inherit arcan)
(name "arcan-sdl")
(inputs
- `(("sdl" ,sdl)
- ,@(fold alist-delete (package-inputs arcan)
- '("libdrm"))))
+ (modify-inputs (package-inputs arcan)
+ (delete "libdrm")
+ (prepend sdl)))
(arguments
`(,@(ensure-keyword-arguments
(package-arguments arcan)
@@ -218,11 +217,7 @@ engine programmable using Lua.")
,(string-append "--with-xkb-output="
"/tmp")))) ; FIXME: Copied from xorg
(native-inputs
- `(("pkg-config" ,pkg-config)
- ("autoconf" ,autoconf)
- ("automake" ,automake)
- ("libtool" ,libtool)
- ("util-macros" ,util-macros)))
+ (list pkg-config autoconf automake libtool util-macros))
(inputs
`(("arcan" ,arcan)
("font-util" ,font-util)
[-- Attachment #3: Type: text/plain, Size: 12 bytes --]
Comments:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: Type: text/x-patch, Size: 593 bytes --]
@@ -3797,11 +3713,11 @@ important tasks for becoming a daemon process:
"1aycpc387wqz7h9w2p53qxn43qsh3m6by6ak4kkc66x9aprr63rz"))))
(build-system python-build-system)
(propagated-inputs
- `(("python-six" ,python-six)))
+ (list python-six))
(native-inputs
- `(;; For tests.
- ("graphviz" ,graphviz) ;for 'dot'
- ("python-nose" ,python-nose)))
+ (list ;; For tests.
+ graphviz ;for 'dot'
+ python-nose))
(home-page "https://github.com/c0fec0de/anytree")
(synopsis "Lightweight tree data library")
[-- Attachment #5: Type: text/plain, Size: 37 bytes --]
Pretty cool, no? :-)
Ludo’.
^ permalink raw reply [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 00/11] Removing input labels from package definitions
2021-06-22 9:02 [bug#49169] [PATCH 00/11] Removing input labels from package definitions Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
2021-06-22 9:09 ` [bug#49169] [PATCH 00/11] Removing input labels from package definitions Ludovic Courtès
@ 2021-06-27 11:00 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
3 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-27 11:00 UTC (permalink / raw)
To: 49169
Hi!
Ludovic Courtès <ludo@gnu.org> skribis:
> This patch series does the ground work to remove input labels
> from package definitions. In other words:
>
> (package
> ;; …
> (inputs `(("libunistring" ,libunistring)
> ("libffi" ,libffi))))
>
> becomes:
>
> (package
> ;; …
> (inputs (list libunistring libffi)))
>
> Note that it does not change the value returned by ‘package-inputs’
> & co.: that still includes input labels. Likewise, build-side code
> does not see any difference (there are still input alists).
The 2nd phase of this change (could be a year from now) would be to
remove labels entirely from the API: ‘package-inputs’ and related
procedures would return a label-less list. We’d most likely keep the
‘%build-inputs’ and ‘inputs’ alists on the build side.
However, this phase will be trickier. Labels currently serve as an
indirection to implement “virtual dependencies”, as in this example:
(package
;; …
(arguments '(… (assoc-ref inputs "mpi") …))
(inputs `(("mpi" ,openmpi))))
Here you can replace ‘openmpi’ with ‘mpich’ or ‘my-custom-openmpi’
(through inheritance or with ‘--with-input’) and the build-side code in
‘arguments’ still behaves as expected.
Once labels have fully disappeared, the build-side ‘inputs’ could only
contain the real package name, so either “openmpi” or “mpich”.
We could replace the build-side ‘assoc-ref’ with host-side code like:
(package
;; …
(arguments
(list #:phases
#~(… #$(lookup-package-input this-package "openmpi") …))))
but again, it depends on the actual package name, so it doesn’t help.
So we need… something else.
I don’t think it’s a showstopper for this patch series, but it does mean
that for the time being one has to know about labels to understand what
happens in package variants.
Ludo’.
^ permalink raw reply [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 00/11] Removing input labels from package definitions
2021-06-22 9:09 ` [bug#49169] [PATCH 00/11] Removing input labels from package definitions Ludovic Courtès
@ 2021-06-27 18:37 ` Christopher Baines
2021-06-28 9:54 ` Ludovic Courtès
0 siblings, 1 reply; 40+ messages in thread
From: Christopher Baines @ 2021-06-27 18:37 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 49169
[-- Attachment #1: Type: text/plain, Size: 2214 bytes --]
Ludovic Courtès <ludo@gnu.org> writes:
> Ludovic Courtès <ludo@gnu.org> skribis:
>
>> The main change is the addition of ‘guix style’, based on the script
>> I posted earlier. ‘guix style’ is able to systematically preserve
>> comments (margin comments and line comments). It recognizes and
>> “translates” several common idioms.
>
> Here’s a couple of diffs generated by ‘guix style’:
>
> @@ -171,9 +170,9 @@ engine programmable using Lua.")
> (inherit arcan)
> (name "arcan-sdl")
> (inputs
> - `(("sdl" ,sdl)
> - ,@(fold alist-delete (package-inputs arcan)
> - '("libdrm"))))
> + (modify-inputs (package-inputs arcan)
> + (delete "libdrm")
> + (prepend sdl)))
> (arguments
> `(,@(ensure-keyword-arguments
> (package-arguments arcan)
> @@ -218,11 +217,7 @@ engine programmable using Lua.")
> ,(string-append "--with-xkb-output="
> "/tmp")))) ; FIXME: Copied from xorg
> (native-inputs
> - `(("pkg-config" ,pkg-config)
> - ("autoconf" ,autoconf)
> - ("automake" ,automake)
> - ("libtool" ,libtool)
> - ("util-macros" ,util-macros)))
> + (list pkg-config autoconf automake libtool util-macros))
> (inputs
> `(("arcan" ,arcan)
> ("font-util" ,font-util)
>
> Comments:
>
> @@ -3797,11 +3713,11 @@ important tasks for becoming a daemon process:
> "1aycpc387wqz7h9w2p53qxn43qsh3m6by6ak4kkc66x9aprr63rz"))))
> (build-system python-build-system)
> (propagated-inputs
> - `(("python-six" ,python-six)))
> + (list python-six))
> (native-inputs
> - `(;; For tests.
> - ("graphviz" ,graphviz) ;for 'dot'
> - ("python-nose" ,python-nose)))
> + (list ;; For tests.
> + graphviz ;for 'dot'
> + python-nose))
> (home-page "https://github.com/c0fec0de/anytree")
> (synopsis "Lightweight tree data library")
>
> Pretty cool, no? :-)
The automated translation is pretty impressive! I've had a quick look
through the patches and they look good to me.
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]
^ permalink raw reply [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 00/11] Removing input labels from package definitions
2021-06-27 18:37 ` Christopher Baines
@ 2021-06-28 9:54 ` Ludovic Courtès
0 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-28 9:54 UTC (permalink / raw)
To: Christopher Baines; +Cc: 49169
Hi,
Christopher Baines <mail@cbaines.net> skribis:
> The automated translation is pretty impressive! I've had a quick look
> through the patches and they look good to me.
Awesome, thanks for taking the time!
Ludo’.
^ permalink raw reply [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 00/16] Removing input labels from package definitions
2021-06-22 9:02 [bug#49169] [PATCH 00/11] Removing input labels from package definitions Ludovic Courtès
` (2 preceding siblings ...)
2021-06-27 11:00 ` Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 01/16] records: Support field sanitizers Ludovic Courtès
` (17 more replies)
3 siblings, 18 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
Hi!
This is an improved version of this patch series, with the following
changes:
• ‘guix style’ supports -e/--expression and
--input-simplification=POLICY. The latter allows users to ask
for input simplification even when labels don’t match package
names (this is useful in obvious cases where there’s a “libX11”
label for the “libx11” package, for instance.)
• I changed a few importers to emit simplified package inputs.
We’ll have to take care of the other importers eventually.
I plan to merge this series by the end of the week on ‘core-updates’.
The plan is to run ‘guix style’ (with no arguments: convert all the
packages as long as that does not involve a rebuild) towards the end
of the ‘core-updates’ cycle so as to minimize merge conflicts.
Thanks,
Ludo’.
Ludovic Courtès (16):
records: Support field sanitizers.
packages: Allow inputs to be plain package lists.
lint: Add 'input-labels' checker.
packages: Add 'lookup-package-input' & co.
packages: Add 'modify-inputs'.
gnu: Change inputs of core packages to plain lists.
utils: 'edit-expression' no longer leaks file ports.
utils: Add 'go-to-location' with source location caching.
utils: 'edit-expression' modifies the file only if necessary.
utils: 'edit-expression' copies part of the original source map.
Add 'guix style'.
packages: 'hidden-package' inherits the original package location.
import: pypi: Emit new-style package inputs.
import: cran: Emit new-style package inputs.
import: print: Emit new-style package inputs when possible.
import: elpa: Emit new-style package inputs.
.dir-locals.el | 6 +
Makefile.am | 2 +
doc/guix.texi | 208 ++++++++++++++--
gnu/packages/base.scm | 48 ++--
gnu/packages/guile.scm | 103 +++-----
gnu/packages/mes.scm | 25 +-
guix/import/cran.scm | 8 +-
guix/import/elpa.scm | 7 +-
guix/import/print.scm | 57 +++--
guix/import/pypi.scm | 15 +-
guix/lint.scm | 36 +++
guix/packages.scm | 146 +++++++++++-
guix/records.scm | 65 +++--
guix/scripts/style.scm | 527 +++++++++++++++++++++++++++++++++++++++++
guix/utils.scm | 151 +++++++++---
po/guix/POTFILES.in | 1 +
tests/cran.scm | 10 +-
tests/lint.scm | 14 ++
tests/packages.scm | 86 ++++---
tests/print.scm | 4 +-
tests/pypi.scm | 18 +-
tests/records.scm | 38 +++
tests/style.scm | 366 ++++++++++++++++++++++++++++
23 files changed, 1643 insertions(+), 298 deletions(-)
create mode 100644 guix/scripts/style.scm
create mode 100644 tests/style.scm
base-commit: 4c0cf61afd5ed62e830f2e87ef6b72505f2c303a
--
2.32.0
^ permalink raw reply [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 01/16] records: Support field sanitizers.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 02/16] packages: Allow inputs to be plain package lists Ludovic Courtès
` (16 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/records.scm (make-syntactic-constructor): Add #:sanitizers.
[field-sanitizer]: New procedure.
[wrap-field-value]: Honor F's sanitizer.
(define-record-type*)[field-sanitizer]: New procedure.
Pass #:sanitizer to 'make-syntactic-constructor'.
* tests/records.scm ("define-record-type* & sanitize")
("define-record-type* & sanitize & thunked"): New tests.
---
guix/records.scm | 65 +++++++++++++++++++++++++++++++++++++----------
tests/records.scm | 38 +++++++++++++++++++++++++++
2 files changed, 89 insertions(+), 14 deletions(-)
diff --git a/guix/records.scm b/guix/records.scm
index 3d54a51956..ed94c83dac 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
@@ -120,7 +120,8 @@ context of the definition of a thunked field."
"Make the syntactic constructor NAME for TYPE, that calls CTOR, and
expects all of EXPECTED fields to be initialized. DEFAULTS is the list of
FIELD/DEFAULT-VALUE tuples, THUNKED is the list of identifiers of thunked
-fields, and DELAYED is the list of identifiers of delayed fields.
+fields, DELAYED is the list of identifiers of delayed fields, and SANITIZERS
+is the list of FIELD/SANITIZER tuples.
ABI-COOKIE is the cookie (an integer) against which to check the run-time ABI
of TYPE matches the expansion-time ABI."
@@ -130,6 +131,7 @@ of TYPE matches the expansion-time ABI."
#:this-identifier this-identifier
#:delayed delayed
#:innate innate
+ #:sanitizers sanitizers
#:defaults defaults)
(define-syntax name
(lambda (s)
@@ -169,19 +171,30 @@ of TYPE matches the expansion-time ABI."
(define (innate-field? f)
(memq (syntax->datum f) 'innate))
+ (define field-sanitizer
+ (let ((lst (map (match-lambda
+ ((f p)
+ (list (syntax->datum f) p)))
+ #'sanitizers)))
+ (lambda (f)
+ (or (and=> (assoc-ref lst (syntax->datum f)) car)
+ #'(lambda (x) x)))))
+
(define (wrap-field-value f value)
- (cond ((thunked-field? f)
- #`(lambda (x)
- (syntax-parameterize ((#,this-identifier
- (lambda (s)
- (syntax-case s ()
- (id
- (identifier? #'id)
- #'x)))))
- #,value)))
- ((delayed-field? f)
- #`(delay #,value))
- (else value)))
+ (let* ((sanitizer (field-sanitizer f))
+ (value #`(#,sanitizer #,value)))
+ (cond ((thunked-field? f)
+ #`(lambda (x)
+ (syntax-parameterize ((#,this-identifier
+ (lambda (s)
+ (syntax-case s ()
+ (id
+ (identifier? #'id)
+ #'x)))))
+ #,value)))
+ ((delayed-field? f)
+ #`(delay #,value))
+ (else value))))
(define default-values
;; List of symbol/value tuples.
@@ -291,6 +304,19 @@ can access the record it belongs to via the 'this-thing' identifier.
A field can also be marked as \"delayed\" instead of \"thunked\", in which
case its value is effectively wrapped in a (delay …) form.
+A field can also have an associated \"sanitizer\", which is a procedure that
+takes a user-supplied field value and returns a \"sanitized\" value for the
+field:
+
+ (define-record-type* <thing> thing make-thing
+ thing?
+ this-thing
+ (name thing-name
+ (sanitize (lambda (value)
+ (cond ((string? value) value)
+ ((symbol? value) (symbol->string value))
+ (else (throw 'bad! value)))))))
+
It is possible to copy an object 'x' created with 'thing' like this:
(thing (inherit x) (name \"bar\"))
@@ -307,6 +333,14 @@ inherited."
(field-default-value #'(field properties ...)))
(_ #f)))
+ (define (field-sanitizer s)
+ (syntax-case s (sanitize)
+ ((field (sanitize proc) _ ...)
+ (list #'field #'proc))
+ ((field _ properties ...)
+ (field-sanitizer #'(field properties ...)))
+ (_ #f)))
+
(define-field-property-predicate delayed-field? delayed)
(define-field-property-predicate thunked-field? thunked)
(define-field-property-predicate innate-field? innate)
@@ -376,6 +410,8 @@ inherited."
(innate (filter-map innate-field? field-spec))
(defaults (filter-map field-default-value
#'((field properties ...) ...)))
+ (sanitizers (filter-map field-sanitizer
+ #'((field properties ...) ...)))
(cookie (compute-abi-cookie field-spec)))
(with-syntax (((field-spec* ...)
(map field-spec->srfi-9 field-spec))
@@ -421,6 +457,7 @@ of a record instantiation"
#:this-identifier #'this-identifier
#:delayed #,delayed
#:innate #,innate
+ #:sanitizers #,sanitizers
#:defaults #,defaults)))))
((_ type syntactic-ctor ctor pred
(field get properties ...) ...)
diff --git a/tests/records.scm b/tests/records.scm
index 706bb3dbfd..d014e7a995 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -283,6 +283,44 @@
(equal? (foo-bar y) 1)) ;promise was already forced
(eq? (foo-baz y) 'b)))))
+(test-assert "define-record-type* & sanitize"
+ (begin
+ (define-record-type* <foo> foo make-foo
+ foo?
+ (bar foo-bar
+ (default "bar")
+ (sanitize (lambda (x) (string-append x "!")))))
+
+ (let* ((p (foo))
+ (q (foo (inherit p)))
+ (r (foo (inherit p) (bar "baz")))
+ (s (foo (bar "baz"))))
+ (and (string=? (foo-bar p) "bar!")
+ (equal? q p)
+ (string=? (foo-bar r) "baz!")
+ (equal? s r)))))
+
+(test-assert "define-record-type* & sanitize & thunked"
+ (let ((sanitized 0))
+ (define-record-type* <foo> foo make-foo
+ foo?
+ (bar foo-bar
+ (default "bar")
+ (sanitize (lambda (x)
+ (set! sanitized (+ 1 sanitized))
+ (string-append x "!")))))
+
+ (let ((p (foo)))
+ (and (string=? (foo-bar p) "bar!")
+ (string=? (foo-bar p) "bar!") ;twice
+ (= sanitized 1) ;sanitizer was called at init time only
+ (let ((q (foo (bar "baz"))))
+ (and (string=? (foo-bar q) "baz!")
+ (string=? (foo-bar q) "baz!") ;twice
+ (= sanitized 2)
+ (let ((r (foo (inherit q))))
+ (and (string=? (foo-bar r) "baz!")
+ (= sanitized 2))))))))) ;no re-sanitization
(test-assert "define-record-type* & wrong field specifier"
(let ((exp '(begin
(define-record-type* <foo> foo make-foo
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 02/16] packages: Allow inputs to be plain package lists.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 01/16] records: Support field sanitizers Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 03/16] lint: Add 'input-labels' checker Ludovic Courtès
` (15 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/packages.scm (add-input-label, sanitize-inputs): New procedures.
(<package>)[inputs, propagated-inputs, native-inputs]: Add 'sanitize' property.
* doc/guix.texi (Defining Packages, package Reference):
(Defining Package Variants): Adjust examples accordingly.
* tests/packages.scm ("transaction-upgrade-entry, zero upgrades, propagated inputs")
("transaction-upgrade-entry, grafts")
("package-transitive-inputs")
("package-transitive-supported-systems")
("package-closure")
("supported-package?")
("package-derivation, inputs deduplicated")
("package-transitive-native-search-paths")
("package-grafts, indirect grafts")
("package-grafts, indirect grafts, propagated inputs")
("package-grafts, same replacement twice")
("package-grafts, dependency on several outputs")
("replacement also grafted")
("package->bag, sensitivity to %current-target-system")
("package->bag, propagated inputs")
("package->bag, sensitivity to %current-system")
("package-input-rewriting/spec, identity")
("package-input-rewriting, identity"): Use the label-less input style.
---
doc/guix.texi | 44 +++++++++++++++++-------
guix/packages.scm | 35 +++++++++++++++++--
tests/packages.scm | 86 ++++++++++++++++++++++------------------------
3 files changed, 106 insertions(+), 59 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 53766fbec2..1659a2687a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6476,7 +6476,7 @@ package looks like this:
"0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
(build-system gnu-build-system)
(arguments '(#:configure-flags '("--enable-silent-rules")))
- (inputs `(("gawk" ,gawk)))
+ (inputs (list gawk))
(synopsis "Hello, GNU world: An example GNU package")
(description "Guess what GNU Hello prints!")
(home-page "https://www.gnu.org/software/hello/")
@@ -6564,8 +6564,8 @@ Reference Manual}).
@item
The @code{inputs} field specifies inputs to the build process---i.e.,
-build-time or run-time dependencies of the package. Here, we define an
-input called @code{"gawk"} whose value is that of the @code{gawk}
+build-time or run-time dependencies of the package. Here, we add
+an input, a reference to the @code{gawk}
variable; @code{gawk} is itself bound to a @code{<package>} object.
@cindex backquote (quasiquote)
@@ -6690,20 +6690,41 @@ list, typically containing sequential keyword-value pairs.
@itemx @code{native-inputs} (default: @code{'()})
@itemx @code{propagated-inputs} (default: @code{'()})
@cindex inputs, of packages
-These fields list dependencies of the package. Each one is a list of
-tuples, where each tuple has a label for the input (a string) as its
+These fields list dependencies of the package. Each element of these
+lists is either a package, origin, or other ``file-like object''
+(@pxref{G-Expressions}); to specify the output of that file-like object
+that should be used, pass a two-element list where the second element is
+the output (@pxref{Packages with Multiple Outputs}, for more on package
+outputs). For example, the list below specifies three inputs:
+
+@lisp
+(list libffi libunistring
+ `(,glib "bin")) ;the "bin" output of GLib
+@end lisp
+
+In the example above, the @code{"out"} output of @code{libffi} and
+@code{libunistring} is used.
+
+@quotation Compatibility Note
+Until version 1.3.0, input lists were a list of tuples,
+where each tuple has a label for the input (a string) as its
first element, a package, origin, or derivation as its second element,
and optionally the name of the output thereof that should be used, which
-defaults to @code{"out"} (@pxref{Packages with Multiple Outputs}, for
-more on package outputs). For example, the list below specifies three
-inputs:
+defaults to @code{"out"}. For example, the list below is equivalent to
+the one above, but using the @dfn{old input style}:
@lisp
+;; Old input style (deprecated).
`(("libffi" ,libffi)
("libunistring" ,libunistring)
- ("glib:bin" ,glib "bin")) ;the "bin" output of Glib
+ ("glib:bin" ,glib "bin")) ;the "bin" output of GLib
@end lisp
+This style is now deprecated; it is still supported but support will be
+removed in a future version. It should not be used for new package
+definitions.
+@end quotation
+
@cindex cross compilation, package dependencies
The distinction between @code{native-inputs} and @code{inputs} is
necessary when considering cross-compilation. When cross-compiling,
@@ -6789,7 +6810,7 @@ cross-compiling:
;; When cross-compiled, Guile, for example, depends on
;; a native version of itself. Add it here.
(native-inputs (if (%current-target-system)
- `(("self" ,this-package))
+ (list this-package)
'())))
@end lisp
@@ -7105,8 +7126,7 @@ depends on it:
(name name)
(version "3.0")
;; several fields omitted
- (inputs
- `(("lua" ,lua)))
+ (inputs (list lua))
(synopsis "Socket library for Lua")))
(define-public lua5.1-socket
diff --git a/guix/packages.scm b/guix/packages.scm
index a66dbea1b7..087e6e6a4a 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -366,6 +366,14 @@ name of its URI."
;; <https://lists.gnu.org/archive/html/guix-devel/2017-03/msg00790.html>.
(fold delete %supported-systems '("mips64el-linux" "powerpc-linux")))
+(define-inlinable (sanitize-inputs inputs)
+ "Sanitize INPUTS by turning it into a list of name/package tuples if it's
+not already the case."
+ (cond ((null? inputs) inputs)
+ ((and (pair? (car inputs))
+ (string? (caar inputs)))
+ inputs)
+ (else (map add-input-label inputs))))
;; A package.
(define-record-type* <package>
@@ -380,11 +388,14 @@ name of its URI."
(default '()) (thunked))
(inputs package-inputs ; input packages or derivations
- (default '()) (thunked))
+ (default '()) (thunked)
+ (sanitize sanitize-inputs))
(propagated-inputs package-propagated-inputs ; same, but propagated
- (default '()) (thunked))
+ (default '()) (thunked)
+ (sanitize sanitize-inputs))
(native-inputs package-native-inputs ; native input packages/derivations
- (default '()) (thunked))
+ (default '()) (thunked)
+ (sanitize sanitize-inputs))
(outputs package-outputs ; list of strings
(default '("out")))
@@ -415,6 +426,24 @@ name of its URI."
source-properties->location))
(innate)))
+(define (add-input-label input)
+ "Add an input label to INPUT."
+ (match input
+ ((? package? package)
+ (list (package-name package) package))
+ (((? package? package) output) ;XXX: ugly?
+ (list (package-name package) package output))
+ ((? gexp-input?) ;XXX: misplaced because 'native?' field is ignored?
+ (let ((obj (gexp-input-thing input))
+ (output (gexp-input-output input)))
+ `(,(if (package? obj)
+ (package-name obj)
+ "_")
+ ,obj
+ ,@(if (string=? output "out") '() (list output)))))
+ (x
+ `("_" ,x))))
+
(set-record-type-printer! <package>
(lambda (package port)
(let ((loc (package-location package))
diff --git a/tests/packages.scm b/tests/packages.scm
index 47d10af5bc..936aede4ff 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -137,7 +137,7 @@
;; inputs. See <https://bugs.gnu.org/35872>.
(let* ((dep (dummy-package "dep" (version "2")))
(old (dummy-package "foo" (version "1")
- (propagated-inputs `(("dep" ,dep)))))
+ (propagated-inputs (list dep))))
(drv (package-derivation %store old))
(tx (mock ((gnu packages) find-best-packages-by-name
(const (list old)))
@@ -225,7 +225,7 @@
(bar (dummy-package "bar" (version "0")
(replacement old)))
(new (dummy-package "foo" (version "1")
- (inputs `(("bar" ,bar)))))
+ (inputs (list bar))))
(tx (mock ((gnu packages) find-best-packages-by-name
(const (list new)))
(transaction-upgrade-entry
@@ -275,13 +275,13 @@
(test-assert "package-transitive-inputs"
(let* ((a (dummy-package "a"))
(b (dummy-package "b"
- (propagated-inputs `(("a" ,a)))))
+ (propagated-inputs (list a))))
(c (dummy-package "c"
- (inputs `(("a" ,a)))))
+ (inputs (list a))))
(d (dummy-package "d"
(propagated-inputs `(("x" "something.drv")))))
(e (dummy-package "e"
- (inputs `(("b" ,b) ("c" ,c) ("d" ,d))))))
+ (inputs (list b c d)))))
(and (null? (package-transitive-inputs a))
(equal? `(("a" ,a)) (package-transitive-inputs b))
(equal? `(("a" ,a)) (package-transitive-inputs c))
@@ -327,19 +327,19 @@
(b (dummy-package "b"
(build-system trivial-build-system)
(supported-systems '("x" "y"))
- (inputs `(("a" ,a)))))
+ (inputs (list a))))
(c (dummy-package "c"
(build-system trivial-build-system)
(supported-systems '("y" "z"))
- (inputs `(("b" ,b)))))
+ (inputs (list b))))
(d (dummy-package "d"
(build-system trivial-build-system)
(supported-systems '("x" "y" "z"))
- (inputs `(("b" ,b) ("c" ,c)))))
+ (inputs (list b c))))
(e (dummy-package "e"
(build-system trivial-build-system)
(supported-systems '("x" "y" "z"))
- (inputs `(("d" ,d))))))
+ (inputs (list d)))))
(list (package-transitive-supported-systems a)
(package-transitive-supported-systems b)
(package-transitive-supported-systems c)
@@ -355,13 +355,13 @@
(build-system trivial-build-system))))))
(let* ((a (dummy-package/no-implicit "a"))
(b (dummy-package/no-implicit "b"
- (propagated-inputs `(("a" ,a)))))
+ (propagated-inputs (list a))))
(c (dummy-package/no-implicit "c"
- (inputs `(("a" ,a)))))
+ (inputs (list a))))
(d (dummy-package/no-implicit "d"
- (native-inputs `(("b" ,b)))))
+ (native-inputs (list b))))
(e (dummy-package/no-implicit "e"
- (inputs `(("c" ,c) ("d" ,d))))))
+ (inputs (list c d)))))
(lset= eq?
(list a b c d e)
(package-closure (list e))
@@ -384,12 +384,11 @@
(u (dummy-origin))
(i (dummy-origin))
(a (dummy-package "a"))
- (b (dummy-package "b"
- (inputs `(("a" ,a) ("i" ,i)))))
+ (b (dummy-package "b" (inputs (list a i))))
(c (package (inherit b) (source o)))
(d (dummy-package "d"
(build-system trivial-build-system)
- (source u) (inputs `(("c" ,c))))))
+ (source u) (inputs (list c)))))
(test-assert "package-direct-sources, no source"
(null? (package-direct-sources a)))
(test-equal "package-direct-sources, #f source"
@@ -457,7 +456,7 @@
(supported-systems '("x86_64-linux"))))
(p (dummy-package "foo"
(build-system gnu-build-system)
- (inputs `(("d" ,d)))
+ (inputs (list d))
(supported-systems '("x86_64-linux" "armhf-linux")))))
(and (supported-package? p "x86_64-linux")
(not (supported-package? p "i686-linux"))
@@ -706,7 +705,7 @@
(test-assert "package-derivation, inputs deduplicated"
(let* ((dep (dummy-package "dep"))
- (p0 (dummy-package "p" (inputs `(("dep" ,dep)))))
+ (p0 (dummy-package "p" (inputs (list dep))))
(p1 (package (inherit p0)
(inputs `(("dep" ,(package (inherit dep)))
,@(package-inputs p0))))))
@@ -755,7 +754,7 @@
(parameterize ((%graft? #f))
(let* ((dep (dummy-package "dep"))
(p (dummy-package "p"
- (inputs `(("dep" ,dep "non-existent"))))))
+ (inputs (list `(,dep "non-existent"))))))
(guard (c ((derivation-missing-output-error? c)
(and (string=? (derivation-missing-output c) "non-existent")
(equal? (package-derivation %store dep)
@@ -913,12 +912,12 @@
(p1 (dummy-package "p1" (native-search-paths (sp "PATH1"))))
(p2 (dummy-package "p2"
(native-search-paths (sp "PATH2"))
- (inputs `(("p0" ,p0)))
- (propagated-inputs `(("p1" ,p1)))))
+ (inputs (list p0))
+ (propagated-inputs (list p1))))
(p3 (dummy-package "p3"
(native-search-paths (sp "PATH3"))
- (native-inputs `(("p0" ,p0)))
- (propagated-inputs `(("p2" ,p2))))))
+ (native-inputs (list p0))
+ (propagated-inputs (list p2)))))
(lset= string=?
'("PATH1" "PATH2" "PATH3")
(map search-path-specification-variable
@@ -972,7 +971,7 @@
(dep* (package (inherit dep) (replacement new)))
(dummy (dummy-package "dummy"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("dep" ,dep*))))))
+ (inputs (list dep*)))))
(equal? (package-grafts %store dummy)
(list (graft
(origin (package-derivation %store dep))
@@ -1004,11 +1003,11 @@
(dep (package (inherit new) (version "0.0")))
(dep* (package (inherit dep) (replacement new)))
(prop (dummy-package "propagated"
- (propagated-inputs `(("dep" ,dep*)))
+ (propagated-inputs (list dep*))
(arguments '(#:implicit-inputs? #f))))
(dummy (dummy-package "dummy"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("prop" ,prop))))))
+ (inputs (list prop)))))
(equal? (package-grafts %store dummy)
(list (graft
(origin (package-derivation %store dep))
@@ -1021,16 +1020,16 @@
(dep (package (inherit new) (version "0") (replacement new)))
(p1 (dummy-package "intermediate1"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("dep" ,dep)))))
+ (inputs (list dep))))
(p2 (dummy-package "intermediate2"
(arguments '(#:implicit-inputs? #f))
;; Here we copy DEP to have an equivalent package that is not
;; 'eq?' to DEP. This is similar to what happens with
;; 'package-with-explicit-inputs' & co.
- (inputs `(("dep" ,(package (inherit dep)))))))
+ (inputs (list (package (inherit dep))))))
(p3 (dummy-package "final"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("p1" ,p1) ("p2" ,p2))))))
+ (inputs (list p1 p2)))))
(equal? (package-grafts %store p3)
(list (graft
(origin (package-derivation %store
@@ -1048,8 +1047,7 @@
(p0* (package (inherit p0) (version "1.1")))
(p1 (dummy-package "p1"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("p0" ,p0)
- ("p0:lib" ,p0 "lib"))))))
+ (inputs (list p0 `(,p0 "lib"))))))
(lset= equal? (pk (package-grafts %store p1))
(list (graft
(origin (package-derivation %store p0))
@@ -1097,7 +1095,7 @@
#t)))))
(p2r (dummy-package "P2"
(build-system trivial-build-system)
- (inputs `(("p1" ,p1)))
+ (inputs (list p1))
(arguments
`(#:guile ,%bootstrap-guile
#:builder (let ((out (assoc-ref %outputs "out")))
@@ -1118,7 +1116,7 @@
#t)))))
(p3 (dummy-package "p3"
(build-system trivial-build-system)
- (inputs `(("p2" ,p2)))
+ (inputs (list p2))
(arguments
`(#:guile ,%bootstrap-guile
#:builder (let ((out (assoc-ref %outputs "out")))
@@ -1187,7 +1185,7 @@
(lower lower)))
(dep (dummy-package "dep" (build-system bs)))
(pkg (dummy-package "example"
- (native-inputs `(("dep" ,dep)))))
+ (native-inputs (list dep))))
(do-not-build (lambda (continue store lst . _) lst)))
(equal? (with-build-handler do-not-build
(parameterize ((%current-target-system "powerpc64le-linux-gnu")
@@ -1214,9 +1212,9 @@
(test-assert "package->bag, propagated inputs"
(let* ((dep (dummy-package "dep"))
(prop (dummy-package "prop"
- (propagated-inputs `(("dep" ,dep)))))
+ (propagated-inputs (list dep))))
(dummy (dummy-package "dummy"
- (inputs `(("prop" ,prop)))))
+ (inputs (list prop))))
(inputs (bag-transitive-inputs (package->bag dummy #:graft? #f))))
(match (assoc "dep" inputs)
(("dep" package)
@@ -1229,7 +1227,7 @@
`(("libxml2" ,libxml2))
'()))))
(pkg (dummy-package "foo"
- (native-inputs `(("dep" ,dep)))))
+ (native-inputs (list dep))))
(bag (package->bag pkg (%current-system) "i586-gnu")))
(equal? (parameterize ((%current-system "x86_64-linux"))
(bag-transitive-inputs bag))
@@ -1242,7 +1240,7 @@
`(("libxml2" ,libxml2))
'()))))
(pkg (dummy-package "foo"
- (native-inputs `(("dep" ,dep)))))
+ (native-inputs (list dep))))
(bag (package->bag pkg (%current-system) "foo86-hurd")))
(equal? (parameterize ((%current-target-system "foo64-gnu"))
(bag-transitive-inputs bag))
@@ -1548,11 +1546,11 @@
(build-system trivial-build-system)))
(glib (dummy-package "glib"
(build-system trivial-build-system)
- (propagated-inputs `(("libffi" ,libffi)))))
+ (propagated-inputs (list libffi))))
(gobject (dummy-package "gobject-introspection"
(build-system trivial-build-system)
- (inputs `(("glib" ,glib)))
- (propagated-inputs `(("libffi" ,libffi)))))
+ (inputs (list glib))
+ (propagated-inputs (list libffi))))
(rewrite (package-input-rewriting/spec
`(("glib" . ,identity)))))
(and (= (length (package-transitive-inputs gobject))
@@ -1569,11 +1567,11 @@
(build-system trivial-build-system)))
(glib (dummy-package "glib"
(build-system trivial-build-system)
- (propagated-inputs `(("libffi" ,libffi)))))
+ (propagated-inputs (list libffi))))
(gobject (dummy-package "gobject-introspection"
(build-system trivial-build-system)
- (inputs `(("glib" ,glib)))
- (propagated-inputs `(("libffi" ,libffi)))))
+ (inputs (list glib))
+ (propagated-inputs (list libffi))))
(rewrite (package-input-rewriting `((,glib . ,glib)))))
(and (= (length (package-transitive-inputs gobject))
(length (package-transitive-inputs (rewrite gobject))))
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 03/16] lint: Add 'input-labels' checker.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 01/16] records: Support field sanitizers Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 02/16] packages: Allow inputs to be plain package lists Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 04/16] packages: Add 'lookup-package-input' & co Ludovic Courtès
` (14 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/lint.scm (check-input-labels): New procedure.
(%local-checkers): Add 'input-labels' checker.
* tests/lint.scm ("input labels: no warnings")
("input labels: one warning"): New tests.
* doc/guix.texi (Invoking guix lint): Mention it.
---
doc/guix.texi | 6 ++++++
guix/lint.scm | 36 ++++++++++++++++++++++++++++++++++++
tests/lint.scm | 14 ++++++++++++++
3 files changed, 56 insertions(+)
diff --git a/doc/guix.texi b/doc/guix.texi
index 1659a2687a..0e5d1a9fa7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12153,6 +12153,12 @@ declare them as in this example:
@item formatting
Warn about obvious source code formatting issues: trailing white space,
use of tabulations, etc.
+
+@item input-labels
+Report old-style input labels that do not match the name of the
+corresponding package. This aims to help migrate from the ``old input
+style''. @xref{package Reference}, for more information on package
+inputs and input styles.
@end table
The general syntax is:
diff --git a/guix/lint.scm b/guix/lint.scm
index d65d5ce8f9..198e091f47 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -79,6 +79,7 @@
#:export (check-description-style
check-inputs-should-be-native
check-inputs-should-not-be-an-input-at-all
+ check-input-labels
check-patch-file-names
check-patch-headers
check-synopsis-style
@@ -416,6 +417,37 @@ of a package, and INPUT-NAMES, a list of package specifications such as
(package-input-intersection (package-direct-inputs package)
input-names))))
+(define (check-input-labels package)
+ "Emit a warning for labels that differ from the corresponding package name."
+ (define (check input-kind package-inputs)
+ (define (warning label name)
+ (make-warning package
+ (G_ "label '~a' does not match package name '~a'")
+ (list label name)
+ #:field input-kind))
+
+ (append-map (match-lambda
+ (((? string? label) (? package? dependency))
+ (if (string=? label (package-name dependency))
+ '()
+ (list (warning label (package-name dependency)))))
+ (((? string? label) (? package? dependency) output)
+ (let ((expected (string-append (package-name dependency)
+ ":" output)))
+ (if (string=? label expected)
+ '()
+ (list (warning label expected)))))
+ (_
+ '()))
+ (package-inputs package)))
+
+ (append-map (match-lambda
+ ((kind proc)
+ (check kind proc)))
+ `((native-inputs ,package-native-inputs)
+ (inputs ,package-inputs)
+ (propagated-inputs ,package-propagated-inputs))))
+
(define (package-name-regexp package)
"Return a regexp that matches PACKAGE's name as a word at the beginning of a
line."
@@ -1583,6 +1615,10 @@ them for PACKAGE."
(name 'inputs-should-not-be-input)
(description "Identify inputs that shouldn't be inputs at all")
(check check-inputs-should-not-be-an-input-at-all))
+ (lint-checker
+ (name 'input-labels)
+ (description "Identify input labels that do not match package names")
+ (check check-input-labels))
(lint-checker
(name 'license)
;; TRANSLATORS: <license> is the name of a data type and must not be
diff --git a/tests/lint.scm b/tests/lint.scm
index 6222c3b15a..0a8f1c6f54 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -356,6 +356,20 @@
`(("python-setuptools" ,python-setuptools))))))
(check-inputs-should-not-be-an-input-at-all pkg))))
+(test-assert "input labels: no warnings"
+ (let ((pkg (dummy-package "x"
+ (inputs `(("glib" ,glib)
+ ("pkg-config" ,pkg-config))))))
+ (null? (check-input-labels pkg))))
+
+(test-equal "input labels: one warning"
+ "label 'pkgkonfig' does not match package name 'pkg-config'"
+ (single-lint-warning-message
+ (let ((pkg (dummy-package "x"
+ (inputs `(("glib" ,glib)
+ ("pkgkonfig" ,pkg-config))))))
+ (check-input-labels pkg))))
+
(test-equal "file patches: different file name -> warning"
"file names of patches should start with the package name"
(single-lint-warning-message
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 04/16] packages: Add 'lookup-package-input' & co.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (2 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 03/16] lint: Add 'input-labels' checker Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 05/16] packages: Add 'modify-inputs' Ludovic Courtès
` (13 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/packages.scm (lookup-input, lookup-package-input)
(lookup-package-native-input, lookup-package-propagated-input)
(lookup-package-direct-input): New procedures.
* doc/guix.texi (package Reference): Document them.
---
doc/guix.texi | 24 ++++++++++++++++++++++++
guix/packages.scm | 34 ++++++++++++++++++++++++++++++++++
2 files changed, 58 insertions(+)
diff --git a/doc/guix.texi b/doc/guix.texi
index 0e5d1a9fa7..d88f857c3a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6817,6 +6817,30 @@ cross-compiling:
It is an error to refer to @code{this-package} outside a package definition.
@end deffn
+The following helper procedures are provided to help deal with package
+inputs.
+
+@deffn {Scheme Procedure} lookup-package-input @var{package} @var{name}
+@deffnx {Scheme Procedure} lookup-package-native-input @var{package} @var{name}
+@deffnx {Scheme Procedure} lookup-package-propagated-input @var{package} @var{name}
+@deffnx {Scheme Procedure} lookup-package-direct-input @var{package} @var{name}
+Look up @var{name} among @var{package}'s inputs (or native, propagated,
+or direct inputs). Return it if found, @code{#f} otherwise.
+
+@var{name} is the name of a package depended on. Here's how you might
+use it:
+
+@lisp
+(use-modules (guix packages) (gnu packages base))
+
+(lookup-package-direct-input coreutils "gmp")
+@result{} #<package gmp@@6.2.1 @dots{}>
+@end lisp
+
+In this example we obtain the @code{gmp} package that is among the
+direct inputs of @code{coreutils}.
+@end deffn
+
Because packages are regular Scheme objects that capture a complete
dependency graph and associated build procedures, it is often useful to
write procedures that take a package and return a modified version
diff --git a/guix/packages.scm b/guix/packages.scm
index 087e6e6a4a..c845026827 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -108,6 +108,11 @@
deprecated-package
package-field-location
+ lookup-package-input
+ lookup-package-native-input
+ lookup-package-propagated-input
+ lookup-package-direct-input
+
package-direct-sources
package-transitive-sources
package-direct-inputs
@@ -889,6 +894,35 @@ preserved, and only duplicate propagated inputs are removed."
((input rest ...)
(loop rest (cons input result) propagated first? seen)))))
+(define (lookup-input inputs name)
+ "Lookup NAME among INPUTS, an input list."
+ ;; Note: Currently INPUTS is assumed to be an input list that contains input
+ ;; labels. In the future, input labels will be gone and this procedure will
+ ;; check package names.
+ (match (assoc-ref inputs name)
+ ((obj) obj)
+ ((obj _) obj)
+ (#f #f)))
+
+(define (lookup-package-input package name)
+ "Look up NAME among PACKAGE's inputs. Return it if found, #f otherwise."
+ (lookup-input (package-inputs package) name))
+
+(define (lookup-package-native-input package name)
+ "Look up NAME among PACKAGE's native inputs. Return it if found, #f
+otherwise."
+ (lookup-input (package-native-inputs package) name))
+
+(define (lookup-package-propagated-input package name)
+ "Look up NAME among PACKAGE's propagated inputs. Return it if found, #f
+otherwise."
+ (lookup-input (package-propagated-inputs package) name))
+
+(define (lookup-package-direct-input package name)
+ "Look up NAME among PACKAGE's direct inputs. Return it if found, #f
+otherwise."
+ (lookup-input (package-direct-inputs package) name))
+
(define (package-direct-sources package)
"Return all source origins associated with PACKAGE; including origins in
PACKAGE's inputs."
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 05/16] packages: Add 'modify-inputs'.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (3 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 04/16] packages: Add 'lookup-package-input' & co Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 06/16] gnu: Change inputs of core packages to plain lists Ludovic Courtès
` (12 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/packages.scm (inputs-sans-labels, replace-input): New procedures.
(prepend, replace, modify-inputs): New macros.
* doc/guix.texi (Defining Package Variants): Document 'modify-inputs'.
* dir-locals.el: Add 'modify-inputs' and its keywords.
---
.dir-locals.el | 6 +++++
doc/guix.texi | 38 ++++++++++++++++++++------
guix/packages.scm | 68 +++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 104 insertions(+), 8 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index 378071ea67..8cddfd7952 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -57,6 +57,12 @@
(eval . (put 'substitute* 'scheme-indent-function 1))
(eval . (put 'match-record 'scheme-indent-function 2))
+ ;; 'modify-inputs' and its keywords.
+ (eval . (put 'modify-inputs 'scheme-indent-function 1))
+ (eval . (put 'replace 'scheme-indent-function 1))
+ (eval . (put 'prepend 'scheme-indent-function 2))
+ (eval . (put 'append 'scheme-indent-function 2))
+
;; 'modify-phases' and its keywords.
(eval . (put 'modify-phases 'scheme-indent-function 1))
(eval . (put 'replace 'scheme-indent-function 1))
diff --git a/doc/guix.texi b/doc/guix.texi
index d88f857c3a..939b092a55 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7120,20 +7120,42 @@ optional dependency, you can define a variant that removes that
dependency like so:
@lisp
-(use-modules (gnu packages gdb) ;for 'gdb'
- (srfi srfi-1)) ;for 'alist-delete'
+(use-modules (gnu packages gdb)) ;for 'gdb'
(define gdb-sans-guile
(package
(inherit gdb)
- (inputs (alist-delete "guile"
- (package-inputs gdb)))))
+ (inputs (modify-inputs (package-inputs gdb)
+ (delete "guile")))))
@end lisp
-The @code{alist-delete} call above removes the tuple from the
-@code{inputs} field that has @code{"guile"} as its first element
-(@pxref{SRFI-1 Association Lists,,, guile, GNU Guile Reference
-Manual}).
+The @code{modify-inputs} form above removes the @code{"guile"} package
+from the @code{inputs} field of @code{gdb}. The @code{modify-inputs}
+macro is a helper that can prove useful anytime you want to remove, add,
+or replace package inputs.
+
+@deffn {Scheme Syntax} modify-inputs @var{inputs} @var{clauses}
+Modify the given package inputs, as returned by @code{package-inputs} & co.,
+according to the given clauses. The example below removes the GMP and ACL
+inputs of Coreutils and adds libcap to the back of the input list:
+
+@lisp
+(modify-inputs (package-inputs coreutils)
+ (delete "gmp" "acl")
+ (append libcap))
+@end lisp
+
+The example below replaces the @code{guile} package from the inputs of
+@code{guile-redis} with @code{guile-2.2}:
+
+@lisp
+(modify-inputs (package-inputs guile-redis)
+ (replace "guile" guile-2.2))
+@end lisp
+
+The last type of clause is @code{prepend}, to add inputs to the front of
+the list.
+@end deffn
In some cases, you may find it useful to write functions
(``procedures'', in Scheme parlance) that return a package based on some
diff --git a/guix/packages.scm b/guix/packages.scm
index c845026827..4ac1624ce2 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -55,6 +55,7 @@
#:re-export (%current-system
%current-target-system
search-path-specification) ;for convenience
+ #:re-export-and-replace (delete) ;used as syntactic keyword
#:export (content-hash
content-hash?
content-hash-algorithm
@@ -113,6 +114,10 @@
lookup-package-propagated-input
lookup-package-direct-input
+ prepend ;syntactic keyword
+ replace ;syntactic keyword
+ modify-inputs
+
package-direct-sources
package-transitive-sources
package-direct-inputs
@@ -923,6 +928,69 @@ otherwise."
otherwise."
(lookup-input (package-direct-inputs package) name))
+(define (inputs-sans-labels inputs)
+ "Return INPUTS stripped of any input labels."
+ (map (match-lambda
+ ((label obj) obj)
+ ((label obj output) `(,obj ,output)))
+ inputs))
+
+(define (replace-input name replacement inputs)
+ "Replace input NAME by REPLACEMENT within INPUTS."
+ (map (lambda (input)
+ (match input
+ (((? string? label) . _)
+ (if (string=? label name)
+ (match replacement ;does REPLACEMENT specify an output?
+ ((_ _) (cons label replacement))
+ (_ (list label replacement)))
+ input))))
+ inputs))
+
+(define-syntax prepend
+ (lambda (s)
+ (syntax-violation 'prepend
+ "'prepend' may only be used within 'modify-inputs'"
+ s)))
+
+(define-syntax replace
+ (lambda (s)
+ (syntax-violation 'replace
+ "'replace' may only be used within 'modify-inputs'"
+ s)))
+
+(define-syntax modify-inputs
+ (syntax-rules (delete prepend append replace)
+ "Modify the given package inputs, as returned by 'package-inputs' & co.,
+according to the given clauses. The example below removes the GMP and ACL
+inputs of Coreutils and adds libcap:
+
+ (modify-inputs (package-inputs coreutils)
+ (delete \"gmp\" \"acl\")
+ (append libcap))
+
+Other types of clauses include 'prepend' and 'replace'."
+ ;; Note: This macro hides the fact that INPUTS, as returned by
+ ;; 'package-inputs' & co., is actually an alist with labels. Eventually,
+ ;; it will operate on list of inputs without labels.
+ ((_ inputs (delete name) clauses ...)
+ (modify-inputs (alist-delete name inputs)
+ clauses ...))
+ ((_ inputs (delete names ...) clauses ...)
+ (modify-inputs (fold alist-delete inputs (list names ...))
+ clauses ...))
+ ((_ inputs (prepend lst ...) clauses ...)
+ (modify-inputs (append (list lst ...) (inputs-sans-labels inputs))
+ clauses ...))
+ ((_ inputs (append lst ...) clauses ...)
+ (modify-inputs (append (inputs-sans-labels inputs) (list lst ...))
+ clauses ...))
+ ((_ inputs (replace name replacement) clauses ...)
+ (modify-inputs (replace-input name replacement inputs)
+ clauses ...))
+ ((_ inputs)
+ inputs)))
+
(define (package-direct-sources package)
"Return all source origins associated with PACKAGE; including origins in
PACKAGE's inputs."
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 06/16] gnu: Change inputs of core packages to plain lists.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (4 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 05/16] packages: Add 'modify-inputs' Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 07/16] utils: 'edit-expression' no longer leaks file ports Ludovic Courtès
` (11 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
This is transparent: the resulting derivations are unchanged.
* gnu/packages/base.scm (grep, sed, tar, patch, diffutils, glibc/hurd-headers)
(coreutils, gnu-make, make-glibc-utf8-locales): Change input fields to
plain package lists and use 'modify-inputs'.
* gnu/packages/guile.scm (guile-1.8, guile-json-1, guile-json-3)
(guile-gdbm-ffi, guile-sqlite3, guile-bytestructures)
(guile-git, guile-zlib, guile-lzlib, guile-zstd, guile-next): Likewise.
* gnu/packages/mes.scm (nyacc-0.86, nyacc-0.99)
(nyacc, nyacc-1.00.2, mes-0.19, mes, m2-planet): Likewise.
---
gnu/packages/base.scm | 48 +++++++++----------
gnu/packages/guile.scm | 103 ++++++++++++-----------------------------
gnu/packages/mes.scm | 25 ++++------
3 files changed, 59 insertions(+), 117 deletions(-)
diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm
index edc4c4a427..96cd2b699c 100644
--- a/gnu/packages/base.scm
+++ b/gnu/packages/base.scm
@@ -109,8 +109,8 @@ command-line arguments, multiple languages, and so on.")
"0gipv6bzkm1aihj0ncqpyh164xrzgcxcv9r1kwzyk2g1mzl1azk6"))
(patches (search-patches "grep-timing-sensitive-test.patch"))))
(build-system gnu-build-system)
- (native-inputs `(("perl" ,perl))) ;some of the tests require it
- (inputs `(("pcre" ,pcre)))
+ (native-inputs (list perl)) ;some of the tests require it
+ (inputs (list pcre))
(arguments
`(#:phases
(modify-phases %standard-phases
@@ -161,8 +161,7 @@ including, for example, recursive directory searching.")
(modules '((guix build utils)))))
(build-system gnu-build-system)
(synopsis "Stream editor")
- (native-inputs
- `(("perl" ,perl))) ;for tests
+ (native-inputs (list perl)) ;for tests
(description
"Sed is a non-interactive, text stream editor. It receives a text
input from a file or from standard input and it then applies a series of text
@@ -215,7 +214,7 @@ implementation offers several extensions over the standard utility.")
;; When cross-compiling, the 'set-shell-file-name' phase needs to be able
;; to refer to the target Bash.
(inputs (if (%current-target-system)
- `(("bash" ,bash))
+ (list bash)
'()))
(synopsis "Managing tar archives")
@@ -248,7 +247,7 @@ standard utility.")
(if (%current-target-system)
`(#:configure-flags '("gl_cv_func_working_mktime=yes"))
'()))
- (native-inputs `(("ed" ,ed)))
+ (native-inputs (list ed))
(synopsis "Apply differences to originals, with optional backups")
(description
"Patch is a program that applies changes to files based on differences
@@ -271,7 +270,7 @@ differences.")
(base32
"09isrg0isjinv8c535nxsi1s86wfdfzml80dbw41dj9x3hiad9xk"))))
(build-system gnu-build-system)
- (native-inputs `(("perl" ,perl)))
+ (native-inputs (list perl))
(synopsis "Comparing and merging files")
(description
"GNU Diffutils is a package containing tools for finding the
@@ -330,16 +329,16 @@ used to apply commands with arbitrarily long arguments.")
"1yjcrh5hw70c0yn8zw55pd6j51dj90anpq8mmg649ps9g3gdhn24"))
(patches (search-patches "coreutils-ls.patch"))))
(build-system gnu-build-system)
- (inputs `(("acl" ,acl) ; TODO: add SELinux
- ("attr" ,attr) ;for xattrs in ls, mv, etc
- ("gmp" ,gmp) ;bignums in 'expr', yay!
+ (inputs `(,acl ;TODO: add SELinux
+ ,attr ;for xattrs in ls, mv, etc
+ ,gmp ;bignums in 'expr', yay!
;; Do not use libcap when cross-compiling since it's not quite
;; cross-compilable; and use it only for supported systems.
,@(if (and (not (%current-target-system))
(member (%current-system)
(package-supported-systems libcap)))
- `(("libcap" ,libcap)) ;capability support in 'ls', etc.
+ `(,libcap) ;capability support in 'ls', etc.
'())))
(native-inputs
;; Perl is needed to run tests in native builds, and to run the bundled
@@ -348,7 +347,7 @@ used to apply commands with arbitrarily long arguments.")
;; for help2man.
(if (%current-target-system)
'()
- `(("perl" ,perl))))
+ (list perl)))
(outputs '("out" "debug"))
(arguments
`(#:parallel-build? #f ; help2man may be called too early
@@ -447,8 +446,8 @@ standard.")
"06cfqzpqsvdnsxbysl5p2fgdgxgl9y4p7scpnrfa8z2zgkjdspz0"))
(patches (search-patches "make-impure-dirs.patch"))))
(build-system gnu-build-system)
- (native-inputs `(("pkg-config" ,pkg-config))) ; to detect Guile
- (inputs `(("guile" ,guile-3.0)))
+ (native-inputs (list pkg-config)) ;to detect Guile
+ (inputs (list guile-3.0))
(outputs '("out" "debug"))
(arguments
`(,@(if (hurd-target?)
@@ -1152,8 +1151,7 @@ to the @code{share/locale} sub-directory of this package.")
locale ".UTF-8")))
',locales)
#t))))
- (native-inputs `(("glibc" ,glibc)
- ("gzip" ,gzip)))
+ (native-inputs (list glibc gzip))
(synopsis (if default-locales?
(P_ "Small sample of UTF-8 locales")
(P_ "Customized sample of UTF-8 locales")))
@@ -1206,17 +1204,15 @@ command.")
(package (inherit glibc)
(name "glibc-hurd-headers")
(outputs '("out"))
- (propagated-inputs `(("gnumach-headers" ,gnumach-headers)
- ("hurd-headers" ,hurd-headers)))
+ (propagated-inputs (list gnumach-headers hurd-headers))
(native-inputs
- `(("mig" ,(if (%current-target-system)
- ;; XXX: When targeting i586-pc-gnu, we need a 32-bit MiG,
- ;; hence this hack.
- (package
- (inherit mig)
- (arguments `(#:system "i686-linux")))
- mig))
- ,@(package-native-inputs glibc)))
+ (modify-inputs (package-native-inputs glibc)
+ (prepend (if (%current-target-system)
+ ;; XXX: When targeting i586-pc-gnu, we need a 32-bit MiG,
+ ;; hence this hack.
+ (package (inherit mig)
+ (arguments `(#:system "i686-linux")))
+ mig))))
(arguments
(substitute-keyword-arguments (package-arguments glibc)
;; We just pass the flags really needed to build the headers.
diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index 0012d919c8..5a3e138fac 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -112,13 +112,11 @@
`(("self" ,this-package))
'()))
- (inputs `(("gawk" ,gawk)
- ("readline" ,readline)))
+ (inputs (list gawk readline))
;; Since `guile-1.8.pc' has "Libs: ... -lgmp -lltdl", these must be
;; propagated.
- (propagated-inputs `(("gmp" ,gmp)
- ("libltdl" ,libltdl)))
+ (propagated-inputs (list gmp libltdl))
(native-search-paths
(list (search-path-specification
@@ -403,14 +401,14 @@ without requiring the source code to be rewritten.")
(delete-file "test-suite/tests/version.test")
#t))))))
(native-inputs
- `(("autoconf" ,autoconf)
- ("automake" ,automake)
- ("libtool" ,libtool)
- ("flex" ,flex)
- ("gettext" ,gnu-gettext)
- ("texinfo" ,texinfo)
- ("gperf" ,gperf)
- ,@(package-native-inputs guile-3.0)))
+ (modify-inputs (package-native-inputs guile-3.0)
+ (prepend autoconf
+ automake
+ libtool
+ flex
+ gnu-gettext
+ texinfo
+ gperf)))
(synopsis "Development version of GNU Guile"))))
(define* (make-guile-readline guile #:optional (name "guile-readline"))
@@ -596,9 +594,8 @@ GNU@tie{}Guile. Use the @code{(ice-9 readline)} module and call its
(build-system gnu-build-system)
(arguments
`(#:make-flags '("GUILE_AUTO_COMPILE=0"))) ;to prevent guild warnings
- (native-inputs `(("pkg-config" ,pkg-config)
- ("guile" ,guile-2.2)))
- (inputs `(("guile" ,guile-2.2)))
+ (native-inputs (list pkg-config guile-2.2))
+ (inputs (list guile-2.2))
(synopsis "JSON module for Guile")
(description
"Guile-JSON supports parsing and building JSON documents according to the
@@ -636,9 +633,8 @@ specification. These are the main features:
(sha256
(base32
"0nj0684qgh6ppkbdyxqfyjwsv2qbyairxpi8fzrhsi3xnc7jn4im"))))
- (native-inputs `(("pkg-config" ,pkg-config)
- ("guile" ,guile-3.0)))
- (inputs `(("guile" ,guile-3.0)))))
+ (native-inputs (list pkg-config guile-3.0))
+ (inputs (list guile-3.0))))
(define-public guile3.0-json
(deprecated-package "guile3.0-json" guile-json-3))
@@ -697,10 +693,8 @@ specification. These are the main features:
(format #f "(dynamic-link \"~a/lib/libgdbm.so\")"
(assoc-ref inputs "gdbm"))))
#t)))))
- (native-inputs
- `(("guile" ,guile-3.0)))
- (inputs
- `(("gdbm" ,gdbm)))
+ (native-inputs (list guile-3.0))
+ (inputs (list gdbm))
(home-page "https://github.com/ijp/guile-gdbm")
(synopsis "Guile bindings to the GDBM library via Guile's FFI")
(description
@@ -731,14 +725,8 @@ Guile's foreign function interface.")
"1nryy9j3bk34i0alkmc9bmqsm0ayz92k1cdf752mvhyjjn8nr928"))
(file-name (string-append name "-" version "-checkout"))))
(build-system gnu-build-system)
- (native-inputs
- `(("autoconf" ,autoconf)
- ("automake" ,automake)
- ("guile" ,guile-3.0)
- ("pkg-config" ,pkg-config)))
- (inputs
- `(("guile" ,guile-3.0)
- ("sqlite" ,sqlite)))
+ (native-inputs (list autoconf automake guile-3.0 pkg-config))
+ (inputs (list guile-3.0 sqlite))
(synopsis "Access SQLite databases from Guile")
(description
"This package provides Guile bindings to the SQLite database system.")
@@ -778,13 +766,8 @@ Guile's foreign function interface.")
(doc (string-append out "/share/doc/" package)))
(install-file "README.md" doc)
#t))))))
- (native-inputs
- `(("autoconf" ,autoconf)
- ("automake" ,automake)
- ("pkg-config" ,pkg-config)
- ("guile" ,guile-3.0)))
- (inputs
- `(("guile" ,guile-3.0)))
+ (native-inputs (list autoconf automake pkg-config guile-3.0))
+ (inputs (list guile-3.0))
(synopsis "Structured access to bytevector contents for Guile")
(description
"Guile bytestructures offers a system imitating the type system
@@ -821,17 +804,11 @@ type system, elevating types to first-class status.")
(arguments
`(#:make-flags '("GUILE_AUTO_COMPILE=0"))) ; to prevent guild warnings
(native-inputs
- `(("pkg-config" ,pkg-config)
- ("autoconf" ,autoconf)
- ("automake" ,automake)
- ("texinfo" ,texinfo)
- ("guile" ,guile-3.0)
- ("guile-bytestructures" ,guile-bytestructures)))
+ (list pkg-config autoconf automake texinfo guile-3.0 guile-bytestructures))
(inputs
- `(("guile" ,guile-3.0)
- ("libgit2" ,libgit2)))
+ (list guile-3.0 libgit2))
(propagated-inputs
- `(("guile-bytestructures" ,guile-bytestructures)))
+ (list guile-bytestructures))
(synopsis "Guile bindings for libgit2")
(description
"This package provides Guile bindings to libgit2, a library to
@@ -868,16 +845,8 @@ manipulate repositories of the Git version control system.")
(arguments
'(#:make-flags
'("GUILE_AUTO_COMPILE=0"))) ;to prevent guild warnings
- (native-inputs
- `(("autoconf" ,autoconf)
- ("automake" ,automake)
- ("pkg-config" ,pkg-config)
- ,@(if (%current-target-system)
- `(("guile" ,guile-3.0)) ;for 'guild compile' and 'guile-3.0.pc'
- '())))
- (inputs
- `(("guile" ,guile-3.0)
- ("zlib" ,zlib)))
+ (native-inputs (list autoconf automake pkg-config guile-3.0))
+ (inputs (list guile-3.0 zlib))
(synopsis "Guile bindings to zlib")
(description
"This package provides Guile bindings for zlib, a lossless
@@ -907,16 +876,8 @@ Guile's foreign function interface.")
(arguments
'(#:make-flags
'("GUILE_AUTO_COMPILE=0"))) ;to prevent guild warnings
- (native-inputs
- `(("autoconf" ,autoconf)
- ("automake" ,automake)
- ("pkg-config" ,pkg-config)
- ,@(if (%current-target-system)
- `(("guile" ,guile-3.0)) ;for 'guild compile' and 'guile-3.0.pc'
- '())))
- (inputs
- `(("guile" ,guile-3.0)
- ("lzlib" ,lzlib)))
+ (native-inputs (list autoconf automake pkg-config guile-3.0))
+ (inputs (list guile-3.0 lzlib))
(synopsis "Guile bindings to lzlib")
(description
"This package provides Guile bindings for lzlib, a C library for
@@ -942,14 +903,8 @@ pure Scheme by using Guile's foreign function interface.")
(base32
"1c8l7829b5yx8wdc0mrhzjfwb6h9hb7cd8dfxcr71a7vlsi86310"))))
(build-system gnu-build-system)
- (native-inputs
- `(("autoconf" ,autoconf)
- ("automake" ,automake)
- ("pkg-config" ,pkg-config)
- ("guile" ,guile-3.0)))
- (inputs
- `(("zstd" ,zstd "lib")
- ("guile" ,guile-3.0)))
+ (native-inputs (list autoconf automake pkg-config guile-3.0))
+ (inputs (list `(,zstd "lib") guile-3.0))
(synopsis "GNU Guile bindings to the zstd compression library")
(description
"This package provides a GNU Guile interface to the zstd (``zstandard'')
diff --git a/gnu/packages/mes.scm b/gnu/packages/mes.scm
index 2defb45ff1..ab41fc7055 100644
--- a/gnu/packages/mes.scm
+++ b/gnu/packages/mes.scm
@@ -56,8 +56,7 @@
(base32
"0lkd9lyspvhxlfs0496gsllwinh62jk9wij6gpadvx9gwz6yavd9"))))
(build-system gnu-build-system)
- (native-inputs
- `(("guile" ,guile-2.2)))
+ (native-inputs (list guile-2.2))
(synopsis "LALR(1) Parser Generator in Guile")
(description
"NYACC is an LALR(1) parser generator implemented in Guile.
@@ -92,10 +91,8 @@ extensive examples, including parsers for the Javascript and C99 languages.")
(("^DOCDIR =.*")
"DOCDIR = @prefix@/share/doc/$(PACKAGE_TARNAME)\n"))
#t))))
- (native-inputs
- `(("pkg-config" ,pkg-config)))
- (inputs
- `(("guile" ,guile-2.2)))))
+ (native-inputs (list pkg-config))
+ (inputs (list guile-2.2))))
(define-public nyacc
(package
@@ -116,8 +113,7 @@ extensive examples, including parsers for the Javascript and C99 languages.")
"GUILE_GLOBAL_SITE=\
$prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION\n"))
#t))))
- (inputs
- `(("guile" ,guile-3.0)))))
+ (inputs (list guile-3.0))))
(define-public nyacc-1.00.2
(package
@@ -145,8 +141,7 @@ $prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION\n"))
(sha256
(base32
"065ksalfllbdrzl12dz9d9dcxrv97wqxblslngsc6kajvnvlyvpk"))))
- (inputs
- `(("guile" ,guile-2.2)))))
+ (inputs (list guile-2.2))))
(define-public mes-0.19
;; Mes used for bootstrap.
@@ -162,9 +157,7 @@ $prefix/share/guile/site/$GUILE_EFFECTIVE_VERSION\n"))
"15h4yhaywdc0djpjlin2jz1kzahpqxfki0r0aav1qm9nxxmnp1l0"))))
(build-system gnu-build-system)
(supported-systems '("i686-linux" "x86_64-linux"))
- (propagated-inputs
- `(("mescc-tools" ,mescc-tools-0.5.2)
- ("nyacc" ,nyacc-0.86)))
+ (propagated-inputs (list mescc-tools-0.5.2 nyacc-0.86))
(native-inputs
`(("guile" ,guile-2.2)
,@(let ((target-system (or (%current-target-system)
@@ -205,9 +198,7 @@ Guile.")
(base32
"0mnryfkl0dwbr5gxp16j5s95gw7z1vm1fqa1pxabp0aiar1hw53s"))))
(supported-systems '("armhf-linux" "i686-linux" "x86_64-linux"))
- (propagated-inputs
- `(("mescc-tools" ,mescc-tools)
- ("nyacc" ,nyacc-1.00.2)))
+ (propagated-inputs (list mescc-tools nyacc-1.00.2))
(native-search-paths
(list (search-path-specification
(variable "C_INCLUDE_PATH")
@@ -377,7 +368,7 @@ get_machine.")
(base32
"0yyc0fcbbxi9jqa1n76x0rwspdrwmc8g09jlmsw9c35nflrhmz8q"))))
(native-inputs
- `(("mescc-tools" ,mescc-tools)))
+ (list mescc-tools))
(build-system gnu-build-system)
(arguments
`(#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out")))
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 07/16] utils: 'edit-expression' no longer leaks file ports.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (5 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 06/16] gnu: Change inputs of core packages to plain lists Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 08/16] utils: Add 'go-to-location' with source location caching Ludovic Courtès
` (10 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/utils.scm (edit-expression): Use 'call-with-input-file' to make
sure IN gets closed.
---
guix/utils.scm | 64 ++++++++++++++++++++++++++------------------------
1 file changed, 33 insertions(+), 31 deletions(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index 19990ceb8a..a13b13c4fa 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -342,38 +342,40 @@ a list of command-line arguments passed to the compression program."
be a procedure that takes the original expression in string and returns a new
one. ENCODING will be used to interpret all port I/O, it default to UTF-8.
This procedure returns #t on success."
+ (define file (assq-ref source-properties 'filename))
+ (define line (assq-ref source-properties 'line))
+ (define column (assq-ref source-properties 'column))
+
(with-fluids ((%default-port-encoding encoding))
- (let* ((file (assq-ref source-properties 'filename))
- (line (assq-ref source-properties 'line))
- (column (assq-ref source-properties 'column))
- (in (open-input-file file))
- ;; The start byte position of the expression.
- (start (begin (while (not (and (= line (port-line in))
- (= column (port-column in))))
- (when (eof-object? (read-char in))
- (error (format #f "~a: end of file~%" in))))
- (ftell in)))
- ;; The end byte position of the expression.
- (end (begin (read in) (ftell in))))
- (seek in 0 SEEK_SET) ; read from the beginning of the file.
- (let* ((pre-bv (get-bytevector-n in start))
- ;; The expression in string form.
- (str (iconv:bytevector->string
- (get-bytevector-n in (- end start))
- (port-encoding in)))
- (post-bv (get-bytevector-all in))
- (str* (proc str)))
- ;; Verify the edited expression is still a scheme expression.
- (call-with-input-string str* read)
- ;; Update the file with edited expression.
- (with-atomic-file-output file
- (lambda (out)
- (put-bytevector out pre-bv)
- (display str* out)
- ;; post-bv maybe the end-of-file object.
- (when (not (eof-object? post-bv))
- (put-bytevector out post-bv))
- #t))))))
+ (call-with-input-file file
+ (lambda (in)
+ (let* ( ;; The start byte position of the expression.
+ (start (begin (while (not (and (= line (port-line in))
+ (= column (port-column in))))
+ (when (eof-object? (read-char in))
+ (error (format #f "~a: end of file~%" in))))
+ (ftell in)))
+ ;; The end byte position of the expression.
+ (end (begin (read in) (ftell in))))
+ (seek in 0 SEEK_SET) ; read from the beginning of the file.
+ (let* ((pre-bv (get-bytevector-n in start))
+ ;; The expression in string form.
+ (str (iconv:bytevector->string
+ (get-bytevector-n in (- end start))
+ (port-encoding in)))
+ (post-bv (get-bytevector-all in))
+ (str* (proc str)))
+ ;; Verify the edited expression is still a scheme expression.
+ (call-with-input-string str* read)
+ ;; Update the file with edited expression.
+ (with-atomic-file-output file
+ (lambda (out)
+ (put-bytevector out pre-bv)
+ (display str* out)
+ ;; post-bv maybe the end-of-file object.
+ (when (not (eof-object? post-bv))
+ (put-bytevector out post-bv))
+ #t))))))))
\f
;;;
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 08/16] utils: Add 'go-to-location' with source location caching.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (6 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 07/16] utils: 'edit-expression' no longer leaks file ports Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 09/16] utils: 'edit-expression' modifies the file only if necessary Ludovic Courtès
` (9 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/utils.scm (%source-location-map): New variable.
(go-to-location): New procedure.
(edit-expression): Use it instead of custom loop.
* guix/packages.scm (package-field-location)[goto]: Remove.
Use 'go-to-location' instead of 'goto'.
---
guix/packages.scm | 8 +-----
guix/utils.scm | 66 ++++++++++++++++++++++++++++++++++++++++++++---
2 files changed, 63 insertions(+), 11 deletions(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index 4ac1624ce2..d15a17edc0 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -514,12 +514,6 @@ object."
(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 (goto port line column)
- (unless (and (= (port-column port) (- column 1))
- (= (port-line port) (- line 1)))
- (unless (eof-object? (read-char port))
- (goto port line column))))
-
(match (package-location package)
(($ <location> file line column)
(match (search-path %load-path file)
@@ -529,7 +523,7 @@ object."
;; In general we want to keep relative file names for modules.
(call-with-input-file file-found
(lambda (port)
- (goto port line column)
+ (go-to-location port line column)
(match (read port)
(('package inits ...)
(let ((field (assoc field inits)))
diff --git a/guix/utils.scm b/guix/utils.scm
index a13b13c4fa..f8f6672bb1 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -49,6 +49,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module ((ice-9 iconv) #:prefix iconv:)
+ #:use-module (ice-9 vlist)
#:autoload (zlib) (make-zlib-input-port make-zlib-output-port)
#:use-module (system foreign)
#:re-export (<location> ;for backwards compatibility
@@ -117,6 +118,7 @@
cache-directory
readlink*
+ go-to-location
edit-expression
filtered-port
@@ -337,6 +339,65 @@ a list of command-line arguments passed to the compression program."
(unless (every (compose zero? cdr waitpid) pids)
(error "compressed-output-port failure" pids))))))
+(define %source-location-map
+ ;; Maps inode/device tuples to "source location maps" used by
+ ;; 'go-to-location'.
+ (make-hash-table))
+
+(define (go-to-location port line column)
+ "Jump to LINE and COLUMN (both one-indexed) in PORT. Maintain a source
+location map such that this can boil down to seek(2) and a few read(2) calls,
+which can drastically speed up repetitive operations on large files."
+ (let* ((stat (stat port))
+ (key (list (stat:ino stat) (stat:dev stat)))
+ (stamp (list (stat:mtime stat) (stat:mtimensec stat)
+ (stat:size stat)))
+
+ ;; Look for an up-to-date source map for KEY. The map is a vlist
+ ;; where each entry gives the byte offset of the beginning of a line:
+ ;; element 0 is the offset of the first line, element 1 the offset of
+ ;; the second line, etc. The map is filled lazily.
+ (source-map (match (hash-ref %source-location-map key)
+ (#f
+ (vlist-cons 0 vlist-null))
+ ((cache-stamp ... map)
+ (if (equal? cache-stamp stamp) ;invalidate?
+ map
+ (vlist-cons 0 vlist-null)))))
+ (last (vlist-length source-map)))
+ ;; Jump to LINE, ideally via SOURCE-MAP.
+ (if (<= line last)
+ (seek port (vlist-ref source-map (- line 1)) SEEK_SET)
+ (let ((target line)
+ (offset (vlist-ref source-map (- last 1))))
+ (seek port offset SEEK_SET)
+ (let loop ((source-map (vlist-reverse source-map))
+ (line last))
+ (if (< line target)
+ (match (read-char port)
+ (#\newline
+ (loop (vlist-cons (ftell port) source-map)
+ (+ 1 line)))
+ ((? eof-object?)
+ (error "unexpected end of file" port line))
+ (chr (loop source-map line)))
+ (hash-set! %source-location-map key
+ `(,@stamp
+ ,(vlist-reverse source-map)))))))
+
+ ;; Read up to COLUMN.
+ (let ((target column))
+ (let loop ((column 1))
+ (when (< column target)
+ (match (read-char port)
+ (#\newline (error "unexpected end of line" port))
+ (#\tab (loop (+ 8 column)))
+ (chr (loop (+ 1 column)))))))
+
+ ;; Update PORT's position info.
+ (set-port-line! port (- line 1))
+ (set-port-column! port (- column 1))))
+
(define* (edit-expression source-properties proc #:key (encoding "UTF-8"))
"Edit the expression specified by SOURCE-PROPERTIES using PROC, which should
be a procedure that takes the original expression in string and returns a new
@@ -350,10 +411,7 @@ This procedure returns #t on success."
(call-with-input-file file
(lambda (in)
(let* ( ;; The start byte position of the expression.
- (start (begin (while (not (and (= line (port-line in))
- (= column (port-column in))))
- (when (eof-object? (read-char in))
- (error (format #f "~a: end of file~%" in))))
+ (start (begin (go-to-location in (+ 1 line) (+ 1 column))
(ftell in)))
;; The end byte position of the expression.
(end (begin (read in) (ftell in))))
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 09/16] utils: 'edit-expression' modifies the file only if necessary.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (7 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 08/16] utils: Add 'go-to-location' with source location caching Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 10/16] utils: 'edit-expression' copies part of the original source map Ludovic Courtès
` (8 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/utils.scm (edit-expression): Check whether STR* equals STR.
---
guix/utils.scm | 24 +++++++++++++-----------
1 file changed, 13 insertions(+), 11 deletions(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index f8f6672bb1..e6d0761679 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -423,17 +423,19 @@ This procedure returns #t on success."
(port-encoding in)))
(post-bv (get-bytevector-all in))
(str* (proc str)))
- ;; Verify the edited expression is still a scheme expression.
- (call-with-input-string str* read)
- ;; Update the file with edited expression.
- (with-atomic-file-output file
- (lambda (out)
- (put-bytevector out pre-bv)
- (display str* out)
- ;; post-bv maybe the end-of-file object.
- (when (not (eof-object? post-bv))
- (put-bytevector out post-bv))
- #t))))))))
+ ;; Modify FILE only if there are changes.
+ (unless (string=? str* str)
+ ;; Verify the edited expression is still a scheme expression.
+ (call-with-input-string str* read)
+ ;; Update the file with edited expression.
+ (with-atomic-file-output file
+ (lambda (out)
+ (put-bytevector out pre-bv)
+ (display str* out)
+ ;; post-bv maybe the end-of-file object.
+ (when (not (eof-object? post-bv))
+ (put-bytevector out post-bv))
+ #t)))))))))
\f
;;;
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 10/16] utils: 'edit-expression' copies part of the original source map.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (8 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 09/16] utils: 'edit-expression' modifies the file only if necessary Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 11/16] Add 'guix style' Ludovic Courtès
` (7 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/utils.scm (source-location-key/stamp): New procedure.
(go-to-location): Use it.
(move-source-location-map!): New procedure.
(edit-expression): Call it.
---
guix/utils.scm | 37 ++++++++++++++++++++++++++++++++-----
1 file changed, 32 insertions(+), 5 deletions(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index e6d0761679..65d709a01f 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -34,6 +34,7 @@
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-39)
+ #:use-module (srfi srfi-71)
#:use-module (ice-9 ftw)
#:use-module (rnrs io ports) ;need 'port-position' etc.
#:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
@@ -344,14 +345,20 @@ a list of command-line arguments passed to the compression program."
;; 'go-to-location'.
(make-hash-table))
-(define (go-to-location port line column)
+(define (source-location-key/stamp stat)
+ "Return two values: the key for STAT in %SOURCE-LOCATION-MAP, and a stamp
+used to invalidate corresponding entries."
+ (let ((key (list (stat:ino stat) (stat:dev stat)))
+ (stamp (list (stat:mtime stat) (stat:mtimensec stat)
+ (stat:size stat))))
+ (values key stamp)))
+
+(define* (go-to-location port line column)
"Jump to LINE and COLUMN (both one-indexed) in PORT. Maintain a source
location map such that this can boil down to seek(2) and a few read(2) calls,
which can drastically speed up repetitive operations on large files."
(let* ((stat (stat port))
- (key (list (stat:ino stat) (stat:dev stat)))
- (stamp (list (stat:mtime stat) (stat:mtimensec stat)
- (stat:size stat)))
+ (key stamp (source-location-key/stamp stat))
;; Look for an up-to-date source map for KEY. The map is a vlist
;; where each entry gives the byte offset of the beginning of a line:
@@ -398,6 +405,20 @@ which can drastically speed up repetitive operations on large files."
(set-port-line! port (- line 1))
(set-port-column! port (- column 1))))
+(define (move-source-location-map! source target line)
+ "Move the source location map from SOURCE up to LINE to TARGET. SOURCE and
+TARGET must be stat buffers as returned by 'stat'."
+ (let* ((source-key (source-location-key/stamp source))
+ (target-key target-stamp (source-location-key/stamp target)))
+ (match (hash-ref %source-location-map source-key)
+ (#f #t)
+ ((_ ... source-map)
+ ;; Strip the source map and update the associated stamp.
+ (let ((source-map (vlist-take source-map (max line 1))))
+ (hash-remove! %source-location-map source-key)
+ (hash-set! %source-location-map target-key
+ `(,@target-stamp ,source-map)))))))
+
(define* (edit-expression source-properties proc #:key (encoding "UTF-8"))
"Edit the expression specified by SOURCE-PROPERTIES using PROC, which should
be a procedure that takes the original expression in string and returns a new
@@ -435,7 +456,13 @@ This procedure returns #t on success."
;; post-bv maybe the end-of-file object.
(when (not (eof-object? post-bv))
(put-bytevector out post-bv))
- #t)))))))))
+ #t))
+
+ ;; Due to 'with-atomic-file-output', IN and FILE no longer share
+ ;; the same inode, but we can reassign the source map up to LINE
+ ;; to the new file.
+ (move-source-location-map! (stat in) (stat file)
+ (+ 1 line)))))))))
\f
;;;
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 11/16] Add 'guix style'.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (9 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 10/16] utils: 'edit-expression' copies part of the original source map Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-07-01 14:13 ` zimoun
2021-06-30 20:48 ` [bug#49169] [PATCH v2 12/16] packages: 'hidden-package' inherits the original package location Ludovic Courtès
` (6 subsequent siblings)
17 siblings, 1 reply; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/scripts/style.scm, tests/style.scm: New files.
* Makefile.am (MODULES, SCM_TESTS): Add them.
* po/guix/POTFILES.in: Add 'guix/scripts/style.scm'.
* doc/guix.texi (Invoking guix style): New node.
(package Reference): Reference it.
(Invoking guix lint): Likewise.
---
Makefile.am | 2 +
doc/guix.texi | 100 +++++++-
guix/scripts/style.scm | 527 +++++++++++++++++++++++++++++++++++++++++
po/guix/POTFILES.in | 1 +
tests/style.scm | 366 ++++++++++++++++++++++++++++
5 files changed, 994 insertions(+), 2 deletions(-)
create mode 100644 guix/scripts/style.scm
create mode 100644 tests/style.scm
diff --git a/Makefile.am b/Makefile.am
index 05f013e3c2..7d5f6a7fa2 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -286,6 +286,7 @@ MODULES = \
guix/scripts/refresh.scm \
guix/scripts/repl.scm \
guix/scripts/describe.scm \
+ guix/scripts/style.scm \
guix/scripts/system.scm \
guix/scripts/system/search.scm \
guix/scripts/system/reconfigure.scm \
@@ -500,6 +501,7 @@ SCM_TESTS = \
tests/swh.scm \
tests/syscalls.scm \
tests/system.scm \
+ tests/style.scm \
tests/texlive.scm \
tests/transformations.scm \
tests/ui.scm \
diff --git a/doc/guix.texi b/doc/guix.texi
index 939b092a55..dffec903a3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -286,6 +286,7 @@ Utilities
* Invoking guix hash:: Computing the cryptographic hash of a file.
* Invoking guix import:: Importing package definitions.
* Invoking guix refresh:: Updating package definitions.
+* Invoking guix style:: Styling package definitions.
* Invoking guix lint:: Finding errors in package definitions.
* Invoking guix size:: Profiling disk usage.
* Invoking guix graph:: Visualizing the graph of packages.
@@ -6722,7 +6723,8 @@ the one above, but using the @dfn{old input style}:
This style is now deprecated; it is still supported but support will be
removed in a future version. It should not be used for new package
-definitions.
+definitions. @xref{Invoking guix style}, on how to migrate to the new
+style.
@end quotation
@cindex cross compilation, package dependencies
@@ -10249,6 +10251,7 @@ the Scheme programming interface of Guix in a convenient way.
* Invoking guix hash:: Computing the cryptographic hash of a file.
* Invoking guix import:: Importing package definitions.
* Invoking guix refresh:: Updating package definitions.
+* Invoking guix style:: Styling package definitions.
* Invoking guix lint:: Finding errors in package definitions.
* Invoking guix size:: Profiling disk usage.
* Invoking guix graph:: Visualizing the graph of packages.
@@ -12071,6 +12074,98 @@ token procured from @uref{https://github.com/settings/tokens} or
otherwise.
+@node Invoking guix style
+@section Invoking @command{guix style}
+
+The @command{guix style} command helps packagers style their package
+definitions according to the latest fashionable trends. The command
+currently focuses on one aspect: the style of package inputs. It may
+eventually be extended to handle other stylistic matters.
+
+The way package inputs are written is going through a transition
+(@pxref{package Reference}, for more on package inputs). Until version
+1.3.0, package inputs were written using the ``old style'', where each
+input was given an explicit label, most of the time the package name:
+
+@lisp
+(package
+ ;; @dots{}
+ ;; The "old style" (deprecated).
+ (inputs `(("libunistring" ,libunistring)
+ ("libffi" ,libffi))))
+@end lisp
+
+Today, the old style is deprecated and the preferred style looks like
+this:
+
+@lisp
+(package
+ ;; @dots{}
+ ;; The "new style".
+ (inputs (list libunistring libffi)))
+@end lisp
+
+Likewise, uses of @code{alist-delete} and friends to manipulate inputs
+is now deprecated in favor of @code{modify-inputs} (@pxref{Defining
+Package Variants}, for more info on @code{modify-inputs}).
+
+In the vast majority of cases, this is a purely mechanical change on the
+surface syntax that does not even incur a package rebuild. Running
+@command{guix style} can do that for you, whether you're working on
+packages in Guix proper or in an external channel.
+
+The general syntax is:
+
+@example
+guix style [@var{options}] @var{package}@dots{}
+@end example
+
+This causes @command{guix style} to analyze and rewrite the definition
+of @var{package}@dots{}. It does so in a conservative way: preserving
+comments and bailing out if it cannot make sense of the code that
+appears in an inputs field. The available options are listed below.
+
+@table @code
+@item --load-path=@var{directory}
+@itemx -L @var{directory}
+Add @var{directory} to the front of the package module search path
+(@pxref{Package Modules}).
+
+@item --expression=@var{expr}
+@itemx -e @var{expr}
+Style the package @var{expr} evaluates to.
+
+For example, running:
+
+@example
+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
@section Invoking @command{guix lint}
@@ -12204,7 +12299,8 @@ use of tabulations, etc.
Report old-style input labels that do not match the name of the
corresponding package. This aims to help migrate from the ``old input
style''. @xref{package Reference}, for more information on package
-inputs and input styles.
+inputs and input styles. @xref{Invoking guix style}, on how to migrate
+to the new style.
@end table
The general syntax is:
diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
new file mode 100644
index 0000000000..3c100197a7
--- /dev/null
+++ b/guix/scripts/style.scm
@@ -0,0 +1,527 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;;
+;;; This script updates package definitions so they use the "simplified" style
+;;; for input lists, as in:
+;;;
+;;; (package
+;;; ;; ...
+;;; (inputs (list foo bar baz)))
+;;;
+;;; Code:
+
+(define-module (guix scripts style)
+ #:autoload (gnu packages) (specification->package fold-packages)
+ #:use-module (guix scripts)
+ #:use-module ((guix scripts build) #:select (%standard-build-options))
+ #:use-module (guix combinators)
+ #:use-module (guix ui)
+ #:use-module (guix packages)
+ #:use-module (guix utils)
+ #:use-module (guix i18n)
+ #:use-module (guix diagnostics)
+ #:use-module (ice-9 control)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 rdelim)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-37)
+ #:export (guix-style))
+
+\f
+;;;
+;;; Comment-preserving reader.
+;;;
+
+;; A comment.
+(define-record-type <comment>
+ (comment str margin?)
+ comment?
+ (str comment->string)
+ (margin? comment-margin?))
+
+(define (read-with-comments port)
+ "Like 'read', but include <comment> objects when they're encountered."
+ ;; Note: Instead of implementing this functionality in 'read' proper, which
+ ;; is the best approach long-term, this code is a later on top of 'read',
+ ;; such that we don't have to rely on a specific Guile version.
+ (let loop ((blank-line? #t)
+ (return (const 'unbalanced)))
+ (match (read-char port)
+ ((? eof-object? eof)
+ eof) ;oops!
+ (chr
+ (cond ((eqv? chr #\newline)
+ (loop #t return))
+ ((char-set-contains? char-set:whitespace chr)
+ (loop blank-line? return))
+ ((memv chr '(#\( #\[))
+ (let/ec return
+ (let liip ((lst '()))
+ (liip (cons (loop (match lst
+ (((? comment?) . _) #t)
+ (_ #f))
+ (lambda ()
+ (return (reverse lst))))
+ lst)))))
+ ((memv chr '(#\) #\]))
+ (return))
+ ((eq? chr #\')
+ (list 'quote (loop #f return)))
+ ((eq? chr #\`)
+ (list 'quasiquote (loop #f return)))
+ ((eq? chr #\,)
+ (list (match (peek-char port)
+ (#\@
+ (read-char port)
+ 'unquote-splicing)
+ (_
+ 'unquote))
+ (loop #f return)))
+ ((eqv? chr #\;)
+ (unread-char chr port)
+ (comment (read-line port 'concat)
+ (not blank-line?)))
+ (else
+ (unread-char chr port)
+ (read port)))))))
+
+\f
+;;;
+;;; Comment-preserving pretty-printer.
+;;;
+
+(define* (pretty-print-with-comments port obj
+ #:key
+ (indent 0)
+ (max-width 78)
+ (long-list 5))
+ (let loop ((indent indent)
+ (column indent)
+ (delimited? #t) ;true if comes after a delimiter
+ (obj obj))
+ (match obj
+ ((? comment? comment)
+ (if (comment-margin? comment)
+ (begin
+ (display " " port)
+ (display (comment->string comment) port))
+ (begin
+ ;; When already at the beginning of a line, for example because
+ ;; COMMENT follows a margin comment, no need to emit a newline.
+ (unless (= column indent)
+ (newline port)
+ (display (make-string indent #\space) port))
+ (display (comment->string comment) port)))
+ (display (make-string indent #\space) port)
+ indent)
+ (('quote lst)
+ (unless delimited? (display " " port))
+ (display "'" port)
+ (loop indent (+ column (if delimited? 1 2)) #t lst))
+ (('quasiquote lst)
+ (unless delimited? (display " " port))
+ (display "`" port)
+ (loop indent (+ column (if delimited? 1 2)) #t lst))
+ (('unquote lst)
+ (unless delimited? (display " " port))
+ (display "," port)
+ (loop indent (+ column (if delimited? 1 2)) #t lst))
+ (('modify-inputs inputs clauses ...)
+ ;; Special-case 'modify-inputs' to have one clause per line and custom
+ ;; indentation.
+ (let ((head "(modify-inputs "))
+ (display head port)
+ (loop (+ indent 4)
+ (+ column (string-length head))
+ #t
+ inputs)
+ (let* ((indent (+ indent 2))
+ (column (fold (lambda (clause column)
+ (newline port)
+ (display (make-string indent #\space)
+ port)
+ (loop indent indent #t clause))
+ indent
+ clauses)))
+ (display ")" port)
+ (+ column 1))))
+ ((head tail ...)
+ (unless delimited? (display " " port))
+ (display "(" port)
+ (let* ((new-column (loop indent (+ 1 column) #t head))
+ (indent (+ indent (- new-column column)))
+ (long? (> (length tail) long-list)))
+ (define column
+ (fold2 (lambda (item column first?)
+ (define newline?
+ ;; Insert a newline if ITEM is itself a list, or if TAIL
+ ;; is long, but only if ITEM is not the first item.
+ (and (or (pair? item) long?)
+ (not first?) (not (comment? item))))
+
+ (when newline?
+ (newline port)
+ (display (make-string indent #\space) port))
+ (let ((column (if newline? indent column)))
+ (values (loop indent
+ column
+ (= column indent)
+ item)
+ (comment? item))))
+ (+ 1 new-column)
+ #t ;first
+ tail))
+ (display ")" port)
+ (+ column 1)))
+ (_
+ (let* ((str (object->string obj))
+ (len (string-length str)))
+ (if (> (+ column 1 len) max-width)
+ (begin
+ (newline port)
+ (display (make-string indent #\space) port)
+ (display str port)
+ (+ indent len))
+ (begin
+ (unless delimited? (display " " port))
+ (display str port)
+ (+ column (if delimited? 1 2) len))))))))
+
+(define (object->string* obj indent)
+ (call-with-output-string
+ (lambda (port)
+ (pretty-print-with-comments port obj
+ #:indent indent))))
+
+\f
+;;;
+;;; Simplifying input expressions.
+;;;
+
+(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 (simplify-input-expression return)
+ (match-lambda
+ ((label ('unquote symbol)) symbol)
+ ((label ('unquote symbol) output)
+ (list 'quasiquote
+ (list (list 'unquote symbol) output)))
+ (_
+ ;; Expression doesn't look like a simple input.
+ (warning location (G_ "~a: complex expression, \
+bailing out~%")
+ package)
+ (return str))))
+
+ (define (simplify-input exp input return)
+ (define package* package)
+
+ (match input
+ ((or ((? string? label) (? package? package))
+ ((? string? label) (? package? package)
+ (? string?)))
+ ;; If LABEL doesn't match PACKAGE's name, then simplifying would incur
+ ;; a rebuild, and perhaps it would break build-side code relying on
+ ;; this specific label.
+ (if (label-matches? label (package-name package))
+ ((simplify-input-expression return) exp)
+ (begin
+ (warning location (G_ "~a: input label \
+'~a' does not match package name, bailing out~%")
+ package* label)
+ (return str))))
+ (_
+ (warning location (G_ "~a: non-trivial input, \
+bailing out~%")
+ package*)
+ (return str))))
+
+ (define (simplify-expressions exp inputs return)
+ ;; Simplify the expressions in EXP, which correspond to INPUTS, and return
+ ;; a list of expressions. Call RETURN with a string when bailing out.
+ (let loop ((result '())
+ (exp exp)
+ (inputs inputs))
+ (match exp
+ (((? comment? head) . rest)
+ (loop (cons head result) rest inputs))
+ ((head . rest)
+ (match inputs
+ ((input . inputs)
+ ;; HEAD (an sexp) and INPUT (an input tuple) are correlated.
+ (loop (cons (simplify-input head input return) result)
+ rest inputs))
+ (()
+ ;; If EXP and INPUTS have a different length, that
+ ;; means EXP is a non-trivial input list, for example
+ ;; with input-splicing, conditionals, etc.
+ (warning location (G_ "~a: input expression is too short~%")
+ package)
+ (return str))))
+ (()
+ ;; It's possible for EXP to contain fewer elements than INPUTS, for
+ ;; example in the case of input splicing. No bailout here. (XXX)
+ (reverse result)))))
+
+ (define inputs-exp
+ (call-with-input-string str read-with-comments))
+
+ (match inputs-exp
+ (('list _ ...) ;already done
+ str)
+ (('modify-inputs _ ...) ;already done
+ str)
+ (('quasiquote ;prepending inputs
+ (exp ...
+ ('unquote-splicing
+ ((and symbol (or 'package-inputs 'package-native-inputs
+ 'package-propagated-inputs))
+ arg))))
+ (let/ec return
+ (object->string*
+ (let ((things (simplify-expressions exp inputs return)))
+ `(modify-inputs (,symbol ,arg)
+ (prepend ,@things)))
+ (location-column location))))
+ (('quasiquote ;replacing an input
+ ((and exp ((? string? to-delete) ('unquote replacement)))
+ ('unquote-splicing
+ ('alist-delete (? string? to-delete)
+ ((and symbol
+ (or 'package-inputs 'package-native-inputs
+ 'package-propagated-inputs))
+ arg)))))
+ (let/ec return
+ (object->string*
+ (let ((things (simplify-expressions (list exp)
+ (list (car inputs))
+ return)))
+ `(modify-inputs (,symbol ,arg)
+ (replace ,to-delete ,replacement)))
+ (location-column location))))
+
+ (('quasiquote ;removing an input
+ (exp ...
+ ('unquote-splicing
+ ('alist-delete (? string? to-delete)
+ ((and symbol
+ (or 'package-inputs 'package-native-inputs
+ 'package-propagated-inputs))
+ arg)))))
+ (let/ec return
+ (object->string*
+ (let ((things (simplify-expressions exp inputs return)))
+ `(modify-inputs (,symbol ,arg)
+ (delete ,to-delete)
+ (prepend ,@things)))
+ (location-column location))))
+ (('fold 'alist-delete ;removing several inputs
+ ((and symbol
+ (or 'package-inputs 'package-native-inputs
+ 'package-propagated-inputs))
+ arg)
+ ('quote ((? string? to-delete) ...)))
+ (object->string*
+ `(modify-inputs (,symbol ,arg)
+ (delete ,@to-delete))
+ (location-column location)))
+ (('quasiquote ;removing several inputs and adding others
+ (exp ...
+ ('unquote-splicing
+ ('fold 'alist-delete
+ ((and symbol
+ (or 'package-inputs 'package-native-inputs
+ 'package-propagated-inputs))
+ arg)
+ ('quote ((? string? to-delete) ...))))))
+ (let/ec return
+ (object->string*
+ (let ((things (simplify-expressions exp inputs return)))
+ `(modify-inputs (,symbol ,arg)
+ (delete ,@to-delete)
+ (prepend ,@things)))
+ (location-column location))))
+ (('quasiquote (exp ...))
+ (let/ec return
+ (object->string*
+ `(list ,@(simplify-expressions exp inputs return))
+ (location-column location))))
+ (_
+ (warning location (G_ "~a: unsupported input style, \
+bailing out~%")
+ package)
+ str)))
+
+(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)
+ (()
+ #f)
+ (inputs
+ (match (package-field-location package field-name)
+ (#f
+ ;; 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)
+ (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))
+ (loc2 (package-location p2)))
+ (and loc1 loc2
+ (if (string=? (location-file loc1) (location-file loc2))
+ (< (location-line loc1) (location-line loc2))
+ (string<? (location-file loc1) (location-file loc2))))))
+
+\f
+;;;
+;;; Options.
+;;;
+
+(define %options
+ ;; Specification of the command-line options.
+ (list (find (lambda (option)
+ (member "load-path" (option-names option)))
+ %standard-build-options)
+
+ (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
+ (show-help)
+ (exit 0)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (show-version-and-exit "guix style")))))
+
+(define (show-help)
+ (display (G_ "Usage: guix style [OPTION]... [PACKAGE]...
+Update package definitions to the latest style.\n"))
+ (display (G_ "
+ -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"))
+ (display (G_ "
+ -V, --version display version information and exit"))
+ (newline)
+ (show-bug-report-information))
+
+(define %default-options
+ ;; Alist of default option values.
+ '((input-simplification-policy . silent)))
+
+\f
+;;;
+;;; Entry point.
+;;;
+
+(define-command (guix-style . args)
+ (category packaging)
+ (synopsis "update the style of package definitions")
+
+ (define (parse-options)
+ ;; Return the alist of option values.
+ (parse-command-line args %options (list %default-options)
+ #:build-options? #f))
+
+ (let* ((opts (parse-options))
+ (packages (filter-map (match-lambda
+ (('argument . spec)
+ (specification->package spec))
+ (('expression . str)
+ (read/eval str))
+ (_ #f))
+ 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
+ ;; we modify files.
+ (sort (if (null? packages)
+ (fold-packages cons '() #:select? (const #t))
+ packages)
+ (negate package-location<?)))))
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index 14324b25de..6a55046531 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -115,5 +115,6 @@ guix/scripts/offload.scm
guix/scripts/perform-download.scm
guix/scripts/refresh.scm
guix/scripts/repl.scm
+guix/scripts/style.scm
guix/scripts/system/reconfigure.scm
nix/nix-daemon/guix-daemon.cc
diff --git a/tests/style.scm b/tests/style.scm
new file mode 100644
index 0000000000..ada9197fc1
--- /dev/null
+++ b/tests/style.scm
@@ -0,0 +1,366 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (tests-style)
+ #:use-module (guix packages)
+ #:use-module (guix scripts style)
+ #:use-module ((guix utils) #:select (call-with-temporary-directory))
+ #:use-module ((guix build utils) #:select (substitute*))
+ #:use-module (guix diagnostics)
+ #:use-module (gnu packages acl)
+ #:use-module (gnu packages multiprecision)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-64)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 rdelim)
+ #:use-module (ice-9 pretty-print))
+
+(define (call-with-test-package inputs proc)
+ (call-with-temporary-directory
+ (lambda (directory)
+ (call-with-output-file (string-append directory "/my-packages.scm")
+ (lambda (port)
+ (pretty-print
+ `(begin
+ (define-module (my-packages)
+ #:use-module (guix)
+ #:use-module (guix licenses)
+ #:use-module (gnu packages acl)
+ #:use-module (gnu packages base)
+ #:use-module (gnu packages multiprecision)
+ #:use-module (srfi srfi-1))
+
+ (define base
+ (package
+ (inherit coreutils)
+ (inputs '())
+ (native-inputs '())
+ (propagated-inputs '())))
+
+ (define (sdl-union . lst)
+ (package
+ (inherit base)
+ (name "sdl-union")))
+
+ (define-public my-coreutils
+ (package
+ (inherit base)
+ ,@inputs
+ (name "my-coreutils"))))
+ port)))
+
+ (proc directory))))
+
+(define test-directory
+ ;; Directory where the package definition lives.
+ (make-parameter #f))
+
+(define-syntax-rule (with-test-package fields exp ...)
+ (call-with-test-package fields
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ ;; Run as a separate process to make sure FILE is reloaded.
+ (system* "guix" "style" "-L" directory "my-coreutils")
+ (system* "cat" file)
+
+ (load file)
+ (parameterize ((test-directory directory))
+ exp ...))))
+
+(define* (read-lines port line #:optional (count 1))
+ "Read COUNT lines from PORT, starting from LINE."
+ (let loop ((lines '())
+ (count count))
+ (cond ((< (port-line port) (- line 1))
+ (read-char port)
+ (loop lines count))
+ ((zero? count)
+ (string-concatenate-reverse lines))
+ (else
+ (match (read-line port 'concat)
+ ((? eof-object?)
+ (loop lines 0))
+ (line
+ (loop (cons line lines) (- count 1))))))))
+
+(define* (read-package-field package field #:optional (count 1))
+ (let* ((location (package-field-location package field))
+ (file (location-file location))
+ (line (location-line location)))
+ (call-with-input-file (if (string-prefix? "/" file)
+ file
+ (string-append (test-directory) "/"
+ file))
+ (lambda (port)
+ (read-lines port line count)))))
+
+\f
+(test-begin "style")
+
+(test-equal "nothing to rewrite"
+ '()
+ (with-test-package '()
+ (package-direct-inputs (@ (my-packages) my-coreutils))))
+
+(test-equal "input labels, mismatch"
+ (list `(("foo" ,gmp) ("bar" ,acl))
+ " (inputs `((\"foo\" ,gmp) (\"bar\" ,acl)))\n")
+ (with-test-package '((inputs `(("foo" ,gmp) ("bar" ,acl))))
+ (list (package-direct-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs))))
+
+(test-equal "input labels, simple"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ " (inputs (list gmp acl))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl))))
+ (list (package-direct-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs))))
+
+(test-equal "input labels, long list with one item per line"
+ (list (concatenate (make-list 4 `(("gmp" ,gmp) ("acl" ,acl))))
+ "\
+ (list gmp
+ acl
+ gmp
+ acl
+ gmp
+ acl
+ gmp
+ acl))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl))))
+ (list (package-direct-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 8))))
+
+(test-equal "input labels, sdl-union"
+ "\
+ (list gmp acl
+ (sdl-union 1 2 3 4)))\n"
+ (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
+ ("sdl-union" ,(sdl-union 1 2 3 4)))))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 2)))
+
+(test-equal "input labels, output"
+ (list `(("gmp" ,gmp "debug") ("acl" ,acl))
+ " (inputs (list `(,gmp \"debug\") acl))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp "debug") ("acl" ,acl))))
+ (list (package-direct-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs))))
+
+(test-equal "input labels, prepend"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (prepend gmp acl)))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
+ ,@(package-propagated-inputs coreutils))))
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 2))))
+
+(test-equal "input labels, prepend + delete"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (delete \"gmp\")
+ (prepend gmp acl)))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp)
+ ("acl" ,acl)
+ ,@(alist-delete "gmp"
+ (package-propagated-inputs coreutils)))))
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 3))))
+
+(test-equal "input labels, prepend + delete multiple"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (delete \"foo\" \"bar\" \"baz\")
+ (prepend gmp acl)))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp)
+ ("acl" ,acl)
+ ,@(fold alist-delete
+ (package-propagated-inputs coreutils)
+ '("foo" "bar" "baz")))))
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 3))))
+
+(test-equal "input labels, replace"
+ (list '() ;there's no "gmp" input to replace
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (replace \"gmp\" gmp)))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp)
+ ,@(alist-delete "gmp"
+ (package-propagated-inputs coreutils)))))
+ (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))
+ " (inputs (list gmp)) ;margin comment\n"
+ " (native-inputs (list acl)) ;another one\n")
+ (call-with-test-package '((inputs `(("gmp" ,gmp)))
+ (native-inputs `(("acl" ,acl))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (substitute* file
+ (("\"gmp\"(.*)$" _ rest)
+ (string-append "\"gmp\"" (string-trim-right rest)
+ " ;margin comment\n"))
+ (("\"acl\"(.*)$" _ rest)
+ (string-append "\"acl\"" (string-trim-right rest)
+ " ;another one\n")))
+ (system* "cat" file)
+
+ (system* "guix" "style" "-L" directory "my-coreutils")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (package-native-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs)
+ (read-package-field (@ (my-packages) my-coreutils) 'native-inputs)))))
+
+(test-equal "input labels, margin comment on long list"
+ (list (concatenate (make-list 4 `(("gmp" ,gmp) ("acl" ,acl))))
+ "\
+ (list gmp ;margin comment
+ acl
+ gmp ;margin comment
+ acl
+ gmp ;margin comment
+ acl
+ gmp ;margin comment
+ acl))\n")
+ (call-with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (substitute* file
+ (("\"gmp\"(.*)$" _ rest)
+ (string-append "\"gmp\"" (string-trim-right rest)
+ " ;margin comment\n")))
+ (system* "cat" file)
+
+ (system* "guix" "style" "-L" directory "my-coreutils")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 8)))))
+
+(test-equal "input labels, line comment"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (inputs (list gmp
+ ;; line comment!
+ acl))\n")
+ (call-with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (substitute* file
+ ((",gmp\\)(.*)$" _ rest)
+ (string-append ",gmp)\n ;; line comment!\n" rest)))
+
+ (system* "guix" "style" "-L" directory "my-coreutils")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 3)))))
+
+(test-equal "input labels, modify-inputs and margin comment"
+ (list `(("gmp" ,gmp) ("acl" ,acl) ("mpfr" ,mpfr))
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (prepend gmp ;margin comment
+ acl ;another one
+ mpfr)))\n")
+ (call-with-test-package '((inputs
+ `(("gmp" ,gmp) ("acl" ,acl) ("mpfr" ,mpfr)
+ ,@(package-propagated-inputs coreutils))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (substitute* file
+ ((",gmp\\)(.*)$" _ rest)
+ (string-append ",gmp) ;margin comment\n" rest))
+ ((",acl\\)(.*)$" _ rest)
+ (string-append ",acl) ;another one\n" rest)))
+
+ (system* "guix" "style" "-L" directory "my-coreutils")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 4)))))
+
+(test-end)
+
+;; Local Variables:
+;; eval: (put 'with-test-package 'scheme-indent-function 1)
+;; eval: (put 'call-with-test-package 'scheme-indent-function 1)
+;; End:
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 12/16] packages: 'hidden-package' inherits the original package location.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (10 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 11/16] Add 'guix style' Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 13/16] import: pypi: Emit new-style package inputs Ludovic Courtès
` (5 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/packages.scm (hidden-package): Inherit 'location' from P.
---
guix/packages.scm | 1 +
1 file changed, 1 insertion(+)
diff --git a/guix/packages.scm b/guix/packages.scm
index d15a17edc0..20cad34dcb 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -491,6 +491,7 @@ it has in Guix."
user interfaces, ignores."
(package
(inherit p)
+ (location (package-location p))
(properties `((hidden? . #t)
,@(package-properties p)))))
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 13/16] import: pypi: Emit new-style package inputs.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (11 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 12/16] packages: 'hidden-package' inherits the original package location Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 14/16] import: cran: " Ludovic Courtès
` (4 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/import/pypi.scm (maybe-inputs): Wrap PACKAGE-INPUTS in 'list'
instead of 'quasiquote'.
(compute-inputs)[requirement->package-name/sort]: Return a list of symbols.
* tests/pypi.scm ("pypi->guix-package, no wheel")
("pypi->guix-package, wheels"): Adjust accordingly.
---
guix/import/pypi.scm | 15 ++++-----------
tests/pypi.scm | 18 ++++--------------
2 files changed, 8 insertions(+), 25 deletions(-)
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index 6731d50891..f3619dcd9e 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2015 Cyril Roelandt <tipecaml@gmail.com>
-;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@@ -183,7 +183,7 @@ the input field."
(()
'())
((package-inputs ...)
- `((,input-type (,'quasiquote ,package-inputs))))))
+ `((,input-type (list ,@package-inputs))))))
(define %requirement-name-regexp
;; Regexp to match the requirement name in a requirement specification.
@@ -402,15 +402,8 @@ return the unaltered list of upstream dependency names."
(remove (cut string=? "argparse" <>) deps))
(define (requirement->package-name/sort deps)
- (sort
- (map (lambda (input)
- (let ((guix-name (python->package-name input)))
- (list guix-name (list 'unquote (string->symbol guix-name)))))
- deps)
- (lambda args
- (match args
- (((a _ ...) (b _ ...))
- (string-ci<? a b))))))
+ (map string->symbol
+ (sort (map python->package-name deps) string-ci<?)))
(define process-requirements
(compose requirement->package-name/sort strip-argparse))
diff --git a/tests/pypi.scm b/tests/pypi.scm
index f421d6d9df..bb81e91839 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -213,13 +213,8 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
('base32
(? string? hash)))))
('build-system 'python-build-system)
- ('propagated-inputs
- ('quasiquote
- (("python-bar" ('unquote 'python-bar))
- ("python-foo" ('unquote 'python-foo)))))
- ('native-inputs
- ('quasiquote
- (("python-pytest" ('unquote 'python-pytest)))))
+ ('propagated-inputs ('list 'python-bar 'python-foo))
+ ('native-inputs ('list 'python-pytest))
('home-page "http://example.com")
('synopsis "summary")
('description "summary")
@@ -282,13 +277,8 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
('base32
(? string? hash)))))
('build-system 'python-build-system)
- ('propagated-inputs
- ('quasiquote
- (("python-bar" ('unquote 'python-bar))
- ("python-baz" ('unquote 'python-baz)))))
- ('native-inputs
- ('quasiquote
- (("python-pytest" ('unquote 'python-pytest)))))
+ ('propagated-inputs ('list 'python-bar 'python-baz))
+ ('native-inputs ('list 'python-pytest))
('home-page "http://example.com")
('synopsis "summary")
('description "summary")
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 14/16] import: cran: Emit new-style package inputs.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (12 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 13/16] import: pypi: Emit new-style package inputs Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 15/16] import: print: Emit new-style package inputs when possible Ludovic Courtès
` (3 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/import/cran.scm (format-inputs): Emit symbols or
'specification->package' calls.
(maybe-inputs): Wrap in 'list' instead of 'quasiquote'.
* tests/cran.scm ("description->package"): Adjust accordingly.
---
guix/import/cran.scm | 8 ++++----
tests/cran.scm | 10 ++--------
2 files changed, 6 insertions(+), 12 deletions(-)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index f649928c5a..510882bc00 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;;
@@ -135,9 +135,9 @@
(map (lambda (name)
(case (%input-style)
((specification)
- (list name (list 'unquote (list 'specification->package name))))
+ `(specification->package ,name))
(else
- (list name (list 'unquote (string->symbol name))))))
+ (string->symbol name))))
(sort names string-ci<?)))
(define* (maybe-inputs package-inputs #:optional (type 'inputs))
@@ -147,7 +147,7 @@ package definition."
(()
'())
((package-inputs ...)
- `((,type (,'quasiquote ,(format-inputs package-inputs)))))))
+ `((,type (list ,@(format-inputs package-inputs)))))))
(define %cran-url "https://cran.r-project.org/web/packages/")
(define %cran-canonical-url "https://cran.r-project.org/package=")
diff --git a/tests/cran.scm b/tests/cran.scm
index 70d2277198..e59b7daef7 100644
--- a/tests/cran.scm
+++ b/tests/cran.scm
@@ -117,15 +117,9 @@ Date/Publication: 2015-07-14 14:15:16
(? string? hash)))))
('properties ('quasiquote (('upstream-name . "My-Example"))))
('build-system 'r-build-system)
- ('inputs
- ('quasiquote
- (("cairo" ('unquote 'cairo)))))
+ ('inputs ('list 'cairo))
('propagated-inputs
- ('quasiquote
- (("r-bh" ('unquote 'r-bh))
- ("r-proto" ('unquote 'r-proto))
- ("r-rcpp" ('unquote 'r-rcpp))
- ("r-scales" ('unquote 'r-scales)))))
+ ('list 'r-bh 'r-proto 'r-rcpp 'r-scales))
('home-page "http://gnu.org/s/my-example")
('synopsis "Example package")
('description
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 15/16] import: print: Emit new-style package inputs when possible.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (13 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 14/16] import: cran: " Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 16/16] import: elpa: Emit new-style package inputs Ludovic Courtès
` (2 subsequent siblings)
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/import/print.scm (redundant-input-labels?): New procedure.
(package->code)[package-lists->code]: Rename to...
[inputs->code]: ... this. When 'redundant-input-labels?' returns true,
emit label-less inputs. Adjust callers to new name.
* tests/print.scm (pkg-with-inputs): Adjust accordingly.
---
guix/import/print.scm | 57 +++++++++++++++++++++++++++++--------------
tests/print.scm | 4 +--
2 files changed, 41 insertions(+), 20 deletions(-)
diff --git a/guix/import/print.scm b/guix/import/print.scm
index dcc38abc70..77492e222c 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2020 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -30,6 +31,14 @@
#:use-module (ice-9 match)
#:export (package->code))
+(define (redundant-input-labels? inputs)
+ "Return #t if input labels in the INPUTS list are redundant."
+ (every (match-lambda
+ ((label (? package? package) . _)
+ (string=? label (package-name package)))
+ (_ #f))
+ inputs))
+
;; FIXME: the quasiquoted arguments field may contain embedded package
;; objects, e.g. in #:disallowed-references; they will just be printed with
;; their usual #<package ...> representation, not as variable names.
@@ -104,21 +113,33 @@ when evaluated."
,@(if (null? patches) '()
`((patches (search-patches ,@(map basename patches))))))))
- (define (package-lists->code lsts)
- (list 'quasiquote
- (map (match-lambda
- ((? symbol? s)
- (list (symbol->string s) (list 'unquote s)))
- ((label pkg . out)
- (let ((mod (package-module-name pkg)))
- (cons* label
- ;; FIXME: using '@ certainly isn't pretty, but it
- ;; avoids having to import the individual package
- ;; modules.
- (list 'unquote
- (list '@ mod (variable-name pkg mod)))
- out))))
- lsts)))
+ (define (inputs->code inputs)
+ (if (redundant-input-labels? inputs)
+ `(list ,@(map (match-lambda ;no need for input labels ("new style")
+ ((_ package)
+ (let ((module (package-module-name package)))
+ `(@ ,module ,(variable-name package module))))
+ ((_ package output)
+ (let ((module (package-module-name package)))
+ (list 'quasiquote
+ (list
+ (list 'unquote
+ `(@ ,module
+ ,(variable-name package module)))
+ output)))))
+ inputs))
+ (list 'quasiquote ;preserve input labels (deprecated)
+ (map (match-lambda
+ ((label pkg . out)
+ (let ((mod (package-module-name pkg)))
+ (cons* label
+ ;; FIXME: using '@ certainly isn't pretty, but it
+ ;; avoids having to import the individual package
+ ;; modules.
+ (list 'unquote
+ (list '@ mod (variable-name pkg mod)))
+ out))))
+ inputs))))
(let ((name (package-name package))
(version (package-version package))
@@ -160,13 +181,13 @@ when evaluated."
(outs `((outputs (list ,@outs)))))
,@(match native-inputs
(() '())
- (pkgs `((native-inputs ,(package-lists->code pkgs)))))
+ (pkgs `((native-inputs ,(inputs->code pkgs)))))
,@(match inputs
(() '())
- (pkgs `((inputs ,(package-lists->code pkgs)))))
+ (pkgs `((inputs ,(inputs->code pkgs)))))
,@(match propagated-inputs
(() '())
- (pkgs `((propagated-inputs ,(package-lists->code pkgs)))))
+ (pkgs `((propagated-inputs ,(inputs->code pkgs)))))
,@(if (lset= string=? supported-systems %supported-systems)
'()
`((supported-systems (list ,@supported-systems))))
diff --git a/tests/print.scm b/tests/print.scm
index 3386590d3a..1b24e12f2e 100644
--- a/tests/print.scm
+++ b/tests/print.scm
@@ -60,8 +60,8 @@
(base32
"070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
(build-system (@ (guix build-system gnu) gnu-build-system))
- (inputs `(("coreutils" ,(@ (gnu packages base) coreutils))
- ("glibc" ,(@ (gnu packages base) glibc) "debug")))
+ (inputs (list (@ (gnu packages base) coreutils)
+ `(,(@ (gnu packages base) glibc) "debug")))
(home-page "http://gnu.org")
(synopsis "Dummy")
(description "This is a dummy package.")
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 16/16] import: elpa: Emit new-style package inputs.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (14 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 15/16] import: print: Emit new-style package inputs when possible Ludovic Courtès
@ 2021-06-30 20:48 ` Ludovic Courtès
2021-07-10 4:53 ` [bug#49169] [PATCH 00/11] Removing input labels from package definitions Sarah Morgensen via Guix-patches via
2021-07-10 23:11 ` Ludovic Courtès
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-06-30 20:48 UTC (permalink / raw)
To: 49169; +Cc: Ludovic Courtès
* guix/import/elpa.scm (elpa-package->sexp)[dependencies]: Turn into a
list of symbols.
[maybe-inputs]: Wrap in 'list' instead of 'quasiquote'.
---
guix/import/elpa.scm | 7 ++-----
1 file changed, 2 insertions(+), 5 deletions(-)
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index c0dc5acf51..0a1c414c25 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -350,9 +350,7 @@ type '<elpa-package>'."
(elpa-package-inputs pkg))))
(define dependencies
- (map (lambda (n)
- (let ((new-n (elpa-name->package-name n)))
- (list new-n (list 'unquote (string->symbol new-n)))))
+ (map (compose string->symbol elpa-name->package-name)
dependencies-names))
(define (maybe-inputs input-type inputs)
@@ -360,8 +358,7 @@ type '<elpa-package>'."
(()
'())
((inputs ...)
- (list (list input-type
- (list 'quasiquote inputs))))))
+ (list (list input-type `(list ,@inputs))))))
(define melpa-source
(melpa-recipe->origin melpa-recipe))
--
2.32.0
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH v2 11/16] Add 'guix style'.
2021-06-30 20:48 ` [bug#49169] [PATCH v2 11/16] Add 'guix style' Ludovic Courtès
@ 2021-07-01 14:13 ` zimoun
0 siblings, 0 replies; 40+ messages in thread
From: zimoun @ 2021-07-01 14:13 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 49169
Hi,
On Wed, 30 Jun 2021 at 22:50, Ludovic Courtès <ludo@gnu.org> wrote:
> +;;;
> +;;; Entry point.
> +;;;
> +
> +(define-command (guix-style . args)
> + (category packaging)
> + (synopsis "update the style of package definitions")
All this patch LGTM. Well, I do not know if the category is not
"plumbing" instead of "packaging".
Cheers,
simon
^ permalink raw reply [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 00/11] Removing input labels from package definitions
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (15 preceding siblings ...)
2021-06-30 20:48 ` [bug#49169] [PATCH v2 16/16] import: elpa: Emit new-style package inputs Ludovic Courtès
@ 2021-07-10 4:53 ` Sarah Morgensen via Guix-patches via
2021-07-10 13:45 ` Ludovic Courtès
2021-07-10 23:15 ` Ludovic Courtès
2021-07-10 23:11 ` Ludovic Courtès
17 siblings, 2 replies; 40+ messages in thread
From: Sarah Morgensen via Guix-patches via @ 2021-07-10 4:53 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 49169
[-- Attachment #1: Type: text/plain, Size: 1167 bytes --]
Hello :)
This is a wonderful direction! I am always happy to see boilerplate
evaporate.
Ludovic Courtès <ludo@gnu.org> writes:
> • I changed a few importers to emit simplified package inputs.
> We’ll have to take care of the other importers eventually.
I found one more easy change to make in the importers. I just gave it a
quick smoke test with the Go importer, nothing exhaustive; and I'm not
sure which other importers use it. I've attached the patch below.
> doc/guix.texi | 208 ++++++++++++++--
In the manual, you added:
> Each element of these lists is either a package, origin, or other
> ``file-like object'' [...]
How should a file input like this be handled?
("some.patch" (search-patch "some.patch"))
If I had to guess, I'd try some gexp like...
#$(local-file (search-patch "some.patch"))
But I really have no idea!
> guix/scripts/style.scm | 527 +++++++++++++++++++++++++++++++++++++++++
> tests/style.scm | 366 ++++++++++++++++++++++++++++
> 23 files changed, 1643 insertions(+), 298 deletions(-)
The style script makes up fully half of the patch! Wow.
--
Sarah
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: emit-new-package-inputs-other-importers.patch --]
[-- Type: text/x-patch, Size: 1287 bytes --]
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index d817318a91..5075e5c491 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -237,12 +237,10 @@ into a proper sentence and by using two spaces between sentences."
optional OUTPUT, tries to generate a quoted list of inputs, as suitable to
use in an 'inputs' field of a package definition."
(define (make-input input version)
- (cons* input (list 'unquote (string->symbol
- (if version
- (string-append input "-" version)
- input)))
- (or (and output (list output))
- '())))
+ (let ((name (if version (string-append input "-" version) input)))
+ (if output
+ (list (string->symbol name) output)
+ (string->symbol name))))
(map (match-lambda
((input version) (make-input input version))
@@ -263,7 +261,7 @@ snippet generated is for regular inputs."
(()
'())
((package-inputs ...)
- `((,field-name (,'quasiquote ,package-inputs)))))))
+ `((,field-name (list ,@package-inputs)))))))
(define* (maybe-native-inputs package-names #:optional (output #f))
"Same as MAYBE-INPUTS, but for native inputs."
^ permalink raw reply related [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 00/11] Removing input labels from package definitions
2021-07-10 4:53 ` [bug#49169] [PATCH 00/11] Removing input labels from package definitions Sarah Morgensen via Guix-patches via
@ 2021-07-10 13:45 ` Ludovic Courtès
2021-07-10 23:15 ` Ludovic Courtès
1 sibling, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-07-10 13:45 UTC (permalink / raw)
To: Sarah Morgensen; +Cc: 49169
Hello!
Sarah Morgensen <iskarian@mgsn.dev> skribis:
> This is a wonderful direction! I am always happy to see boilerplate
> evaporate.
Heh thanks, I agree!
> Ludovic Courtès <ludo@gnu.org> writes:
>
>> • I changed a few importers to emit simplified package inputs.
>> We’ll have to take care of the other importers eventually.
>
> I found one more easy change to make in the importers. I just gave it a
> quick smoke test with the Go importer, nothing exhaustive; and I'm not
> sure which other importers use it. I've attached the patch below.
Awesome, I’ll apply this patch on your behalf.
> In the manual, you added:
>
>> Each element of these lists is either a package, origin, or other
>> ``file-like object'' [...]
>
> How should a file input like this be handled?
>
> ("some.patch" (search-patch "some.patch"))
>
> If I had to guess, I'd try some gexp like...
>
> #$(local-file (search-patch "some.patch"))
Exactly, or:
(local-file "patches/some.patch")
>> guix/scripts/style.scm | 527 +++++++++++++++++++++++++++++++++++++++++
>> tests/style.scm | 366 ++++++++++++++++++++++++++++
>> 23 files changed, 1643 insertions(+), 298 deletions(-)
>
> The style script makes up fully half of the patch! Wow.
Yes, but the patch resulting from running ‘guix style’ will be an order
of magnitude bigger. :-)
Now that ‘core-updates’ is in a better shape, I feel safer pushing this
patch series. Let’s see…
Thanks!
Ludo’.
^ permalink raw reply [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 00/11] Removing input labels from package definitions
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
` (16 preceding siblings ...)
2021-07-10 4:53 ` [bug#49169] [PATCH 00/11] Removing input labels from package definitions Sarah Morgensen via Guix-patches via
@ 2021-07-10 23:11 ` Ludovic Courtès
17 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-07-10 23:11 UTC (permalink / raw)
To: 49169
Ludovic Courtès <ludo@gnu.org> skribis:
> records: Support field sanitizers.
> packages: Allow inputs to be plain package lists.
> lint: Add 'input-labels' checker.
> packages: Add 'lookup-package-input' & co.
> packages: Add 'modify-inputs'.
> gnu: Change inputs of core packages to plain lists.
> utils: 'edit-expression' no longer leaks file ports.
> utils: Add 'go-to-location' with source location caching.
> utils: 'edit-expression' modifies the file only if necessary.
> utils: 'edit-expression' copies part of the original source map.
> Add 'guix style'.
> packages: 'hidden-package' inherits the original package location.
> import: pypi: Emit new-style package inputs.
> import: cran: Emit new-style package inputs.
> import: print: Emit new-style package inputs when possible.
> import: elpa: Emit new-style package inputs.
Pushed as ab270bf2e9e301b14fe90c36976835331d67acf5, followed by commit
adding a news entry.
Ludo’.
^ permalink raw reply [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 00/11] Removing input labels from package definitions
2021-07-10 4:53 ` [bug#49169] [PATCH 00/11] Removing input labels from package definitions Sarah Morgensen via Guix-patches via
2021-07-10 13:45 ` Ludovic Courtès
@ 2021-07-10 23:15 ` Ludovic Courtès
2021-07-12 6:15 ` Sarah Morgensen via Guix-patches via
1 sibling, 1 reply; 40+ messages in thread
From: Ludovic Courtès @ 2021-07-10 23:15 UTC (permalink / raw)
To: Sarah Morgensen; +Cc: 49169
Hi again,
Sarah Morgensen <iskarian@mgsn.dev> skribis:
> diff --git a/guix/import/utils.scm b/guix/import/utils.scm
> index d817318a91..5075e5c491 100644
> --- a/guix/import/utils.scm
> +++ b/guix/import/utils.scm
> @@ -237,12 +237,10 @@ into a proper sentence and by using two spaces between sentences."
> optional OUTPUT, tries to generate a quoted list of inputs, as suitable to
> use in an 'inputs' field of a package definition."
> (define (make-input input version)
> - (cons* input (list 'unquote (string->symbol
> - (if version
> - (string-append input "-" version)
> - input)))
> - (or (and output (list output))
> - '())))
> + (let ((name (if version (string-append input "-" version) input)))
> + (if output
> + (list (string->symbol name) output)
> + (string->symbol name))))
>
> (map (match-lambda
> ((input version) (make-input input version))
> @@ -263,7 +261,7 @@ snippet generated is for regular inputs."
> (()
> '())
> ((package-inputs ...)
> - `((,field-name (,'quasiquote ,package-inputs)))))))
> + `((,field-name (list ,@package-inputs)))))))
>
> (define* (maybe-native-inputs package-names #:optional (output #f))
> "Same as MAYBE-INPUTS, but for native inputs."
On closer inspection, it seems that this change would affect the Crate
importer. Unfortunately, Crate packages live in their own world and are
unaffected by package input simplification.
This is unfortunate, also because they probably never even use input
labels that can be seen in #:cargo-development-inputs and the likes.
That said, it would be good to simplify that too, and I’m open to
suggestions on how to achieve that!
Ludo’.
^ permalink raw reply [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 00/11] Removing input labels from package definitions
2021-07-10 23:15 ` Ludovic Courtès
@ 2021-07-12 6:15 ` Sarah Morgensen via Guix-patches via
2021-07-12 8:47 ` Ludovic Courtès
0 siblings, 1 reply; 40+ messages in thread
From: Sarah Morgensen via Guix-patches via @ 2021-07-12 6:15 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 49169
Hi!
Ludovic Courtès <ludo@gnu.org> writes:
> On closer inspection, it seems that this change would affect the Crate
> importer. Unfortunately, Crate packages live in their own world and are
> unaffected by package input simplification.
Well, that was an interesting code dive :) They really do live in their
own world...
>
> This is unfortunate, also because they probably never even use input
> labels that can be seen in #:cargo-development-inputs and the likes.
>
> That said, it would be good to simplify that too, and I’m open to
> suggestions on how to achieve that!
I have submitted a patchset [0] which just has the crate importer use
the same sanitizer as package inputs, which should be good enough until
we get rid of input labels in the internals.
In the longer term, perhaps we would benefit from some way of indicating
inputs which are just source? Something like
(package ... (source-inputs ...))
where the listed packages only provide their source instead of any
outputs, and only transitively include other packages via source-inputs.
This would bypass any patching done in phases, but I don't think that's
common enough in these "source" packages that it would be onerous to use
origin patches/snippets instead. This would be useful for any build
system which does not (re)use artifacts from a package's dependencies
(such as cargo and go).
[0] https://issues.guix.gnu.org/49531
--
Sarah
^ permalink raw reply [flat|nested] 40+ messages in thread
* [bug#49169] [PATCH 00/11] Removing input labels from package definitions
2021-07-12 6:15 ` Sarah Morgensen via Guix-patches via
@ 2021-07-12 8:47 ` Ludovic Courtès
0 siblings, 0 replies; 40+ messages in thread
From: Ludovic Courtès @ 2021-07-12 8:47 UTC (permalink / raw)
To: Sarah Morgensen; +Cc: 49169
Hi!
Sarah Morgensen <iskarian@mgsn.dev> skribis:
> I have submitted a patchset [0] which just has the crate importer use
> the same sanitizer as package inputs, which should be good enough until
> we get rid of input labels in the internals.
Excellent, I’ll take a look.
> In the longer term, perhaps we would benefit from some way of indicating
> inputs which are just source? Something like
>
> (package ... (source-inputs ...))
>
> where the listed packages only provide their source instead of any
> outputs, and only transitively include other packages via source-inputs.
> This would bypass any patching done in phases, but I don't think that's
> common enough in these "source" packages that it would be onerous to use
> origin patches/snippets instead. This would be useful for any build
> system which does not (re)use artifacts from a package's dependencies
> (such as cargo and go).
Yeah, I really don’t know. I thought we could just as well say that
‘inputs’ means “source inputs” for those packages (and indeed that’s
what happens for Go packages), but I always fail to wrap my head around
the specific needs and constraints of Cargo and Go.
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 40+ messages in thread
end of thread, other threads:[~2021-07-12 8:48 UTC | newest]
Thread overview: 40+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2021-06-22 9:02 [bug#49169] [PATCH 00/11] Removing input labels from package definitions Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 02/11] packages: Allow inputs to be plain package lists Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 03/11] lint: Add 'input-labels' checker Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 04/11] packages: Add 'lookup-package-input' & co Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 05/11] packages: Add 'modify-inputs' Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 06/11] gnu: Change inputs of core packages to plain lists Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 07/11] utils: 'edit-expression' no longer leaks file ports Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 08/11] utils: Add 'go-to-location' with source location caching Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 09/11] utils: 'edit-expression' modifies the file only if necessary Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 10/11] utils: 'edit-expression' copies part of the original source map Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 11/11] Add 'guix style' Ludovic Courtès
2021-06-22 9:09 ` [bug#49169] [PATCH 00/11] Removing input labels from package definitions Ludovic Courtès
2021-06-27 18:37 ` Christopher Baines
2021-06-28 9:54 ` Ludovic Courtès
2021-06-27 11:00 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 01/16] records: Support field sanitizers Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 02/16] packages: Allow inputs to be plain package lists Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 03/16] lint: Add 'input-labels' checker Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 04/16] packages: Add 'lookup-package-input' & co Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 05/16] packages: Add 'modify-inputs' Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 06/16] gnu: Change inputs of core packages to plain lists Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 07/16] utils: 'edit-expression' no longer leaks file ports Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 08/16] utils: Add 'go-to-location' with source location caching Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 09/16] utils: 'edit-expression' modifies the file only if necessary Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 10/16] utils: 'edit-expression' copies part of the original source map Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 11/16] Add 'guix style' Ludovic Courtès
2021-07-01 14:13 ` zimoun
2021-06-30 20:48 ` [bug#49169] [PATCH v2 12/16] packages: 'hidden-package' inherits the original package location Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 13/16] import: pypi: Emit new-style package inputs Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 14/16] import: cran: " Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 15/16] import: print: Emit new-style package inputs when possible Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 16/16] import: elpa: Emit new-style package inputs Ludovic Courtès
2021-07-10 4:53 ` [bug#49169] [PATCH 00/11] Removing input labels from package definitions Sarah Morgensen via Guix-patches via
2021-07-10 13:45 ` Ludovic Courtès
2021-07-10 23:15 ` Ludovic Courtès
2021-07-12 6:15 ` Sarah Morgensen via Guix-patches via
2021-07-12 8:47 ` Ludovic Courtès
2021-07-10 23:11 ` Ludovic Courtès
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.