diff options
| -rw-r--r-- | guix/read-print.scm | 32 | ||||
| -rw-r--r-- | tests/read-print.scm | 37 |
2 files changed, 66 insertions, 3 deletions
diff --git a/guix/read-print.scm b/guix/read-print.scm index 33ed6e3dbe..4a3afdd4f9 100644 --- a/guix/read-print.scm +++ b/guix/read-print.scm @@ -25,7 +25,9 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:export (pretty-print-with-comments + pretty-print-with-comments/splice read-with-comments + read-with-comments/sequence object->string* blank? @@ -147,8 +149,9 @@ single <vertical-space> record." ((? space?) (loop)) (chr (unread-char chr port))))) -(define (read-with-comments port) - "Like 'read', but include <blank> objects when they're encountered." +(define* (read-with-comments port #:key (blank-line? #t)) + "Like 'read', but include <blank> objects when they're encountered. When +BLANK-LINE? is true, assume PORT is at the beginning of a new line." ;; Note: Instead of implementing this functionality in 'read' proper, which ;; is the best approach long-term, this code is a layer on top of 'read', ;; such that we don't have to rely on a specific Guile version. @@ -167,7 +170,7 @@ single <vertical-space> record." dotted)) ((x . rest) (loop (cons x result) rest))))) - (let loop ((blank-line? #t) + (let loop ((blank-line? blank-line?) (return (const 'unbalanced))) (match (read-char port) ((? eof-object? eof) @@ -217,6 +220,20 @@ single <vertical-space> record." ((and token '#{.}#) (if (eq? chr #\.) dot token)) (token token)))))))) + +(define (read-with-comments/sequence port) + "Read from PORT until the end-of-file is reached and return the list of +expressions and blanks that were read." + (let loop ((lst '()) + (blank-line? #t)) + (match (read-with-comments port #:blank-line? blank-line?) + ((? eof-object?) + (reverse! lst)) + ((? blank? blank) + (loop (cons blank lst) #t)) + (exp + (loop (cons exp lst) #f))))) + ;;; ;;; Comment-preserving pretty-printer. @@ -625,3 +642,12 @@ passed as-is to 'pretty-print-with-comments'." (apply pretty-print-with-comments port obj #:indent indent args)))) + +(define* (pretty-print-with-comments/splice port lst + #:rest rest) + "Write to PORT the expressions and blanks listed in LST." + (for-each (lambda (exp) + (apply pretty-print-with-comments port exp rest) + (unless (blank? exp) + (newline port))) + lst)) diff --git a/tests/read-print.scm b/tests/read-print.scm index 70be7754f8..94f018dd44 100644 --- a/tests/read-print.scm +++ b/tests/read-print.scm @@ -33,6 +33,16 @@ read-with-comments))) (pretty-print-with-comments port exp args ...)))))) +(define-syntax-rule (test-pretty-print/sequence str args ...) + "Likewise, but read and print entire sequences rather than individual +expressions." + (test-equal str + (call-with-output-string + (lambda (port) + (let ((lst (call-with-input-string str + read-with-comments/sequence))) + (pretty-print-with-comments/splice port lst args ...)))))) + (test-begin "read-print") @@ -251,6 +261,33 @@ mnopqrstuvwxyz.\")" ;; page break above end)") +(test-pretty-print/sequence "\ +;;; This is a top-level comment. + + +;; Above is a page break. +(this is an sexp + ;; with a comment + !!) + +;; The end.\n") + +(test-pretty-print/sequence " +;;; Hello! + +(define-module (foo bar) + #:use-module (guix) + #:use-module (gnu)) + + +;; And now, the OS. +(operating-system + (host-name \"komputilo\") + (locale \"eo_EO.UTF-8\") + + (services + (cons (service mcron-service-type) %base-services)))\n") + (test-equal "pretty-print-with-comments, canonicalize-comment" "\ (list abc |