From 20b3e8c22e34d612eaf7865e2a38a1b5614902b1 Mon Sep 17 00:00:00 2001 From: Sorawee Porncharoenwase Date: Thu, 31 Oct 2024 06:28:57 -0700 Subject: [PATCH] Format provide and contract-out According to the discussion in https://github.com/racket/drracket/pull/690#discussion_r1817965197 --- conventions.rkt | 52 +++++++++++-- tests/test-cases/test-contract-out.rkt | 80 +++++++++++++++++++ tests/test-cases/test-contract-out.rkt.out | 91 ++++++++++++++++++++++ 3 files changed, 216 insertions(+), 7 deletions(-) create mode 100644 tests/test-cases/test-contract-out.rkt create mode 100644 tests/test-cases/test-contract-out.rkt.out diff --git a/conventions.rkt b/conventions.rkt index e259feb..4cde33f 100644 --- a/conventions.rkt +++ b/conventions.rkt @@ -192,6 +192,7 @@ #:arg-formatter [format-arg #f] #:body-formatter [format-body #f] #:require-body? [require-body? #t] + #:leading-spaces [leading-spaces space] #:kw-map [kw-map default-kw-map]) #:type node? #:default [format-arg pretty] @@ -217,10 +218,10 @@ first-line] [_ (<$> first-line - (<+> space ((format-vertical/helper - #:body-formatter format-body - #:kw-map kw-map) - tail)))])))])) + (<+> leading-spaces ((format-vertical/helper + #:body-formatter format-body + #:kw-map kw-map) + tail)))])))])) (define-pretty (format-clause-2/indirect #:kw-map [kw-map default-kw-map] #:flat? [flat? #t]) #:type values @@ -395,7 +396,7 @@ [#:else (format-let* doc)])) ;; always in the form -#;(provide a +#;(require a b c) (define-pretty format-require @@ -409,6 +410,36 @@ ((format-vertical/helper) (cons -first-arg tail)))))] [#:else (format-#%app doc)])) +;; mostly in the form +#;(provide a + b + c) +;; except when we have contract-out, where we prefer this form +#;(provide + a + (contract-out + [foo ...] + [bar ...])) +(define-pretty format-provide + #:type node? + (define has-contract-out? + (for/or ([item (node-content doc)]) + (and (node? item) + (match/extract (node-content item) #:as _u _t + [([(atom _ "contract-out" 'symbol) #t]) #t] + [#:else #f])))) + (define combinator + (if has-contract-out? <$> <+s>)) + (match/extract (node-content doc) #:as unfits tail + [([-provide #t] [-first-arg #f]) + (pretty-node #:unfits unfits + (combinator (flatten (pretty -provide)) + (try-indent #:n 0 + #:because-of (cons -first-arg tail) + ((format-vertical/helper) + (cons -first-arg tail)))))] + [#:else (format-#%app doc)])) + ;; support optional super id: either #;(struct name super (fields ...) #:kw) #;(struct name (fields ...) #:kw) @@ -465,8 +496,7 @@ (define/record standard-formatter-map #:record all-kws [("if") format-if] - [("provide" - "require" + [("require" "import" "export" "link" @@ -475,6 +505,14 @@ "for-template" "for-label") format-require] + + [("provide") format-provide] + [("contract-out") + (format-uniform-body/helper 0 + #:body-formatter (format-clause-2/indirect) + #:require-body? #f + #:leading-spaces empty-doc)] + [("public" "private" "override" "augment" "inherit" "field" "init") format-require] [("pubment" "public-final" "overment" "override-final" "augride" "augment-final") format-require] diff --git a/tests/test-cases/test-contract-out.rkt b/tests/test-cases/test-contract-out.rkt new file mode 100644 index 0000000..b6044aa --- /dev/null +++ b/tests/test-cases/test-contract-out.rkt @@ -0,0 +1,80 @@ +#lang racket + +(provide (contract-out [a integer?] + [b integer?] + [c integer?])) + +(provide a + b + c + (contract-out [a integer?] + [b integer?] + [c integer?])) + +(provide + glob/c + (contract-out + [glob (->* [glob/c] [#:capture-dotfiles? boolean?] (listof path?))] + [in-glob (->* [glob/c] [#:capture-dotfiles? boolean?] (sequence/c path?))] + [glob-match? (->* [glob/c path-string?] [#:capture-dotfiles? boolean?] boolean?)] + [glob-quote (->i ([ps path-string?]) [r (ps) (if (path? ps) path? string?)])] + [glob-capture-dotfiles? (parameter/c boolean?)])) + +(provide + (contract-out + [untgz (->* ((or/c path-string? input-port?)) + (#:dest + (or/c #f path-string?) + #:strip-count exact-nonnegative-integer? + #:permissive? any/c + #:filter (path? (or/c path? #f) + symbol? exact-integer? (or/c path? #f) + exact-nonnegative-integer? exact-nonnegative-integer? + . -> . any/c)) + void?)])) + +(begin-for-syntax + (require racket/contract/base + syntax/parse/private/pattern-expander + (submod syntax/parse/private/residual ct)) + (provide pattern-expander? + (contract-out + [prop:syntax-class + (struct-type-property/c (or/c identifier? (-> any/c identifier?)))] + [pattern-expander + (-> (-> syntax? syntax?) pattern-expander?)] + [prop:pattern-expander + (struct-type-property/c (-> pattern-expander? (-> syntax? syntax?)))] + [syntax-local-syntax-parse-pattern-introduce + (-> syntax? syntax?)]))) + +(provide (contract-out + [make-constructor-style-printer + (-> (-> any/c (or/c symbol? string?)) + (-> any/c sequence?) + (-> any/c output-port? (or/c #t #f 0 1) void?))]) + struct->list) + + +(provide parse-srv-rr + (contract-out + (struct srv-rr ((priority (integer-in 0 65535)) + (weight (integer-in 0 65535)) + (port (integer-in 0 65535)) + (target string?))))) + +(provide (contract-out [crypto-random-bytes (-> exact-nonnegative-integer? bytes?)] + [random-ref (->* (sequence?) (pseudo-random-generator?) any/c)] + [random-sample (->* (sequence? exact-nonnegative-integer?) + (pseudo-random-generator? + #:replacement? any/c) + (listof any/c))])) + + (provide + (contract-out + [argmax + (->i ([f (-> any/c real?)] [lov (and/c pair? list?)]) () + (r (f lov) + (lambda (r) + (define f@r (f r)) + (for/and ((v lov)) (>= f@r (f v))))))])) diff --git a/tests/test-cases/test-contract-out.rkt.out b/tests/test-cases/test-contract-out.rkt.out new file mode 100644 index 0000000..9a2ab81 --- /dev/null +++ b/tests/test-cases/test-contract-out.rkt.out @@ -0,0 +1,91 @@ +#lang racket + +(provide + (contract-out + [a integer?] + [b integer?] + [c integer?])) + +(provide + a + b + c + (contract-out + [a integer?] + [b integer?] + [c integer?])) + +(provide + glob/c + (contract-out + [glob (->* [glob/c] [#:capture-dotfiles? boolean?] (listof path?))] + [in-glob (->* [glob/c] [#:capture-dotfiles? boolean?] (sequence/c path?))] + [glob-match? (->* [glob/c path-string?] [#:capture-dotfiles? boolean?] boolean?)] + [glob-quote (->i ([ps path-string?]) [r (ps) (if (path? ps) path? string?)])] + [glob-capture-dotfiles? (parameter/c boolean?)])) + +(provide + (contract-out + [untgz + (->* ((or/c path-string? input-port?)) + (#:dest (or/c #f path-string?) + #:strip-count exact-nonnegative-integer? + #:permissive? any/c + #:filter (path? (or/c path? #f) + symbol? + exact-integer? + (or/c path? #f) + exact-nonnegative-integer? + exact-nonnegative-integer? + . -> . + any/c)) + void?)])) + +(begin-for-syntax + (require racket/contract/base + syntax/parse/private/pattern-expander + (submod syntax/parse/private/residual ct)) + (provide + pattern-expander? + (contract-out + [prop:syntax-class (struct-type-property/c (or/c identifier? (-> any/c identifier?)))] + [pattern-expander (-> (-> syntax? syntax?) pattern-expander?)] + [prop:pattern-expander (struct-type-property/c (-> pattern-expander? (-> syntax? syntax?)))] + [syntax-local-syntax-parse-pattern-introduce (-> syntax? syntax?)]))) + +(provide + (contract-out + [make-constructor-style-printer + (-> (-> any/c (or/c symbol? string?)) + (-> any/c sequence?) + (-> any/c output-port? (or/c #t #f 0 1) void?))]) + struct->list) + +(provide + parse-srv-rr + (contract-out + [struct + srv-rr + ((priority (integer-in 0 65535)) (weight (integer-in 0 65535)) + (port (integer-in 0 65535)) + (target string?))])) + +(provide + (contract-out + [crypto-random-bytes (-> exact-nonnegative-integer? bytes?)] + [random-ref (->* (sequence?) (pseudo-random-generator?) any/c)] + [random-sample + (->* (sequence? exact-nonnegative-integer?) + (pseudo-random-generator? #:replacement? any/c) + (listof any/c))])) + +(provide + (contract-out + [argmax + (->i ([f (-> any/c real?)] [lov (and/c pair? list?)]) + () + (r (f lov) + (lambda (r) + (define f@r (f r)) + (for/and ([v lov]) + (>= f@r (f v))))))]))