[bug#52974] [PATCH 0/5] Formatting package definitions with 'guix style'

[bug#52974] [PATCH 0/5] Formatting package definitions with 'guix style'

[Ludovic Courtès]

Hello Guix!

This patch set extends ‘guix style’ so that it can format
package definitions following our conventions.  It adds a
new ‘-S’ option to ‘guix style’, which allows you to select
a “styling rule”.

To obtain the same behavior as before, you now need to run
‘guix style -S inputs’ (this is an incompatibility); ‘guix
style’ alone is equivalent to ‘guix style -S format’, which
formats the given package definition(s).

The code of the pretty printer is not pretty, but it does a
rather good job, notably because it recognizes our special
forms and rules, unlike ‘pretty-print’.  I’m sure we could
spend months tweaking it, but I think it’s reached the point
where we can recommend it.

This nicely replaces ‘etc/indent-code.el’ and will hopefully
make the lives of contributors easier.

Thoughts?

Eventually we should change importers to use this instead of
(ice-9 pretty-print).  I also envision a rule to rewrite Rust
packages to look like regular packages, as discussed earlier
with Efraim, which will benefit from this work.

Ludo’.

Ludovic Courtès (5):
  style: Improve pretty printer and add tests.
  style: Allow special forms to be scoped.
  style: Add support for "newline forms".
  style: Add '--styling' option.
  style: '-S format' canonicalizes comments.

 doc/contributing.texi  |  18 +-
 doc/guix.texi          |  60 +++++-
 etc/indent-code.el     | 120 ------------
 guix/scripts/style.scm | 415 +++++++++++++++++++++++++++++++++++------
 tests/style.scm        | 162 +++++++++++++++-
 5 files changed, 571 insertions(+), 204 deletions(-)
 delete mode 100755 etc/indent-code.el


base-commit: 637dec9d45db4df2a3e6aa565fa2c5cf6bb77768
-- 
2.33.0

[bug#52974] [PATCH 1/5] style: Improve pretty printer and add tests.

[Ludovic Courtès]

* guix/scripts/style.scm (vhashq): New macro.
(%special-forms): New variable.
(special-form?): New procedure.
(pretty-print-with-comments): Add many clauses and tweak existing
rules.
* tests/style.scm (test-pretty-print): New macro.
<top level>: Add 'test-pretty-print' tests.
---
 guix/scripts/style.scm | 270 +++++++++++++++++++++++++++++++++--------
 tests/style.scm        |  95 +++++++++++++++
 2 files changed, 316 insertions(+), 49 deletions(-)

diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 3b246e9c66..a5204d02ef 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -40,11 +40,15 @@ (define-module (guix scripts style)
   #:use-module (ice-9 control)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
-  #:export (guix-style))
+  #:export (pretty-print-with-comments
+            read-with-comments
+
+            guix-style))
 
 \f
 ;;;
@@ -109,15 +113,136 @@ (define (read-with-comments port)
 ;;; Comment-preserving pretty-printer.
 ;;;
 
+(define-syntax vhashq
+  (syntax-rules ()
+    ((_) vlist-null)
+    ((_ (key value) rest ...)
+     (vhash-consq key value (vhashq rest ...)))))
+
+(define %special-forms
+  ;; Forms that are indented specially.  The number is meant to be understood
+  ;; like Emacs' 'scheme-indent-function' symbol property.
+  (vhashq
+   ('begin 1)
+   ('lambda 2)
+   ('lambda* 2)
+   ('match-lambda 1)
+   ('match-lambda* 2)
+   ('define 2)
+   ('define* 2)
+   ('define-public 2)
+   ('define*-public 2)
+   ('define-syntax 2)
+   ('define-syntax-rule 2)
+   ('define-module 2)
+   ('define-gexp-compiler 2)
+   ('let 2)
+   ('let* 2)
+   ('letrec 2)
+   ('letrec* 2)
+   ('match 2)
+   ('when 2)
+   ('unless 2)
+   ('package 1)
+   ('origin 1)
+   ('operating-system 1)
+   ('modify-inputs 2)
+   ('modify-phases 2)
+   ('add-after 3)
+   ('add-before 3)
+   ;; ('replace 2)
+   ('substitute* 2)
+   ('substitute-keyword-arguments 2)
+   ('call-with-input-file 2)
+   ('call-with-output-file 2)
+   ('with-output-to-file 2)
+   ('with-input-from-file 2)))
+
+(define (special-form? symbol)
+  (vhash-assq symbol %special-forms))
+
+(define (escaped-string str)
+  "Return STR with backslashes and double quotes escaped.  Everything else, in
+particular newlines, is left as is."
+  (list->string
+   `(#\"
+     ,@(string-fold-right (lambda (chr lst)
+                            (match chr
+                              (#\" (cons* #\\ #\" lst))
+                              (#\\ (cons* #\\ #\\ lst))
+                              (_   (cons chr lst))))
+                          '()
+                          str)
+     #\")))
+
+(define (string-width str)
+  "Return the \"width\" of STR--i.e., the width of the longest line of STR."
+  (apply max (map string-length (string-split str #\newline))))
+
 (define* (pretty-print-with-comments port obj
                                      #:key
                                      (indent 0)
                                      (max-width 78)
                                      (long-list 5))
+  "Pretty-print OBJ to PORT, attempting to at most MAX-WIDTH character columns
+and assuming the current column is INDENT.  Comments present in OBJ are
+included in the output.
+
+Lists longer than LONG-LIST are written as one element per line."
   (let loop ((indent indent)
              (column indent)
              (delimited? #t)                  ;true if comes after a delimiter
              (obj obj))
+    (define (print-sequence indent column lst delimited?)
+      (define long?
+        (> (length lst) long-list))
+
+      (let print ((lst lst)
+                  (first? #t)
+                  (delimited? delimited?)
+                  (column column))
+        (match lst
+          (()
+           column)
+          ((item . tail)
+           (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.  Also insert a newline
+             ;; before a keyword.
+             (and (or (pair? item) long?
+                      (and (keyword? item)
+                           (not (eq? item #:allow-other-keys))))
+                  (not first?) (not delimited?)
+                  (not (comment? item))))
+
+           (when newline?
+             (newline port)
+             (display (make-string indent #\space) port))
+           (let ((column (if newline? indent column)))
+             (print tail #f
+                    (comment? item)
+                    (loop indent column
+                          (or newline? delimited?)
+                          item)))))))
+
+    (define (sequence-would-protrude? indent lst)
+      ;; Return true if elements of LST written at INDENT would protrude
+      ;; beyond MAX-WIDTH.  This is implemented as a cheap test with false
+      ;; negatives to avoid actually rendering all of LST.
+      (find (match-lambda
+              ((? string? str)
+               (>= (+ (string-width str) 2 indent) max-width))
+              ((? symbol? symbol)
+               (>= (+ (string-width (symbol->string symbol)) indent)
+                   max-width))
+              ((? boolean?)
+               (>= (+ 2 indent) max-width))
+              (()
+               (>= (+ 2 indent) max-width))
+              (_                                  ;don't know
+               #f))
+            lst))
+
     (match obj
       ((? comment? comment)
        (if (comment-margin? comment)
@@ -145,57 +270,104 @@ (define* (pretty-print-with-comments port obj
        (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 "))
+      (('unquote-splicing lst)
+       (unless delimited? (display " " port))
+       (display ",@" port)
+       (loop indent (+ column (if delimited? 2 3)) #t lst))
+      (('gexp lst)
+       (unless delimited? (display " " port))
+       (display "#~" port)
+       (loop indent (+ column (if delimited? 2 3)) #t lst))
+      (('ungexp obj)
+       (unless delimited? (display " " port))
+       (display "#$" port)
+       (loop indent (+ column (if delimited? 2 3)) #t obj))
+      (('ungexp-native obj)
+       (unless delimited? (display " " port))
+       (display "#+" port)
+       (loop indent (+ column (if delimited? 2 3)) #t obj))
+      (('ungexp-splicing lst)
+       (unless delimited? (display " " port))
+       (display "#$@" port)
+       (loop indent (+ column (if delimited? 3 4)) #t lst))
+      (('ungexp-native-splicing lst)
+       (unless delimited? (display " " port))
+       (display "#+@" port)
+       (loop indent (+ column (if delimited? 3 4)) #t lst))
+      (((? special-form? head) arguments ...)
+       ;; Special-case 'let', 'lambda', 'modify-inputs', etc. so the second
+       ;; and following arguments are less indented.
+       (let* ((lead  (- (cdr (vhash-assq head %special-forms)) 1))
+              (head  (symbol->string head))
+              (total (length arguments)))
+         (unless delimited? (display " " port))
+         (display "(" port)
          (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)))
+         (unless (zero? lead)
+           (display " " port))
+
+         ;; Print the first LEAD arguments.
+         (let* ((indent (+ column 2
+                                  (if delimited? 0 1)))
+                (column (+ column 1
+                                  (if (zero? lead) 0 1)
+                                  (if delimited? 0 1)
+                                  (string-length head)))
+                (initial-indent column))
+           (define new-column
+             (let inner ((n lead)
+                         (arguments (take arguments (min lead total)))
+                         (column column))
+               (if (zero? n)
+                   (begin
+                     (newline port)
+                     (display (make-string indent #\space) port)
+                     indent)
+                   (match arguments
+                     (() column)
+                     ((head . tail)
+                      (inner (- n 1) tail
+                             (loop initial-indent
+                                   column
+                                   (= n lead)
+                                   head)))))))
+
+           ;; Print the remaining arguments.
+           (let ((column (print-sequence
+                          indent new-column
+                          (drop arguments (min lead total))
+                          #t)))
+             (display ")" port)
+             (+ column 1)))))
+      ((head tail ...)
+       (let* ((overflow? (>= column max-width))
+              (column    (if overflow?
+                             (+ indent 1)
+                             (+ column (if delimited? 1 2)))))
+         (if overflow?
+             (begin
+               (newline port)
+               (display (make-string indent #\space) port))
+             (unless delimited? (display " " port)))
+         (display "(" port)
+         (let* ((new-column (loop column column #t head))
+                (indent (if (or (>= new-column max-width)
+                                (not (symbol? head))
+                                (sequence-would-protrude?
+                                 (+ new-column 1) tail))
+                            column
+                            (+ new-column 1))))
+           (define column
+             (print-sequence indent new-column tail #f))
            (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)
+       (let* ((str (if (string? obj)
+                       (escaped-string obj)
+                       (object->string obj)))
+              (len (string-width str)))
+         (if (and (> (+ column 1 len) max-width)
+                  (not delimited?))
              (begin
                (newline port)
                (display (make-string indent #\space) port)
@@ -204,7 +376,7 @@ (define newline?
              (begin
                (unless delimited? (display " " port))
                (display str port)
-               (+ column (if delimited? 1 2) len))))))))
+               (+ column (if delimited? 0 1) len))))))))
 
 (define (object->string* obj indent)
   (call-with-output-string
diff --git a/tests/style.scm b/tests/style.scm
index ada9197fc1..d9e8d803f4 100644
--- a/tests/style.scm
+++ b/tests/style.scm
@@ -21,6 +21,7 @@ (define-module (tests-style)
   #:use-module (guix scripts style)
   #:use-module ((guix utils) #:select (call-with-temporary-directory))
   #:use-module ((guix build utils) #:select (substitute*))
+  #:use-module (guix gexp)                        ;for the reader extension
   #:use-module (guix diagnostics)
   #:use-module (gnu packages acl)
   #:use-module (gnu packages multiprecision)
@@ -111,6 +112,17 @@ (define* (read-package-field package field #:optional (count 1))
       (lambda (port)
         (read-lines port line count)))))
 
+(define-syntax-rule (test-pretty-print str args ...)
+  "Test equality after a round-trip where STR is passed to
+'read-with-comments' and the resulting sexp is then passed to
+'pretty-print-with-comments'."
+  (test-equal str
+    (call-with-output-string
+      (lambda (port)
+        (let ((exp (call-with-input-string str
+                     read-with-comments)))
+         (pretty-print-with-comments port exp args ...))))))
+
 \f
 (test-begin "style")
 
@@ -358,6 +370,89 @@ (define file
       (list (package-inputs (@ (my-packages) my-coreutils))
             (read-package-field (@ (my-packages) my-coreutils) 'inputs 4)))))
 
+(test-pretty-print "(list 1 2 3 4)")
+(test-pretty-print "(list 1
+                          2
+                          3
+                          4)"
+                   #:long-list 3
+                   #:indent 20)
+(test-pretty-print "\
+(list abc
+      def)"
+                   #:max-width 11)
+(test-pretty-print "\
+(#:foo
+ #:bar)"
+                   #:max-width 10)
+
+(test-pretty-print "\
+(#:first 1
+ #:second 2
+ #:third 3)")
+
+(test-pretty-print "\
+((x
+  1)
+ (y
+  2)
+ (z
+  3))"
+                   #:max-width 3)
+
+(test-pretty-print "\
+(let ((x 1)
+      (y 2)
+      (z 3)
+      (p 4))
+  (+ x y))"
+                   #:max-width 11)
+
+(test-pretty-print "\
+(lambda (x y)
+  ;; This is a procedure.
+  (let ((z (+ x y)))
+    (* z z)))")
+
+(test-pretty-print "\
+#~(string-append #$coreutils \"/bin/uname\")")
+
+(test-pretty-print "\
+(package
+  (inherit coreutils)
+  (version \"42\"))")
+
+(test-pretty-print "\
+(modify-phases %standard-phases
+  (add-after 'unpack 'post-unpack
+    (lambda _
+      #t))
+  (add-before 'check 'pre-check
+    (lambda* (#:key inputs #:allow-other-keys)
+      do things ...)))")
+
+(test-pretty-print "\
+(#:phases (modify-phases sdfsdf
+            (add-before 'x 'y
+              (lambda _
+                xyz))))")
+
+(test-pretty-print "\
+(description \"abcdefghijkl
+mnopqrstuvwxyz.\")"
+                   #:max-width 30)
+
+(test-pretty-print "\
+(description
+ \"abcdefghijkl
+mnopqrstuvwxyz.\")"
+                   #:max-width 12)
+
+(test-pretty-print "\
+(description
+ \"abcdefghijklmnopqrstuvwxyz\")"
+                   #:max-width 33)
+
 (test-end)
 
 ;; Local Variables:
-- 
2.33.0

[bug#52974] [PATCH 2/5] style: Allow special forms to be scoped.

[Ludovic Courtès]

* guix/scripts/style.scm (vhashq): Add clause for 'lst, and change
default clause.
(%special-forms): Add context for 'add-after and 'add-before.  Add
'replace.
(prefix?, special-form-lead): New procedures.
(special-form?): Remove.
(pretty-print-with-comments): Add 'context' to the threaded state.
Adjust 'print-sequence' and adjust 'loop' calls accordingly.
* tests/style.scm: Add tests for 'replace.
---
 guix/scripts/style.scm | 88 +++++++++++++++++++++++++++++-------------
 tests/style.scm        | 12 ++++++
 2 files changed, 73 insertions(+), 27 deletions(-)

diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index a5204d02ef..625e942613 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -114,14 +114,19 @@ (define (read-with-comments port)
 ;;;
 
 (define-syntax vhashq
-  (syntax-rules ()
+  (syntax-rules (quote)
     ((_) vlist-null)
+    ((_ (key (quote (lst ...))) rest ...)
+     (vhash-consq key '(lst ...) (vhashq rest ...)))
     ((_ (key value) rest ...)
-     (vhash-consq key value (vhashq rest ...)))))
+     (vhash-consq key '((() . value)) (vhashq rest ...)))))
 
 (define %special-forms
   ;; Forms that are indented specially.  The number is meant to be understood
-  ;; like Emacs' 'scheme-indent-function' symbol property.
+  ;; like Emacs' 'scheme-indent-function' symbol property.  When given an
+  ;; alist instead of a number, the alist gives "context" in which the symbol
+  ;; is a special form; for instance, context (modify-phases) means that the
+  ;; symbol must appear within a (modify-phases ...) expression.
   (vhashq
    ('begin 1)
    ('lambda 2)
@@ -148,9 +153,9 @@ (define %special-forms
    ('operating-system 1)
    ('modify-inputs 2)
    ('modify-phases 2)
-   ('add-after 3)
-   ('add-before 3)
-   ;; ('replace 2)
+   ('add-after '(((modify-phases) . 3)))
+   ('add-before '(((modify-phases) . 3)))
+   ('replace '(((modify-phases) . 2)))         ;different from 'modify-inputs'
    ('substitute* 2)
    ('substitute-keyword-arguments 2)
    ('call-with-input-file 2)
@@ -158,8 +163,30 @@ (define %special-forms
    ('with-output-to-file 2)
    ('with-input-from-file 2)))
 
-(define (special-form? symbol)
-  (vhash-assq symbol %special-forms))
+(define (prefix? candidate lst)
+  "Return true if CANDIDATE is a prefix of LST."
+  (let loop ((candidate candidate)
+             (lst lst))
+    (match candidate
+      (() #t)
+      ((head1 . rest1)
+       (match lst
+         (() #f)
+         ((head2 . rest2)
+          (and (equal? head1 head2)
+               (loop rest1 rest2))))))))
+
+(define (special-form-lead symbol context)
+  "If SYMBOL is a special form in the given CONTEXT, return its number of
+arguments; otherwise return #f.  CONTEXT is a stack of symbols lexically
+surrounding SYMBOL."
+  (match (vhash-assq symbol %special-forms)
+    (#f #f)
+    ((_ . alist)
+     (any (match-lambda
+            ((prefix . level)
+             (and (prefix? prefix context) (- level 1))))
+          alist))))
 
 (define (escaped-string str)
   "Return STR with backslashes and double quotes escaped.  Everything else, in
@@ -192,8 +219,9 @@ (define* (pretty-print-with-comments port obj
   (let loop ((indent indent)
              (column indent)
              (delimited? #t)                  ;true if comes after a delimiter
+             (context '())                    ;list of "parent" symbols
              (obj obj))
-    (define (print-sequence indent column lst delimited?)
+    (define (print-sequence context indent column lst delimited?)
       (define long?
         (> (length lst) long-list))
 
@@ -223,6 +251,7 @@ (define newline?
                     (comment? item)
                     (loop indent column
                           (or newline? delimited?)
+                          context
                           item)))))))
 
     (define (sequence-would-protrude? indent lst)
@@ -243,6 +272,9 @@ (define (sequence-would-protrude? indent lst)
                #f))
             lst))
 
+    (define (special-form? head)
+      (special-form-lead head context))
+
     (match obj
       ((? comment? comment)
        (if (comment-margin? comment)
@@ -261,45 +293,46 @@ (define (sequence-would-protrude? indent lst)
       (('quote lst)
        (unless delimited? (display " " port))
        (display "'" port)
-       (loop indent (+ column (if delimited? 1 2)) #t lst))
+       (loop indent (+ column (if delimited? 1 2)) #t context lst))
       (('quasiquote lst)
        (unless delimited? (display " " port))
        (display "`" port)
-       (loop indent (+ column (if delimited? 1 2)) #t lst))
+       (loop indent (+ column (if delimited? 1 2)) #t context lst))
       (('unquote lst)
        (unless delimited? (display " " port))
        (display "," port)
-       (loop indent (+ column (if delimited? 1 2)) #t lst))
+       (loop indent (+ column (if delimited? 1 2)) #t context lst))
       (('unquote-splicing lst)
        (unless delimited? (display " " port))
        (display ",@" port)
-       (loop indent (+ column (if delimited? 2 3)) #t lst))
+       (loop indent (+ column (if delimited? 2 3)) #t context lst))
       (('gexp lst)
        (unless delimited? (display " " port))
        (display "#~" port)
-       (loop indent (+ column (if delimited? 2 3)) #t lst))
+       (loop indent (+ column (if delimited? 2 3)) #t context lst))
       (('ungexp obj)
        (unless delimited? (display " " port))
        (display "#$" port)
-       (loop indent (+ column (if delimited? 2 3)) #t obj))
+       (loop indent (+ column (if delimited? 2 3)) #t context obj))
       (('ungexp-native obj)
        (unless delimited? (display " " port))
        (display "#+" port)
-       (loop indent (+ column (if delimited? 2 3)) #t obj))
+       (loop indent (+ column (if delimited? 2 3)) #t context obj))
       (('ungexp-splicing lst)
        (unless delimited? (display " " port))
        (display "#$@" port)
-       (loop indent (+ column (if delimited? 3 4)) #t lst))
+       (loop indent (+ column (if delimited? 3 4)) #t context lst))
       (('ungexp-native-splicing lst)
        (unless delimited? (display " " port))
        (display "#+@" port)
-       (loop indent (+ column (if delimited? 3 4)) #t lst))
+       (loop indent (+ column (if delimited? 3 4)) #t context lst))
       (((? special-form? head) arguments ...)
        ;; Special-case 'let', 'lambda', 'modify-inputs', etc. so the second
        ;; and following arguments are less indented.
-       (let* ((lead  (- (cdr (vhash-assq head %special-forms)) 1))
-              (head  (symbol->string head))
-              (total (length arguments)))
+       (let* ((lead    (special-form-lead head context))
+              (context (cons head context))
+              (head    (symbol->string head))
+              (total   (length arguments)))
          (unless delimited? (display " " port))
          (display "(" port)
          (display head port)
@@ -327,14 +360,14 @@ (define new-column
                      (() column)
                      ((head . tail)
                       (inner (- n 1) tail
-                             (loop initial-indent
-                                   column
+                             (loop initial-indent column
                                    (= n lead)
+                                   context
                                    head)))))))
 
            ;; Print the remaining arguments.
            (let ((column (print-sequence
-                          indent new-column
+                          context indent new-column
                           (drop arguments (min lead total))
                           #t)))
              (display ")" port)
@@ -343,14 +376,15 @@ (define new-column
        (let* ((overflow? (>= column max-width))
               (column    (if overflow?
                              (+ indent 1)
-                             (+ column (if delimited? 1 2)))))
+                             (+ column (if delimited? 1 2))))
+              (context   (cons head context)))
          (if overflow?
              (begin
                (newline port)
                (display (make-string indent #\space) port))
              (unless delimited? (display " " port)))
          (display "(" port)
-         (let* ((new-column (loop column column #t head))
+         (let* ((new-column (loop column column #t context head))
                 (indent (if (or (>= new-column max-width)
                                 (not (symbol? head))
                                 (sequence-would-protrude?
@@ -358,7 +392,7 @@ (define new-column
                             column
                             (+ new-column 1))))
            (define column
-             (print-sequence indent new-column tail #f))
+             (print-sequence context indent new-column tail #f))
            (display ")" port)
            (+ column 1))))
       (_
diff --git a/tests/style.scm b/tests/style.scm
index d9e8d803f4..6c449cb72e 100644
--- a/tests/style.scm
+++ b/tests/style.scm
@@ -453,6 +453,18 @@ (define file
  \"abcdefghijklmnopqrstuvwxyz\")"
                    #:max-width 33)
 
+(test-pretty-print "\
+(modify-phases %standard-phases
+  (replace 'build
+    ;; Nicely indented in 'modify-phases' context.
+    (lambda _
+      #t)))")
+
+(test-pretty-print "\
+(modify-inputs inputs
+  ;; Regular indentation for 'replace' here.
+  (replace \"gmp\" gmp))")
+
 (test-end)
 
 ;; Local Variables:
-- 
2.33.0

[bug#52974] [PATCH 3/5] style: Add support for "newline forms".

[Ludovic Courtès]

This allows us to express cases where a newline should be inserted
immediately after the head symbol of a list.

* guix/scripts/style.scm (%newline-forms): New variable.
(newline-form?): New procedure.
(pretty-print-with-comments): Handle "newline forms".
* tests/style.scm: Add test.
---
 guix/scripts/style.scm | 40 +++++++++++++++++++++++++++++++++++-----
 tests/style.scm        | 13 +++++++++++++
 2 files changed, 48 insertions(+), 5 deletions(-)

diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 625e942613..00680daa23 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -163,6 +163,18 @@ (define %special-forms
    ('with-output-to-file 2)
    ('with-input-from-file 2)))
 
+(define %newline-forms
+  ;; List heads that must be followed by a newline.  The second argument is
+  ;; the context in which they must appear.  This is similar to a special form
+  ;; of 1, except that indent is 1 instead of 2 columns.
+  (vhashq
+   ('arguments '(package))
+   ('sha256 '(origin source package))
+   ('base32 '(sha256 origin))
+   ('search-paths '(package))
+   ('native-search-paths '(package))
+   ('search-path-specification '())))
+
 (define (prefix? candidate lst)
   "Return true if CANDIDATE is a prefix of LST."
   (let loop ((candidate candidate)
@@ -188,6 +200,14 @@ (define (special-form-lead symbol context)
              (and (prefix? prefix context) (- level 1))))
           alist))))
 
+(define (newline-form? symbol context)
+  "Return true if parenthesized expressions starting with SYMBOL must be
+followed by a newline."
+  (match (vhash-assq symbol %newline-forms)
+    (#f #f)
+    ((_ . prefix)
+     (prefix? prefix context))))
+
 (define (escaped-string str)
   "Return STR with backslashes and double quotes escaped.  Everything else, in
 particular newlines, is left as is."
@@ -377,6 +397,7 @@ (define new-column
               (column    (if overflow?
                              (+ indent 1)
                              (+ column (if delimited? 1 2))))
+              (newline?  (newline-form? head context))
               (context   (cons head context)))
          (if overflow?
              (begin
@@ -384,17 +405,26 @@ (define new-column
                (display (make-string indent #\space) port))
              (unless delimited? (display " " port)))
          (display "(" port)
+
          (let* ((new-column (loop column column #t context head))
                 (indent (if (or (>= new-column max-width)
                                 (not (symbol? head))
                                 (sequence-would-protrude?
-                                 (+ new-column 1) tail))
+                                 (+ new-column 1) tail)
+                                newline?)
                             column
                             (+ new-column 1))))
-           (define column
-             (print-sequence context indent new-column tail #f))
-           (display ")" port)
-           (+ column 1))))
+           (when newline?
+             ;; Insert a newline right after HEAD.
+             (newline port)
+             (display (make-string indent #\space) port))
+
+           (let ((column
+                  (print-sequence context indent
+                                  (if newline? indent new-column)
+                                  tail newline?)))
+             (display ")" port)
+             (+ column 1)))))
       (_
        (let* ((str (if (string? obj)
                        (escaped-string obj)
diff --git a/tests/style.scm b/tests/style.scm
index 6c449cb72e..8022688419 100644
--- a/tests/style.scm
+++ b/tests/style.scm
@@ -465,6 +465,19 @@ (define file
   ;; Regular indentation for 'replace' here.
   (replace \"gmp\" gmp))")
 
+(test-pretty-print "\
+(package
+  ;; Here 'sha256', 'base32', and 'arguments' must be
+  ;; immediately followed by a newline.
+  (source (origin
+            (method url-fetch)
+            (sha256
+             (base32
+              \"not a real base32 string\"))))
+  (arguments
+   '(#:phases %standard-phases
+     #:tests? #f)))")
+
 (test-end)
 
 ;; Local Variables:
-- 
2.33.0

[bug#52974] [PATCH 4/5] style: Add '--styling' option.

[Ludovic Courtès]

* guix/scripts/style.scm (format-package-definition): New procedure.
(%options, show-help): Add "--styling".
(%default-options): Add 'styling-procedure'.
(guix-style): Honor it.
* tests/style.scm (with-test-package)
("input labels, 'safe' policy")
("input labels, 'safe' policy, nothing changed")
("input labels, margin comment")
("input labels, margin comment on long list")
("input labels, line comment")
("input labels, modify-inputs and margin comment"): Pass "-S inputs".
* etc/indent-code.el: Remove.
* doc/contributing.texi (Formatting Code): Mention "guix style" instead
of "etc/indent-code.el".
(Submitting Patches): Add item for "guix style".
* doc/guix.texi (Invoking guix style): Document "-S" and update.
---
 doc/contributing.texi  |  18 +++----
 doc/guix.texi          |  60 +++++++++++++++++----
 etc/indent-code.el     | 120 -----------------------------------------
 guix/scripts/style.scm |  43 +++++++++++++--
 tests/style.scm        |  17 ++++--
 5 files changed, 111 insertions(+), 147 deletions(-)
 delete mode 100755 etc/indent-code.el

diff --git a/doc/contributing.texi b/doc/contributing.texi
index 72f5ce1e0e..9f97788c0b 100644
--- a/doc/contributing.texi
+++ b/doc/contributing.texi
@@ -959,17 +959,11 @@ If you do not use Emacs, please make sure to let your editor knows these
 rules.  To automatically indent a package definition, you can also run:
 
 @example
-./etc/indent-code.el gnu/packages/@var{file}.scm @var{package}
+./pre-inst-env guix style @var{package}
 @end example
 
 @noindent
-This automatically indents the definition of @var{package} in
-@file{gnu/packages/@var{file}.scm} by running Emacs in batch mode.  To
-indent a whole file, omit the second argument:
-
-@example
-./etc/indent-code.el gnu/services/@var{file}.scm
-@end example
+@xref{Invoking guix style}, for more information.
 
 @cindex Vim, Scheme code editing
 If you are editing code with Vim, we recommend that you run @code{:set
@@ -1038,6 +1032,10 @@ Run @code{guix lint @var{package}}, where @var{package} is the
 name of the new or modified package, and fix any errors it reports
 (@pxref{Invoking guix lint}).
 
+@item
+Run @code{guix style @var{package}} to format the new package definition
+according to the project's conventions (@pxref{Invoking guix style}).
+
 @item
 Make sure the package builds on your platform, using @code{guix build
 @var{package}}.
@@ -1175,8 +1173,8 @@ Examples of unrelated changes include the addition of several packages,
 or a package update along with fixes to that package.
 
 @item
-Please follow our code formatting rules, possibly running the
-@command{etc/indent-code.el} script to do that automatically for you
+Please follow our code formatting rules, possibly running
+@command{guix style} script to do that automatically for you
 (@pxref{Formatting Code}).
 
 @item
diff --git a/doc/guix.texi b/doc/guix.texi
index b72a3d1263..01d4c14e9c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12771,8 +12771,16 @@ otherwise.
 
 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.
+currently provides the providing styling rules:
+
+@itemize
+@item
+formatting package definitions according to the project's conventions
+(@pxref{Formatting Code});
+
+@item
+rewriting package inputs to the ``new style'', as explained below.
+@end itemize
 
 The way package inputs are written is going through a transition
 (@pxref{package Reference}, for more on package inputs).  Until version
@@ -12803,7 +12811,7 @@ 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
+@command{guix style -S inputs} can do that for you, whether you're working on
 packages in Guix proper or in an external channel.
 
 The general syntax is:
@@ -12813,15 +12821,48 @@ 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.
+of @var{package}@dots{} or, when @var{package} is omitted, of @emph{all}
+the packages.  The @option{--styling} or @option{-S} option allows you
+to select the style rule, the default rule being @code{format}---see
+below.
+
+The available options are listed below.
 
 @table @code
 @item --dry-run
 @itemx -n
 Show source file locations that would be edited but do not modify them.
 
+@item --styling=@var{rule}
+@itemx -S @var{rule}
+Apply @var{rule}, one of the following styling rules:
+
+@table @code
+@item format
+Format the given package definition(s)---this is the default styling
+rule.  For example, a packager running Guix on a checkout
+(@pxref{Running Guix Before It Is Installed}) might want to reformat the
+definition of the Coreutils package like so:
+
+@example
+./pre-inst-env guix style coreutils
+@end example
+
+@item inputs
+Rewrite package inputs to the ``new style'', as described above.  This
+is how you would rewrite inputs of package @code{whatnot} in your own
+channel:
+
+@example
+guix style -L ~/my/channel -S inputs whatnot
+@end example
+
+Rewriting is done in a conservative way: preserving comments and bailing
+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.
+@end table
+
 @item --load-path=@var{directory}
 @itemx -L @var{directory}
 Add @var{directory} to the front of the package module search path
@@ -12840,9 +12881,10 @@ guix style -e '(@@ (gnu packages gcc) gcc-5)'
 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:
+When using the @code{inputs} styling rule, with @samp{-S inputs}, this
+option specifies 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
diff --git a/etc/indent-code.el b/etc/indent-code.el
deleted file mode 100755
index bdea8ee8bf..0000000000
--- a/etc/indent-code.el
+++ /dev/null
@@ -1,120 +0,0 @@
-:;exec emacs --batch --quick --load="$0" --funcall=main "$@"
-;;; indent-code.el --- Run Emacs to indent a package definition.
-
-;; Copyright © 2017 Alex Kost <alezost@gmail.com>
-;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
-;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
-;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
-
-;; 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 this program.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This scripts indents the given file or package definition in the specified
-;; file using Emacs.
-
-;;; Code:
-
-;; Load Scheme indentation rules from ".dir-locals.el".
-(with-temp-buffer
-  (scheme-mode)
-  (let ((default-directory (file-name-as-directory load-file-name))
-        (enable-local-variables :all))
-    (hack-dir-local-variables)
-    (hack-local-variables-apply)))
-
-;; Add indentation info for Scheme constructs that are not Guix-specific.
-;; This is normally provided by Geiser but this file is for people who may not
-;; be running Geiser, so we just copy it here (from 'geiser-syntax.el').
-(defmacro guix-syntax--scheme-indent (&rest pairs)
-  `(progn ,@(mapcar (lambda (p)
-                      `(put ',(car p) 'scheme-indent-function ',(cadr p)))
-                    pairs)))
-
-(guix-syntax--scheme-indent
- (and-let* 1)
- (case-lambda 0)
- (catch defun)
- (class defun)
- (dynamic-wind 0)
- (guard 1)
- (let*-values 1)
- (let-values 1)
- (let/ec 1)
- (letrec* 1)
- (match 1)
- (match-lambda 0)
- (match-lambda* 0)
- (match-let scheme-let-indent)
- (match-let* 1)
- (match-letrec 1)
- (opt-lambda 1)
- (parameterize 1)
- (parameterize* 1)
- (receive 2)
- (require-extension 0)
- (syntax-case 2)
- (test-approximate 1)
- (test-assert 1)
- (test-eq 1)
- (test-equal 1)
- (test-eqv 1)
- (test-group-with-cleanup 1)
- (test-runner-on-bad-count! 1)
- (test-runner-on-bad-end-name! 1)
- (test-runner-on-final! 1)
- (test-runner-on-group-begin! 1)
- (test-runner-on-group-end! 1)
- (test-runner-on-test-begin! 1)
- (test-runner-on-test-end! 1)
- (test-with-runner 1)
- (unless 1)
- (when 1)
- (while 1)
- (with-exception-handler 1)
- (with-syntax 1))
-
-\f
-(defun main ()
-  (pcase command-line-args-left
-    (`(,file-name ,package-name)
-     ;; Indent the definition of PACKAGE-NAME in FILE-NAME.
-     (find-file file-name)
-     (goto-char (point-min))
-     (if (re-search-forward (concat "^(define\\(\\|-public\\) +"
-                                    package-name)
-                            nil t)
-         (let ((indent-tabs-mode nil))
-           (beginning-of-defun)
-           (mark-sexp)
-           (untabify (point) (mark))
-           (indent-sexp)
-           (save-buffer)
-           (message "Done!"))
-       (error "Package '%s' not found in '%s'"
-              package-name file-name)))
-    (`(,file-name)
-     ;; Indent all of FILE-NAME.
-     (find-file file-name)
-     (let ((indent-tabs-mode nil))
-       (untabify (point-min) (point-max))
-       (indent-region (point-min) (point-max))
-       (save-buffer)
-       (message "Done!")))
-    (x
-     (error "Usage: indent-code.el FILE [PACKAGE]"))))
-
-;;; indent-code.el ends here
diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 00680daa23..47549c7e4a 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -685,6 +685,29 @@ (define matches?
             (list package-inputs package-native-inputs
                   package-propagated-inputs)))
 
+\f
+;;;
+;;; Formatting package definitions.
+;;;
+
+(define* (format-package-definition package
+                                    #:key policy
+                                    (edit-expression edit-expression))
+  "Reformat the definition of PACKAGE."
+  (unless (package-definition-location package)
+    (leave (package-location package)
+           (G_ "no definition location for package ~a~%")
+           (package-full-name package)))
+
+  (edit-expression
+   (location->source-properties (package-definition-location package))
+   (lambda (str)
+     (let ((exp (call-with-input-string str
+                  read-with-comments)))
+       (object->string* exp
+                        (location-column
+                         (package-definition-location package)))))))
+
 (define (package-location<? p1 p2)
   "Return true if P1's location is \"before\" P2's."
   (let ((loc1 (package-location p1))
@@ -711,6 +734,15 @@ (define %options
         (option '(#\e "expression") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'expression arg result)))
+        (option '(#\S "styling") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'styling-procedure
+                              (match arg
+                                ("inputs" simplify-package-inputs)
+                                ("format" format-package-definition)
+                                (_ (leave (G_ "~a: unknown styling~%")
+                                          arg)))
+                              result)))
         (option '("input-simplification") #t #f
                 (lambda (opt name arg result)
                   (let ((symbol (string->symbol arg)))
@@ -731,6 +763,9 @@ (define %options
 (define (show-help)
   (display (G_ "Usage: guix style [OPTION]... [PACKAGE]...
 Update package definitions to the latest style.\n"))
+  (display (G_ "
+  -S, --styling=RULE     apply RULE, a styling rule"))
+  (newline)
   (display (G_ "
   -n, --dry-run          display files that would be edited but do nothing"))
   (display (G_ "
@@ -751,7 +786,8 @@ (define (show-help)
 
 (define %default-options
   ;; Alist of default option values.
-  '((input-simplification-policy . silent)))
+  `((input-simplification-policy . silent)
+    (styling-procedure . ,format-package-definition)))
 
 \f
 ;;;
@@ -778,11 +814,12 @@ (define (parse-options)
          (edit     (if (assoc-ref opts 'dry-run?)
                        edit-expression/dry-run
                        edit-expression))
+         (style    (assoc-ref opts 'styling-procedure))
          (policy   (assoc-ref opts 'input-simplification-policy)))
     (with-error-handling
       (for-each (lambda (package)
-                  (simplify-package-inputs package #:policy policy
-                                           #:edit-expression edit))
+                  (style package #:policy policy
+                         #:edit-expression edit))
                 ;; Sort package by source code location so that we start editing
                 ;; files from the bottom and going upward.  That way, the
                 ;; 'location' field of <package> records is not invalidated as
diff --git a/tests/style.scm b/tests/style.scm
index 8022688419..7dae543860 100644
--- a/tests/style.scm
+++ b/tests/style.scm
@@ -78,7 +78,8 @@ (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* "guix" "style" "-L" directory "-S" "inputs"
+               "my-coreutils")
       (system* "cat" file)
 
       (load file)
@@ -237,6 +238,7 @@ (define file
         (string-append directory "/my-packages.scm"))
 
       (system* "guix" "style" "-L" directory "my-coreutils"
+               "-S" "inputs"
                "--input-simplification=safe")
 
       (load file)
@@ -258,6 +260,7 @@ (define file
         (string-append directory "/my-packages.scm"))
 
       (system* "guix" "style" "-L" directory "my-coreutils"
+               "-S" "inputs"
                "--input-simplification=safe")
 
       (load file)
@@ -284,7 +287,8 @@ (define file
                         " ;another one\n")))
       (system* "cat" file)
 
-      (system* "guix" "style" "-L" directory "my-coreutils")
+      (system* "guix" "style" "-L" directory "-S" "inputs"
+               "my-coreutils")
 
       (load file)
       (list (package-inputs (@ (my-packages) my-coreutils))
@@ -317,7 +321,8 @@ (define file
                         " ;margin comment\n")))
       (system* "cat" file)
 
-      (system* "guix" "style" "-L" directory "my-coreutils")
+      (system* "guix" "style" "-L" directory "-S" "inputs"
+               "my-coreutils")
 
       (load file)
       (list (package-inputs (@ (my-packages) my-coreutils))
@@ -338,7 +343,8 @@ (define file
         ((",gmp\\)(.*)$" _ rest)
          (string-append ",gmp)\n   ;; line comment!\n" rest)))
 
-      (system* "guix" "style" "-L" directory "my-coreutils")
+      (system* "guix" "style" "-L" directory "-S" "inputs"
+               "my-coreutils")
 
       (load file)
       (list (package-inputs (@ (my-packages) my-coreutils))
@@ -364,7 +370,8 @@ (define file
         ((",acl\\)(.*)$" _ rest)
          (string-append ",acl) ;another one\n" rest)))
 
-      (system* "guix" "style" "-L" directory "my-coreutils")
+      (system* "guix" "style" "-L" directory "-S" "inputs"
+               "my-coreutils")
 
       (load file)
       (list (package-inputs (@ (my-packages) my-coreutils))
-- 
2.33.0

[bug#52974] [PATCH 5/5] style: '-S format' canonicalizes comments.

[Ludovic Courtès]

* guix/scripts/style.scm (canonicalize-comment): New procedure.
(pretty-print-with-comments): Add #:format-comment. and honor it.
(object->string*): Add 'args' and honor them.
(format-package-definition): Pass #:format-comment to
'object->string*'.
* tests/style.scm ("pretty-print-with-comments, canonicalize-comment"):
New test.
---
 guix/scripts/style.scm | 36 +++++++++++++++++++++++++++++-------
 tests/style.scm        | 25 +++++++++++++++++++++++++
 2 files changed, 54 insertions(+), 7 deletions(-)

diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 47549c7e4a..3c83265f8d 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -47,6 +47,7 @@ (define-module (guix scripts style)
   #:use-module (srfi srfi-37)
   #:export (pretty-print-with-comments
             read-with-comments
+            canonicalize-comment
 
             guix-style))
 
@@ -226,8 +227,23 @@ (define (string-width str)
   "Return the \"width\" of STR--i.e., the width of the longest line of STR."
   (apply max (map string-length (string-split str #\newline))))
 
+(define (canonicalize-comment c)
+  "Canonicalize comment C, ensuring it has the \"right\" number of leading
+semicolons."
+  (let ((line (string-trim-both
+               (string-trim (comment->string c) (char-set #\;)))))
+    (comment (string-append
+              (if (comment-margin? c)
+                  ";"
+                  (if (string-null? line)
+                      ";;"                        ;no trailing space
+                      ";; "))
+              line "\n")
+             (comment-margin? c))))
+
 (define* (pretty-print-with-comments port obj
                                      #:key
+                                     (format-comment identity)
                                      (indent 0)
                                      (max-width 78)
                                      (long-list 5))
@@ -235,7 +251,9 @@ (define* (pretty-print-with-comments port obj
 and assuming the current column is INDENT.  Comments present in OBJ are
 included in the output.
 
-Lists longer than LONG-LIST are written as one element per line."
+Lists longer than LONG-LIST are written as one element per line.  Comments are
+passed through FORMAT-COMMENT before being emitted; a useful value for
+FORMAT-COMMENT is 'canonicalize-comment'."
   (let loop ((indent indent)
              (column indent)
              (delimited? #t)                  ;true if comes after a delimiter
@@ -300,14 +318,16 @@ (define (special-form? head)
        (if (comment-margin? comment)
            (begin
              (display " " port)
-             (display (comment->string comment) port))
+             (display (comment->string (format-comment 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 (comment->string (format-comment comment))
+                      port)))
        (display (make-string indent #\space) port)
        indent)
       (('quote lst)
@@ -442,11 +462,12 @@ (define new-column
                (display str port)
                (+ column (if delimited? 0 1) len))))))))
 
-(define (object->string* obj indent)
+(define (object->string* obj indent . args)
   (call-with-output-string
     (lambda (port)
-      (pretty-print-with-comments port obj
-                                  #:indent indent))))
+      (apply pretty-print-with-comments port obj
+             #:indent indent
+             args))))
 
 \f
 ;;;
@@ -706,7 +727,8 @@ (define* (format-package-definition package
                   read-with-comments)))
        (object->string* exp
                         (location-column
-                         (package-definition-location package)))))))
+                         (package-definition-location package))
+                        #:format-comment canonicalize-comment)))))
 
 (define (package-location<? p1 p2)
   "Return true if P1's location is \"before\" P2's."
diff --git a/tests/style.scm b/tests/style.scm
index 7dae543860..8c6d37a661 100644
--- a/tests/style.scm
+++ b/tests/style.scm
@@ -485,6 +485,31 @@ (define file
    '(#:phases %standard-phases
      #:tests? #f)))")
 
+(test-equal "pretty-print-with-comments, canonicalize-comment"
+  "\
+(list abc
+      ;; Not a margin comment.
+      ;; Ditto.
+      ;;
+      ;; There's a blank line above.
+      def ;margin comment
+      ghi)"
+  (let ((sexp (call-with-input-string
+                  "\
+(list abc
+  ;Not a margin comment.
+  ;;;  Ditto.
+  ;;;;;
+  ; There's a blank line above.
+  def  ;; margin comment
+  ghi)"
+                read-with-comments)))
+    (call-with-output-string
+      (lambda (port)
+        (pretty-print-with-comments port sexp
+                                    #:format-comment
+                                    canonicalize-comment)))))
+
 (test-end)
 
 ;; Local Variables:
-- 
2.33.0

bug#52974: [PATCH 0/5] Formatting package definitions with 'guix style'

[Ludovic Courtès]

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

> This patch set extends ‘guix style’ so that it can format
> package definitions following our conventions.  It adds a
> new ‘-S’ option to ‘guix style’, which allows you to select
> a “styling rule”.

Applied!

  0976e92a0f news: Add news entry about 'guix style'.
  5d9a5e2301 style: '-S format' canonicalizes comments.
  c4fe13c294 style: Add '--styling' option.
  6f892630ae style: Add support for "newline forms".
  208a7aa17b style: Allow special forms to be scoped.
  97d0055edb style: Improve pretty printer and add tests.

There wasn’t any formal comment during the review process, which is
unfortunate, but of course we can still tweak ‘guix style’ as we go.

Ludo’.