Hello, Pluto

Provide support for creating/modifying views and setting metadata.
All of git-annex's view commands are exposed, and most of the
"setting" features of the 'git annex metadata' command are supported.
Of the remaining bits, I intend to support only the --force
flag (needed for setting metadata a directory's files).

The user interface may still require a good amount of tweaking, but
things seem to be in a working state.

1 files changed, 197 insertions, 0 deletions

diff --git a/annexview-tests.el b/annexview-tests.el
new file mode 100644
index 0000000..62d1d7a
--- /dev/null
+++ b/annexview-tests.el
@@ -0,0 +1,197 @@
+;;; annexview-tests.el --- Tests for Annexview
+
+;; Copyright (C) 2018 Kyle Meyer <kyle@kyleam.com>
+;;
+;; License: GPLv3
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'ert)
+(require 'subr-x)
+
+(require 'annexview)
+
+;;; Utilities
+
+;; Originally modified from Magit's magit-with-test-directory.
+(defmacro annexview-with-test-directory (&rest body)
+  (declare (indent 0) (debug t))
+  (let ((dir (make-symbol "dir")))
+    `(let ((,dir (file-name-as-directory (make-temp-file "annexview-" t)))
+           (process-environment process-environment))
+       (push "GIT_AUTHOR_NAME=A U Thor" process-environment)
+       (push "GIT_AUTHOR_EMAIL=a.u.thor@example.com" process-environment)
+       (condition-case err
+           (cl-letf (((symbol-function #'message) #'format))
+             (let ((default-directory ,dir))
+               ,@body))
+         (error (message "Keeping test directory: %s" ,dir)
+                (signal (car err) (cdr err))))
+       (delete-directory ,dir t))))
+
+(defun annexview-tests-commit-annex-file (filename)
+  (with-temp-file (expand-file-name filename)
+    (insert (symbol-name (gensym "content"))))
+  (annexview-call-git-annex "add" filename)
+  (annexview-call-git "commit" (concat "-mAdd " filename)))
+
+(defmacro annexview-with-test-repo (&rest body)
+  (declare (indent 0) (debug t))
+  `(annexview-with-test-directory
+     (annexview-call-git "init" ".")
+     (annexview-call-git "annex" "init" "test-repo")
+     (annexview-tests-commit-annex-file "foo")
+     (annexview-tests-commit-annex-file "bar")
+     (annexview-call-git-annex
+      "metadata" "--tag" "foo-tag0" "--tag" "foo-tag1" "--" "foo")
+     (annexview-call-git-annex "metadata" "--set" "f=bar-field" "--" "bar")
+     (annexview-call-git-annex "metadata" "--set" "year=2017" "--" "foo")
+     (annexview-call-git-annex "metadata" "--set" "year=2018" "--" "bar")
+     (unwind-protect
+         (progn ,@body)
+       (call-process "chmod" nil nil nil "-R" "777" "."))))
+
+(defun annexview-string-sort (seq)
+  (sort seq #'string-lessp))
+
+
+;;; Inspection
+
+(ert-deftest annexview-metadata-key-fields ()
+  (annexview-with-test-repo
+    (let ((assert-things
+           (lambda ()
+             (let ((values (apply #'append (hash-table-values
+                                            (annexview-metadata-key-fields)))))
+               (should (member (list "tag" "foo-tag0" "foo-tag1") values))
+               (should (member (list "f" "bar-field") values))
+               (should (member (list "year" "2017") values))
+               (should (member (list "year" "2018") values))))))
+      (funcall assert-things)
+      ;; Dumb test of cache
+      (cl-letf (((symbol-function #'annexview--read-json-item)
+                 (lambda () (error "Shouldn't be called"))))
+        (funcall assert-things)))))
+
+(ert-deftest annexview-fields ()
+  (annexview-with-test-repo
+    (let ((values (annexview-fields)))
+      (should (= (length values) 3))
+      (should (member (list "tag" "foo-tag0" "foo-tag1") values))
+      (should (member (list "f" "bar-field") values))
+      (should (member (list "year" "2017" "2018") values)))
+    (let ((foo-values (annexview-fields (list "foo"))))
+      (should (member (list "tag" "foo-tag0" "foo-tag1")
+                      foo-values))
+      (should (member (list "year" "2017")
+                      foo-values)))))
+
+(ert-deftest annexview-field-names ()
+  (annexview-with-test-repo
+    (should (equal (annexview-string-sort (annexview-field-names))
+                   (list "f" "tag" "year")))
+    (should (equal (annexview-field-names (list "bar"))
+                   (list "f" "year")))))
+
+(ert-deftest annexview-field-values ()
+  (annexview-with-test-repo
+    (should (equal (annexview-string-sort (annexview-field-values "year"))
+                   (list "2017" "2018")))
+    (should (equal (annexview-string-sort
+                    (annexview-field-values "year" (list "foo")))
+                   (list "2017")))))
+
+(ert-deftest annexview-field-values ()
+  (annexview-with-test-repo
+    (should (equal (annexview-string-sort (annexview-tags))
+                   (list "foo-tag0" "foo-tag1")))
+    (should (equal (annexview-string-sort (annexview-tags (list "foo")))
+                   (list "foo-tag0" "foo-tag1")))
+    (should-not (annexview-tags (list "bar")))))
+
+
+;;; Modification
+
+(ert-deftest annexview-set ()
+  (let ((assert-things
+         (lambda ()
+           (should (equal (annexview-string-sort
+                           (annexview-field-names (list "bar")))
+                          (list "f" "year")))
+           (should (equal (annexview-field-values "f" (list "bar"))
+                          (list "bar-field")))
+           (should (equal (annexview-field-values "year" (list "bar"))
+                          (list "2000")))
+           (should (equal (annexview-field-values "tag" (list "foo"))
+                          (list "foo-tag0" "tag-new"))))))
+    (annexview-with-test-repo
+      (annexview-set (list "foo") '((+= "tag" "tag-new")
+                                    (-= "tag" "foo-tag1")))
+      (annexview-set (list "bar") '((\?= "f" "ignored")
+                                    (= "year" "2000")))
+      (funcall assert-things))
+    ;; Single item commands
+    (annexview-with-test-repo
+      (annexview-field-add-value "tag" "tag-new" (list "foo"))
+      (annexview-field-remove-value "tag" "foo-tag1" (list "foo"))
+      (annexview-field-init-value "f" "ignored" (list "bar"))
+      (annexview-field-set-value "year" "2000" (list "bar"))
+      (funcall assert-things))
+    ;; Single item commands, with tag variants
+    (annexview-with-test-repo
+      (annexview-add-tag "tag-new" (list "foo"))
+      (annexview-remove-tag "foo-tag1" (list "foo"))
+      (annexview-field-init-value "f" "ignored" (list "bar"))
+      (annexview-field-set-value "year" "2000" (list "bar"))
+      (funcall assert-things))))
+
+(ert-deftest annexview-remove-field ()
+  (annexview-with-test-repo
+    (should (annexview-field-values "year" (list "foo" "bar")))
+    (annexview-remove-field "year" (list "foo" "bar"))
+    (should-not (annexview-field-values "year" (list "foo" "bar")))))
+
+
+;;; Completion
+
+(ert-deftest annexview--completion-info ()
+  (pcase-dolist (`(,string . ,expected)
+                 '(("blah" . (:plain "" "blah"))
+                   ("!neg" . (:negated "!" "neg"))
+                   ("prev=v:curr" . (:previous-input "prev=v:" "curr"))
+                   ("prev!=v:" . (:previous-input "prev!=v:" ""))))
+    (should (equal (annexview--completion-info string)
+                   expected))))
+
+
+;;; Views
+
+(ert-deftest annexview-views ()
+  (annexview-with-test-repo
+    (annexview-create-view (list "year=*"))
+    (should (file-exists-p "2017"))
+    (should (file-exists-p "2018"))
+    ;; vpop
+    (annexview-vpop)
+    (should-not (file-exists-p "2017"))
+    (should-not (file-exists-p "2018"))
+    ;; vcycle
+    (annexview-create-view (list "tag=*" "year=*"))
+    (should (equal (annexview-string-sort (annexview-views))
+                   (list "tag=_;year=_" "year=_")))
+    (should (file-exists-p "foo-tag0"))
+    (should (file-exists-p "foo-tag1"))
+    (annexview-vcycle)
+    (should (file-exists-p "2017"))
+    (should (file-exists-p "2017/foo-tag0"))
+    ;; vfilter
+    (annexview-create-view (list "year=*"))
+    (annexview-vfilter (list "tag=foo-tag0"))
+    (should (file-exists-p "2017"))
+    (should-not (file-exists-p "2018"))
+    ;; vadd
+    (annexview-create-view (list "tag=*"))
+    (annexview-vadd (list "year=*"))
+    (should (file-exists-p "2017"))
+    (should (file-exists-p "2017/foo-tag0"))))