Split commits by rule

main.rkt

@@ -41,6 +41,7 @@
          rebellion/collection/hash
          rebellion/collection/list
          rebellion/collection/multiset
+         resyntax/private/commit
          rebellion/collection/range-set
          rebellion/streaming/reducer
          rebellion/streaming/transducer
@@ -107,6 +108,14 @@
     (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)
@@ -118,32 +127,15 @@
                      #:mode 'text #:exists 'replace)))
 
 
-(struct resyntax-fix-commit (message file-changes) #:transparent)
-
-
-(define (resyntax-analysis-fix-commits analysis)
-  (for/list ([pass (resyntax-analysis-all-results analysis)]
-             [pass-number (in-naturals 1)])
-    (define message (format "Resyntax pass ~a" pass-number))
-    (define changes
-      (for/hash ([(source results) (in-hash pass)])
-        (define new-contents
-          (modified-source-contents (refactoring-result-set-updated-source results)))
-        (values source new-contents)))
-    (resyntax-fix-commit message changes)))
-
-
 (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-fix-commit message changes) commit)
-    (for ([(source new-contents) (in-hash changes)]
-          #:do [(define path (source-path source))]
-          #:when path)
+    (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")

private/commit.rkt

@@ -0,0 +1,8 @@
+#lang racket/base
+
+
+(provide (struct-out resyntax-commit))
+
+
+
+(struct resyntax-commit (message changes) #:transparent)

private/refactoring-result.rkt

@@ -29,22 +29,29 @@
   [refactoring-result-set-base-source (-> refactoring-result-set? source?)]
   [refactoring-result-set-updated-source (-> refactoring-result-set? modified-source?)]
   [refactoring-result-set-results (-> refactoring-result-set? (listof refactoring-result?))]
-  [refactoring-result-set-modified-lines (-> refactoring-result-set? immutable-range-set?)]))
+  [refactoring-result-set-modified-lines (-> refactoring-result-set? immutable-range-set?)]
+  [refactoring-result-map-commits
+   (-> (hash/c source? refactoring-result-set?) (listof resyntax-commit?))]))
 
 
 (require racket/sequence
+         racket/hash
+         resyntax/private/logger
          rebellion/base/comparator
          rebellion/base/immutable-string
          rebellion/base/range
+         (only-in racket/list first)
          rebellion/base/symbol
          rebellion/collection/list
          rebellion/collection/range-set
+         resyntax/private/commit
          rebellion/streaming/transducer
          rebellion/type/record
          resyntax/private/code-snippet
          resyntax/private/line-replacement
          resyntax/private/linemap
          resyntax/private/source
+         rebellion/collection/sorted-set
          resyntax/private/string-replacement
          resyntax/private/syntax-replacement)
 
@@ -117,6 +124,57 @@
              #:into (into-range-set natural<=>)))
 
 
+(define string-replacement<=> (comparator-map natural<=> string-replacement-start))
+
+
+(define (refactoring-result-map-commits result-map)
+  (define rule-names
+    (transduce (in-hash-values result-map)
+               (append-mapping refactoring-result-set-results)
+               (mapping refactoring-result-rule-name)
+               (deduplicating)
+               #:into into-list))
+  (define source-contents
+    (for/hash ([source (in-hash-keys result-map)])
+      (values source (source->string source))))
+  (for/fold ([committed-replacements (hash)]
+             [commits '()]
+             #:result (reverse commits))
+            ([rule (in-list rule-names)])
+    (define rule-results
+      (for*/list ([results (in-hash-values result-map)]
+                  [result (in-list (refactoring-result-set-results results))]
+                  #:when (equal? (refactoring-result-rule-name result) rule))
+        result))
+    (define replacements
+      (for/hash ([(source results) (in-hash result-map)])
+        (define source-replacements
+          (transduce (refactoring-result-set-results results)
+                     (filtering (λ (r) (equal? (refactoring-result-rule-name r) rule)))
+                     (mapping refactoring-result-string-replacement)
+                     #:into (into-sorted-set string-replacement<=>)))
+        (values source source-replacements)))
+    (define new-committed-replacements
+      (hash-union committed-replacements replacements #:combine sorted-set-add-all))
+    (define new-contents
+      (for/hash ([(source old-contents) (in-hash source-contents)])
+        (define replacement
+          (transduce (hash-ref new-committed-replacements source '())
+                     #:into union-into-string-replacement))
+        (values (source-path source) (string-apply-replacement old-contents replacement))))
+    (define description
+      (refactoring-result-message (first rule-results)))
+    (define num-fixes (length rule-results))
+    (define message
+      (format "Fix ~a occurrence~a of `~a`\n\n~a"
+              num-fixes
+              (if (equal? num-fixes 1) "" "s")
+              rule
+              description))
+    (define commit (resyntax-commit message new-contents))
+    (values new-committed-replacements (cons commit commits))))
+
+
 (define (refactoring-result-original-code result)
   (define replacement (refactoring-result-string-replacement result))
   (define full-orig-code