Format provide and contract-out

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]
 

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))))))]))

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))))))]))