style: '-S format' canonicalizes comments.

* 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.
This commit is contained in:
Ludovic Courtès 2022-01-02 18:14:00 +01:00
parent c4fe13c294
commit 5d9a5e2301
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 56 additions and 8 deletions

View file

@ -47,6 +47,7 @@ (define-module (guix scripts style)
#:use-module (srfi srfi-37) #:use-module (srfi srfi-37)
#:export (pretty-print-with-comments #:export (pretty-print-with-comments
read-with-comments read-with-comments
canonicalize-comment
guix-style)) guix-style))
@ -227,8 +228,23 @@ (define (string-width str)
"Return the \"width\" of STR--i.e., the width of the longest line of 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)))) (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 (define* (pretty-print-with-comments port obj
#:key #:key
(format-comment identity)
(indent 0) (indent 0)
(max-width 78) (max-width 78)
(long-list 5)) (long-list 5))
@ -236,7 +252,9 @@ (define* (pretty-print-with-comments port obj
and assuming the current column is INDENT. Comments present in OBJ are and assuming the current column is INDENT. Comments present in OBJ are
included in the output. 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) (let loop ((indent indent)
(column indent) (column indent)
(delimited? #t) ;true if comes after a delimiter (delimited? #t) ;true if comes after a delimiter
@ -301,14 +319,16 @@ (define (special-form? head)
(if (comment-margin? comment) (if (comment-margin? comment)
(begin (begin
(display " " port) (display " " port)
(display (comment->string comment) port)) (display (comment->string (format-comment comment))
port))
(begin (begin
;; When already at the beginning of a line, for example because ;; When already at the beginning of a line, for example because
;; COMMENT follows a margin comment, no need to emit a newline. ;; COMMENT follows a margin comment, no need to emit a newline.
(unless (= column indent) (unless (= column indent)
(newline port) (newline port)
(display (make-string indent #\space) 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) (display (make-string indent #\space) port)
indent) indent)
(('quote lst) (('quote lst)
@ -443,11 +463,12 @@ (define new-column
(display str port) (display str port)
(+ column (if delimited? 0 1) len)))))))) (+ column (if delimited? 0 1) len))))))))
(define (object->string* obj indent) (define (object->string* obj indent . args)
(call-with-output-string (call-with-output-string
(lambda (port) (lambda (port)
(pretty-print-with-comments port obj (apply pretty-print-with-comments port obj
#:indent indent)))) #:indent indent
args))))
;;; ;;;
@ -701,13 +722,15 @@ (define* (format-package-definition package
(package-full-name package))) (package-full-name package)))
(edit-expression (edit-expression
(location->source-properties (package-definition-location package)) (location->source-properties
(absolute-location (package-definition-location package)))
(lambda (str) (lambda (str)
(let ((exp (call-with-input-string str (let ((exp (call-with-input-string str
read-with-comments))) read-with-comments)))
(object->string* exp (object->string* exp
(location-column (location-column
(package-definition-location package))))))) (package-definition-location package))
#:format-comment canonicalize-comment)))))
(define (package-location<? p1 p2) (define (package-location<? p1 p2)
"Return true if P1's location is \"before\" P2's." "Return true if P1's location is \"before\" P2's."

View file

@ -485,6 +485,31 @@ (define file
'(#:phases %standard-phases '(#:phases %standard-phases
#:tests? #f)))") #: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) (test-end)
;; Local Variables: ;; Local Variables: