#350

Committed 13 Nov 2025 08:15AM UTC coverage: 93.268% (-0.4%) from 93.661%

Build # #350

Build Type

Pull #754

cover

Committed by

Copilot

Commit Message

Return #t instead of (void) for no-suggestion rules

When a rule uses #:no-suggestion, the transformer now returns (present #t)
instead of (present #'(void)) for pattern matches.

Co-authored-by: jackfirth <8175575+jackfirth@users.noreply.github.com>

Pull Request Pull Request #754: Add support for warning-only refactoring rules

Run Details

179 of 322 new or added lines in 10 files covered. (55.59%)

1 existing line in 1 file now uncovered.

15378 of 16488 relevant lines covered (93.27%)

0.93 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

53.57

/private/github.rkt

#lang racket/base


(require racket/contract/base)


(provide
 (contract-out
  [github-review-request? (-> any/c boolean?)]
  [github-review-request-jsexpr (-> github-review-request? jsexpr?)]
  [refactoring-results->github-review
   (-> (sequence/c refactoring-result?) #:file-count exact-nonnegative-integer?
       github-review-request?)]))


(require json
         racket/list
         racket/match
         racket/pretty
         racket/sequence
         racket/string
         rebellion/collection/list
         rebellion/streaming/transducer
         rebellion/type/record
         resyntax/private/line-replacement
         resyntax/private/refactoring-result
         resyntax/private/run-command
         resyntax/private/source
         resyntax/private/string-indent
         resyntax/private/syntax-replacement)


;@----------------------------------------------------------------------------------------------------


(define-record-type github-review-request
  (owner-repo pull-number body event comments))


(define (github-review-request-jsexpr req)
  (match-define
    (github-review-request
     #:owner-repo owner-repo #:pull-number pull-number #:body body #:event event #:comments comments)
    req)
  (match-define (list owner repo) (string-split owner-repo "/"))
  (hash 'owner owner
        'repo repo
        'body body
        'event event
        'comments (map github-review-comment-jsexpr comments)
        'pull_number pull-number))


(define-record-type github-review-comment
  (path body start-line end-line start-side end-side))


(define (github-review-comment-jsexpr comment)
  (match-define
    (github-review-comment #:path path
                           #:body body
                           #:start-line start-line
                           #:end-line end-line
                           #:start-side start-side
                           #:end-side end-side)
    comment)
  (if (= start-line end-line)
      (hash 'path path
            'body body
            'line end-line
            'side end-side)
      (hash 'path path
            'body body
            'start_line start-line
            'line end-line
            'start_side start-side
            'side end-side)))


(define (git-path path)
  (string-split (run-command "git" "ls-tree" "-r" "-z" "--name-only" "HEAD" path) "\0"))


(define git-pr-ref-regexp #rx"^refs/pull/([0-9]+)/merge$")


(define (git-ref->pr-number ref)
  (match ref
    [(regexp git-pr-ref-regexp (list _ num))
     (string->number num)]
    [_
     (error (format "ref ~a doesn't represent a pull request" ref))]))


(define (refactoring-result->github-review-comment result)
  (cond
    [(refactoring-result-has-fix? result)
     ;; For results with fixes, generate a suggestion comment
     (define path
       (file-source-path (syntax-replacement-source (refactoring-result-syntax-replacement result))))
     (define replacement (refactoring-result-line-replacement result))
     (define body
       (format #<<EOS
**`~a`:** ~a

```suggestion
~a
```

<details>
<summary>Debugging details</summary>

<details>
  <summary>Textual replacement</summary>

  ```scheme
~a
  ```
</details>

<details>
  <summary>Syntactic replacement</summary>

  ```scheme
~a
  ```
</details>
</details>
EOS
               (refactoring-result-rule-name result)
               (refactoring-result-message result)
               (line-replacement-new-text replacement)
               (string-indent (pretty-format replacement) #:amount 2)
               (string-indent (pretty-format (refactoring-result-syntax-replacement result))
                              #:amount 2)))
     (github-review-comment
      #:path (first (git-path path))
      #:body body
      #:start-line (line-replacement-start-line replacement)
      #:end-line (line-replacement-original-end-line replacement)
      #:start-side "RIGHT"
      #:end-side "RIGHT")]
    [else
     ;; For warning-only results, generate a comment without a suggestion
     (define source (refactoring-result-source result))
     (define path (file-source-path source))
     (define line (refactoring-result-original-line result))
     (define body
       (format "**`~a`:** ~a"
               (refactoring-result-rule-name result)
               (refactoring-result-message result)))
     (github-review-comment
      #:path (first (git-path path))
      #:body body
      #:start-line line
      #:end-line line
      #:start-side "RIGHT"
      #:end-side "RIGHT")]))


(define branch-ref (getenv "GITHUB_REF"))
(define github-repository (getenv "GITHUB_REPOSITORY"))


(define (github-review-body comments? file-count)
  (format "[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed ~a in this pull request and ~a"
          (if (= file-count 1) "1 file" (format "~a files" file-count))
          (if comments? "has added suggestions." "found no issues.")))


(define (refactoring-results->github-review results #:file-count file-count)
  (define comments
    (transduce results (mapping refactoring-result->github-review-comment) #:into into-list))
  (github-review-request
   #:owner-repo github-repository
   #:pull-number (git-ref->pr-number branch-ref)
   #:body (github-review-body (not (null? comments)) file-count)
   #:event (if (empty? comments) "APPROVE" "COMMENT")
   #:comments comments))


(module+ test
  (require rackunit)

  (test-case "github-review-comment-jsexpr"
    (test-case "single-line comment"
      (define comment
        (github-review-comment
         #:path "file.rkt"
         #:body "Fix this issue"
         #:start-line 10
         #:end-line 10
         #:start-side "RIGHT"
         #:end-side "RIGHT"))
      (define result (github-review-comment-jsexpr comment))
      (check-equal? (hash-ref result 'path) "file.rkt")
      (check-equal? (hash-ref result 'body) "Fix this issue")
      (check-equal? (hash-ref result 'line) 10)
      (check-equal? (hash-ref result 'side) "RIGHT")
      (check-false (hash-has-key? result 'start_line))
      (check-false (hash-has-key? result 'start_side)))
    (test-case "multi-line comment"
      (define comment
        (github-review-comment
         #:path "another.rkt"
         #:body "Multi-line issue"
         #:start-line 5
         #:end-line 8
         #:start-side "LEFT"
         #:end-side "RIGHT"))
      (define result (github-review-comment-jsexpr comment))
      (check-equal? (hash-ref result 'path) "another.rkt")
      (check-equal? (hash-ref result 'body) "Multi-line issue")
      (check-equal? (hash-ref result 'start_line) 5)
      (check-equal? (hash-ref result 'line) 8)
      (check-equal? (hash-ref result 'start_side) "LEFT")
      (check-equal? (hash-ref result 'side) "RIGHT")))
  (test-case "github-review-request-jsexpr"
    (define comment1
      (github-review-comment
       #:path "file1.rkt"
       #:body "Comment 1"
       #:start-line 1
       #:end-line 1
       #:start-side "RIGHT"
       #:end-side "RIGHT"))
    (define comment2
      (github-review-comment
       #:path "file2.rkt"
       #:body "Comment 2"
       #:start-line 5
       #:end-line 10
       #:start-side "LEFT"
       #:end-side "RIGHT"))
    (define request
      (github-review-request
       #:owner-repo "owner/repo"
       #:pull-number 123
       #:body "Review body"
       #:event "COMMENT"
       #:comments (list comment1 comment2)))
    (define result (github-review-request-jsexpr request))
    (check-equal? (hash-ref result 'owner) "owner")
    (check-equal? (hash-ref result 'repo) "repo")
    (check-equal? (hash-ref result 'pull_number) 123)
    (check-equal? (hash-ref result 'body) "Review body")
    (check-equal? (hash-ref result 'event) "COMMENT")
    (check-equal? (length (hash-ref result 'comments)) 2))
  (test-case "git-ref->pr-number"
    (test-case "valid PR ref"
      (check-equal? (git-ref->pr-number "refs/pull/42/merge") 42)
      (check-equal? (git-ref->pr-number "refs/pull/123/merge") 123)
      (check-equal? (git-ref->pr-number "refs/pull/1/merge") 1))
    (test-case "invalid refs raise errors"
      (check-exn exn:fail? (lambda () (git-ref->pr-number "refs/heads/main")))
      (check-exn exn:fail? (lambda () (git-ref->pr-number "refs/pull/42/head")))
      (check-exn exn:fail? (lambda () (git-ref->pr-number "invalid")))))
  (test-case "github-review-body"
    (test-case "with comments"
      (check-equal? (github-review-body #t 1)
                    "[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed 1 file in this pull request and has added suggestions.")
      (check-equal? (github-review-body #t 5)
                    "[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed 5 files in this pull request and has added suggestions."))
    (test-case "without comments"
      (check-equal? (github-review-body #f 1)
                    "[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed 1 file in this pull request and found no issues.")
      (check-equal? (github-review-body #f 3)
                    "[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed 3 files in this pull request and found no issues."))))

1	#lang racket/base	1✔
2
3
4	(require racket/contract/base)	1✔
5
6
7	(provide	1✔
8	(contract-out	1✔
9	[github-review-request? (-> any/c boolean?)]	1✔
10	[github-review-request-jsexpr (-> github-review-request? jsexpr?)]	1✔
11	[refactoring-results->github-review	1✔
12	(-> (sequence/c refactoring-result?) #:file-count exact-nonnegative-integer?	1✔
13	github-review-request?)]))	1✔
14
15
16	(require json	1✔
17	racket/list	1✔
18	racket/match	1✔
19	racket/pretty	1✔
20	racket/sequence	1✔
21	racket/string	1✔
22	rebellion/collection/list	1✔
23	rebellion/streaming/transducer	1✔
24	rebellion/type/record	1✔
25	resyntax/private/line-replacement	1✔
26	resyntax/private/refactoring-result	1✔
27	resyntax/private/run-command	1✔
28	resyntax/private/source	1✔
29	resyntax/private/string-indent	1✔
30	resyntax/private/syntax-replacement)	1✔
31
32
33	;@----------------------------------------------------------------------------------------------------
34
35
36	(define-record-type github-review-request	1✔
37	(owner-repo pull-number body event comments))	1✔
38
39
40	(define (github-review-request-jsexpr req)	1✔
41	(match-define	1✔
42	(github-review-request	1✔
43	#:owner-repo owner-repo #:pull-number pull-number #:body body #:event event #:comments comments)	1✔
44	req)	1✔
45	(match-define (list owner repo) (string-split owner-repo "/"))	1✔
46	(hash 'owner owner	1✔
47	'repo repo	1✔
48	'body body	1✔
49	'event event	1✔
50	'comments (map github-review-comment-jsexpr comments)	1✔
51	'pull_number pull-number))	1✔
52
53
54	(define-record-type github-review-comment	1✔
55	(path body start-line end-line start-side end-side))	1✔
56
57
58	(define (github-review-comment-jsexpr comment)	1✔
59	(match-define	1✔
60	(github-review-comment #:path path	1✔
61	#:body body	1✔
62	#:start-line start-line	1✔
63	#:end-line end-line	1✔
64	#:start-side start-side	1✔
65	#:end-side end-side)	1✔
66	comment)	1✔
67	(if (= start-line end-line)	1✔
68	(hash 'path path	1✔
69	'body body	1✔
70	'line end-line	1✔
71	'side end-side)	1✔
72	(hash 'path path	1✔
73	'body body	1✔
74	'start_line start-line	1✔
75	'line end-line	1✔
76	'start_side start-side	1✔
77	'side end-side)))	1✔
78
79
80	(define (git-path path)	1✔
81	(string-split (run-command "git" "ls-tree" "-r" "-z" "--name-only" "HEAD" path) "\0"))	×
82
83
84	(define git-pr-ref-regexp #rx"^refs/pull/([0-9]+)/merge$")	1✔
85
86
87	(define (git-ref->pr-number ref)	1✔
88	(match ref	1✔
89	[(regexp git-pr-ref-regexp (list _ num))	1✔
90	(string->number num)]	1✔
91	[_	1✔
92	(error (format "ref ~a doesn't represent a pull request" ref))]))	1✔
93
94
95	(define (refactoring-result->github-review-comment result)	1✔
NEW 96	(cond	×
NEW 97	[(refactoring-result-has-fix? result)	×
98	;; For results with fixes, generate a suggestion comment
NEW 99	(define path	×
NEW 100	(file-source-path (syntax-replacement-source (refactoring-result-syntax-replacement result))))	×
NEW 101	(define replacement (refactoring-result-line-replacement result))	×
NEW 102	(define body	×
NEW 103	(format #<<EOS	×
UNCOV 104	`~a`: ~a	×
105
106	```suggestion	×
107	~a	×
108	```	×
109
110	<details>	×
111	<summary>Debugging details</summary>	×
112
113	<details>	×
114	<summary>Textual replacement</summary>	×
115
116	```scheme	×
117	~a	×
118	```	×
119	</details>	×
120
121	<details>	×
122	<summary>Syntactic replacement</summary>	×
123
124	```scheme	×
125	~a	×
126	```	×
127	</details>	×
128	</details>	×
129	EOS	×
NEW 130	(refactoring-result-rule-name result)	×
NEW 131	(refactoring-result-message result)	×
NEW 132	(line-replacement-new-text replacement)	×
NEW 133	(string-indent (pretty-format replacement) #:amount 2)	×
NEW 134	(string-indent (pretty-format (refactoring-result-syntax-replacement result))	×
NEW 135	#:amount 2)))	×
NEW 136	(github-review-comment	×
NEW 137	#:path (first (git-path path))	×
NEW 138	#:body body	×
NEW 139	#:start-line (line-replacement-start-line replacement)	×
NEW 140	#:end-line (line-replacement-original-end-line replacement)	×
NEW 141	#:start-side "RIGHT"	×
NEW 142	#:end-side "RIGHT")]	×
NEW 143	[else	×
144	;; For warning-only results, generate a comment without a suggestion
NEW 145	(define source (refactoring-result-source result))	×
NEW 146	(define path (file-source-path source))	×
NEW 147	(define line (refactoring-result-original-line result))	×
NEW 148	(define body	×
NEW 149	(format "`~a`: ~a"	×
NEW 150	(refactoring-result-rule-name result)	×
NEW 151	(refactoring-result-message result)))	×
NEW 152	(github-review-comment	×
NEW 153	#:path (first (git-path path))	×
NEW 154	#:body body	×
NEW 155	#:start-line line	×
NEW 156	#:end-line line	×
NEW 157	#:start-side "RIGHT"	×
NEW 158	#:end-side "RIGHT")]))	×
159
160
161	(define branch-ref (getenv "GITHUB_REF"))	1✔
162	(define github-repository (getenv "GITHUB_REPOSITORY"))	1✔
163
164
165	(define (github-review-body comments? file-count)	1✔
166	(format "[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed ~a in this pull request and ~a"	1✔
167	(if (= file-count 1) "1 file" (format "~a files" file-count))	1✔
168	(if comments? "has added suggestions." "found no issues.")))	1✔
169
170
171	(define (refactoring-results->github-review results #:file-count file-count)	×
172	(define comments	×
173	(transduce results (mapping refactoring-result->github-review-comment) #:into into-list))	×
174	(github-review-request	×
175	#:owner-repo github-repository	×
176	#:pull-number (git-ref->pr-number branch-ref)	×
177	#:body (github-review-body (not (null? comments)) file-count)	×
178	#:event (if (empty? comments) "APPROVE" "COMMENT")	×
179	#:comments comments))	×
180
181
182	(module+ test
183	(require rackunit)
184
185	(test-case "github-review-comment-jsexpr"
186	(test-case "single-line comment"
187	(define comment
188	(github-review-comment
189	#:path "file.rkt"
190	#:body "Fix this issue"
191	#:start-line 10
192	#:end-line 10
193	#:start-side "RIGHT"
194	#:end-side "RIGHT"))
195	(define result (github-review-comment-jsexpr comment))
196	(check-equal? (hash-ref result 'path) "file.rkt")
197	(check-equal? (hash-ref result 'body) "Fix this issue")
198	(check-equal? (hash-ref result 'line) 10)
199	(check-equal? (hash-ref result 'side) "RIGHT")
200	(check-false (hash-has-key? result 'start_line))
201	(check-false (hash-has-key? result 'start_side)))
202	(test-case "multi-line comment"
203	(define comment
204	(github-review-comment
205	#:path "another.rkt"
206	#:body "Multi-line issue"
207	#:start-line 5
208	#:end-line 8
209	#:start-side "LEFT"
210	#:end-side "RIGHT"))
211	(define result (github-review-comment-jsexpr comment))
212	(check-equal? (hash-ref result 'path) "another.rkt")
213	(check-equal? (hash-ref result 'body) "Multi-line issue")
214	(check-equal? (hash-ref result 'start_line) 5)
215	(check-equal? (hash-ref result 'line) 8)
216	(check-equal? (hash-ref result 'start_side) "LEFT")
217	(check-equal? (hash-ref result 'side) "RIGHT")))
218	(test-case "github-review-request-jsexpr"
219	(define comment1
220	(github-review-comment
221	#:path "file1.rkt"
222	#:body "Comment 1"
223	#:start-line 1
224	#:end-line 1
225	#:start-side "RIGHT"
226	#:end-side "RIGHT"))
227	(define comment2
228	(github-review-comment
229	#:path "file2.rkt"
230	#:body "Comment 2"
231	#:start-line 5
232	#:end-line 10
233	#:start-side "LEFT"
234	#:end-side "RIGHT"))
235	(define request
236	(github-review-request
237	#:owner-repo "owner/repo"
238	#:pull-number 123
239	#:body "Review body"
240	#:event "COMMENT"
241	#:comments (list comment1 comment2)))
242	(define result (github-review-request-jsexpr request))
243	(check-equal? (hash-ref result 'owner) "owner")
244	(check-equal? (hash-ref result 'repo) "repo")
245	(check-equal? (hash-ref result 'pull_number) 123)
246	(check-equal? (hash-ref result 'body) "Review body")
247	(check-equal? (hash-ref result 'event) "COMMENT")
248	(check-equal? (length (hash-ref result 'comments)) 2))
249	(test-case "git-ref->pr-number"
250	(test-case "valid PR ref"
251	(check-equal? (git-ref->pr-number "refs/pull/42/merge") 42)
252	(check-equal? (git-ref->pr-number "refs/pull/123/merge") 123)
253	(check-equal? (git-ref->pr-number "refs/pull/1/merge") 1))
254	(test-case "invalid refs raise errors"
255	(check-exn exn:fail? (lambda () (git-ref->pr-number "refs/heads/main")))
256	(check-exn exn:fail? (lambda () (git-ref->pr-number "refs/pull/42/head")))
257	(check-exn exn:fail? (lambda () (git-ref->pr-number "invalid")))))
258	(test-case "github-review-body"
259	(test-case "with comments"
260	(check-equal? (github-review-body #t 1)
261	"[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed 1 file in this pull request and has added suggestions.")
262	(check-equal? (github-review-body #t 5)
263	"[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed 5 files in this pull request and has added suggestions."))
264	(test-case "without comments"
265	(check-equal? (github-review-body #f 1)
266	"[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed 1 file in this pull request and found no issues.")
267	(check-equal? (github-review-body #f 3)
268	"[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed 3 files in this pull request and found no issues."))))

jackfirth / resyntax / #350

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous