Skip to content

Automated Resyntax fixes #690

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Oct 27, 2024
Merged

Automated Resyntax fixes #690

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
49 changes: 25 additions & 24 deletions drracket/help/bug-report.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,13 +1,13 @@
#lang racket/base
(require string-constants
net/head
racket/gui/base
(require browser/htmltext
framework
net/head
net/uri-codec
net/url
racket/class
racket/gui/base
racket/port
net/url
net/uri-codec
browser/htmltext
string-constants
"private/bug-report-controls.rkt"
"private/buginfo.rkt"
"private/save-bug-report.rkt")
Expand Down Expand Up @@ -49,10 +49,10 @@
[(null? open-frames)
(report-bug/new-frame this-bug-id frame-mixin)]
[else
(let ([open-frame (car open-frames)])
(if (= (send open-frame get-bug-id) this-bug-id)
(send open-frame show #t)
(loop (cdr open-frames))))]))]
(define open-frame (car open-frames))
(if (= (send open-frame get-bug-id) this-bug-id)
(send open-frame show #t)
(loop (cdr open-frames)))]))]
[else
(report-bug/new-frame this-bug-id frame-mixin)]))

Expand Down Expand Up @@ -259,24 +259,25 @@
[else #f]))
;; skip HTTP headers
(regexp-match-positions #rx"\r?\n\r?\n" port)
(if error?
;; error status => show as error
(begin (with-pending-text
(λ ()
(send pending-text erase)
(render-html-to-text port pending-text #t #f)))
(channel-put exn-chan #f)) ; #f = "already rendered"
(cond
[error?
;; error status => show as error
(with-pending-text (λ ()
(send pending-text erase)
(render-html-to-text port pending-text #t #f)))
(channel-put exn-chan #f)] ; #f = "already rendered"
;; (hopefully) a good result
(let ([response-text (new html-text%)])
(render-html-to-text port response-text #t #f)
(send response-text auto-wrap #t)
(send response-text lock #t)
(channel-put response-chan response-text))))))))))
[else
(define response-text (new html-text%))
(render-html-to-text port response-text #t #f)
(send response-text auto-wrap #t)
(send response-text lock #t)
(channel-put response-chan response-text)]))))))))
(define (render-error to-render)
(cond
[(string? to-render)
(let ([str (string-append "<pre>\n\nERROR:\n"to-render"\n</pre>\n")])
(render-error (open-input-string str)))]
(define str (string-append "<pre>\n\nERROR:\n" to-render "\n</pre>\n"))
(render-error (open-input-string str))]
[(exn? to-render)
(define sp (open-output-string))
(fprintf sp "~a\n" (exn-message to-render))
Expand Down
175 changes: 70 additions & 105 deletions drracket/help/private/bug-report-controls.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,26 +1,21 @@
#lang racket/base
(require racket/gui/base
(require (for-syntax racket/base
racket/list)
framework
pkg
racket/class
racket/contract
racket/gui/base
racket/pretty
string-constants/string-constant
setup/dirs
setup/link
framework
pkg
(for-syntax racket/base
racket/list)
string-constants/string-constant
"buginfo.rkt"
"save-bug-report.rkt")

(provide/contract
[add-bug-report-controls
(-> (is-a?/c area-container<%>)
saved-report?
(-> any)
(-> any)
(-> any)
any)])
(provide (contract-out
[add-bug-report-controls
(-> (is-a?/c area-container<%>) saved-report? (-> any) (-> any) (-> any) any)]))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can we ask that (provide (contract-out always be on two lines?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Which "two lines" are you talking about? Is it how in each clause, the identifier should be in one line, and the corresponding contract should be in another line? That can be adjusted by changing the formatter of contract-out. But wouldn't this look better?

(provide (contract-out
          [foo (-> number? number?)]
          [bar (-> number? number?)])))

Or are you talking about how you always want:

(provide 
 (contract-out 
  [foo ...]))

instead?

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The latter. The provide and the contract-out on two separate lines.

It may be better to think of this as something that should happen because future lines'll have less leftward drift just in general, or may it is better to special case these two? Or maybe this is an unreasonable request? :)

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I also think it should always look like the latter.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Or maybe this is an unreasonable request?

It's totally reasonable! I'm simply trying to pinpoint what exactly is the general change that you want. I understand how you want the above, specific program to be formatted. But what about the below program -- which one do you prefer?

(A)

(provide foo
         bar
         (contract-out 
          [baz ...]))

vs

(B)

(provide 
 foo
 bar
 (contract-out 
  [baz ...]))

I'm mentioning this because my understanding is that:

(provide foo
         bar
         baz)

is the usual format for provide. So (A) seems to be more consistent with the usual format? But if that is the case, then it feels weird to me that we want:

(provide foo
         bar
         (contract-out 
          [baz ...]))

but at the same time also don't want

(provide (contract-out 
          [baz ...]))

One possibility to satisfy all constraints might be to have a rule like "if contract-out is the only subform of provide, then provide and contract-out should be in different lines." That would work, but I'm not sure if that's what you had in mind.

Copy link
Collaborator

@jackfirth jackfirth Oct 30, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I prefer B in the options you provided, though I'm not thrilled about it when it happens.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

So @jackfirth's proposed rule is that if contract-out is one of subforms of provide, then always enter a newline after provide. That definitely could be done if we all agree with it.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I agree; option B is my preference too. Another option is to split the provide into two provides when there is a contract-out form. Maybe that's a bad idea, tho.

Copy link
Contributor

@sorawee sorawee Oct 31, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Something like this? sorawee/fmt#81

which would affect the format of:

The file test-contract-out.rkt.out contains some example output.


(define (add-bug-report-controls compose-panel init-bug-report ok cancel close-and-save)
(define top-panel (make-object vertical-panel% compose-panel))
Expand Down Expand Up @@ -61,10 +56,9 @@
(define (align-labels)
(send synthesized-dialog reflow-container)
(send compose-panel reflow-container)
(let ([width (apply max (map (lambda (x) (send (car (send x get-children)) get-width))
lps))])
(for ([x (in-list lps)])
(send x min-width width))))
(define width (apply max (map (lambda (x) (send (car (send x get-children)) get-width)) lps)))
(for ([x (in-list lps)])
(send x min-width width)))

(define name
(build/label
Expand Down Expand Up @@ -151,24 +145,19 @@
(build/label
label
(lambda (panel)
(let* ([text (new (editor:standard-style-list-mixin
(editor:keymap-mixin
(if key
save-text%
text:basic%))))]
[canvas (new canvas:basic%
(style '(hide-hscroll))
(parent panel)
(editor text))])
(send text set-paste-text-only #t)
(send text auto-wrap #t)
(send text set-max-undo-history 'forever)
(send text set-styles-fixed #t)
(when key
(send text insert (saved-report-lookup init-bug-report key))
(send text set-position 0 0)
(send text initialized))
canvas))
(define text
(new (editor:standard-style-list-mixin
(editor:keymap-mixin (if key save-text% text:basic%)))))
(define canvas (new canvas:basic% (style '(hide-hscroll)) (parent panel) (editor text)))
(send text set-paste-text-only #t)
(send text auto-wrap #t)
(send text set-max-undo-history 'forever)
(send text set-styles-fixed #t)
(when key
(send text insert (saved-report-lookup init-bug-report key))
(send text set-position 0 0)
(send text initialized))
canvas)
#t
#:stretch? stretch?
#:top-panel top-panel
Expand Down Expand Up @@ -253,28 +242,24 @@
(send synthesized-dialog reflow-container) ;; help out the editor by resizing the container to a reasonable width (and thus make word-wrapping easier)

(define extras
(map (lambda (bri)
(let ([label (bri-label bri)])
(cons
label
(build/label
label
(lambda (panel)
(let ([field
(keymap:call/text-keymap-initializer
(lambda ()
(new text-field%
[label #f]
[parent panel]
[callback void]
[init-value ""]
[min-height (bri-min-height bri)])))])
(send field set-value (bri-value bri))
(send (send field get-editor) set-position 0)
field))
#f
#:top-panel synthesized-panel))))
(get-bug-report-infos)))
(for/list ([bri (in-list (get-bug-report-infos))])
(define label (bri-label bri))
(cons label
(build/label label
(lambda (panel)
(let ([field (keymap:call/text-keymap-initializer
(lambda ()
(new text-field%
[label #f]
[parent panel]
[callback void]
[init-value ""]
[min-height (bri-min-height bri)])))])
(send field set-value (bri-value bri))
(send (send field get-editor) set-position 0)
field))
#f
#:top-panel synthesized-panel))))

(define still-save? #t)
(define (no-more-saving) (set! still-save? #f))
Expand Down Expand Up @@ -308,9 +293,8 @@
(cons 'description (get-content description))
(cons 'how-to-repeat (get-content reproduce))
(cons 'platform (get-environment)))
(map (λ (bri) (cons (string->symbol (format "~a" (bri-label bri)))
(bri-value bri)))
(get-bug-report-infos))))
(for/list ([bri (in-list (get-bug-report-infos))])
(cons (string->symbol (format "~a" (bri-label bri))) (bri-value bri)))))

(define (get-environment)
(string-append (send environment get-value)
Expand All @@ -324,28 +308,15 @@
"\n"
(apply
string-append
(map (lambda (extra)
(format "~a: ~a\n"
(car extra)
(send (cdr extra) get-value)))
extras))))
(for/list ([extra (in-list extras)])
(format "~a: ~a\n" (car extra) (send (cdr extra) get-value))))))

(define (get-content canvas)
(define t (send canvas get-editor))
(send t get-text 0 (send t last-position)))

(define (set-content canvas str)
(define t (send canvas get-editor))
(send t begin-edit-sequence)
(send t erase)
(send t insert str)
(send t end-edit-sequence))

(define (compose-view-focus)
(send (if (string=? "" (preferences:get 'drracket:full-name))
name
summary)
focus))
(send (if (string=? "" (preferences:get 'drracket:full-name)) name summary) focus))

(define button-panel
(new horizontal-panel% [parent compose-panel]
Expand All @@ -368,34 +339,28 @@


(define (sanity-checking)
(let ([no-value?
(lambda (f)
(cond
[(is-a? f editor-canvas%)
(= 0 (send (send f get-editor) last-position))]
[else (string=? "" (send f get-value))]))])
(let/ec done-checking
(for-each
(lambda (field field-name)
(when (no-value? field)
(message-box (string-constant illegal-bug-report)
(format (string-constant pls-fill-in-field) field-name))
(done-checking #f)))
(list name summary)
(list (string-constant bug-report-field-name)
(string-constant bug-report-field-summary)))

(when (and (no-value? description)
(no-value? reproduce))
(message-box (string-constant illegal-bug-report)
(string-constant pls-fill-in-either-description-or-reproduce))
(done-checking #f))

(unless (regexp-match #rx"@" (or (preferences:get 'drracket:email) ""))
(message-box (string-constant illegal-bug-report)
(string-constant malformed-email-address))
(done-checking #f))
(done-checking #t))))
(define (no-value? f)
(cond
[(is-a? f editor-canvas%) (= 0 (send (send f get-editor) last-position))]
[else (string=? "" (send f get-value))]))
(let/ec done-checking
(for-each (lambda (field field-name)
(when (no-value? field)
(message-box (string-constant illegal-bug-report)
(format (string-constant pls-fill-in-field) field-name))
(done-checking #f)))
(list name summary)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Personally I would write it like this:

(define (<f> field field-name)
  ...)

(<f> name (string-constant bug-report-field-name))
(<f> summary (string-constant bug-report-field-summary))

It's going to be difficult to come up with the name <f> though...

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Agreed, but yeah there's no easy way to automatically pick a name for <f> here.

Unless... I suppose... one could use an LLM to do that...

No. I will not walk down that dark road.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

a for loop still seems preferable to the for-each, tho?

(list (string-constant bug-report-field-name)
(string-constant bug-report-field-summary)))
(when (and (no-value? description) (no-value? reproduce))
(message-box (string-constant illegal-bug-report)
(string-constant pls-fill-in-either-description-or-reproduce))
(done-checking #f))
(unless (regexp-match #rx"@" (or (preferences:get 'drracket:email) ""))
(message-box (string-constant illegal-bug-report)
(string-constant malformed-email-address))
(done-checking #f))
(done-checking #t)))

(send version-tf set-value (format "~a" (version:version)))

Expand Down
36 changes: 18 additions & 18 deletions drracket/help/private/save-bug-report.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
#lang racket/base

(require racket/match
(require framework/preferences
racket/contract
racket/serialize
racket/list
framework/preferences)
racket/match
racket/serialize)

(define bug-classes '(("software bug" "sw-bug")
("documentation bug" "doc-bug")
Expand Down Expand Up @@ -182,18 +182,18 @@
saved-report?
default-severity
default-class)
(provide/contract
[register-new-bug-id (-> saved-report?)]
[lookup-bug-report (-> number? saved-report?)]
[saved-report-lookup (-> saved-report? (apply or/c valid-keys) string?)]
[saved-report-id (-> saved-report? number?)]
[save-bug-report (-> number?
#:severity (apply or/c bug-severities)
#:class (apply or/c (map car bug-classes))
#:subject string?
#:description string?
#:how-to-repeat string?
void?)]
[unsave-bug-report (-> number? void?)]
[saved-bug-report-titles/ids (-> (listof brinfo?))]
[discard-all-except (-> (-> number? boolean?) void?)])
(provide (contract-out [register-new-bug-id (-> saved-report?)]
[lookup-bug-report (-> number? saved-report?)]
[saved-report-lookup (-> saved-report? (apply or/c valid-keys) string?)]
[saved-report-id (-> saved-report? number?)]
[save-bug-report
(-> number?
#:severity (apply or/c bug-severities)
#:class (apply or/c (map car bug-classes))
#:subject string?
#:description string?
#:how-to-repeat string?
void?)]
[unsave-bug-report (-> number? void?)]
[saved-bug-report-titles/ids (-> (listof brinfo?))]
[discard-all-except (-> (-> number? boolean?) void?)]))
Loading