diff --git a/cli.rkt b/cli.rkt index 6701102f..5d16738c 100644 --- a/cli.rkt +++ b/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)] diff --git a/main.rkt b/main.rkt index 6dd82fe2..dc7db22b 100644 --- a/main.rkt +++ b/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,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 @@ -47,6 +49,7 @@ 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)) diff --git a/private/commit.rkt b/private/commit.rkt new file mode 100644 index 00000000..6fcd8d07 --- /dev/null +++ b/private/commit.rkt @@ -0,0 +1,8 @@ +#lang racket/base + + +(provide (struct-out resyntax-commit)) + + + +(struct resyntax-commit (message changes) #:transparent) \ No newline at end of file diff --git a/private/git.rkt b/private/git.rkt index de3dcad6..a3baa3e3 100644 --- a/private/git.rkt +++ b/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"))) diff --git a/private/refactoring-result.rkt b/private/refactoring-result.rkt index f7016666..6e76e8c4 100644 --- a/private/refactoring-result.rkt +++ b/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