Quasi-pretty-printed text output (indentation, basically)

implementations/racket/preserves/main.rkt

@@ -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 (!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))])
     (match c
       [#\\ (! "\\\\")]
@@ -581,37 +596,65 @@
       [#\u09 (! "\\t")]
       [_ (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)
     (match vs
       ['() (void)]
       [(cons v0 vs)
-       (item-writer v0)
+       (!indent inner-distance)
+       (item-writer inner-distance v0)
        (for [(v (in-list vs))]
          (! "~a" comma)
-         (item-writer v))])
+         (!indent* inner-distance)
+         (item-writer inner-distance v))
+       (!indent outer-distance)])
     (! "~a" closer))
 
-  (define (write-record label fields)
+  (define (write-record outer-distance label fields)
     (! "<")
-    (write-value label)
-    (for [(f (in-list fields))]
+    (write-value outer-distance label)
+    (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)
-    (write-value k)
+    (write-value distance k)
     (! ": ")
-    (write-value v))
+    (write-value distance v))
 
   (define (binunescaped? b)
     (or (<= #x20 b #x21)
         (<= #x23 b #x5b)
         (<= #x5d b #x7e)))
 
-  (define (write-value v)
+  (define (write-value distance v)
     (match v
       [#f (! "#false")]
       [#t (! "#true")]
@@ -648,22 +691,22 @@
                       [(== PIPE) (! "\\|")]
                       [_ (write-stringlike-char c)]))
                   (! "|")))]
-      [(record label fields) (write-record label fields)]
+      [(record label fields) (write-record distance label fields)]
       [(? non-object-struct?)
        (define key (prefab-struct-key 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)]
-      [(? set?)  (write-sequence "#set{" ", " "}" write-value (set->list v))]
-      [(? dict?) (write-sequence "{" ", " "}" write-key-value (dict->list v))]
+      [(? list?) (write-sequence distance "[" "," "]" write-value v)]
+      [(? set?)  (write-sequence distance "#set{" "," "}" write-value (set->list v))]
+      [(? dict?) (write-sequence distance "{" "," "}" write-key-value (dict->list v))]
 
       [_ (error 'write-preserve "Cannot encode value ~v" v)]))
 
-  (write-value v0))
+  (write-value 0 v0))
 
-(define (preserve->string v0)
-  (with-output-to-string (lambda () (write-preserve v0))))
+(define (preserve->string v0 #:indent [indent-amount #f])
+  (with-output-to-string (lambda () (write-preserve v0 #:indent indent-amount))))
 
 ;;---------------------------------------------------------------------------
 
@@ -891,7 +934,10 @@
                   read-preserve)))
     (local-require racket/pretty)
     (for [((t-name _t-name-anns t t-anns) (in-hash/annotations tests test-annotations))]
-      (pretty-print (list t-name t t-anns))
-      (write-preserve t)
-      (newline)))
+      (newline)
+      (newline)
+      (write-preserve t #:indent #t)
+      (newline)
+      (newline)
+      (pretty-print (list t-name t t-anns))))
   )