read-print: Add code to read and write sequences of expressions/blanks.

* guix/read-print.scm (read-with-comments): Add #:blank-line? and honor it.
(read-with-comments/sequence, pretty-print-with-comments/splice): New
procedures.
* tests/read-print.scm (test-pretty-print/sequence): New macro.
Add tests using it.
This commit is contained in:
Ludovic Courtès 2022-08-02 17:08:53 +02:00
parent 077324a16f
commit 9b00c97de4
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 66 additions and 3 deletions

View File

@ -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))

View File

@ -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