diff options
| -rw-r--r-- | .dir-locals.el | 2 | ||||
| -rw-r--r-- | tests/git.scm | 60 | ||||
| -rw-r--r-- | tissue/git.scm | 51 |
3 files changed, 88 insertions, 25 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index d129e76..f6bf9b6 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -11,6 +11,8 @@ (eval . (put 'function-documentation 'scheme-indent-function 2)) (eval . (put 'docstring-function-documentation 'scheme-indent-function 2)) (eval . (put 'with-ellipsis 'scheme-indent-function 1)) + (eval . (put 'with-variable 'scheme-indent-function 2)) + (eval . (put 'with-variables 'scheme-indent-function 1)) (eval . (font-lock-add-keywords 'scheme-mode (list (cons (rx "(" (group "define-lazy")) (list 1 'font-lock-keyword-face)) diff --git a/tests/git.scm b/tests/git.scm new file mode 100644 index 0000000..bf2d9eb --- /dev/null +++ b/tests/git.scm @@ -0,0 +1,60 @@ +;;; tissue --- Text based issue tracker +;;; Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net> +;;; +;;; This file is part of tissue. +;;; +;;; tissue is free software: you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation, either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; tissue is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with tissue. If not, see <https://www.gnu.org/licenses/>. + +(import (srfi srfi-26) + (srfi srfi-64) + (ice-9 match)) + +(define (with-variable variable value thunk) + "Set VARIABLE to VALUE, run THUNK and restore the old value of +VARIABLE. Return the value returned by THUNK." + (let ((old-value (variable-ref variable))) + (dynamic-wind + (cut variable-set! variable value) + thunk + (cut variable-set! variable old-value)))) + +(define (with-variables variable-bindings thunk) + "Set VARIABLE-BINDINGS, run THUNK and restore the old values of the +variables. Return the value returned by THUNK. VARIABLE-BINDINGS is a +list of pairs mapping variables to their values." + (match variable-bindings + (((variable . value) tail ...) + (with-variable variable value + (cut with-variables tail thunk))) + (() (thunk)))) + +(define-syntax-rule (var@@ module-name variable-name) + (module-variable (resolve-module 'module-name) + 'variable-name)) + +(test-begin "git") + +(test-equal "Infer changes by root commit" + '(("foo" . "foo") + ("bar" . "bar")) + (with-variables (list (cons (var@@ (git) commit-parents) + (const (list))) + (cons (var@@ (git) commit-tree) + (const #t)) + (cons (var@@ (git) tree-list) + (const (list "foo" "bar")))) + (cut (@@ (tissue git) commit-file-changes) + #f #f))) + +(test-end "git") diff --git a/tissue/git.scm b/tissue/git.scm index c837da7..562e715 100644 --- a/tissue/git.scm +++ b/tissue/git.scm @@ -1,5 +1,5 @@ ;;; tissue --- Text based issue tracker -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of tissue. ;;; @@ -152,9 +152,10 @@ to a file on the filesystem or in REPOSITORY." (call-with-port (open-bytevector-input-port (blob-content blob)) proc))))) -(define (commit-deltas repository commit) - "Return the list of <diff-delta> objects created by COMMIT with -respect to its first parent in REPOSITORY." +(define (commit-file-changes repository commit) + "Return a list of pairs describing files modified by COMMIT with +respect to its first parent in REPOSITORY. Each pair maps the old +filename before COMMIT to the new filename after COMMIT." (match (commit-parents commit) ((parent _ ...) (let ((diff (diff-tree-to-tree repository @@ -162,7 +163,9 @@ respect to its first parent in REPOSITORY." (commit-tree commit)))) (diff-find-similar! diff) (diff-fold (lambda (delta progress result) - (cons delta result)) + (cons (cons (diff-file-path (diff-delta-old-file delta)) + (diff-file-path (diff-delta-new-file delta))) + result)) (lambda (delta binary result) result) (lambda (delta hunk result) @@ -171,7 +174,9 @@ respect to its first parent in REPOSITORY." result) (list) diff))) - (() (list)))) + (() (map (lambda (file) + (cons file file)) + (tree-list (commit-tree commit)))))) (define (file-modification-table repository) "Return a hashtable mapping files to the list of commits in REPOSITORY @@ -180,25 +185,21 @@ that modified them." (renames (make-hashtable string-hash string=?))) (fold-commits (lambda (commit _) - (map (lambda (delta) - ;; Map old filename to current filename if they are - ;; different. Note that this manner of following renames - ;; requires a linear git history and will not work with - ;; branch merges. - (unless (string=? (diff-file-path (diff-delta-old-file delta)) - (diff-file-path (diff-delta-new-file delta))) - (hashtable-set! renames - (diff-file-path (diff-delta-old-file delta)) - (diff-file-path (diff-delta-new-file delta)))) - (hashtable-update! result - ;; If necessary, translate old - ;; filename to current filename. - (hashtable-ref renames - (diff-file-path (diff-delta-old-file delta)) - (diff-file-path (diff-delta-old-file delta))) - (cut cons commit <>) - (list))) - (commit-deltas repository commit))) + (map (match-lambda + ((old-file . new-file) + ;; Map old filename to current filename if they are + ;; different. Note that this manner of following renames + ;; requires a linear git history and will not work with + ;; branch merges. + (unless (string=? old-file new-file) + (hashtable-set! renames old-file new-file)) + (hashtable-update! result + ;; If necessary, translate old + ;; filename to current filename. + (hashtable-ref renames old-file old-file) + (cut cons commit <>) + (list)))) + (commit-file-changes repository commit))) #f repository) result)) |