Split commits

cli.rkt

@@ -4,10 +4,7 @@
 (require fancy-app
          json
          racket/cmdline
-         racket/file
          racket/format
-         racket/hash
-         (except-in racket/list range)
          racket/logging
          racket/match
          racket/path
@@ -27,22 +24,29 @@
          resyntax/default-recommendations
          resyntax/private/file-group
          resyntax/private/github
-         resyntax/private/limiting
-         resyntax/private/line-replacement
          resyntax/private/refactoring-result
          resyntax/private/source
          resyntax/private/string-indent
-         resyntax/private/syntax-replacement
-         (only-in racket/list append-map empty? shuffle))
+         resyntax/private/syntax-replacement)
 
 
 ;@----------------------------------------------------------------------------------------------------
 
 
 (define-enum-type resyntax-output-format (plain-text github-pull-request-review git-commit-message))
+(define-enum-type resyntax-fix-method (modify-files create-multiple-git-commits))
 (define-record-type resyntax-analyze-options (targets suite output-format output-destination))
+
+
 (define-record-type resyntax-fix-options
-  (targets suite output-format max-fixes max-modified-files max-modified-lines max-pass-count))
+  (targets
+   suite
+   fix-method
+   output-format
+   max-fixes
+   max-modified-files
+   max-modified-lines
+   max-pass-count))
 
 
 (define all-lines (range-set (unbounded-range #:comparator natural<=>)))
@@ -114,6 +118,7 @@ determined by the GITHUB_REPOSITORY and GITHUB_REF environment variables."
   (define suite default-recommendations)
   (define (add-target! target)
     (vector-builder-add targets target))
+  (define fix-method modify-files)
   (define output-format plain-text)
   (define max-fixes +inf.0)
   (define max-pass-count 10)
@@ -137,10 +142,6 @@ determined by the GITHUB_REPOSITORY and GITHUB_REF environment variables."
     "An installed package to fix."
     (add-target! (package-file-group pkgname)))
 
-   ("--output-as-commit-message"
-    "Report results in the form of a Git commit message printed to stdout."
-    (set! output-format git-commit-message))
-
    ("--local-git-repository"
     repopath baseref
     "A Git repository to search for modified files to fix. The repopath argument is a directory
@@ -151,6 +152,14 @@ changed relative to baseref are analyzed and fixed."
 
    #:once-each
 
+   ("--create-multiple-commits"
+    "Modify files by creating a series of individual Git commits."
+    (set! fix-method create-multiple-git-commits))
+
+   ("--output-as-commit-message"
+    "Report results in the form of a Git commit message printed to stdout."
+    (set! output-format git-commit-message))
+
    ("--refactoring-suite"
     modpath
     suite-name
@@ -183,6 +192,7 @@ are needed when applying a fix unlocks further fixes."
 
   (resyntax-fix-options #:targets (build-vector targets)
                         #:suite suite
+                        #:fix-method fix-method
                         #:output-format output-format
                         #:max-fixes max-fixes
                         #:max-modified-files max-modified-files
@@ -261,6 +271,7 @@ For help on these, use 'analyze --help' or 'fix --help'."
 
 (define (resyntax-fix-run)
   (define options (resyntax-fix-parse-command-line))
+  (define fix-method (resyntax-fix-options-fix-method options))
   (define output-format (resyntax-fix-options-output-format options))
   (define sources (file-groups-resolve (resyntax-fix-options-targets options)))
   (define max-modified-files (resyntax-fix-options-max-modified-files options))
@@ -272,7 +283,11 @@ For help on these, use 'analyze --help' or 'fix --help'."
                           #:max-passes (resyntax-fix-options-max-pass-count options)
                           #:max-modified-sources max-modified-files
                           #:max-modified-lines max-modified-lines))
-  (resyntax-analysis-write-file-changes! analysis)
+  (match fix-method
+    [(== modify-files)
+     (resyntax-analysis-write-file-changes! analysis)]
+    [(== create-multiple-git-commits)
+     (resyntax-analysis-commit-fixes! analysis)])
   (match output-format
     [(== git-commit-message)
      (resyntax-fix-print-git-commit-message analysis)]

main.rkt

@@ -15,6 +15,7 @@
   [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
@@ -40,13 +41,15 @@
          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/comment-reader
+         resyntax/private/git
          resyntax/private/limiting
          resyntax/private/line-replacement
          resyntax/private/logger
@@ -105,15 +108,40 @@
     (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)
-  (log-resyntax-info "--- fixing code ---")
-  (for ([source (in-list (resyntax-analysis-final-sources 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)))
+
+
 (define (resyntax-analyze source
                           #:suite [suite default-recommendations]
                           #:lines [lines (range-set (unbounded-range #:comparator natural<=>))])
@@ -308,7 +336,7 @@
     (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\n")
+                    "  lines modified by result: ~a")
      (refactoring-result-rule-name result)
      lines
      modified-lines))

private/commit.rkt

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

private/git.rkt

@@ -6,7 +6,8 @@
 
 (provide
  (contract-out
-  [git-diff-modified-lines (-> string? (hash/c path? immutable-range-set?))]))
+  [git-diff-modified-lines (-> string? (hash/c path? immutable-range-set?))]
+  [git-commit! (-> string? void?)]))
 
 
 (require fancy-app
@@ -64,3 +65,8 @@
       'lex-line
       "a git file name line (starting with '+++ b/') or a hunk range line (starting with '@@')"
       line)]))
+
+
+(define (git-commit! message)
+  (unless (system (format "git commit --all --message='~a'" message))
+    (raise-arguments-error 'git-commit-modified-files "committing files to Git failed")))

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