#380

Committed 02 Jul 2026 05:12PM UTC coverage: 93.772% (-0.006%) from 93.778%

Build # #380

Build Type

push

cover

Committed by

web-flow

Commit Message

Remove redundant subtype-specific source accessors (#786)

Co-authored-by: Claude Fable 5 <noreply@anthropic.com>

Coverage Stats

4 of 15 new or added lines in 4 files covered. (26.67%)

1 existing line in 1 file now uncovered.

15553 of 16586 relevant lines covered (93.77%)

0.94 hits per line

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

60.98

/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/grimoire/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)
  (define path
    (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"))


(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/grimoire/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✔
96	(define path	×
NEW 97	(source-path (syntax-replacement-source (refactoring-result-syntax-replacement result))))	×
98	(define replacement (refactoring-result-line-replacement result))	×
99	(define body	×
100	(format #<<EOS	×
101	`~a`: ~a	×
102
103	```suggestion	×
104	~a	×
105	```	×
106
107	<details>	×
108	<summary>Debugging details</summary>	×
109
110	<details>	×
111	<summary>Textual replacement</summary>	×
112
113	```scheme	×
114	~a	×
115	```	×
116	</details>	×
117
118	<details>	×
119	<summary>Syntactic replacement</summary>	×
120
121	```scheme	×
122	~a	×
123	```	×
124	</details>	×
125	</details>	×
126	EOS	×
127	(refactoring-result-rule-name result)	×
128	(refactoring-result-message result)	×
129	(line-replacement-new-text replacement)	×
130	(string-indent (pretty-format replacement) #:amount 2)	×
131	(string-indent (pretty-format (refactoring-result-syntax-replacement result))	×
132	#:amount 2)))	×
133	(github-review-comment	×
134	#:path (first (git-path path))	×
135	#:body body	×
136	#:start-line (line-replacement-start-line replacement)	×
137	#:end-line (line-replacement-original-end-line replacement)	×
138	#:start-side "RIGHT"	×
139	#:end-side "RIGHT"))	×
140
141
142	(define branch-ref (getenv "GITHUB_REF"))	1✔
143	(define github-repository (getenv "GITHUB_REPOSITORY"))	1✔
144
145
146	(define (github-review-body comments? file-count)	1✔
147	(format "[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed ~a in this pull request and ~a"	1✔
148	(if (= file-count 1) "1 file" (format "~a files" file-count))	1✔
149	(if comments? "has added suggestions." "found no issues.")))	1✔
150
151
152	(define (refactoring-results->github-review results #:file-count file-count)	×
153	(define comments	×
154	(transduce results (mapping refactoring-result->github-review-comment) #:into into-list))	×
155	(github-review-request	×
156	#:owner-repo github-repository	×
157	#:pull-number (git-ref->pr-number branch-ref)	×
158	#:body (github-review-body (not (null? comments)) file-count)	×
159	#:event (if (empty? comments) "APPROVE" "COMMENT")	×
160	#:comments comments))	×
161
162
163	(module+ test
164	(require rackunit)
165
166	(test-case "github-review-comment-jsexpr"
167	(test-case "single-line comment"
168	(define comment
169	(github-review-comment
170	#:path "file.rkt"
171	#:body "Fix this issue"
172	#:start-line 10
173	#:end-line 10
174	#:start-side "RIGHT"
175	#:end-side "RIGHT"))
176	(define result (github-review-comment-jsexpr comment))
177	(check-equal? (hash-ref result 'path) "file.rkt")
178	(check-equal? (hash-ref result 'body) "Fix this issue")
179	(check-equal? (hash-ref result 'line) 10)
180	(check-equal? (hash-ref result 'side) "RIGHT")
181	(check-false (hash-has-key? result 'start_line))
182	(check-false (hash-has-key? result 'start_side)))
183	(test-case "multi-line comment"
184	(define comment
185	(github-review-comment
186	#:path "another.rkt"
187	#:body "Multi-line issue"
188	#:start-line 5
189	#:end-line 8
190	#:start-side "LEFT"
191	#:end-side "RIGHT"))
192	(define result (github-review-comment-jsexpr comment))
193	(check-equal? (hash-ref result 'path) "another.rkt")
194	(check-equal? (hash-ref result 'body) "Multi-line issue")
195	(check-equal? (hash-ref result 'start_line) 5)
196	(check-equal? (hash-ref result 'line) 8)
197	(check-equal? (hash-ref result 'start_side) "LEFT")
198	(check-equal? (hash-ref result 'side) "RIGHT")))
199	(test-case "github-review-request-jsexpr"
200	(define comment1
201	(github-review-comment
202	#:path "file1.rkt"
203	#:body "Comment 1"
204	#:start-line 1
205	#:end-line 1
206	#:start-side "RIGHT"
207	#:end-side "RIGHT"))
208	(define comment2
209	(github-review-comment
210	#:path "file2.rkt"
211	#:body "Comment 2"
212	#:start-line 5
213	#:end-line 10
214	#:start-side "LEFT"
215	#:end-side "RIGHT"))
216	(define request
217	(github-review-request
218	#:owner-repo "owner/repo"
219	#:pull-number 123
220	#:body "Review body"
221	#:event "COMMENT"
222	#:comments (list comment1 comment2)))
223	(define result (github-review-request-jsexpr request))
224	(check-equal? (hash-ref result 'owner) "owner")
225	(check-equal? (hash-ref result 'repo) "repo")
226	(check-equal? (hash-ref result 'pull_number) 123)
227	(check-equal? (hash-ref result 'body) "Review body")
228	(check-equal? (hash-ref result 'event) "COMMENT")
229	(check-equal? (length (hash-ref result 'comments)) 2))
230	(test-case "git-ref->pr-number"
231	(test-case "valid PR ref"
232	(check-equal? (git-ref->pr-number "refs/pull/42/merge") 42)
233	(check-equal? (git-ref->pr-number "refs/pull/123/merge") 123)
234	(check-equal? (git-ref->pr-number "refs/pull/1/merge") 1))
235	(test-case "invalid refs raise errors"
236	(check-exn exn:fail? (lambda () (git-ref->pr-number "refs/heads/main")))
237	(check-exn exn:fail? (lambda () (git-ref->pr-number "refs/pull/42/head")))
238	(check-exn exn:fail? (lambda () (git-ref->pr-number "invalid")))))
239	(test-case "github-review-body"
240	(test-case "with comments"
241	(check-equal? (github-review-body #t 1)
242	"[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed 1 file in this pull request and has added suggestions.")
243	(check-equal? (github-review-body #t 5)
244	"[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed 5 files in this pull request and has added suggestions."))
245	(test-case "without comments"
246	(check-equal? (github-review-body #f 1)
247	"[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed 1 file in this pull request and found no issues.")
248	(check-equal? (github-review-body #f 3)
249	"[Resyntax](https://docs.racket-lang.org/resyntax/) analyzed 3 files in this pull request and found no issues."))))

jackfirth / resyntax / #380

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