Add modified sources and use them for new analysis API (#381)

Part of #380. Now it's possible for Resyntax to analyze files after prior modifications without actually modifying the file.

cli.rkt

@@ -222,7 +222,11 @@ For help on these, use 'analyze --help' or 'fix --help'."
   (printf "resyntax: --- analyzing code ---\n")
   (define results
     (transduce files
-               (append-mapping (refactor-file _ #:suite (resyntax-analyze-options-suite options)))
+               (append-mapping
+                (λ (portion)
+                  (resyntax-analyze (file-source (file-portion-path portion))
+                                    #:suite (resyntax-analyze-options-suite options)
+                                    #:lines (file-portion-lines portion))))
                #:into into-list))
 
   (define (display-results)
@@ -373,9 +377,12 @@ For help on these, use 'analyze --help' or 'fix --help'."
                ;; a convenient manner.
 
                (append-mapping entry-value) ; throw away the file path, we don't need it anymore
-               (append-mapping (λ (p)
-                                 (refactor-file (filter-file-portion p lines-to-analyze-by-file)
-                                                #:suite (resyntax-fix-options-suite options))))
+               (mapping (filter-file-portion _ lines-to-analyze-by-file))
+               (append-mapping
+                (λ (portion)
+                  (resyntax-analyze (file-portion-path portion)
+                                    #:suite (resyntax-fix-options-suite options)
+                                    #:lines (file-portion-lines portion))))
                (limiting max-modified-lines
                          #:by (λ (result)
                                 (define replacement (refactoring-result-line-replacement result))

main.rkt

@@ -6,10 +6,9 @@
 
 (provide
  (contract-out
-  [refactor! (-> (sequence/c refactoring-result?) void?)]
-  [refactor
-   (->* (string?) (#:suite refactoring-suite? #:lines range-set?) (listof refactoring-result?))]
-  [refactor-file (->* (file-portion?) (#:suite refactoring-suite?) (listof refactoring-result?))]))
+  [resyntax-analyze
+   (->* (source?) (#:suite refactoring-suite? #:lines range-set?) (listof refactoring-result?))]
+  [refactor! (-> (sequence/c refactoring-result?) void?)]))
 
 
 (require fancy-app
@@ -49,6 +48,30 @@
 ;@----------------------------------------------------------------------------------------------------
 
 
+(define (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 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 macro expansion\n  error:\n~a"
+     (or (source-path source) "string source")
+     (string-indent (exn-message e) #:amount 3))
+    empty-list)
+
+  (with-handlers ([exn:fail:syntax? skip]
+                  [exn:fail:filesystem:missing-module? skip])
+    (define analysis
+      (parameterize ([current-namespace (make-base-namespace)])
+        (source-analyze source #:lines lines)))
+    (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments #:lines lines)))
+
+
 (define (refactoring-rules-refactor rules syntax #:comments comments #:analysis analysis)
 
   (define (refactor rule)
@@ -97,43 +120,6 @@
      result)))
 
 
-(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 #:lines lines))
-    (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments #:lines lines)))
-
-
-(define (refactor-file portion #:suite [suite default-recommendations])
-  (define path (file-portion-path portion))
-  (define lines (file-portion-lines portion))
-  (log-resyntax-info "analyzing ~a" path)
-  (define source (file-source path))
-
-  (define (skip e)
-    (log-resyntax-error
-     "skipping ~a\n encountered an error during macro expansion\n  error:\n~a"
-     path
-     (string-indent (exn-message e) #:amount 3))
-    empty-list)
-
-  (with-handlers ([exn:fail:syntax? skip]
-                  [exn:fail:filesystem:missing-module? skip])
-    (parameterize ([current-namespace (make-base-namespace)])
-      (define analysis (source-analyze source #:lines lines))
-      (define comments (with-input-from-source source read-comment-locations))
-      (define full-source (source->string source))
-      (for ([comment (in-range-set comments)])
-        (log-resyntax-debug "parsed comment: ~a: ~v"
-                            comment
-                            (substring-by-range full-source comment)))
-      (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments #:lines lines))))
-
-
 (define (refactor-visited-forms #:analysis analysis #:suite suite #:comments comments #:lines lines)
   (define rule-list (refactoring-suite-rules suite))
   (for*/fold ([results '()]
@@ -199,8 +185,8 @@
 
 
 (module+ test
-  (test-case "refactor"
-    (define results (refactor "#lang racket (or 1 (or 2 3))"))
+  (test-case "resyntax-analyze"
+    (define 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

private/source.rkt

@@ -7,17 +7,22 @@
 (provide
  (contract-out
   [source? (-> any/c boolean?)]
+  [unmodified-source? (-> any/c boolean?)]
   [source->string (-> source? immutable-string?)]
+  [source-path (-> source? (or/c path? #false))]
   [source-directory (-> source? (or/c path? #false))]
   [source-read-syntax (-> source? syntax?)]
-  [source-produced-syntax? (-> source? syntax? boolean?)]
   [source-analyze (->* (source?) (#:lines range-set?) source-code-analysis?)]
   [file-source? (-> any/c boolean?)]
   [file-source (-> path-string? file-source?)]
   [file-source-path (-> file-source? path?)]
   [string-source? (-> any/c boolean?)]
   [string-source (-> string? string-source?)]
   [string-source-contents (-> string-source? immutable-string?)]
+  [modified-source? (-> any/c boolean?)]
+  [modified-source (-> unmodified-source? string? modified-source?)]
+  [modified-source-contents (-> modified-source? immutable-string?)]
+  [modified-source-original (-> modified-source? unmodified-source?)]
   [source-code-analysis? (-> any/c boolean?)]
   [source-code-analysis-code (-> source-code-analysis? source?)]
   [source-code-analysis-visited-forms (-> source-code-analysis? (listof syntax?))]
@@ -54,14 +59,24 @@
 (struct source () #:transparent)
 
 
-(struct file-source source (path) #:transparent
+(struct unmodified-source source () #:transparent)
+
+
+(struct file-source unmodified-source (path)
+  #:transparent
   #:guard (λ (path _) (simple-form-path path)))
 
 
-(struct string-source source (contents) #:transparent
+(struct string-source unmodified-source (contents)
+  #:transparent
   #:guard (λ (contents _) (string->immutable-string contents)))
 
 
+(struct modified-source source (original contents)
+  #:transparent
+  #:guard (λ (original contents _) (values original (string->immutable-string contents))))
+
+
 (define-record-type source-code-analysis (code visited-forms))
 (define-record-type source-location (source line column position span))
 
@@ -75,7 +90,11 @@
 
   (match code
     [(file-source path) (call-with-input-file path call-proc-with-reencoded-input)]
-    [(string-source contents) (call-proc-with-reencoded-input (open-input-string contents))]))
+    [(string-source contents) (call-proc-with-reencoded-input (open-input-string contents))]
+    [(modified-source (file-source path) contents)
+     (call-proc-with-reencoded-input (open-input-string contents path))]
+    [(modified-source (? string-source?) contents)
+     (call-proc-with-reencoded-input (open-input-string contents))]))
 
 
 (define (source->string code)
@@ -89,9 +108,14 @@
   (with-input-from-source code read-from-input))
 
 
+(define/guard (source-path code)
+  (guard-match (or (file-source path) (modified-source (file-source path) _)) code #:else #false)
+  path)
+
+
 (define/guard (source-directory code)
-  (guard-match (file-source path) code #:else #false)
-  (path-only path))
+  (define path (source-path code))
+  (and path (path-only path)))
 
 
 (define (source-analyze code #:lines [lines (range-set (unbounded-range #:comparator natural<=>))])
@@ -115,13 +139,13 @@
 
     (define (syntax-original-and-from-source? stx)
       (and (syntax-original? stx)
-               ;; Some macros are able to bend hygiene and syntax properties in such a way that they
-               ;; introduce syntax objects into the program that are syntax-original?, but from a
-               ;; different file than the one being expanded. So in addition to checking for
-               ;; originality, we also check that they come from the same source as the main program
-               ;; 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)))
+           ;; Some macros are able to bend hygiene and syntax properties in such a way that they
+           ;; introduce syntax objects into the program that are syntax-original?, but from a
+           ;; different file than the one being expanded. So in addition to checking for
+           ;; originality, we also check that they come from the same source as the main program
+           ;; 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)))
 
     (define/guard (resyntax-should-analyze-syntax? stx #:as-visit? [as-visit? #true])
       (guard (syntax-original-and-from-source? stx) #:else #false)
@@ -205,9 +229,3 @@
 (define syntax-source-location<=>
   (comparator-chain (comparator-map real<=> source-location-position)
                     (comparator-map (comparator-reverse real<=>) source-location-span)))
-
-
-(define/guard (source-produced-syntax? code stx)
-  (guard (syntax-original? stx) #:else #false)
-  (guard-match (file-source path) code #:else #false)
-  (equal? path (syntax-source stx)))

test/private/rackunit.rkt

@@ -123,8 +123,9 @@
   (define results
     (call-with-logs-captured
      (λ ()
-       (refactor (code-block-raw-string original-program)
-                 #:suite suite #:lines modified-line-mask))))
+       (resyntax-analyze (string-source (code-block-raw-string original-program))
+                         #:suite suite
+                         #:lines modified-line-mask))))
 
   (with-check-info*
       (if (empty? results)
@@ -189,7 +190,8 @@
 
   (define results
     (call-with-logs-captured
-     (λ () (refactor (code-block-raw-string original-program) #:suite suite))))
+     (λ ()
+       (resyntax-analyze (string-source (code-block-raw-string original-program)) #:suite suite))))
   (define replacement
     (transduce results
                (mapping refactoring-result-string-replacement)