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:
parent
077324a16f
commit
9b00c97de4
@ -25,7 +25,9 @@
|
|||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-35)
|
#:use-module (srfi srfi-35)
|
||||||
#:export (pretty-print-with-comments
|
#:export (pretty-print-with-comments
|
||||||
|
pretty-print-with-comments/splice
|
||||||
read-with-comments
|
read-with-comments
|
||||||
|
read-with-comments/sequence
|
||||||
object->string*
|
object->string*
|
||||||
|
|
||||||
blank?
|
blank?
|
||||||
@ -147,8 +149,9 @@ single <vertical-space> record."
|
|||||||
((? space?) (loop))
|
((? space?) (loop))
|
||||||
(chr (unread-char chr port)))))
|
(chr (unread-char chr port)))))
|
||||||
|
|
||||||
(define (read-with-comments port)
|
(define* (read-with-comments port #:key (blank-line? #t))
|
||||||
"Like 'read', but include <blank> objects when they're encountered."
|
"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
|
;; 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',
|
;; 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.
|
;; such that we don't have to rely on a specific Guile version.
|
||||||
@ -167,7 +170,7 @@ single <vertical-space> record."
|
|||||||
dotted))
|
dotted))
|
||||||
((x . rest) (loop (cons x result) rest)))))
|
((x . rest) (loop (cons x result) rest)))))
|
||||||
|
|
||||||
(let loop ((blank-line? #t)
|
(let loop ((blank-line? blank-line?)
|
||||||
(return (const 'unbalanced)))
|
(return (const 'unbalanced)))
|
||||||
(match (read-char port)
|
(match (read-char port)
|
||||||
((? eof-object? eof)
|
((? eof-object? eof)
|
||||||
@ -217,6 +220,20 @@ single <vertical-space> record."
|
|||||||
((and token '#{.}#)
|
((and token '#{.}#)
|
||||||
(if (eq? chr #\.) dot token))
|
(if (eq? chr #\.) dot token))
|
||||||
(token 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.
|
;;; Comment-preserving pretty-printer.
|
||||||
@ -625,3 +642,12 @@ passed as-is to 'pretty-print-with-comments'."
|
|||||||
(apply pretty-print-with-comments port obj
|
(apply pretty-print-with-comments port obj
|
||||||
#:indent indent
|
#:indent indent
|
||||||
args))))
|
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))
|
||||||
|
@ -33,6 +33,16 @@
|
|||||||
read-with-comments)))
|
read-with-comments)))
|
||||||
(pretty-print-with-comments port exp args ...))))))
|
(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")
|
(test-begin "read-print")
|
||||||
|
|
||||||
@ -251,6 +261,33 @@ mnopqrstuvwxyz.\")"
|
|||||||
;; page break above
|
;; page break above
|
||||||
end)")
|
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"
|
(test-equal "pretty-print-with-comments, canonicalize-comment"
|
||||||
"\
|
"\
|
||||||
(list abc
|
(list abc
|
||||||
|
Loading…
Reference in New Issue
Block a user