Post-filter results to changed lines only (#301)

main.rkt

@@ -40,6 +40,12 @@
          resyntax/refactoring-suite)
 
 
+(module+ test
+  (require (submod "..")
+           racket/list
+           rackunit))
+
+
 ;@----------------------------------------------------------------------------------------------------
 
 
@@ -91,13 +97,15 @@
      result)))
 
 
-(define (refactor code-string #:suite [suite default-recommendations])
+(define (refactor code-string
+                  #:suite [suite default-recommendations]
+                  #:lines [lines (range-set (unbounded-range #:comparator natural<=>))])
   (define rule-list (refactoring-suite-rules suite))
   (define source (string-source code-string))
   (define comments (with-input-from-source source read-comment-locations))
   (parameterize ([current-namespace (make-base-namespace)])
-    (define analysis (source-analyze source))
-    (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments)))
+    (define analysis (source-analyze source #:lines lines))
+    (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments #:lines lines)))
 
 
 (define (refactor-file portion #:suite [suite default-recommendations])
@@ -123,10 +131,10 @@
         (log-resyntax-debug "parsed comment: ~a: ~v"
                             comment
                             (substring-by-range full-source comment)))
-      (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments))))
+      (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments #:lines lines))))
 
 
-(define (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments)
+(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<=>)]
@@ -135,7 +143,8 @@
               #:unless (range-set-intersects? modified-positions (syntax-source-range stx))
               [result
                (in-option
-                (refactoring-rules-refactor rule-list stx #:comments comments #:analysis analysis))])
+                (refactoring-rules-refactor rule-list stx #:comments comments #:analysis analysis))]
+              #:when (range-set-encloses? lines (refactoring-result-modified-line-range result)))
     (values (cons result results)
             (range-set-add modified-positions (refactoring-result-modified-range result)))))
 
@@ -171,3 +180,13 @@
        (min (string-length str) (+ (range-bound-endpoint upper-bound) 1))]
       [else (range-bound-endpoint upper-bound)]))
   (substring str start end))
+
+
+(module+ test
+  (test-case "refactor"
+    (define results (refactor "#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)"))))))

private/line-replacement.rkt

@@ -72,34 +72,53 @@
 
 
 (define (string-replacement->line-replacement replacement original-string)
-  (define lmap (string-linemap original-string))
+  (define new-string (string-apply-replacement original-string replacement))
+  (define orig-lmap (string-linemap original-string))
+  (define new-lmap (string-linemap new-string))
+
+  (define start-line
+    (linemap-position-to-line orig-lmap (add1 (string-replacement-start replacement))))
   (define start-pos
-    (sub1 (linemap-position-to-start-of-line lmap (add1 (string-replacement-start replacement)))))
+    (sub1
+     (linemap-position-to-start-of-line orig-lmap (add1 (string-replacement-start replacement)))))
   (define original-end-pos
     (sub1
-     (linemap-position-to-end-of-line lmap (add1 (string-replacement-original-end replacement)))))
+     (linemap-position-to-end-of-line orig-lmap
+                                      (add1 (string-replacement-original-end replacement)))))
   (define new-end-pos
-    (sub1 (linemap-position-to-end-of-line lmap (add1 (string-replacement-new-end replacement)))))
-  (define original-code (substring original-string start-pos original-end-pos))
-  (define new-code
-    (substring (string-apply-replacement original-string replacement) start-pos new-end-pos))
-  (define start-line (linemap-position-to-line lmap (add1 (string-replacement-start replacement))))
+    (sub1 (linemap-position-to-end-of-line new-lmap (add1 (string-replacement-new-end replacement)))))
+
+  (define original-substr (substring original-string start-pos original-end-pos))
+  (define new-substr (substring new-string start-pos new-end-pos))
   (line-replacement #:start-line start-line
-                    #:original-lines (in-lines (open-input-string original-code))
-                    #:new-lines (in-lines (open-input-string new-code))))
+                    #:original-lines (in-lines (open-input-string original-substr))
+                    #:new-lines (in-lines (open-input-string new-substr))))
 
 
 (module+ test
   (test-case "string-replacement->line-replacement"
-    (define s "hello\nworld\nhow are you\ntoday?")
-    (define middle-of-world-index 8)
-    (define start-of-are-you-index 16)
-    (check-equal? (substring s middle-of-world-index start-of-are-you-index) "rld\nhow ")
-    (define str-replacement
-      (string-replacement #:start middle-of-world-index
-                          #:end start-of-are-you-index
-                          #:contents (list (inserted-string "RLD HOW "))))
-    (check-equal? (string-replacement->line-replacement str-replacement s)
-                  (line-replacement #:start-line 2
-                                    #:original-lines (list "world" "how are you")
-                                    #:new-lines (list "woRLD HOW are you")))))
+
+    (test-case "multiple middle lines"
+      (define s "hello\nworld\nhow are you\ntoday?")
+      (define middle-of-world-index 8)
+      (define start-of-are-you-index 16)
+      (check-equal? (substring s middle-of-world-index start-of-are-you-index) "rld\nhow ")
+      (define str-replacement
+        (string-replacement #:start middle-of-world-index
+                            #:end start-of-are-you-index
+                            #:contents (list (inserted-string "RLD HOW "))))
+      (check-equal? (string-replacement->line-replacement str-replacement s)
+                    (line-replacement #:start-line 2
+                                      #:original-lines (list "world" "how are you")
+                                      #:new-lines (list "woRLD HOW are you"))))
+
+    (test-case "entire string replacement"
+      (define s "hello\nworld\nhow are you\ntoday?")
+      (define str-replacement
+        (string-replacement #:start 0
+                            #:end (string-length s)
+                            #:contents (list (inserted-string "hello world"))))
+      (check-equal? (string-replacement->line-replacement str-replacement s)
+                    (line-replacement #:start-line 1
+                                      #:original-lines (list "hello" "world" "how are you" "today?")
+                                      #:new-lines (list "hello world"))))))

private/refactoring-result.rkt

@@ -15,6 +15,7 @@
   [refactoring-result-rule-name (-> refactoring-result? interned-symbol?)]
   [refactoring-result-message (-> refactoring-result? immutable-string?)]
   [refactoring-result-modified-range (-> refactoring-result? range?)]
+  [refactoring-result-modified-line-range (-> refactoring-result? range?)]
   [refactoring-result-syntax-replacement (-> refactoring-result? syntax-replacement?)]
   [refactoring-result-string-replacement (-> refactoring-result? string-replacement?)]
   [refactoring-result-line-replacement (-> refactoring-result? line-replacement?)]
@@ -58,6 +59,13 @@
                      #:comparator natural<=>))
 
 
+(define (refactoring-result-modified-line-range result)
+  (define replacement (refactoring-result-line-replacement result))
+  (closed-open-range (line-replacement-start-line replacement)
+                     (line-replacement-original-end-line replacement)
+                     #:comparator natural<=>))
+
+
 (define (refactoring-result-original-line result)
   (line-replacement-start-line (refactoring-result-line-replacement result)))
 

private/source.rkt

@@ -119,7 +119,7 @@
            ;; syntax object. The (open ...) clause of the define-signature macro bends hygiene
            ;; in this way, and is what originally motivated the addition of this check.
            (equal? (syntax-source stx) program-source-name)
-           (range-set-encloses? lines (syntax-line-range stx #:linemap code-linemap))))
+           (range-set-overlaps? lines (syntax-line-range stx #:linemap code-linemap))))
 
     (define/match (observe-event! sig val)
       [('visit (? syntax? visited))

private/string-replacement.rkt

@@ -106,7 +106,7 @@
    #:original-span (- end start)
    #:new-end (+ start new-span)
    #:new-span new-span
-   #:required-length (add1 (option-get max-end end))
+   #:required-length (option-get max-end end)
    #:contents content-list))
 
 
@@ -213,23 +213,33 @@
 
 (module+ test
   (test-case (name-string string-apply-replacement)
-    (define s "good morning and hello world")
-    (define replacement-pieces
-      (list
-       (inserted-string "evening")
-       (copied-string 12 17)
-       (inserted-string "goodbye")))
-    (define replacement
-      (string-replacement
-       #:start 5
-       #:end 22
-       #:contents replacement-pieces))
-    (check-equal? (string-replacement-original-span replacement) 17)
-    (check-equal? (string-replacement-new-span replacement) 19)
-    (check-equal? (string-replacement-length-change replacement) 2)
-    (check-equal? (string-replacement-new-end replacement) 24)
-    (check-equal? (string-replacement-render replacement s) "evening and goodbye")
-    (check-equal? (string-apply-replacement s replacement) "good evening and goodbye world")))
+
+    (test-case "replace middle part"
+      (define s "good morning and hello world")
+      (define replacement-pieces
+        (list
+         (inserted-string "evening")
+         (copied-string 12 17)
+         (inserted-string "goodbye")))
+      (define replacement
+        (string-replacement
+         #:start 5
+         #:end 22
+         #:contents replacement-pieces))
+      (check-equal? (string-replacement-original-span replacement) 17)
+      (check-equal? (string-replacement-new-span replacement) 19)
+      (check-equal? (string-replacement-length-change replacement) 2)
+      (check-equal? (string-replacement-new-end replacement) 24)
+      (check-equal? (string-replacement-render replacement s) "evening and goodbye")
+      (check-equal? (string-apply-replacement s replacement) "good evening and goodbye world"))
+
+    (test-case "replace entire string"
+      (define s "good morning and hello world")
+      (define replacement
+        (string-replacement #:start 0
+                            #:end (string-length s)
+                            #:contents (list (inserted-string "hi there"))))
+      (check-equal? (string-apply-replacement s replacement) "hi there"))))
 
 
 (define (file-apply-string-replacement! path replacement)