#236

Committed 05 Nov 2025 05:27PM UTC coverage: 93.371% (+0.2%) from 93.123%

Build # #236

Build Type

Pull #730

cover

Committed by

Copilot

Commit Message

Fix formatting in github-test.rkt to match project conventions

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

Pull Request Pull Request #730: Add test coverage for github.rkt module

Run Details

6 of 15 new or added lines in 1 file covered. (40.0%)

11 existing lines in 1 file now uncovered.

14861 of 15916 relevant lines covered (93.37%)

0.93 hits per line

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

66.2

/private/github.rkt

#lang racket/base


(require racket/contract/base)


(provide
 (contract-out
  [github-review-request? (-> any/c boolean?)]
  [github-review-request
   (-> #:owner-repo string?
       #:pull-number exact-nonnegative-integer?
       #:body string?
       #:event string?
       #:comments list?
       github-review-request?)]
  [github-review-request-jsexpr (-> github-review-request? jsexpr?)]
  [github-review-comment? (-> any/c boolean?)]
  [github-review-comment
   (-> #:path string?
       #:body string?
       #:start-line exact-nonnegative-integer?
       #:end-line exact-nonnegative-integer?
       #:start-side string?
       #:end-side string?
       github-review-comment?)]
  [github-review-comment-jsexpr (-> github-review-comment? jsexpr?)]
  [git-ref->pr-number (-> string? exact-nonnegative-integer?)]
  [github-review-body (-> boolean? exact-nonnegative-integer? string?)]
  [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)
  (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"))


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

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	1✔
11	(-> #:owner-repo string?	1✔
12	#:pull-number exact-nonnegative-integer?	1✔
13	#:body string?	1✔
14	#:event string?	1✔
15	#:comments list?	1✔
16	github-review-request?)]	1✔
17	[github-review-request-jsexpr (-> github-review-request? jsexpr?)]	1✔
18	[github-review-comment? (-> any/c boolean?)]	1✔
19	[github-review-comment	1✔
20	(-> #:path string?	1✔
21	#:body string?	1✔
22	#:start-line exact-nonnegative-integer?	1✔
23	#:end-line exact-nonnegative-integer?	1✔
24	#:start-side string?	1✔
25	#:end-side string?	1✔
26	github-review-comment?)]	1✔
27	[github-review-comment-jsexpr (-> github-review-comment? jsexpr?)]	1✔
28	[git-ref->pr-number (-> string? exact-nonnegative-integer?)]	1✔
29	[github-review-body (-> boolean? exact-nonnegative-integer? string?)]	1✔
30	[refactoring-results->github-review	1✔
31	(-> (sequence/c refactoring-result?) #:file-count exact-nonnegative-integer?	1✔
32	github-review-request?)]))	1✔
33
34
35	(require json	1✔
36	racket/list	1✔
37	racket/match	1✔
38	racket/pretty	1✔
39	racket/sequence	1✔
40	racket/string	1✔
41	rebellion/collection/list	1✔
42	rebellion/streaming/transducer	1✔
43	rebellion/type/record	1✔
44	resyntax/private/line-replacement	1✔
45	resyntax/private/refactoring-result	1✔
46	resyntax/private/run-command	1✔
47	resyntax/private/source	1✔
48	resyntax/private/string-indent	1✔
49	resyntax/private/syntax-replacement)	1✔
50
51
52	;@----------------------------------------------------------------------------------------------------
53
54
55	(define-record-type github-review-request	1✔
56	(owner-repo pull-number body event comments))	1✔
57
58
59	(define (github-review-request-jsexpr req)	1✔
60	(match-define	1✔
61	(github-review-request	1✔
62	#:owner-repo owner-repo #:pull-number pull-number #:body body #:event event #:comments comments)	1✔
63	req)	1✔
64	(match-define (list owner repo) (string-split owner-repo "/"))	1✔
65	(hash 'owner owner	1✔
66	'repo repo	1✔
67	'body body	1✔
68	'event event	1✔
69	'comments (map github-review-comment-jsexpr comments)	1✔
70	'pull_number pull-number))	1✔
71
72
73	(define-record-type github-review-comment	1✔
74	(path body start-line end-line start-side end-side))	1✔
75
76
77	(define (github-review-comment-jsexpr comment)	1✔
78	(match-define	1✔
79	(github-review-comment #:path path	1✔
80	#:body body	1✔
81	#:start-line start-line	1✔
82	#:end-line end-line	1✔
83	#:start-side start-side	1✔
84	#:end-side end-side)	1✔
85	comment)	1✔
86	(if (= start-line end-line)	1✔
87	(hash 'path path	1✔
88	'body body	1✔
89	'line end-line	1✔
90	'side end-side)	1✔
91	(hash 'path path	1✔
92	'body body	1✔
93	'start_line start-line	1✔
94	'line end-line	1✔
95	'start_side start-side	1✔
96	'side end-side)))	1✔
97
98
99	(define (git-path path)	1✔
100	(string-split (run-command "git" "ls-tree" "-r" "-z" "--name-only" "HEAD" path) "\0"))	×
101
102
103	(define git-pr-ref-regexp #rx"^refs/pull/([0-9]+)/merge$")	1✔
104
105
106	(define (git-ref->pr-number ref)	1✔
107	(match ref	1✔
108	[(regexp git-pr-ref-regexp (list _ num))	1✔
109	(string->number num)]	1✔
110	[_	1✔
111	(error (format "ref ~a doesn't represent a pull request" ref))]))	1✔
112
113
114	(define (refactoring-result->github-review-comment result)	1✔
115	(define path	×
116	(file-source-path (syntax-replacement-source (refactoring-result-syntax-replacement result))))	×
UNCOV 117	(define replacement (refactoring-result-line-replacement result))	×
118	(define body	×
119	(format #<<EOS	×
UNCOV 120	`~a`: ~a	×
121
122	```suggestion	×
123	~a	×
124	```	×
125
126	<details>	×
127	<summary>Debugging details</summary>	×
128
129	<details>	×
130	<summary>Textual replacement</summary>	×
131
132	```scheme	×
133	~a	×
134	```	×
135	</details>	×
136
137	<details>	×
138	<summary>Syntactic replacement</summary>	×
139
UNCOV 140	```scheme	×
UNCOV 141	~a	×
UNCOV 142	```	×
UNCOV 143	</details>	×
UNCOV 144	</details>	×
UNCOV 145	EOS	×
UNCOV 146	(refactoring-result-rule-name result)	×
147	(refactoring-result-message result)	×
148	(line-replacement-new-text replacement)	×
149	(string-indent (pretty-format replacement) #:amount 2)	×
UNCOV 150	(string-indent (pretty-format (refactoring-result-syntax-replacement result))	×
UNCOV 151	#:amount 2)))	×
152	(github-review-comment	×
153	#:path (first (git-path path))	×
154	#:body body	×
155	#:start-line (line-replacement-start-line replacement)	×
156	#:end-line (line-replacement-original-end-line replacement)	×
157	#:start-side "RIGHT"	×
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
NEW 171	(define (refactoring-results->github-review results #:file-count file-count)	×
NEW 172	(define comments	×
NEW 173	(transduce results (mapping refactoring-result->github-review-comment) #:into into-list))	×
NEW 174	(github-review-request	×
NEW 175	#:owner-repo github-repository	×
NEW 176	#:pull-number (git-ref->pr-number branch-ref)	×
NEW 177	#:body (github-review-body (not (null? comments)) file-count)	×
NEW 178	#:event (if (empty? comments) "APPROVE" "COMMENT")	×
NEW 179	#:comments comments))	×

jackfirth / resyntax / #236

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