diff options
| author | Craig Jennings <c@cjennings.net> | 2026-06-05 00:56:19 -0500 |
|---|---|---|
| committer | Craig Jennings <c@cjennings.net> | 2026-06-05 00:56:19 -0500 |
| commit | 951abea0b2ed07d71676cd4d10ff7c6ca50d1390 (patch) | |
| tree | 6fbe516d9b757e38a5e6e6950f6fe8e4767bf40b /tests | |
| parent | 387c8a9ff9828d1b024987d136d216ef12c5103f (diff) | |
| download | pearl-951abea0b2ed07d71676cd4d10ff7c6ca50d1390.tar.gz pearl-951abea0b2ed07d71676cd4d10ff7c6ca50d1390.zip | |
feat(views): sort the active view interactively
pearl-set-sort reorders the current view by updated, created, priority, or title without hand-editing a source. pearl-toggle-sort-order flips asc/desc on the current sort, defaulting to updated descending. Both are M-x for now. The spec deferred a key binding until the menu layout settles.
Priority and title sort client-side: pearl--reorder-issue-subtrees moves whole issue subtrees by LINEAR-ID, byte-for-byte, so unsaved description and comment edits survive and a non-issue heading is kept rather than dropped. Updated and created refetch with the new server orderBy. The #+LINEAR-SOURCE header is rewritten only after the reorder or refetch succeeds, so a failed sort never advertises an order the buffer doesn't show.
Two things the 2026-05-24 spec predates and I had to settle. A view's :sort now holds Linear's IssueSortInput, so the interactive sort on a view persists under separate :client-sort/:client-order keys and pearl--effective-sort-order re-applies it on refresh. That keeps a view sort surviving a refresh the same way a filter sort does, rather than behaving differently on a distinction the user can't see. Grouped views aren't reorderable in place yet. They refuse with a message. A created/updated sort on a Custom View is refused too, since Linear gives views no server-side order.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/test-pearl-sort.el | 294 |
1 files changed, 294 insertions, 0 deletions
diff --git a/tests/test-pearl-sort.el b/tests/test-pearl-sort.el new file mode 100644 index 0000000..6527989 --- /dev/null +++ b/tests/test-pearl-sort.el @@ -0,0 +1,294 @@ +;;; test-pearl-sort.el --- Tests for interactive sort/order -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program 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. + +;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for changing the order of the active view interactively: +;; the source-plist helpers (symbol :sort/:order for filters, +;; :client-sort/:client-order for views), the #+LINEAR-SOURCE header +;; rewrite, the byte-for-byte client-side subtree reorder (preserving +;; local edits), and the pearl--apply-sort routing (client vs server vs +;; refuse) plus the toggle target. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +(defmacro test-pearl-sort--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT." + (declare (indent 1)) + `(let ((org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +(defconst test-pearl-sort--flat + (concat + "#+title: Linear — My open issues\n" + "#+STARTUP: show2levels\n" + "#+TODO: TODO | DONE\n" + "#+LINEAR-SOURCE: (:type filter :name \"My open issues\" :filter (:open t))\n" + "#+LINEAR-COUNT: 2\n\n" + "* My open issues\n" + "** TODO [#C] SE-2: Beta\n:PROPERTIES:\n:LINEAR-ID: i2\n:LINEAR-IDENTIFIER: SE-2\n:END:\n" + "Body beta.\n" + "** TODO [#A] SE-1: Alpha\n:PROPERTIES:\n:LINEAR-ID: i1\n:LINEAR-IDENTIFIER: SE-1\n:END:\n" + "Body alpha.\n") + "A flat two-issue buffer: SE-2 [#C] Beta first, SE-1 [#A] Alpha second.") + +(defun test-pearl-sort--issue-ids () + "Return the LINEAR-IDs of the level-2 issue headings in document order." + (let (ids) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^\\*\\* " nil t) + (let ((id (org-entry-get nil "LINEAR-ID"))) + (when id (push id ids))))) + (nreverse ids))) + +;;; source-plist helpers + +(ert-deftest test-pearl-source-with-sort-filter-uses-sort-keys () + "A filter source records the interactive sort under :sort/:order (symbols)." + (let ((out (pearl--source-with-sort '(:type filter :name "x") 'priority 'asc))) + (should (eq (plist-get out :sort) 'priority)) + (should (eq (plist-get out :order) 'asc)))) + +(ert-deftest test-pearl-source-with-sort-view-uses-client-keys () + "A view source records the interactive sort under :client-sort/:client-order, +leaving its server :sort (an IssueSortInput) untouched." + (let ((out (pearl--source-with-sort + '(:type view :name "v" :id "vid" :sort ((:priority "Ascending"))) + 'title 'desc))) + (should (eq (plist-get out :client-sort) 'title)) + (should (eq (plist-get out :client-order) 'desc)) + (should (equal (plist-get out :sort) '((:priority "Ascending")))))) + +(ert-deftest test-pearl-effective-sort-order-filter () + "Effective client sort for a filter is its :sort/:order." + (should (equal (pearl--effective-sort-order '(:type filter :sort priority :order asc)) + '(priority . asc)))) + +(ert-deftest test-pearl-effective-sort-order-view-with-client () + "Effective client sort for a view is its :client-sort/:client-order." + (should (equal (pearl--effective-sort-order + '(:type view :sort ((:x "y")) :client-sort title :client-order desc)) + '(title . desc)))) + +(ert-deftest test-pearl-effective-sort-order-view-without-client () + "A view with no client sort has no effective client sort (server order honored)." + (should (equal (pearl--effective-sort-order '(:type view :sort ((:x "y")))) + '(nil . nil)))) + +;;; symbol contract + +(ert-deftest test-pearl-check-sort-order-valid () + "Valid sort/order symbols pass." + (should (pearl--check-sort-order 'priority 'asc)) + (should (pearl--check-sort-order 'updated 'desc)) + (should (pearl--check-sort-order nil nil))) + +(ert-deftest test-pearl-check-sort-order-unknown-sort-errors () + "An unknown sort symbol signals a user-error." + (should-error (pearl--check-sort-order 'sideways 'asc) :type 'user-error)) + +(ert-deftest test-pearl-check-sort-order-unknown-order-errors () + "An unknown order symbol signals a user-error." + (should-error (pearl--check-sort-order 'priority 'upward) :type 'user-error)) + +;;; header rewrite + +(ert-deftest test-pearl-write-linear-source-header-roundtrips () + "Writing a new source header is read back by `pearl--read-active-source'." + (test-pearl-sort--in-org test-pearl-sort--flat + (pearl--write-linear-source-header + '(:type filter :name "My open issues" :filter (:open t) + :sort priority :order asc)) + (let ((src (pearl--read-active-source))) + (should (eq (plist-get src :sort) 'priority)) + (should (eq (plist-get src :order) 'asc))))) + +;;; client-side reorder + +(ert-deftest test-pearl-reorder-priority-ascending () + "Priority-ascending reorder puts the [#A] issue before the [#C] issue." + (test-pearl-sort--in-org test-pearl-sort--flat + (should (eq (pearl--reorder-issue-subtrees 'priority 'asc) t)) + (should (equal (test-pearl-sort--issue-ids) '("i1" "i2"))))) + +(ert-deftest test-pearl-reorder-priority-descending () + "Priority-descending reorder keeps the [#C] issue before the [#A] issue." + (test-pearl-sort--in-org test-pearl-sort--flat + (should (eq (pearl--reorder-issue-subtrees 'priority 'desc) t)) + (should (equal (test-pearl-sort--issue-ids) '("i2" "i1"))))) + +(ert-deftest test-pearl-reorder-title-ascending () + "Title-ascending reorder sorts Alpha before Beta." + (test-pearl-sort--in-org test-pearl-sort--flat + (should (eq (pearl--reorder-issue-subtrees 'title 'asc) t)) + (should (equal (test-pearl-sort--issue-ids) '("i1" "i2"))))) + +(ert-deftest test-pearl-reorder-preserves-local-edits () + "Reorder moves whole subtrees byte-for-byte, keeping an unsaved body edit." + (test-pearl-sort--in-org test-pearl-sort--flat + ;; Edit SE-1's body in place before sorting. + (goto-char (point-min)) + (search-forward "Body alpha.") + (replace-match "Body alpha EDITED LOCALLY.") + (should (eq (pearl--reorder-issue-subtrees 'priority 'asc) t)) + (should (equal (test-pearl-sort--issue-ids) '("i1" "i2"))) + (goto-char (point-min)) + (should (search-forward "Body alpha EDITED LOCALLY." nil t)))) + +(ert-deftest test-pearl-reorder-grouped-refuses () + "A grouped buffer (issues below level 2) refuses with 'grouped, unchanged." + (test-pearl-sort--in-org + (concat + "#+LINEAR-SOURCE: (:type view :name \"v\" :id \"vid\")\n\n" + "* v\n" + "** Group One\n" + "*** TODO [#C] SE-2: Beta\n:PROPERTIES:\n:LINEAR-ID: i2\n:END:\n" + "*** TODO [#A] SE-1: Alpha\n:PROPERTIES:\n:LINEAR-ID: i1\n:END:\n") + (let ((before (buffer-string))) + (should (eq (pearl--reorder-issue-subtrees 'priority 'asc) 'grouped)) + (should (equal (buffer-string) before))))) + +(ert-deftest test-pearl-reorder-no-issues () + "A buffer with no issue headings returns 'no-issues." + (test-pearl-sort--in-org "* Nothing here\nplain text\n" + (should (eq (pearl--reorder-issue-subtrees 'priority 'asc) 'no-issues)))) + +(ert-deftest test-pearl-reorder-keeps-non-issue-subtree-last () + "A level-2 heading with no LINEAR-ID is kept (sorted last), not dropped." + (test-pearl-sort--in-org + (concat + "#+LINEAR-SOURCE: (:type filter :name \"x\" :filter nil)\n\n" + "* x\n" + "** TODO [#C] SE-2: Beta\n:PROPERTIES:\n:LINEAR-ID: i2\n:LINEAR-IDENTIFIER: SE-2\n:END:\n" + "** A stray local heading\nsome notes\n" + "** TODO [#A] SE-1: Alpha\n:PROPERTIES:\n:LINEAR-ID: i1\n:LINEAR-IDENTIFIER: SE-1\n:END:\n") + (should (eq (pearl--reorder-issue-subtrees 'priority 'asc) t)) + (should (equal (test-pearl-sort--issue-ids) '("i1" "i2"))) + (goto-char (point-min)) + (should (search-forward "A stray local heading" nil t)))) + +;;; toggle target + +(ert-deftest test-pearl-toggle-target-filter-no-sort-defaults () + "Toggle on a filter with no sort establishes updated/desc." + (should (equal (pearl--toggle-sort-target '(:type filter)) + '(updated . desc)))) + +(ert-deftest test-pearl-toggle-target-filter-flips-order () + "Toggle on a filter flips the current order, keeping the sort." + (should (equal (pearl--toggle-sort-target '(:type filter :sort priority :order asc)) + '(priority . desc)))) + +(ert-deftest test-pearl-toggle-target-view-needs-client-sort () + "Toggle on a view with no client sort refuses (nothing to flip)." + (should-error (pearl--toggle-sort-target '(:type view :sort ((:x "y")))) + :type 'user-error)) + +(ert-deftest test-pearl-toggle-target-view-flips-client-order () + "Toggle on a view flips the client order." + (should (equal (pearl--toggle-sort-target + '(:type view :client-sort title :client-order desc)) + '(title . asc)))) + +;;; apply-sort routing + +(ert-deftest test-pearl-apply-sort-view-server-key-refuses () + "A created/updated sort on a view is refused (Linear has no view orderBy)." + (test-pearl-sort--in-org test-pearl-sort--flat + (should-error (pearl--apply-sort '(:type view :name "v" :id "vid") 'updated 'desc) + :type 'user-error))) + +(ert-deftest test-pearl-apply-sort-filter-client-key-reorders-and-persists () + "A priority sort on a filter reorders in place and writes :sort to the header." + (test-pearl-sort--in-org test-pearl-sort--flat + (should (eq (pearl--apply-sort + '(:type filter :name "My open issues" :filter (:open t)) + 'priority 'asc) + 'client)) + (should (equal (test-pearl-sort--issue-ids) '("i1" "i2"))) + (should (eq (plist-get (pearl--read-active-source) :sort) 'priority)))) + +(ert-deftest test-pearl-apply-sort-view-client-key-persists-client-keys () + "A priority sort on a view reorders and writes :client-sort, not :sort." + (test-pearl-sort--in-org + (concat + "#+LINEAR-SOURCE: (:type view :name \"v\" :id \"vid\" :sort ((:priority \"Ascending\")))\n\n" + "* v\n" + "** TODO [#C] SE-2: Beta\n:PROPERTIES:\n:LINEAR-ID: i2\n:LINEAR-IDENTIFIER: SE-2\n:END:\n" + "** TODO [#A] SE-1: Alpha\n:PROPERTIES:\n:LINEAR-ID: i1\n:LINEAR-IDENTIFIER: SE-1\n:END:\n") + (should (eq (pearl--apply-sort + (pearl--read-active-source) 'priority 'asc) + 'client)) + (should (equal (test-pearl-sort--issue-ids) '("i1" "i2"))) + (let ((src (pearl--read-active-source))) + (should (eq (plist-get src :client-sort) 'priority)) + (should (equal (plist-get src :sort) '((:priority "Ascending"))))))) + +(ert-deftest test-pearl-apply-sort-grouped-refuses-no-header-write () + "A grouped buffer refuses the client reorder and leaves the header unchanged." + (test-pearl-sort--in-org + (concat + "#+LINEAR-SOURCE: (:type filter :name \"x\" :filter nil)\n\n" + "* x\n" + "** Group\n" + "*** TODO [#A] SE-1: Alpha\n:PROPERTIES:\n:LINEAR-ID: i1\n:END:\n") + (should (eq (pearl--apply-sort '(:type filter :name "x" :filter nil) 'priority 'asc) + 'grouped)) + (should (null (plist-get (pearl--read-active-source) :sort))))) + +;;; server-side refetch persistence (HP3) + +(ert-deftest test-pearl-apply-server-sort-ok-writes-header () + "A successful server refetch writes the updated sort into #+LINEAR-SOURCE." + (test-pearl-sort--in-org test-pearl-sort--flat + (cl-letf (((symbol-function 'pearl--query-issues-async) + (lambda (_filter callback &optional _order-by) + (funcall callback '(:status ok :issues nil :truncated nil)))) + ((symbol-function 'pearl--merge-query-result) (lambda (&rest _) nil)) + ((symbol-function 'pearl--progress) (lambda (&rest _) nil))) + (pearl--apply-server-sort + '(:type filter :name "My open issues" :filter (:open t) :sort updated :order asc) + 'updated 'asc) + (let ((src (pearl--read-active-source))) + (should (eq (plist-get src :sort) 'updated)) + (should (eq (plist-get src :order) 'asc)))))) + +(ert-deftest test-pearl-apply-server-sort-failure-keeps-header () + "A failed server refetch leaves the #+LINEAR-SOURCE header unchanged (HP3)." + (test-pearl-sort--in-org test-pearl-sort--flat + (cl-letf (((symbol-function 'pearl--query-issues-async) + (lambda (_filter callback &optional _order-by) + (funcall callback '(:status error :message "boom")))) + ((symbol-function 'pearl--merge-query-result) (lambda (&rest _) nil)) + ((symbol-function 'pearl--progress) (lambda (&rest _) nil))) + (pearl--apply-server-sort + '(:type filter :name "My open issues" :filter (:open t) :sort updated :order asc) + 'updated 'asc) + (should (null (plist-get (pearl--read-active-source) :sort)))))) + +(provide 'test-pearl-sort) +;;; test-pearl-sort.el ends here |
