Quasi-pretty-printed text output (indentation, basically)
This commit is contained in:
parent
e7a528fc72
commit
fd87f07ec0
|
@ -568,9 +568,24 @@
|
||||||
|
|
||||||
;;---------------------------------------------------------------------------
|
;;---------------------------------------------------------------------------
|
||||||
|
|
||||||
(define (write-preserve v0 [o (current-output-port)])
|
(define (write-preserve v0 [o (current-output-port)] #:indent [indent-amount0 #f])
|
||||||
|
(define indent-amount (match indent-amount0
|
||||||
|
[#f #f]
|
||||||
|
[#t 2] ;; a default
|
||||||
|
[other other]))
|
||||||
|
(define indenting? (and indent-amount #t))
|
||||||
|
|
||||||
(define-syntax-rule (! fmt arg ...) (fprintf o fmt arg ...))
|
(define-syntax-rule (! fmt arg ...) (fprintf o fmt arg ...))
|
||||||
|
|
||||||
|
(define (!indent distance)
|
||||||
|
(when indenting?
|
||||||
|
(! "\n~a" (make-string distance #\space))))
|
||||||
|
|
||||||
|
(define (!indent* distance)
|
||||||
|
(if indenting?
|
||||||
|
(!indent distance)
|
||||||
|
(! " ")))
|
||||||
|
|
||||||
(define (write-stringlike-char c [default (lambda (c) (! "~a" c))])
|
(define (write-stringlike-char c [default (lambda (c) (! "~a" c))])
|
||||||
(match c
|
(match c
|
||||||
[#\\ (! "\\\\")]
|
[#\\ (! "\\\\")]
|
||||||
|
@ -581,37 +596,65 @@
|
||||||
[#\u09 (! "\\t")]
|
[#\u09 (! "\\t")]
|
||||||
[_ (default c)]))
|
[_ (default c)]))
|
||||||
|
|
||||||
(define (write-sequence opener comma closer item-writer vs)
|
(define (write-sequence outer-distance opener comma closer item-writer vs)
|
||||||
|
(define inner-distance (+ outer-distance indent-amount))
|
||||||
(! "~a" opener)
|
(! "~a" opener)
|
||||||
(match vs
|
(match vs
|
||||||
['() (void)]
|
['() (void)]
|
||||||
[(cons v0 vs)
|
[(cons v0 vs)
|
||||||
(item-writer v0)
|
(!indent inner-distance)
|
||||||
|
(item-writer inner-distance v0)
|
||||||
(for [(v (in-list vs))]
|
(for [(v (in-list vs))]
|
||||||
(! "~a" comma)
|
(! "~a" comma)
|
||||||
(item-writer v))])
|
(!indent* inner-distance)
|
||||||
|
(item-writer inner-distance v))
|
||||||
|
(!indent outer-distance)])
|
||||||
(! "~a" closer))
|
(! "~a" closer))
|
||||||
|
|
||||||
(define (write-record label fields)
|
(define (write-record outer-distance label fields)
|
||||||
(! "<")
|
(! "<")
|
||||||
(write-value label)
|
(write-value outer-distance label)
|
||||||
(for [(f (in-list fields))]
|
(for ([f (in-list fields)])
|
||||||
(! " ")
|
(! " ")
|
||||||
(write-value f))
|
(write-value outer-distance f))
|
||||||
(! ">"))
|
(! ">"))
|
||||||
|
|
||||||
(define (write-key-value kv)
|
;; (define (write-record outer-distance label fields)
|
||||||
|
;; (define simple-label? (or (boolean? label) (number? label) (string? label)
|
||||||
|
;; (bytes? label) (symbol? label)))
|
||||||
|
;; (define inner-distance (+ outer-distance
|
||||||
|
;; (if simple-label?
|
||||||
|
;; (+ 2 (string-length (preserve->string label #:indent #f)))
|
||||||
|
;; indent-amount)))
|
||||||
|
;; (define (write-fields fields)
|
||||||
|
;; (for ([f (in-list fields)])
|
||||||
|
;; (!indent* inner-distance)
|
||||||
|
;; (write-value inner-distance f)))
|
||||||
|
;;
|
||||||
|
;; (! "<")
|
||||||
|
;; (write-value inner-distance label)
|
||||||
|
;; (if simple-label?
|
||||||
|
;; (match fields
|
||||||
|
;; ['() (void)]
|
||||||
|
;; [(cons field0 fields)
|
||||||
|
;; (! " ")
|
||||||
|
;; (write-value inner-distance field0)
|
||||||
|
;; (write-fields fields)])
|
||||||
|
;; (write-fields fields))
|
||||||
|
;; (! ">"))
|
||||||
|
|
||||||
|
(define (write-key-value distance kv)
|
||||||
(match-define (cons k v) kv)
|
(match-define (cons k v) kv)
|
||||||
(write-value k)
|
(write-value distance k)
|
||||||
(! ": ")
|
(! ": ")
|
||||||
(write-value v))
|
(write-value distance v))
|
||||||
|
|
||||||
(define (binunescaped? b)
|
(define (binunescaped? b)
|
||||||
(or (<= #x20 b #x21)
|
(or (<= #x20 b #x21)
|
||||||
(<= #x23 b #x5b)
|
(<= #x23 b #x5b)
|
||||||
(<= #x5d b #x7e)))
|
(<= #x5d b #x7e)))
|
||||||
|
|
||||||
(define (write-value v)
|
(define (write-value distance v)
|
||||||
(match v
|
(match v
|
||||||
[#f (! "#false")]
|
[#f (! "#false")]
|
||||||
[#t (! "#true")]
|
[#t (! "#true")]
|
||||||
|
@ -648,22 +691,22 @@
|
||||||
[(== PIPE) (! "\\|")]
|
[(== PIPE) (! "\\|")]
|
||||||
[_ (write-stringlike-char c)]))
|
[_ (write-stringlike-char c)]))
|
||||||
(! "|")))]
|
(! "|")))]
|
||||||
[(record label fields) (write-record label fields)]
|
[(record label fields) (write-record distance label fields)]
|
||||||
[(? non-object-struct?)
|
[(? non-object-struct?)
|
||||||
(define key (prefab-struct-key v))
|
(define key (prefab-struct-key v))
|
||||||
(when (not key) (error 'encode-value "Cannot encode non-prefab struct ~v" v))
|
(when (not key) (error 'encode-value "Cannot encode non-prefab struct ~v" v))
|
||||||
(write-record key (cdr (vector->list (struct->vector v))))]
|
(write-record distance key (cdr (vector->list (struct->vector v))))]
|
||||||
|
|
||||||
[(? list?) (write-sequence "[" ", " "]" write-value v)]
|
[(? list?) (write-sequence distance "[" "," "]" write-value v)]
|
||||||
[(? set?) (write-sequence "#set{" ", " "}" write-value (set->list v))]
|
[(? set?) (write-sequence distance "#set{" "," "}" write-value (set->list v))]
|
||||||
[(? dict?) (write-sequence "{" ", " "}" write-key-value (dict->list v))]
|
[(? dict?) (write-sequence distance "{" "," "}" write-key-value (dict->list v))]
|
||||||
|
|
||||||
[_ (error 'write-preserve "Cannot encode value ~v" v)]))
|
[_ (error 'write-preserve "Cannot encode value ~v" v)]))
|
||||||
|
|
||||||
(write-value v0))
|
(write-value 0 v0))
|
||||||
|
|
||||||
(define (preserve->string v0)
|
(define (preserve->string v0 #:indent [indent-amount #f])
|
||||||
(with-output-to-string (lambda () (write-preserve v0))))
|
(with-output-to-string (lambda () (write-preserve v0 #:indent indent-amount))))
|
||||||
|
|
||||||
;;---------------------------------------------------------------------------
|
;;---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
@ -891,7 +934,10 @@
|
||||||
read-preserve)))
|
read-preserve)))
|
||||||
(local-require racket/pretty)
|
(local-require racket/pretty)
|
||||||
(for [((t-name _t-name-anns t t-anns) (in-hash/annotations tests test-annotations))]
|
(for [((t-name _t-name-anns t t-anns) (in-hash/annotations tests test-annotations))]
|
||||||
(pretty-print (list t-name t t-anns))
|
(newline)
|
||||||
(write-preserve t)
|
(newline)
|
||||||
(newline)))
|
(write-preserve t #:indent #t)
|
||||||
|
(newline)
|
||||||
|
(newline)
|
||||||
|
(pretty-print (list t-name t t-anns))))
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in New Issue