jackfirth / resyntax / #78

Committed 30 Oct 2025 02:25AM UTC coverage: 93.533% (-0.05%) from 93.578%

Build # #78

Build Type

push

cover

Committed by

web-flow

Commit Message

Ensure `no-change-test` programs compile (#676)

Run Details

16 of 20 new or added lines in 3 files covered. (80.0%)

4 existing lines in 1 file now uncovered.

14507 of 15510 relevant lines covered (93.53%)

0.94 hits per line

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

53.95

/main.rkt

#lang racket/base


(require racket/contract/base)


(provide
 (contract-out
  [resyntax-analysis? (-> any/c boolean?)]
  [resyntax-analysis-all-results
   (-> resyntax-analysis?
       (listof (hash/c source? refactoring-result-set? #:flat? #true #:immutable #true)))]
  [resyntax-analysis-final-sources (-> resyntax-analysis? (listof modified-source?))]
  [resyntax-analysis-total-fixes (-> resyntax-analysis? exact-nonnegative-integer?)]
  [resyntax-analysis-total-sources-modified (-> resyntax-analysis? exact-nonnegative-integer?)]
  [resyntax-analysis-rules-applied (-> resyntax-analysis? multiset?)]
  [resyntax-analysis-write-file-changes! (-> resyntax-analysis? void?)]
  [resyntax-analysis-commit-fixes! (-> resyntax-analysis? void?)]
  [resyntax-analyze
   (->* (source?) (#:suite refactoring-suite? #:lines range-set?) refactoring-result-set?)]
  [resyntax-analyze-all
   (->* ((hash/c source? range-set? #:flat? #true))
        (#:suite refactoring-suite?
         #:max-fixes (or/c exact-nonnegative-integer? +inf.0)
         #:max-passes exact-nonnegative-integer?
         #:max-modified-sources (or/c exact-nonnegative-integer? +inf.0)
         #:max-modified-lines (or/c exact-nonnegative-integer? +inf.0))
        resyntax-analysis?)]
  [reysntax-analyze-for-properties-only
   (->* (source?) (#:suite refactoring-suite?) syntax-property-bundle?)]
  [refactor! (-> (sequence/c refactoring-result?) void?)]))


(require fancy-app
         guard
         racket/file
         racket/match
         racket/sequence
         racket/set
         racket/string
         rebellion/base/comparator
         rebellion/base/option
         rebellion/base/range
         rebellion/collection/entry
         rebellion/collection/hash
         rebellion/collection/list
         rebellion/collection/multiset
         resyntax/private/commit
         rebellion/collection/range-set
         rebellion/streaming/reducer
         rebellion/streaming/transducer
         rebellion/type/record
         resyntax/base
         resyntax/default-recommendations
         resyntax/private/analysis
         resyntax/private/comment-reader
         resyntax/private/git
         resyntax/private/limiting
         resyntax/private/line-replacement
         resyntax/private/logger
         resyntax/private/refactoring-result
         resyntax/private/source
         resyntax/private/string-indent
         resyntax/private/string-replacement
         resyntax/private/syntax-property-bundle
         resyntax/private/syntax-range
         resyntax/private/syntax-replacement
         (except-in racket/list range)
         (submod resyntax/base private))


(module+ test
  (require racket/list
           rackunit
           (submod "..")))


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


(define-record-type resyntax-analysis (all-results) #:omit-root-binding)


(define (resyntax-analysis #:all-results all-results)
  (constructor:resyntax-analysis #:all-results (sequence->list all-results)))


(define (resyntax-analysis-final-sources analysis)
  (transduce (resyntax-analysis-all-results analysis)
             (append-mapping in-hash-values)
             (mapping refactoring-result-set-updated-source)
             (indexing modified-source-original)
             (grouping nonempty-into-last)
             (mapping entry-value)
             #:into into-list))


(define (resyntax-analysis-total-fixes analysis)
  (for*/sum ([pass-results (in-list (resyntax-analysis-all-results analysis))]
             [result-set (in-hash-values pass-results)])
    (length (refactoring-result-set-results result-set))))


(define/guard (resyntax-analysis-total-sources-modified analysis)
  (define all-results (resyntax-analysis-all-results analysis))
  (guard (not (empty? all-results)) #:else 0)
  (hash-count (first all-results)))


(define (resyntax-analysis-rules-applied analysis)
  (for*/multiset ([pass-results (in-list (resyntax-analysis-all-results analysis))]
                  [result-set (in-hash-values pass-results)]
                  [result (in-list (refactoring-result-set-results result-set))])
    (refactoring-result-rule-name result)))


(define (analysis-pass-fix-commits pass-results)
  (append-map refactoring-result-map-commits pass-results))


(define (resyntax-analysis-fix-commits analysis)
  (append-map refactoring-result-map-commits (resyntax-analysis-all-results analysis)))


(define (resyntax-analysis-write-file-changes! analysis)
  (define sources (resyntax-analysis-final-sources analysis))
  (unless (empty? sources)
    (log-resyntax-info "--- fixing code ---"))
  (for ([source (in-list sources)]
        #:when (source-path source))
    (log-resyntax-info "fixing ~a" (source-path source))
    (display-to-file (modified-source-contents source) (source-path source)
                     #:mode 'text #:exists 'replace)))


(define (resyntax-analysis-commit-fixes! analysis)
  (define commits (resyntax-analysis-fix-commits analysis))
  (unless (empty? commits)
    (log-resyntax-info "--- fixing code ---"))
  (for ([commit (in-list commits)]
        [i (in-naturals 1)])
    (log-resyntax-info "--- commit ~a ---" i)
    (match-define (resyntax-commit message changes) commit)
    (for ([(path new-contents) (in-hash changes)])
      (log-resyntax-info "fixing ~a" path)
      (display-to-file new-contents path #:mode 'text #:exists 'replace))
    (log-resyntax-info "commiting pass fixes")
    (git-commit! message)))


;; Try to dynamically load a refactoring suite from a language module's resyntax submodule
(define (try-load-lang-refactoring-suite lang-name)
  (with-handlers
      ([exn:fail?
        (λ (e)
          (log-resyntax-error
           "could not load language refactoring suite due to error\n  language: ~a\n  error: ~a"
           lang-name e)
          #false)])
    (define lang-resyntax-submod `(submod ,lang-name resyntax))
    (dynamic-require lang-resyntax-submod 'refactoring-suite (λ () #false))))

(define allowed-langs (set 'racket 'racket/base 'racket/gui))


(define/guard (resyntax-analyze source
                                #:suite [suite default-recommendations]
                                #:lines [lines (range-set (unbounded-range #:comparator natural<=>))])
  (define comments (with-input-from-source source read-comment-locations))
  (define source-lang (source-read-language source))
  (guard source-lang #:else
    (log-resyntax-warning "skipping ~a because its #lang could not be determined"
                          (or (source-path source) "string source"))
    (refactoring-result-set #:base-source source #:results '()))
  ;; Handle supported languages and try dynamic loading for unsupported ones
  (define effective-suite
    (cond
      [(set-member? allowed-langs source-lang) suite]
      [else
       (define lang-suite (try-load-lang-refactoring-suite source-lang))
       (cond
         [lang-suite
          (log-resyntax-debug "using refactoring suite from #lang ~a resyntax submodule for ~a"
                              source-lang (or (source-path source) "string source"))
          lang-suite]
         [else
          (log-resyntax-warning
           (string-append "skipping ~a because it's written in #lang ~a, which is unsupported and"
                          " has no resyntax submodule")
           (or (source-path source) "string source") source-lang)
          #false])]))
  
  (guard effective-suite #:else
    (refactoring-result-set #:base-source source #:results '()))
  (define full-source (source->string source))
  (log-resyntax-info "analyzing ~a" (or (source-path source) "string source"))
  (for ([comment (in-range-set comments)])
    (log-resyntax-debug "parsed comment: ~a: ~v" comment (substring-by-range full-source comment)))

  (define (skip e)
    (log-resyntax-error
     "skipping ~a\n encountered an error during initial analysis\n  error:\n~a"
     (or (source-path source) "string source")
     (string-indent (exn-message e) #:amount 3))
    empty-list)

  (define results
    (with-handlers ([exn:fail? skip])
      (define analysis (source-analyze source #:lines lines))
      (refactor-visited-forms
       #:analysis analysis #:suite effective-suite #:comments comments #:lines lines)))
  
  (refactoring-result-set #:base-source source #:results results))


(define/guard (reysntax-analyze-for-properties-only source #:suite [suite default-recommendations])
  (define comments (with-input-from-source source read-comment-locations))
  (define full-source (source->string source))
  (guard (string-prefix? full-source "#lang racket") #:else
    (log-resyntax-warning "skipping ~a because it does not start with #lang racket"
                          (or (source-path source) "string source"))
    (syntax-property-bundle))
  (log-resyntax-info "analyzing ~a" (or (source-path source) "string source"))
  (for ([comment (in-range-set comments)])
    (log-resyntax-debug "parsed comment: ~a: ~v" comment (substring-by-range full-source comment)))

  (define (skip e)
    (log-resyntax-error
     "skipping ~a\n encountered an error during macro expansion\n  error:\n~a"
     (or (source-path source) "string source")
     (string-indent (exn-message e) #:amount 3))
    (syntax-property-bundle))

  (with-handlers ([exn:fail:syntax? skip]
                  [exn:fail:filesystem:missing-module? skip]
                  [exn:fail:contract:variable? skip])
    (define analysis (source-analyze source))
    (source-code-analysis-added-syntax-properties analysis)))


(define (resyntax-analyze-all sources
                              #:suite [suite default-recommendations]
                              #:max-fixes [max-fixes +inf.0]
                              #:max-passes [max-passes 10]
                              #:max-modified-sources [max-modified-sources +inf.0]
                              #:max-modified-lines [max-modified-lines +inf.0])
  (log-resyntax-info "--- analyzing code ---")
  (for/fold ([pass-result-lists '()]
             [sources sources]
             [max-fixes max-fixes]
             #:result (resyntax-analysis #:all-results (reverse pass-result-lists)))
            ([pass-index (in-range max-passes)]
             #:do [(unless (zero? pass-index)
                     (log-resyntax-info "--- pass ~a ---" (add1 pass-index)))
                   (define pass-results
                     (resyntax-analyze-all-once sources
                                                #:suite suite
                                                #:max-fixes max-fixes
                                                #:max-modified-sources max-modified-sources
                                                #:max-modified-lines max-modified-lines))
                   (define pass-fix-count (count-total-results pass-results))
                   (define new-max-fixes (- max-fixes pass-fix-count))]
             #:break (hash-empty? pass-results)
             #:final (zero? new-max-fixes))
    (define modified-sources (build-modified-source-map pass-results))
    (values (cons pass-results pass-result-lists) modified-sources new-max-fixes)))


(define (count-total-results pass-results)
  (for/sum ([(_ result-set) (in-hash pass-results)])
    (length (refactoring-result-set-results result-set))))


(define (build-modified-source-map pass-results)
  (transduce (in-hash-values pass-results)
             (bisecting refactoring-result-set-updated-source refactoring-result-set-modified-lines)
             #:into into-hash))


(define (resyntax-analyze-all-once sources
                                   #:suite suite
                                   #:max-fixes max-fixes
                                   #:max-modified-sources max-modified-sources
                                   #:max-modified-lines max-modified-lines)
  (transduce (in-hash-entries sources) ; entries with source keys and line range set values

             ;; The following steps perform a kind of layered shuffle: the files to refactor are
             ;; shuffled such that files in the same directory remain together. When combined with
             ;; the #:max-modified-sources argument, this makes Resyntax prefer to refactor closely
             ;; related files instead of selecting arbitrary unrelated files from across an entire
             ;; codebase. This limits potential for merge conflicts and makes changes easier to
             ;; review, since it's more likely the refactored files will have shared context.

             ; key by directory
             (indexing (λ (e) (source-directory (entry-key e))))

             ; group by key and shuffle within each group
             (grouping (into-transduced (shuffling) #:into into-list))

             ; shuffle groups
             (shuffling)

             ; ungroup and throw away directory
             (append-mapping entry-value)

             ;; Now the stream contains exactly what it did before the above steps, but shuffled in
             ;; a convenient manner.
               
             (append-mapping
              (λ (e)
                (match-define (entry source lines) e)
                (define result-set (resyntax-analyze source #:suite suite #:lines lines))
                (refactoring-result-set-results result-set)))
             (limiting max-modified-lines
                       #:by (λ (result)
                              (define replacement (refactoring-result-line-replacement result))
                              (add1 (- (line-replacement-original-end-line replacement)
                                       (line-replacement-start-line replacement)))))
             (if (equal? max-fixes +inf.0) (transducer-pipe) (taking max-fixes))
             (if (equal? max-modified-sources +inf.0)
                 (transducer-pipe)
                 (transducer-pipe
                  (indexing
                   (λ (result)
                     (syntax-replacement-source (refactoring-result-syntax-replacement result))))
                  (grouping into-list)
                  (taking max-modified-sources)
                  (append-mapping entry-value)))
             (indexing refactoring-result-source)
             (grouping into-list)
             (mapping
              (λ (e) (refactoring-result-set #:base-source (entry-key e) #:results (entry-value e))))
             (indexing refactoring-result-set-base-source)
             #:into into-hash))


(define (refactoring-rules-refactor rules syntax #:comments comments #:analysis analysis)

  (define (refactor rule)
    (with-handlers
        ([exn:fail?
          (λ (e)
            (log-resyntax-error "~a: refactoring attempt failed\n  syntax:\n   ~a\n  cause:\n~a"
                                (object-name rule)
                                syntax
                                (string-indent (exn-message e) #:amount 3))
            absent)])
      (guarded-block
        (guard-match (present replacement)
          (parameterize ([current-namespace (source-code-analysis-namespace analysis)])
            (refactoring-rule-refactor rule syntax (source-code-analysis-code analysis)))
          #:else absent)
        (guard (syntax-replacement-introduces-incorrect-bindings? replacement) #:else
          (define bad-ids (syntax-replacement-introduced-incorrect-identifiers replacement))
          (define orig-stx (syntax-replacement-original-syntax replacement))
          (define intro (syntax-replacement-introduction-scope replacement))
          (log-resyntax-warning
           (string-append
            "~a: suggestion discarded because it introduces identifiers with incorrect bindings\n"
            "  incorrect identifiers: ~a\n"
            "  bindings in original context: ~a\n"
            "  bindings in syntax replacement: ~a\n"
            "  replaced syntax: ~a")
           (object-name rule)
           bad-ids
           (for/list ([id (in-list bad-ids)])
             (identifier-binding (datum->syntax orig-stx (syntax->datum id))))
           (for/list ([id (in-list bad-ids)])
             (identifier-binding (intro id 'remove)))
           orig-stx)
          absent)
        (guard (syntax-replacement-preserves-comments? replacement comments) #:else
          (log-resyntax-warning
           (string-append "~a: suggestion discarded because it does not preserve all comments\n"
                          "  dropped comment locations: ~v\n"
                          "  original syntax:\n"
                          "   ~v\n"
                          "  replacement syntax:\n"
                          "   ~v")
           (object-name rule)
           (syntax-replacement-dropped-comment-locations replacement comments)
           (syntax-replacement-original-syntax replacement)
           (syntax-replacement-new-syntax replacement))
          absent)
        (present
         (refactoring-result
          #:rule-name (object-name rule)
          #:message (refactoring-rule-description rule)
          #:syntax-replacement replacement)))))
  
  (falsey->option
   (for*/first ([rule (in-list rules)]
                [result (in-option (refactor rule))])
     result)))


(define (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments #:lines lines)
  (define rule-list (refactoring-suite-rules suite))
  (for*/fold ([results '()]
              [modified-positions (range-set #:comparator natural<=>)]
              #:result (reverse results))
             ([stx (in-list (source-code-analysis-visited-forms analysis))]
              #:unless (range-set-intersects? modified-positions (syntax-source-range stx))
              [result
               (in-option
                (refactoring-rules-refactor rule-list stx #:comments comments #:analysis analysis))]
              #:when (check-lines-enclose-refactoring-result lines result))
    (values (cons result results)
            (range-set-add modified-positions (refactoring-result-modified-range result)))))


(define (check-lines-enclose-refactoring-result lines result)
  (define modified-lines (refactoring-result-modified-line-range result))
  (define enclosed? (range-set-encloses? lines modified-lines))
  (unless enclosed?
    (log-resyntax-info
     (string-append "~a: suggestion discarded because it's outside the analyzed line range\n"
                    "  analyzed lines: ~a\n"
                    "  lines modified by result: ~a")
     (refactoring-result-rule-name result)
     lines
     modified-lines))
  enclosed?)
     

(define (refactor! results)
  (define results-by-path
    (transduce results
               (bisecting
                (λ (result)
                  (file-source-path
                   (syntax-replacement-source (refactoring-result-syntax-replacement result))))
                refactoring-result-string-replacement)
               (grouping union-into-string-replacement)
               #:into into-hash))
  (for ([(path replacement) (in-hash results-by-path)])
    (file-apply-string-replacement! path replacement)))


(define (substring-by-range str rng)
  (define lower-bound (range-lower-bound rng))
  (define start
    (cond
      [(equal? lower-bound unbounded) 0]
      [(equal? (range-bound-type lower-bound) inclusive)
       (range-bound-endpoint lower-bound)]
      [else
       (max 0 (sub1 (range-bound-endpoint lower-bound)))]))
  (define upper-bound (range-upper-bound rng))
  (define end
    (cond
      [(equal? upper-bound unbounded) (string-length str)]
      [(equal? (range-bound-type upper-bound) inclusive)
       (min (string-length str) (+ (range-bound-endpoint upper-bound) 1))]
      [else (range-bound-endpoint upper-bound)]))
  (substring str start end))


(module+ test
  (test-case "resyntax-analyze"
    (define results
      (refactoring-result-set-results
       (resyntax-analyze (string-source "#lang racket (or 1 (or 2 3))"))))
    (check-equal? (length results) 1)
    (check-equal? (refactoring-result-string-replacement (first results))
                  (string-replacement #:start 13
                                      #:end 28
                                      #:contents (list (inserted-string "(or 1 2 3)"))))))

1	#lang racket/base	1✔
2
3
4	(require racket/contract/base)	1✔
5
6
7	(provide	1✔
8	(contract-out	1✔
9	[resyntax-analysis? (-> any/c boolean?)]	1✔
10	[resyntax-analysis-all-results	1✔
11	(-> resyntax-analysis?	1✔
12	(listof (hash/c source? refactoring-result-set? #:flat? #true #:immutable #true)))]	1✔
13	[resyntax-analysis-final-sources (-> resyntax-analysis? (listof modified-source?))]	1✔
14	[resyntax-analysis-total-fixes (-> resyntax-analysis? exact-nonnegative-integer?)]	1✔
15	[resyntax-analysis-total-sources-modified (-> resyntax-analysis? exact-nonnegative-integer?)]	1✔
16	[resyntax-analysis-rules-applied (-> resyntax-analysis? multiset?)]	1✔
17	[resyntax-analysis-write-file-changes! (-> resyntax-analysis? void?)]	1✔
18	[resyntax-analysis-commit-fixes! (-> resyntax-analysis? void?)]	1✔
19	[resyntax-analyze	1✔
20	(->* (source?) (#:suite refactoring-suite? #:lines range-set?) refactoring-result-set?)]	1✔
21	[resyntax-analyze-all	1✔
22	(->* ((hash/c source? range-set? #:flat? #true))	1✔
23	(#:suite refactoring-suite?	1✔
24	#:max-fixes (or/c exact-nonnegative-integer? +inf.0)	1✔
25	#:max-passes exact-nonnegative-integer?	1✔
26	#:max-modified-sources (or/c exact-nonnegative-integer? +inf.0)	1✔
27	#:max-modified-lines (or/c exact-nonnegative-integer? +inf.0))	1✔
28	resyntax-analysis?)]	1✔
29	[reysntax-analyze-for-properties-only	1✔
30	(->* (source?) (#:suite refactoring-suite?) syntax-property-bundle?)]	1✔
31	[refactor! (-> (sequence/c refactoring-result?) void?)]))	1✔
32
33
34	(require fancy-app	1✔
35	guard	1✔
36	racket/file	1✔
37	racket/match	1✔
38	racket/sequence	1✔
39	racket/set	1✔
40	racket/string	1✔
41	rebellion/base/comparator	1✔
42	rebellion/base/option	1✔
43	rebellion/base/range	1✔
44	rebellion/collection/entry	1✔
45	rebellion/collection/hash	1✔
46	rebellion/collection/list	1✔
47	rebellion/collection/multiset	1✔
48	resyntax/private/commit	1✔
49	rebellion/collection/range-set	1✔
50	rebellion/streaming/reducer	1✔
51	rebellion/streaming/transducer	1✔
52	rebellion/type/record	1✔
53	resyntax/base	1✔
54	resyntax/default-recommendations	1✔
55	resyntax/private/analysis	1✔
56	resyntax/private/comment-reader	1✔
57	resyntax/private/git	1✔
58	resyntax/private/limiting	1✔
59	resyntax/private/line-replacement	1✔
60	resyntax/private/logger	1✔
61	resyntax/private/refactoring-result	1✔
62	resyntax/private/source	1✔
63	resyntax/private/string-indent	1✔
64	resyntax/private/string-replacement	1✔
65	resyntax/private/syntax-property-bundle	1✔
66	resyntax/private/syntax-range	1✔
67	resyntax/private/syntax-replacement	1✔
68	(except-in racket/list range)	1✔
69	(submod resyntax/base private))	1✔
70
71
72	(module+ test
73	(require racket/list
74	rackunit
75	(submod "..")))
76
77
78	;@----------------------------------------------------------------------------------------------------
79
80
81	(define-record-type resyntax-analysis (all-results) #:omit-root-binding)	1✔
82
83
84	(define (resyntax-analysis #:all-results all-results)	×
85	(constructor:resyntax-analysis #:all-results (sequence->list all-results)))	×
86
87
88	(define (resyntax-analysis-final-sources analysis)	1✔
89	(transduce (resyntax-analysis-all-results analysis)	×
90	(append-mapping in-hash-values)	×
91	(mapping refactoring-result-set-updated-source)	×
92	(indexing modified-source-original)	×
93	(grouping nonempty-into-last)	×
94	(mapping entry-value)	×
95	#:into into-list))	×
96
97
98	(define (resyntax-analysis-total-fixes analysis)	1✔
99	(for*/sum ([pass-results (in-list (resyntax-analysis-all-results analysis))]	×
100	[result-set (in-hash-values pass-results)])	×
101	(length (refactoring-result-set-results result-set))))	×
102
103
104	(define/guard (resyntax-analysis-total-sources-modified analysis)	1✔
105	(define all-results (resyntax-analysis-all-results analysis))	×
106	(guard (not (empty? all-results)) #:else 0)	×
107	(hash-count (first all-results)))	×
108
109
110	(define (resyntax-analysis-rules-applied analysis)	1✔
111	(for*/multiset ([pass-results (in-list (resyntax-analysis-all-results analysis))]	×
112	[result-set (in-hash-values pass-results)]	×
113	[result (in-list (refactoring-result-set-results result-set))])	×
114	(refactoring-result-rule-name result)))	×
115
116
117	(define (analysis-pass-fix-commits pass-results)	1✔
118	(append-map refactoring-result-map-commits pass-results))	×
119
120
121	(define (resyntax-analysis-fix-commits analysis)	1✔
122	(append-map refactoring-result-map-commits (resyntax-analysis-all-results analysis)))	×
123
124
125	(define (resyntax-analysis-write-file-changes! analysis)	1✔
126	(define sources (resyntax-analysis-final-sources analysis))	×
127	(unless (empty? sources)	×
128	(log-resyntax-info "--- fixing code ---"))	×
129	(for ([source (in-list sources)]	×
130	#:when (source-path source))	×
131	(log-resyntax-info "fixing ~a" (source-path source))	×
132	(display-to-file (modified-source-contents source) (source-path source)	×
133	#:mode 'text #:exists 'replace)))	×
134
135
136	(define (resyntax-analysis-commit-fixes! analysis)	1✔
137	(define commits (resyntax-analysis-fix-commits analysis))	×
138	(unless (empty? commits)	×
139	(log-resyntax-info "--- fixing code ---"))	×
140	(for ([commit (in-list commits)]	×
141	[i (in-naturals 1)])	×
142	(log-resyntax-info "--- commit ~a ---" i)	×
143	(match-define (resyntax-commit message changes) commit)	×
144	(for ([(path new-contents) (in-hash changes)])	×
145	(log-resyntax-info "fixing ~a" path)	×
146	(display-to-file new-contents path #:mode 'text #:exists 'replace))	×
147	(log-resyntax-info "commiting pass fixes")	×
148	(git-commit! message)))	×
149
150
151	;; Try to dynamically load a refactoring suite from a language module's resyntax submodule
152	(define (try-load-lang-refactoring-suite lang-name)	1✔
153	(with-handlers	×
154	([exn:fail?	×
155	(λ (e)	×
156	(log-resyntax-error	×
157	"could not load language refactoring suite due to error\n language: ~a\n error: ~a"	×
158	lang-name e)	×
159	#false)])	×
160	(define lang-resyntax-submod `(submod ,lang-name resyntax))	×
161	(dynamic-require lang-resyntax-submod 'refactoring-suite (λ () #false))))	×
162
163	(define allowed-langs (set 'racket 'racket/base 'racket/gui))	1✔
164
165
166	(define/guard (resyntax-analyze source	1✔
167	#:suite [suite default-recommendations]	1✔
168	#:lines [lines (range-set (unbounded-range #:comparator natural<=>))])	1✔
169	(define comments (with-input-from-source source read-comment-locations))	1✔
170	(define source-lang (source-read-language source))	1✔
171	(guard source-lang #:else	1✔
172	(log-resyntax-warning "skipping ~a because its #lang could not be determined"	1✔
173	(or (source-path source) "string source"))	1✔
174	(refactoring-result-set #:base-source source #:results '()))	1✔
175	;; Handle supported languages and try dynamic loading for unsupported ones
176	(define effective-suite	1✔
177	(cond	1✔
178	[(set-member? allowed-langs source-lang) suite]	1✔
179	[else	1✔
180	(define lang-suite (try-load-lang-refactoring-suite source-lang))	×
181	(cond	×
182	[lang-suite	×
183	(log-resyntax-debug "using refactoring suite from #lang ~a resyntax submodule for ~a"	×
184	source-lang (or (source-path source) "string source"))	×
185	lang-suite]	×
186	[else	×
187	(log-resyntax-warning	×
188	(string-append "skipping ~a because it's written in #lang ~a, which is unsupported and"	×
189	" has no resyntax submodule")	×
190	(or (source-path source) "string source") source-lang)	×
191	#false])]))	×
192
193	(guard effective-suite #:else	1✔
194	(refactoring-result-set #:base-source source #:results '()))	×
195	(define full-source (source->string source))	1✔
196	(log-resyntax-info "analyzing ~a" (or (source-path source) "string source"))	1✔
197	(for ([comment (in-range-set comments)])	1✔
198	(log-resyntax-debug "parsed comment: ~a: ~v" comment (substring-by-range full-source comment)))	1✔
199
200	(define (skip e)	1✔
201	(log-resyntax-error	1✔
UNCOV 202	"skipping ~a\n encountered an error during initial analysis\n error:\n~a"	×
UNCOV 203	(or (source-path source) "string source")	×
UNCOV 204	(string-indent (exn-message e) #:amount 3))	×
UNCOV 205	empty-list)	×
206
207	(define results	1✔
208	(with-handlers ([exn:fail? skip])	1✔
209	(define analysis (source-analyze source #:lines lines))	1✔
210	(refactor-visited-forms	1✔
211	#:analysis analysis #:suite effective-suite #:comments comments #:lines lines)))	1✔
212
213	(refactoring-result-set #:base-source source #:results results))	1✔
214
215
216	(define/guard (reysntax-analyze-for-properties-only source #:suite [suite default-recommendations])	1✔
217	(define comments (with-input-from-source source read-comment-locations))	1✔
218	(define full-source (source->string source))	1✔
219	(guard (string-prefix? full-source "#lang racket") #:else	1✔
220	(log-resyntax-warning "skipping ~a because it does not start with #lang racket"	×
221	(or (source-path source) "string source"))	×
222	(syntax-property-bundle))	×
223	(log-resyntax-info "analyzing ~a" (or (source-path source) "string source"))	1✔
224	(for ([comment (in-range-set comments)])	×
225	(log-resyntax-debug "parsed comment: ~a: ~v" comment (substring-by-range full-source comment)))	×
226
227	(define (skip e)	1✔
228	(log-resyntax-error	1✔
229	"skipping ~a\n encountered an error during macro expansion\n error:\n~a"	×
230	(or (source-path source) "string source")	×
231	(string-indent (exn-message e) #:amount 3))	×
232	(syntax-property-bundle))	×
233
234	(with-handlers ([exn:fail:syntax? skip]	1✔
235	[exn:fail:filesystem:missing-module? skip]	1✔
236	[exn:fail:contract:variable? skip])	1✔
237	(define analysis (source-analyze source))	1✔
238	(source-code-analysis-added-syntax-properties analysis)))	1✔
239
240
241	(define (resyntax-analyze-all sources	×
242	#:suite [suite default-recommendations]	×
243	#:max-fixes [max-fixes +inf.0]	×
244	#:max-passes [max-passes 10]	×
245	#:max-modified-sources [max-modified-sources +inf.0]	×
246	#:max-modified-lines [max-modified-lines +inf.0])	×
247	(log-resyntax-info "--- analyzing code ---")	×
248	(for/fold ([pass-result-lists '()]	×
249	[sources sources]	×
250	[max-fixes max-fixes]	×
251	#:result (resyntax-analysis #:all-results (reverse pass-result-lists)))	×
252	([pass-index (in-range max-passes)]	×
253	#:do [(unless (zero? pass-index)	×
254	(log-resyntax-info "--- pass ~a ---" (add1 pass-index)))	×
255	(define pass-results	×
256	(resyntax-analyze-all-once sources	×
257	#:suite suite	×
258	#:max-fixes max-fixes	×
259	#:max-modified-sources max-modified-sources	×
260	#:max-modified-lines max-modified-lines))	×
261	(define pass-fix-count (count-total-results pass-results))	×
262	(define new-max-fixes (- max-fixes pass-fix-count))]	×
263	#:break (hash-empty? pass-results)	×
264	#:final (zero? new-max-fixes))	×
265	(define modified-sources (build-modified-source-map pass-results))	×
266	(values (cons pass-results pass-result-lists) modified-sources new-max-fixes)))	×
267
268
269	(define (count-total-results pass-results)	1✔
270	(for/sum ([(_ result-set) (in-hash pass-results)])	×
271	(length (refactoring-result-set-results result-set))))	×
272
273
274	(define (build-modified-source-map pass-results)	1✔
275	(transduce (in-hash-values pass-results)	×
276	(bisecting refactoring-result-set-updated-source refactoring-result-set-modified-lines)	×
277	#:into into-hash))	×
278
279
280	(define (resyntax-analyze-all-once sources	×
281	#:suite suite	×
282	#:max-fixes max-fixes	×
283	#:max-modified-sources max-modified-sources	×
284	#:max-modified-lines max-modified-lines)	×
285	(transduce (in-hash-entries sources) ; entries with source keys and line range set values	×
286
287	;; The following steps perform a kind of layered shuffle: the files to refactor are
288	;; shuffled such that files in the same directory remain together. When combined with
289	;; the #:max-modified-sources argument, this makes Resyntax prefer to refactor closely
290	;; related files instead of selecting arbitrary unrelated files from across an entire
291	;; codebase. This limits potential for merge conflicts and makes changes easier to
292	;; review, since it's more likely the refactored files will have shared context.
293
294	; key by directory
295	(indexing (λ (e) (source-directory (entry-key e))))	×
296
297	; group by key and shuffle within each group
298	(grouping (into-transduced (shuffling) #:into into-list))	×
299
300	; shuffle groups
301	(shuffling)	×
302
303	; ungroup and throw away directory
304	(append-mapping entry-value)	×
305
306	;; Now the stream contains exactly what it did before the above steps, but shuffled in
307	;; a convenient manner.
308
309	(append-mapping	×
310	(λ (e)	×
311	(match-define (entry source lines) e)	×
312	(define result-set (resyntax-analyze source #:suite suite #:lines lines))	×
313	(refactoring-result-set-results result-set)))	×
314	(limiting max-modified-lines	×
315	#:by (λ (result)	×
316	(define replacement (refactoring-result-line-replacement result))	×
317	(add1 (- (line-replacement-original-end-line replacement)	×
318	(line-replacement-start-line replacement)))))	×
319	(if (equal? max-fixes +inf.0) (transducer-pipe) (taking max-fixes))	×
320	(if (equal? max-modified-sources +inf.0)	×
321	(transducer-pipe)	×
322	(transducer-pipe	×
323	(indexing	×
324	(λ (result)	×
325	(syntax-replacement-source (refactoring-result-syntax-replacement result))))	×
326	(grouping into-list)	×
327	(taking max-modified-sources)	×
328	(append-mapping entry-value)))	×
329	(indexing refactoring-result-source)	×
330	(grouping into-list)	×
331	(mapping	×
332	(λ (e) (refactoring-result-set #:base-source (entry-key e) #:results (entry-value e))))	×
333	(indexing refactoring-result-set-base-source)	×
334	#:into into-hash))	×
335
336
337	(define (refactoring-rules-refactor rules syntax #:comments comments #:analysis analysis)	1✔
338
339	(define (refactor rule)	1✔
340	(with-handlers	1✔
341	([exn:fail?	1✔
342	(λ (e)	1✔
343	(log-resyntax-error "~a: refactoring attempt failed\n syntax:\n ~a\n cause:\n~a"	×
344	(object-name rule)	×
345	syntax	×
346	(string-indent (exn-message e) #:amount 3))	×
347	absent)])	×
348	(guarded-block	1✔
349	(guard-match (present replacement)	1✔
350	(parameterize ([current-namespace (source-code-analysis-namespace analysis)])	1✔
351	(refactoring-rule-refactor rule syntax (source-code-analysis-code analysis)))	1✔
352	#:else absent)	1✔
353	(guard (syntax-replacement-introduces-incorrect-bindings? replacement) #:else	1✔
354	(define bad-ids (syntax-replacement-introduced-incorrect-identifiers replacement))	1✔
355	(define orig-stx (syntax-replacement-original-syntax replacement))	1✔
356	(define intro (syntax-replacement-introduction-scope replacement))	1✔
357	(log-resyntax-warning	1✔
358	(string-append	1✔
359	"~a: suggestion discarded because it introduces identifiers with incorrect bindings\n"	1✔
360	" incorrect identifiers: ~a\n"	1✔
361	" bindings in original context: ~a\n"	1✔
362	" bindings in syntax replacement: ~a\n"	1✔
363	" replaced syntax: ~a")	1✔
364	(object-name rule)	1✔
365	bad-ids	1✔
366	(for/list ([id (in-list bad-ids)])	1✔
367	(identifier-binding (datum->syntax orig-stx (syntax->datum id))))	1✔
368	(for/list ([id (in-list bad-ids)])	1✔
369	(identifier-binding (intro id 'remove)))	1✔
370	orig-stx)	1✔
371	absent)	1✔
372	(guard (syntax-replacement-preserves-comments? replacement comments) #:else	1✔
373	(log-resyntax-warning	1✔
374	(string-append "~a: suggestion discarded because it does not preserve all comments\n"	1✔
375	" dropped comment locations: ~v\n"	1✔
376	" original syntax:\n"	1✔
377	" ~v\n"	1✔
378	" replacement syntax:\n"	1✔
379	" ~v")	1✔
380	(object-name rule)	1✔
381	(syntax-replacement-dropped-comment-locations replacement comments)	1✔
382	(syntax-replacement-original-syntax replacement)	1✔
383	(syntax-replacement-new-syntax replacement))	1✔
384	absent)	1✔
385	(present	1✔
386	(refactoring-result	1✔
387	#:rule-name (object-name rule)	1✔
388	#:message (refactoring-rule-description rule)	1✔
389	#:syntax-replacement replacement)))))	1✔
390
391	(falsey->option	1✔
392	(for*/first ([rule (in-list rules)]	1✔
393	[result (in-option (refactor rule))])	1✔
394	result)))	1✔
395
396
397	(define (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments #:lines lines)	1✔
398	(define rule-list (refactoring-suite-rules suite))	1✔
399	(for*/fold ([results '()]	1✔
400	[modified-positions (range-set #:comparator natural<=>)]	1✔
401	#:result (reverse results))	1✔
402	([stx (in-list (source-code-analysis-visited-forms analysis))]	1✔
403	#:unless (range-set-intersects? modified-positions (syntax-source-range stx))	1✔
404	[result	1✔
405	(in-option	1✔
406	(refactoring-rules-refactor rule-list stx #:comments comments #:analysis analysis))]	1✔
407	#:when (check-lines-enclose-refactoring-result lines result))	1✔
408	(values (cons result results)	1✔
409	(range-set-add modified-positions (refactoring-result-modified-range result)))))	1✔
410
411
412	(define (check-lines-enclose-refactoring-result lines result)	1✔
413	(define modified-lines (refactoring-result-modified-line-range result))	1✔
414	(define enclosed? (range-set-encloses? lines modified-lines))	1✔
415	(unless enclosed?	1✔
416	(log-resyntax-info	1✔
417	(string-append "~a: suggestion discarded because it's outside the analyzed line range\n"	×
418	" analyzed lines: ~a\n"	×
419	" lines modified by result: ~a")	×
420	(refactoring-result-rule-name result)	×
421	lines	×
422	modified-lines))	×
423	enclosed?)	1✔
424
425
426	(define (refactor! results)	1✔
427	(define results-by-path	×
428	(transduce results	×
429	(bisecting	×
430	(λ (result)	×
431	(file-source-path	×
432	(syntax-replacement-source (refactoring-result-syntax-replacement result))))	×
433	refactoring-result-string-replacement)	×
434	(grouping union-into-string-replacement)	×
435	#:into into-hash))	×
436	(for ([(path replacement) (in-hash results-by-path)])	×
437	(file-apply-string-replacement! path replacement)))	×
438
439
440	(define (substring-by-range str rng)	1✔
441	(define lower-bound (range-lower-bound rng))	1✔
442	(define start	1✔
443	(cond	1✔
444	[(equal? lower-bound unbounded) 0]	×
445	[(equal? (range-bound-type lower-bound) inclusive)	1✔
446	(range-bound-endpoint lower-bound)]	1✔
447	[else	1✔
448	(max 0 (sub1 (range-bound-endpoint lower-bound)))]))	×
449	(define upper-bound (range-upper-bound rng))	1✔
450	(define end	1✔
451	(cond	1✔
452	[(equal? upper-bound unbounded) (string-length str)]	×
453	[(equal? (range-bound-type upper-bound) inclusive)	1✔
454	(min (string-length str) (+ (range-bound-endpoint upper-bound) 1))]	×
455	[else (range-bound-endpoint upper-bound)]))	1✔
456	(substring str start end))	1✔
457
458
459	(module+ test
460	(test-case "resyntax-analyze"
461	(define results
462	(refactoring-result-set-results
463	(resyntax-analyze (string-source "#lang racket (or 1 (or 2 3))"))))
464	(check-equal? (length results) 1)
465	(check-equal? (refactoring-result-string-replacement (first results))
466	(string-replacement #:start 13
467	#:end 28
468	#:contents (list (inserted-string "(or 1 2 3)"))))))

jackfirth / resyntax / #78

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