From 22d71881e5fae4a530249fb4f0d63203b3f3a462 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Thu, 26 Jan 2023 21:32:50 +0000 Subject: git: Infer changes by root commit correctly. * tissue/git.scm (commit-deltas): Rename to ... (commit-file-changes): ... this. Return list of pairs mapping old files to new files. (file-modification-table): Use commit-file-changes instead of commit-deltas. Adapt to new return value. * tests/git.scm: New file. * .dir-locals.el (scheme-mode): Set scheme-indent-function for with-variable and with-variables. --- .dir-locals.el | 2 ++ tests/git.scm | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ tissue/git.scm | 51 +++++++++++++++++++++++++------------------------ 3 files changed, 88 insertions(+), 25 deletions(-) create mode 100644 tests/git.scm 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 +;;; +;;; 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 . + +(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 +;;; Copyright © 2022, 2023 Arun Isaac ;;; ;;; 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 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)) -- cgit v1.2.3