diff options
| -rw-r--r-- | guix/scripts/style.scm | 43 | ||||
| -rw-r--r-- | tests/style.scm | 13 |
2 files changed, 50 insertions, 6 deletions
diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm index 625e942613..09c239498f 100644 --- a/guix/scripts/style.scm +++ b/guix/scripts/style.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -163,6 +163,19 @@ ('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)) + ('git-reference '(uri origin source)) + ('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 +201,14 @@ surrounding SYMBOL." (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 +398,7 @@ Lists longer than LONG-LIST are written as one element per line." (column (if overflow? (+ indent 1) (+ column (if delimited? 1 2)))) + (newline? (newline-form? head context)) (context (cons head context))) (if overflow? (begin @@ -384,17 +406,26 @@ Lists longer than LONG-LIST are written as one element per line." (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 @@ mnopqrstuvwxyz.\")" ;; 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: |