diff --git a/core.rkt b/core.rkt index 85d1a00..28210a8 100644 --- a/core.rkt +++ b/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 diff --git a/params.rkt b/params.rkt index fd03dd6..787ff4f 100644 --- a/params.rkt +++ b/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 "#(")))) diff --git a/regen.rkt b/regen.rkt index 58441df..ad2d805 100644 --- a/regen.rkt +++ b/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))))) diff --git a/tests/config-tests/config.rkt b/tests/config-tests/config.rkt new file mode 100644 index 0000000..c59eaf9 --- /dev/null +++ b/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) diff --git a/tests/config-tests/file.rkt b/tests/config-tests/file.rkt new file mode 100644 index 0000000..b88ed21 --- /dev/null +++ b/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)))))) diff --git a/tests/config-tests/file.rkt.out b/tests/config-tests/file.rkt.out new file mode 100644 index 0000000..26a7454 --- /dev/null +++ b/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))))))