feat: make it possible for users to control paren-shape

Fixes #50

core.rkt

@@ -21,6 +21,7 @@
          syntax/parse/define
          (except-in pretty-expressive flatten)
          "common.rkt"
+         "params.rkt"
          (for-syntax racket/base syntax/parse/lib/function-header))
 
 (define (extract xs extract-configs)
@@ -89,9 +90,21 @@
   (match-define (node comment opener closer prefix _) the-node)
   (define doc
     (pretty-comment comment
-                    (<+> (text (if adjust (first adjust) opener))
+                    (<+> (text
+                          (match (current-adjust-paren-shape)
+                            [#t
+                             #:when adjust
+                             (first adjust)]
+                            [(or #t #f) opener]
+                            [(cons opener _) opener]))
                          d
-                         (text (if adjust (second adjust) closer)))))
+                         (text
+                          (match (current-adjust-paren-shape)
+                            [#t
+                             #:when adjust
+                             (second adjust)]
+                            [(or #t #f) closer]
+                            [(cons _ closer) closer])))))
   (define doc*
     (for/fold ([doc doc]) ([prefix (in-list (reverse prefix))])
       (match prefix

params.rkt

@@ -7,7 +7,8 @@
          current-indent
          current-limit
          current-app?
-         current-ellipsis?)
+         current-ellipsis?
+         current-adjust-paren-shape)
 
 (require racket/match
          racket/string
@@ -27,6 +28,11 @@
   (make-parameter
    (λ (s) (regexp-match #px"^(\\.\\.\\.|\\.\\.\\.\\+|\\.\\.(\\d+))$" s))))
 
+;; `#t` means adjust according to the context (default)
+;; `#f` means do not adjust
+;; `(cons a b)` means always adjust the opener to `a` and the closer to `b`
+(define current-adjust-paren-shape (make-parameter #t))
+
 (define (app-prefix? s)
   (not (or (string-contains? s "#hash")
            (string-contains? s "#("))))

regen.rkt

@@ -5,23 +5,27 @@
 (require file/glob
          raco/all-tools)
 
-(define paths '("tests/test-cases/*.rkt"
-                "tests/benchmarks/*.rkt"))
+(define paths '(["tests/test-cases/*.rkt" ()]
+                ["tests/benchmarks/*.rkt" ()]
+                ["tests/config-tests/file.rkt" ("--config" "tests/config-tests/config.rkt")]))
 
 (define out-ext "out")
 
 (define raco-fmt (hash-ref (all-tools) "fmt"))
 
 (define (regen ext)
-  (for ([f (flatten (map glob paths))])
-    (printf "formatting ~a\n" f)
-
-    (with-output-to-file (format "~a.~a" f ext)
-      #:exists 'replace
-      (λ ()
-        (parameterize ([current-command-line-arguments (vector (~a f))]
-                       [current-namespace (make-base-namespace)])
-          (dynamic-require (second raco-fmt) #f))))))
+  (for ([test-suite (in-list paths)])
+    (match-define (list path args) test-suite)
+    (for ([f (in-list (glob path))])
+      (printf "formatting ~a\n" f)
+      (time
+       (with-output-to-file (format "~a.~a" f ext)
+         #:exists 'replace
+         (λ ()
+           (parameterize ([current-command-line-arguments
+                           (apply vector (append args (list (~a f))))]
+                          [current-namespace (make-base-namespace)])
+             (dynamic-require (second raco-fmt) #f))))))))
 
 (module+ main
   (regen out-ext))
@@ -31,9 +35,11 @@
 
   (define check-ext "out-check")
   (regen check-ext)
-  (for ([f (flatten (map glob paths))])
-    (with-check-info (['filename f])
-      (check-equal? (file->string (format "~a.~a" f check-ext))
-                    (file->string (format "~a.~a" f out-ext))))
-
-    (delete-file (format "~a.~a" f check-ext))))
+  (for ([test-suite (in-list paths)])
+    (match-define (list path _) test-suite)
+    (for ([f (in-list (glob path))])
+      (with-check-info (['filename f])
+        (check-equal? (file->string (format "~a.~a" f check-ext))
+                      (file->string (format "~a.~a" f out-ext))))
+
+      (delete-file (format "~a.~a" f check-ext)))))

tests/config-tests/config.rkt

@@ -0,0 +1,9 @@
+#lang racket/base
+
+(provide the-formatter-map)
+(require fmt/params)
+
+(current-adjust-paren-shape #f)
+
+(define (the-formatter-map s)
+  #f)

tests/config-tests/file.rkt

@@ -0,0 +1,5 @@
+#lang racket
+
+(define (f x) (let ([x (sub1 x)]) (cond [(zero? x) 0] [else (add1 (f x))])))
+
+(define (g x) (let ((x (sub1 x))) (cond ((zero? x) 0) (else (add1 (g x))))))

tests/config-tests/file.rkt.out

@@ -0,0 +1,13 @@
+#lang racket
+
+(define (f x)
+  (let ([x (sub1 x)])
+    (cond
+      [(zero? x) 0]
+      [else (add1 (f x))])))
+
+(define (g x)
+  (let ((x (sub1 x)))
+    (cond
+      ((zero? x) 0)
+      (else (add1 (g x))))))