[bug#63320] [PATCH 0/2] Rewrite 'arguments' to gexps with 'guix style -S arguments'

[bug#63320] [PATCH 0/2] Rewrite 'arguments' to gexps with 'guix style -S arguments'

[Ludovic Courtès]

Hello Guix!

When preparing <https://guix.gnu.org/en/blog/2021/the-big-change/>, I didn’t
consider converting ‘arguments’ from sexps to gexps a priority.  In practice,
we’ve been doing that manually ever since but there’s a sort of a “contamination”
aspect: due to inheritance, we often have to be careful enough to convert
multiple packages at once or to not change anything, or we end up with gexp
records inside sexps¹.  Automation appears to be overdue.

The attached patches add ‘guix style -S arguments’, which rewrites ‘arguments’
from sexps to gexps.  The change doesn’t involve any rebuild, so we could even
run it en masse on the whole repo and be done with it.

Some caveats:

  • The reader in (guix read-print) doesn’t support sexp comments (#;), which
    are used in a couple of packages.  Thus,

      ./pre-inst-env guix style -S arguments

    which traverses all the packages eventually chokes on it.

  • The pretty printer does not insert a newline after #:phases, which makes
    the space for (modify-phases …) expressions sometimes too narrow.  (This
    is not new; try ‘./pre-inst-env guix style PACKAGE’.)

  • More generally, the pretty printer’s output still has occasional glitches,
    sufficiently that running ‘guix style -S arguments’ on the whole repo may
    not be a good idea at the moment.

  • Some modules lack #:use-module (guix gexp), but this has to be added
    manually.

  • We might want an optional conservative policy to leave arguments that
    would not use gexps unchanged.  For instance, we could leave
    (arguments '(#:tests? #f)) unchanged instead of rewriting it to
    (arguments (list #:tests? #f)).

Thoughts?

Ludo’.

¹ This is what prompted Chris to improve error detection:
  <https://issues.guix.gnu.org/63263>.


Ludovic Courtès (2):
  style: Add 'arguments' styling rule.
  DRAFT news: Add entry to 'guix style -S arguments'.

 doc/guix.texi          |  51 ++++++++++++
 etc/news.scm           |  16 ++++
 guix/scripts/style.scm | 173 ++++++++++++++++++++++++++++++++++++++++-
 tests/style.scm        | 136 ++++++++++++++++++++++++++++++++
 4 files changed, 375 insertions(+), 1 deletion(-)


base-commit: 3c91f4ca490a7ac56dc0aebbca9c4bf4df201877
-- 
2.39.2

[bug#63320] [PATCH 1/2] style: Add 'arguments' styling rule.

[Ludovic Courtès]

* guix/scripts/style.scm (unquote->ungexp, gexpify-argument-value)
(quote-argument-value, gexpify-argument-tail)
(gexpify-package-arguments): New procedures.
(%gexp-keywords): New variable.
(%options): Add "arguments" case for 'styling-procedure.
(show-stylings): Update.
* tests/style.scm ("gexpify arguments, already gexpified")
("gexpify arguments, non-gexp arguments, margin comment")
("gexpify arguments, phases and flags")
("gexpify arguments, append arguments")
("gexpify arguments, substitute-keyword-arguments")
("gexpify arguments, append substitute-keyword-arguments"): New tests.
* doc/guix.texi (package Reference): For 'arguments', add compatibility
note and link to 'guix style'.
(Invoking guix style): Document the 'arguments' styling rule.
---
 doc/guix.texi          |  51 ++++++++++++
 guix/scripts/style.scm | 173 ++++++++++++++++++++++++++++++++++++++++-
 tests/style.scm        | 136 ++++++++++++++++++++++++++++++++
 3 files changed, 359 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 55221a10c3..12d7e02bca 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7743,6 +7743,24 @@ package Reference
 @code{#:phases}.  The @code{#:phases} keyword in particular lets you
 modify the set of build phases for your package (@pxref{Build Phases}).
 
+@quotation Compatibility Note
+Until version 1.3.0, the @code{arguments} field would typically use
+@code{quote} (@code{'}) or @code{quasiquote} (@code{`}) and no
+G-expressions, like so:
+
+@lisp
+(package
+  ;; several fields omitted
+  (arguments   ;old-style quoted arguments
+   '(#:tests? #f
+     #:configure-flags '("--enable-frobbing"))))
+@end lisp
+
+To convert from that style to the one shown above, you can run
+@code{guix style -S arguments @var{package}} (@pxref{Invoking guix
+style}).
+@end quotation
+
 @item @code{inputs} (default: @code{'()})
 @itemx @code{native-inputs} (default: @code{'()})
 @itemx @code{propagated-inputs} (default: @code{'()})
@@ -14657,6 +14675,39 @@ Invoking guix style
 out if it cannot make sense of the code that appears in an inputs field.
 The @option{--input-simplification} option described below provides
 fine-grain control over when inputs should be simplified.
+
+@item arguments
+Rewrite package arguments to use G-expressions (@pxref{G-Expressions}).
+For example, consider this package definition:
+
+@lisp
+(define-public my-package
+  (package
+    ;; @dots{}
+    (arguments      ;old-style quoted arguments
+     '(#:make-flags '("V=1")
+       #:phases (modify-phases %standard-phases
+                  (delete 'build))))))
+@end lisp
+
+@noindent
+Running @command{guix style -S arguments} on this package would rewrite
+its @code{arguments} field like to:
+
+@lisp
+(define-public my-package
+  (package
+    ;; @dots{}
+    (arguments
+      (list #:make-flags #~'("V=1")
+            #:phases #~(modify-phases %standard-phases
+                         (delete 'build))))))
+@end lisp
+
+Note that changes made by the @code{arguments} rule do not entail a
+rebuild of the affected packages.  Furthermore, if a package definition
+happens to be using G-expressions already, @command{guix style} leaves
+it unchanged.
 @end table
 
 @item --list-stylings
diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 00c7d3f90c..1d02742524 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -41,6 +41,7 @@ (define-module (guix scripts style)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-37)
   #:export (guix-style))
@@ -302,6 +303,174 @@ (define* (simplify-package-inputs package
             (list package-inputs package-native-inputs
                   package-propagated-inputs)))
 
+\f
+;;;
+;;; Gexpifying package arguments.
+;;;
+
+(define (unquote->ungexp value)
+  "Replace 'unquote' and 'unquote-splicing' in VALUE with their gexp
+counterpart."
+  ;; Replace 'unquote only on the first quasiquotation level.
+  (let loop ((value value)
+             (quotation 1))
+    (match value
+      (('unquote x)
+       (if (= quotation 1)
+           `(ungexp ,x)
+           value))
+      (('unquote-splicing x)
+       (if (= quotation 1)
+           `(ungexp-splicing x)
+           value))
+      (('quasiquote x)
+       (list 'quasiquote (loop x (+ quotation 1))))
+      (('quote x)
+       (list 'quote (loop x (+ quotation 1))))
+      ((lst ...)
+       (map (cut loop <> quotation) lst))
+      (x x))))
+
+(define (gexpify-argument-value value quotation)
+  "Turn VALUE, an sexp, into its gexp equivalent.  QUOTATION is a symbol that
+indicates in what quotation context VALUE is to be interpreted: 'quasiquote,
+'quote, or 'none."
+  (match quotation
+    ('none
+     (match value
+       (('quasiquote value)
+        (gexpify-argument-value value 'quasiquote))
+       (('quote value)
+        (gexpify-argument-value value 'quote))
+       (value value)))
+    ('quote
+     `(gexp ,value))
+    ('quasiquote
+     `(gexp ,(unquote->ungexp value)))))
+
+(define (quote-argument-value value quotation)
+  "Quote VALUE, an sexp.  QUOTATION is a symbol that indicates in what
+quotation context VALUE is to be interpreted: 'quasiquote, 'quote, or 'none."
+  (define (self-quoting? x)
+    (or (boolean? x) (number? x) (string? x) (char? x)
+        (keyword? x)))
+
+  (match quotation
+    ('none
+     (match value
+       (('quasiquote value)
+        (quote-argument-value value 'quasiquote))
+       (('quote value)
+        (quote-argument-value value 'quote))
+       (value value)))
+    ('quote
+     (if (self-quoting? value)
+         value
+         (list 'quote value)))
+    ('quasiquote
+     (match value
+       (('unquote x) x)
+       ((? self-quoting? x) x)
+       (_ (list 'quasiquote value))))))
+
+(define %gexp-keywords
+  ;; Package argument keywords that must be followed by a gexp.
+  '(#:phases #:configure-flags #:make-flags #:strip-flags))
+
+(define (gexpify-argument-tail sexp)
+  "Gexpify SEXP, an unquoted argument tail."
+  (match sexp
+    (('substitute-keyword-arguments lst clauses ...)
+     `(substitute-keyword-arguments ,lst
+        ,@(map (match-lambda
+                 ((((? keyword? keyword) identifier) body)
+                  `((,keyword ,identifier)
+                    ,(if (memq keyword %gexp-keywords)
+                         (gexpify-argument-value body 'none)
+                         (quote-argument-value body 'none))))
+                 ((((? keyword? keyword) identifier default) body)
+                  `((,keyword ,identifier
+                              ,(if (memq keyword %gexp-keywords)
+                                   (gexpify-argument-value default 'none)
+                                   (quote-argument-value default 'none)))
+                    ,(if (memq keyword %gexp-keywords)
+                         (gexpify-argument-value body 'none)
+                         (quote-argument-value body 'none))))
+                 (clause clause))
+               clauses)))
+    (_ sexp)))
+
+(define* (gexpify-package-arguments package
+                                    #:key
+                                    (policy 'none)
+                                    (edit-expression edit-expression))
+  "Rewrite the 'arguments' field of PACKAGE to use gexps where applicable."
+  (define (gexpify location str)
+    (match (call-with-input-string str read-with-comments)
+      ((rest ...)
+       (let ((blanks (take-while blank? rest))
+             (value  (drop-while blank? rest)))
+         (define-values (quotation arguments tail)
+           (match value
+             (('quote (arguments ...)) (values 'quote arguments '()))
+             (('quasiquote (arguments ... ('unquote-splicing tail)))
+              (values 'quasiquote arguments tail))
+             (('quasiquote (arguments ...)) (values 'quasiquote arguments '()))
+             (('list arguments ...) (values 'none arguments '()))
+             (arguments (values 'none '()  arguments))))
+
+         (define (append-tail sexp)
+           (if (null? tail)
+               sexp
+               (let ((tail (gexpify-argument-tail tail)))
+                 (if (null? arguments)
+                     tail
+                     `(append ,sexp ,tail)))))
+
+         (let/ec return
+           (object->string*
+            (append-tail
+             `(list ,@(let loop ((arguments arguments)
+                                 (result '()))
+                        (match arguments
+                          (() (reverse result))
+                          (((? keyword? keyword) value rest ...)
+                           (when (eq? quotation 'none)
+                             (match value
+                               (('gexp _)         ;already gexpified
+                                (return str))
+                               (_ #f)))
+
+                           (loop rest
+                                 (cons* (if (memq keyword %gexp-keywords)
+                                            (gexpify-argument-value value
+                                                                    quotation)
+                                            (quote-argument-value value quotation))
+                                        keyword result)))
+                          (((? blank? blank) rest ...)
+                           (loop rest (cons blank result)))
+                          (_
+                           ;; Something like: ,@(package-arguments xyz).
+                           (warning location
+                                    (G_ "unsupported argument style; \
+bailing out~%"))
+                           (return str))))))
+            (location-column location)))))
+      (_
+       (warning location
+                (G_ "unsupported argument field; bailing out~%"))
+       str)))
+
+  (unless (null? (package-arguments package))
+    (match (package-field-location package 'arguments)
+      (#f
+       #f)
+      (location
+       (edit-expression
+        (location->source-properties (absolute-location location))
+        (lambda (str)
+          (gexpify location str)))))))
+
 \f
 ;;;
 ;;; Formatting package definitions.
@@ -379,6 +548,7 @@ (define %options
                   (alist-cons 'styling-procedure
                               (match arg
                                 ("inputs" simplify-package-inputs)
+                                ("arguments" gexpify-package-arguments)
                                 ("format" format-package-definition)
                                 (_ (leave (G_ "~a: unknown styling~%")
                                           arg)))
@@ -407,7 +577,8 @@ (define %options
 (define (show-stylings)
   (display (G_ "Available styling rules:\n"))
   (display (G_ "- format: Format the given package definition(s)\n"))
-  (display (G_ "- inputs: Rewrite package inputs to the “new style”\n")))
+  (display (G_ "- inputs: Rewrite package inputs to the “new style”\n"))
+  (display (G_ "- arguments: Rewrite package arguments to G-expressions\n")))
 
 (define (show-help)
   (display (G_ "Usage: guix style [OPTION]... [PACKAGE]...
diff --git a/tests/style.scm b/tests/style.scm
index f141a57d7f..5e38549606 100644
--- a/tests/style.scm
+++ b/tests/style.scm
@@ -386,6 +386,142 @@ (define* (read-package-field package field #:optional (count 1))
       (list (package-inputs (@ (my-packages) my-coreutils))
             (read-package-field (@ (my-packages) my-coreutils) 'inputs 4)))))
 
+(test-assert "gexpify arguments, already gexpified"
+  (call-with-test-package '((arguments
+                             (list #:configure-flags #~'("--help"))))
+    (lambda (directory)
+      (define file
+        (string-append directory "/my-packages.scm"))
+      (define (fingerprint file)
+        (let ((stat (stat file)))
+          (list (stat:mtime stat) (stat:size stat))))
+      (define before
+        (fingerprint file))
+
+      (system* "guix" "style" "-L" directory "my-coreutils"
+               "-S" "arguments")
+
+      (equal? (fingerprint file) before))))
+
+(test-equal "gexpify arguments, non-gexp arguments, margin comment"
+  (list (list #:tests? #f #:test-target "check")
+        "\
+      (arguments (list #:tests? #f ;no tests
+                       #:test-target \"check\"))\n")
+  (call-with-test-package '((arguments
+                             '(#:tests? #f
+                               #:test-target "check")))
+    (lambda (directory)
+      (define file
+        (string-append directory "/my-packages.scm"))
+
+      (substitute* file
+        (("#:tests\\? #f" all)
+         (string-append all " ;no tests\n")))
+
+      (system* "guix" "style" "-L" directory "my-coreutils"
+               "-S" "arguments")
+
+      (load file)
+      (list (package-arguments (@ (my-packages) my-coreutils))
+            (read-package-field (@ (my-packages) my-coreutils) 'arguments 2)))))
+
+(test-equal "gexpify arguments, phases and flags"
+  "\
+        (list #:tests? #f
+              #:configure-flags #~'(\"--fast\")
+              #:make-flags #~(list (string-append \"CC=\"
+                                                  #$(cc-for-target)))
+              #:phases #~(modify-phases %standard-phases
+                           ;; Line comment.
+                           whatever)))\n"
+  (call-with-test-package '((arguments
+                             `(#:tests? #f
+                               #:configure-flags '("--fast")
+                               #:make-flags
+                               (list (string-append "CC=" ,(cc-for-target)))
+                               #:phases (modify-phases %standard-phases
+                                          whatever))))
+    (lambda (directory)
+      (define file
+        (string-append directory "/my-packages.scm"))
+
+      (substitute* file
+        (("whatever")
+         "\n;; Line comment.
+         whatever"))
+      (system* "guix" "style" "-L" directory "my-coreutils"
+               "-S" "arguments")
+
+      (load file)
+      (read-package-field (@ (my-packages) my-coreutils) 'arguments 7))))
+
+(test-equal "gexpify arguments, append arguments"
+  "\
+        (append (list #:tests? #f
+                      #:configure-flags #~'(\"--fast\"))
+                (package-arguments coreutils)))\n"
+  (call-with-test-package '((arguments
+                             `(#:tests? #f
+                               #:configure-flags '("--fast")
+                               ,@(package-arguments coreutils))))
+    (lambda (directory)
+      (define file
+        (string-append directory "/my-packages.scm"))
+
+      (system* "guix" "style" "-L" directory "my-coreutils"
+               "-S" "arguments")
+
+      (load file)
+      (read-package-field (@ (my-packages) my-coreutils) 'arguments 3))))
+
+(test-equal "gexpify arguments, substitute-keyword-arguments"
+  "\
+        (substitute-keyword-arguments (package-arguments coreutils)
+          ((#:tests? _ #f)
+           #t)
+          ((#:make-flags flags
+            #~'())
+           #~(cons \"-DXYZ=yes\"
+                   #$flags))))\n"
+  (call-with-test-package '((arguments
+                             (substitute-keyword-arguments
+                                 (package-arguments coreutils)
+                               ((#:tests? _ #f) #t)
+                               ((#:make-flags flags ''())
+                                `(cons "-DXYZ=yes" ,flags)))))
+    (lambda (directory)
+      (define file
+        (string-append directory "/my-packages.scm"))
+
+      (system* "guix" "style" "-L" directory "my-coreutils"
+               "-S" "arguments")
+
+      (load file)
+      (read-package-field (@ (my-packages) my-coreutils) 'arguments 7))))
+
+(test-equal "gexpify arguments, append substitute-keyword-arguments"
+  "\
+        (append (list #:tests? #f)
+                (substitute-keyword-arguments (package-arguments coreutils)
+                  ((#:make-flags flags)
+                   #~(append `(\"-n\" ,%output)
+                             #$flags)))))\n"
+  (call-with-test-package '((arguments
+                             `(#:tests? #f
+                               ,@(substitute-keyword-arguments
+                                     (package-arguments coreutils)
+                                   ((#:make-flags flags)
+                                    `(append `("-n" ,%output) ,flags))))))
+    (lambda (directory)
+      (define file
+        (string-append directory "/my-packages.scm"))
+
+      (system* "guix" "style" "-L" directory "my-coreutils"
+               "-S" "arguments")
+
+      (load file)
+      (read-package-field (@ (my-packages) my-coreutils) 'arguments 5))))
 
 (test-end)
 
-- 
2.39.2

[bug#63320] [PATCH 2/2] DRAFT news: Add entry to 'guix style -S arguments'.

[Ludovic Courtès]

DRAFT: Missing commit ID.

* etc/news.scm: Add entry.
---
 etc/news.scm | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/etc/news.scm b/etc/news.scm
index 22f04e4dae..41a03405a7 100644
--- a/etc/news.scm
+++ b/etc/news.scm
@@ -26,6 +26,22 @@
 (channel-news
  (version 0)
 
+ (entry (commit "FIXME")
+        (title
+         (en "New @code{arguments} rule for @command{guix style}"))
+        (body
+         (en "The @command{guix style} command has a new @dfn{styling rule}
+for package definitions.  Package writers may now run the following command:
+
+@example
+guix style -L /path/to/channel -S arguments @var{package}
+@end example
+
+This command rewrites the @code{arguments} field of @var{package} so that it
+uses G-expressions instead of classical quasiquotation.
+
+Run @command{info \"(guix) Invoking guix style\"} for more info.")))
+
  (entry (commit "ae11fcb84ac478dfa56d322ef08890645183a087")
         (title
          (en "New @option{--with-configure-flag} transformation option")
-- 
2.39.2

[bug#63320] [PATCH 2/2] DRAFT news: Add entry to 'guix style -S arguments'.

[pelzflorian (Florian Pelz)]

Hi Ludo.  Would you add this German translation:

(title
 (en …)
 (de "Neue Stilregel @code{arguments} für @command{guix style}"))
(body
 (en …)
 (de "Der Befehl @command{guix style} verfügt über eine neue @dfn{Stilregel}
für Paketdefinitionen.  Paketautoren können jetzt folgenden Befehl benutzen:

@example
guix style -L /pfad/zum/kanal -S arguments @var{Paket}
@end example

Dadurch wird das Feld @code{arguments} in @var{Paket} so umgeschrieben, dass
G-Ausdrücke (gexps) anstelle von klassischer Quasiquotierung verwendet
werden.

Führen Sie @command{info \"(guix.de) Aufruf von guix style\"} aus, um
mehr Informationen zu erhalten.")))



Regards,
Florian

bug#63320: [PATCH 0/2] Rewrite 'arguments' to gexps with 'guix style -S arguments'

[Ludovic Courtès]

Hi,

Ludovic Courtès <ludo@gnu.org> skribis:

> When preparing <https://guix.gnu.org/en/blog/2021/the-big-change/>, I didn’t
> consider converting ‘arguments’ from sexps to gexps a priority.  In practice,
> we’ve been doing that manually ever since but there’s a sort of a “contamination”
> aspect: due to inheritance, we often have to be careful enough to convert
> multiple packages at once or to not change anything, or we end up with gexp
> records inside sexps¹.  Automation appears to be overdue.
>
> The attached patches add ‘guix style -S arguments’, which rewrites ‘arguments’
> from sexps to gexps.  The change doesn’t involve any rebuild, so we could even
> run it en masse on the whole repo and be done with it.

Pushed as 2344ccee2f28f790fa0b69ecb1916c162c1f8c50, with Florian’s
news entry translation (I just realized I forgot to add you as
co-author, my apologies!).

I guess we should address the shortcomings I mentioned before we can run
it on the whole repo.

Thanks,
Ludo’.