Skip to content

Commit

Permalink
Format provide and contract-out
Browse files Browse the repository at this point in the history 
According to the discussion in racket/drracket#690 (comment)
  • Loading branch information
@sorawee
sorawee committed Oct 31, 2024
1 parent 5d76153 commit 20b3e8c
Show file tree
Hide file tree
Showing 3 changed files with 216 additions and 7 deletions.
52 changes: 45 additions & 7 deletions conventions.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand All @@ -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
Expand Down Expand Up @@ -395,7 +396,7 @@
[#:else (format-let* doc)]))

;; always in the form
#;(provide a
#;(require a
b
c)
(define-pretty format-require
Expand All @@ -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)
Expand Down Expand Up @@ -465,8 +496,7 @@

(define/record standard-formatter-map #:record all-kws
[("if") format-if]
[("provide"
"require"
[("require"
"import"
"export"
"link"
Expand All @@ -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]

Expand Down
80 changes: 80 additions & 0 deletions tests/test-cases/test-contract-out.rkt
View file
Original file line number Diff line number Diff line change
@@ -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))))))]))
91 changes: 91 additions & 0 deletions tests/test-cases/test-contract-out.rkt.out
View file
Original file line number Diff line number Diff line change
@@ -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))))))]))

0 comments on commit 20b3e8c

Please sign in to comment.