diff options
| -rw-r--r-- | pearl.el | 163 | ||||
| -rw-r--r-- | tests/test-pearl-adhoc.el | 14 | ||||
| -rw-r--r-- | tests/test-pearl-local-views.el | 171 |
3 files changed, 321 insertions, 27 deletions
@@ -3664,15 +3664,10 @@ active file with the query recorded as the source." (source (list :type 'filter :name name :filter filter-plist :sort sort :order order))) ;; Account guard, checked before any filter compilation or network call: - ;; a query tagged for another account would otherwise resolve its team / + ;; a view tagged for another account would otherwise resolve its team / ;; state / label names against the wrong workspace. Inert in legacy mode - ;; and for an untagged (shared) query. - (let ((q-account (plist-get spec :account))) - (when (and pearl-accounts q-account) - (let ((active (plist-get (pearl--current-account-context) :name))) - (unless (string-equal q-account active) - (user-error "Local view '%s' belongs to %s; switch accounts first" - name q-account))))) + ;; and for an untagged (shared) view. + (pearl--require-local-view-account name spec) ;; Validate the local view's authoring plist at the command boundary so ;; a typo'd key or bad value surfaces as a clear user-error instead of ;; being silently dropped or failing deeper in the compiler. @@ -4004,18 +3999,71 @@ by hand." (t (message "Kept local view %s; Linear view also untouched" name))))) -(defun pearl--save-query (name filter-plist &optional sort order) - "Save FILTER-PLIST as the local view NAME, replacing any entry of that NAME. -Persists `pearl-local-views' via Customize. SORT and ORDER are -stored when given." - (let ((entry (cons name (append (list :filter filter-plist) - (when sort (list :sort sort)) - (when order (list :order order)))))) +(defun pearl--save-local-view (name filter-plist &optional sort order) + "Save FILTER-PLIST as local view NAME, preserving an existing entry's metadata. +On an existing entry, replaces only `:filter' (and `:sort' / `:order' when +non-nil) and keeps every other key -- `:linear-view-id', `:linear-view-team-id', +`:linear-view-shared', `:linear-view-url', `:linear-view-synced-at', `:account', +and `:copied-from-view-id'. A new entry is stamped with the active account's +name under `:account' when `pearl-accounts' is configured. Persists +`pearl-local-views' via Customize. This is the metadata-preserving writer; +unlike a naive rebuild it never drops a published view's tracking link." + (let* ((existing (assoc name pearl-local-views)) + (spec (and existing (copy-sequence (cdr existing))))) + (setq spec (plist-put spec :filter filter-plist)) + (when sort (setq spec (plist-put spec :sort sort))) + (when order (setq spec (plist-put spec :order order))) + (unless existing + (when pearl-accounts + (let ((active (plist-get (pearl--current-account-context) :name))) + (when active (setq spec (plist-put spec :account active)))))) (setq pearl-local-views - (cons entry (assoc-delete-all name (copy-sequence pearl-local-views)))) + (cons (cons name spec) + (assoc-delete-all name (copy-sequence pearl-local-views)))) (ignore-errors (customize-save-variable 'pearl-local-views pearl-local-views)))) +(defun pearl--require-local-view-account (name spec) + "Refuse when local view NAME (SPEC plist) belongs to a non-active account. +Inert in legacy single-account mode and for an untagged entry -- the same +guard `pearl-run-local-view' applies, shared so every read/mutate command +enforces it identically. Returns the active account name, or nil in legacy +mode, so callers can stamp newly-created entries." + (let ((v-account (plist-get spec :account))) + (cond + ((and pearl-accounts v-account) + (let ((active (plist-get (pearl--current-account-context) :name))) + (unless (string-equal v-account active) + (user-error "Local view '%s' belongs to %s; switch accounts first" + name v-account)) + active)) + (pearl-accounts (plist-get (pearl--current-account-context) :name)) + (t nil)))) + +(defun pearl--resolve-local-view-name (proposed &optional current) + "Resolve a local-view name collision for PROPOSED, returning the final name. +CURRENT, when given, is the entry's existing name -- keeping the same name on +an edit is not a collision. When PROPOSED already names a different local +view, prompts Replace / Rename / Cancel (default Rename); Replace returns the +name to overwrite, Cancel returns nil. Used by create, edit-rename, and +copy-down so the three share one collision policy." + (let ((name proposed) (done nil) (result nil)) + (while (not done) + (cond + ((or (null name) (string-empty-p name)) + (setq done t result nil)) + ((or (and current (string-equal name current)) + (not (assoc name pearl-local-views))) + (setq done t result name)) + (t + (pcase (completing-read + (format "Local view \"%s\" already exists: " name) + '("Rename" "Replace" "Cancel") nil t nil nil "Rename") + ("Replace" (setq done t result name)) + ("Cancel" (setq done t result nil)) + (_ (setq name (read-string "New local-view name: "))))))) + result)) + ;;; Saved-query -> Linear view sync (see docs/saved-query-sync-spec.org) (defun pearl--sync-scope-label (team-name shared) @@ -4418,17 +4466,19 @@ the scope-and-visibility display string for the success message." "Build an ad-hoc issue filter interactively, run it, and render it. Interactively, completes each dimension from the chosen team's fetched projects/states/labels (so a typo can't produce a confusing empty result), and -offers to save the filter as a local query. FILTER-PLIST is the authoring -filter; SAVE-NAME, when given, persists it via `pearl--save-query'." +offers to save it as a local view. FILTER-PLIST is the authoring filter; +SAVE-NAME, when given, persists it via `pearl--save-local-view'. For a +deliberate create use `pearl-create-local-view'; this is the ad-hoc path with +a save offer at the end." (interactive (list (pearl--read-filter-interactively) - (when (pearl--read-yes-no "Save this filter locally so you can re-run it (not pushed to Linear)? ") + (when (pearl--read-yes-no "Save this as a local view so you can re-run it (not published to Linear)? ") (read-string "Name for this local view: ")))) ;; Validate before saving or running, so a bad filter never gets persisted ;; or run -- the command boundary is where the clear error belongs. (pearl--validate-issue-filter filter-plist) (when (and save-name (not (string-empty-p save-name))) - (pearl--save-query save-name filter-plist)) + (pearl--save-local-view save-name filter-plist)) (let ((source (list :type 'filter :name (if (and save-name (not (string-empty-p save-name))) save-name @@ -4439,6 +4489,79 @@ filter; SAVE-NAME, when given, persists it via `pearl--save-query'." (pearl--build-issue-filter filter-plist) (lambda (result) (pearl--render-query-result result source))))) +;;;###autoload +(defun pearl-create-local-view () + "Build a filter interactively, name it, and save it as a local view. +Completes each dimension from the chosen team's fetched values, then prompts a +name (Replace / Rename / Cancel on a collision), persists via +`pearl--save-local-view' (stamping the active account under `pearl-accounts'), +and runs the new view. The deliberate create path; +`pearl-list-issues-filtered' is the ad-hoc run that merely offers to save." + (interactive) + (let ((filter-plist (pearl--read-filter-interactively))) + (pearl--validate-issue-filter filter-plist) + (let ((name (pearl--resolve-local-view-name + (read-string "Name for this local view: ")))) + (unless name (user-error "Cancelled; no local view created")) + (pearl--save-local-view name filter-plist) + (let ((source (list :type 'filter :name name :filter filter-plist))) + (pearl--progress "Running local view %s..." name) + (pearl--query-issues-async + (pearl--build-issue-filter filter-plist) + (lambda (result) (pearl--render-query-result result source))))))) + +(defun pearl--read-sort-or-keep (current) + "Read a sort key, defaulting to CURRENT. Returns a symbol, or nil for none." + (let ((choice (completing-read + "Sort: " + (pearl--completion-table-keep-order + '("keep" "updated" "created" "priority" "title" "none")) + nil t nil nil "keep"))) + (pcase choice ("keep" current) ("none" nil) (_ (intern choice))))) + +(defun pearl--read-order-or-keep (current) + "Read an order, defaulting to CURRENT. Returns `asc', `desc', or nil." + (let ((choice (completing-read + "Order: " + (pearl--completion-table-keep-order '("keep" "desc" "asc")) + nil t nil nil "keep"))) + (pcase choice ("keep" current) (_ (intern choice))))) + +;;;###autoload +(defun pearl-edit-local-view (name) + "Edit the local view NAME, preserving its non-edited metadata. +Refuses a cross-account entry. Offers to rebuild the filter (otherwise keeps +the stored one), then prompts a new name (Replace / Rename / Cancel on a +collision; keeping the same name is fine), and a sort and order. Saves through +`pearl--save-local-view', so a published view keeps its `:linear-view-*' link +and a copied-down view keeps its `:copied-from-view-id'." + (interactive + (list (if (null pearl-local-views) + (user-error "No local views to edit") + (completing-read "Edit local view: " + (mapcar #'car pearl-local-views) nil t)))) + (let ((entry (assoc name pearl-local-views))) + (unless entry (user-error "No local view named %s" name)) + (let ((spec (cdr entry))) + (pearl--require-local-view-account name spec) + (let* ((filter (if (pearl--read-yes-no "Rebuild the filter? " "no") + (pearl--read-filter-interactively) + (plist-get spec :filter))) + (sort (pearl--read-sort-or-keep (plist-get spec :sort))) + (order (pearl--read-order-or-keep (plist-get spec :order))) + (new-name (pearl--resolve-local-view-name + (read-string "Name: " name) name))) + (pearl--validate-issue-filter filter) + (unless new-name (user-error "Cancelled; no edit saved")) + ;; On rename, carry the existing spec to the new name first so the + ;; metadata survives, then let `pearl--save-local-view' update it. + (unless (string-equal new-name name) + (setq pearl-local-views + (cons (cons new-name (copy-sequence spec)) + (assoc-delete-all name (copy-sequence pearl-local-views))))) + (pearl--save-local-view new-name filter sort order) + (message "Saved local view %s" new-name))))) + (defun pearl--cap-issue-list-comments (issue) "Cap a bulk-list ISSUE's fetched comments and record a `:comment-count' marker. The list/view fetch pulls the newest `pearl-list-comments-count-cap'+1 comments diff --git a/tests/test-pearl-adhoc.el b/tests/test-pearl-adhoc.el index 4959840..68a920c 100644 --- a/tests/test-pearl-adhoc.el +++ b/tests/test-pearl-adhoc.el @@ -155,22 +155,22 @@ candidate list, so completion still works the way the framework expects." (should (string= "user-1" (plist-get f :assignee-id))) (should-not (plist-member f :assignee)))) -;;; --save-query +;;; --save-local-view -(ert-deftest test-pearl-save-query-adds-entry () - "Saving a query adds it to the saved-queries variable." +(ert-deftest test-pearl-save-local-view-adds-entry () + "Saving a local view adds it to `pearl-local-views'." (let ((pearl-local-views nil)) (cl-letf (((symbol-function 'customize-save-variable) (lambda (&rest _) nil))) - (pearl--save-query "My filter" '(:open t :labels ("bug"))) + (pearl--save-local-view "My filter" '(:open t :labels ("bug"))) (let ((entry (assoc "My filter" pearl-local-views))) (should entry) (should (equal '(:open t :labels ("bug")) (plist-get (cdr entry) :filter))))))) -(ert-deftest test-pearl-save-query-replaces-same-name () - "Saving under an existing name replaces that entry rather than duplicating." +(ert-deftest test-pearl-save-local-view-replaces-same-name () + "Saving under an existing name updates that entry rather than duplicating." (let ((pearl-local-views '(("Dup" :filter (:open t))))) (cl-letf (((symbol-function 'customize-save-variable) (lambda (&rest _) nil))) - (pearl--save-query "Dup" '(:priority 1)) + (pearl--save-local-view "Dup" '(:priority 1)) (should (= 1 (cl-count "Dup" pearl-local-views :key #'car :test #'string=))) (should (equal '(:priority 1) diff --git a/tests/test-pearl-local-views.el b/tests/test-pearl-local-views.el new file mode 100644 index 0000000..71fb173 --- /dev/null +++ b/tests/test-pearl-local-views.el @@ -0,0 +1,171 @@ +;;; test-pearl-local-views.el --- Tests for local-view create/edit/persistence -*- 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: + +;; Phase 2 of the local/Linear views spec: the metadata-preserving writer +;; `pearl--save-local-view', the shared account guard +;; `pearl--require-local-view-account', and the collision resolver +;; `pearl--resolve-local-view-name'. The load-bearing guarantee is that +;; editing a published local view never drops its `:linear-view-*' tracking +;; link. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) + +(defmacro test-pearl-lv--with-store (initial &rest body) + "Run BODY with `pearl-local-views' set to INITIAL and Customize persistence stubbed." + (declare (indent 1)) + `(let ((pearl-local-views ,initial)) + (cl-letf (((symbol-function 'customize-save-variable) (lambda (&rest _) nil))) + ,@body))) + +;;; pearl--save-local-view -- metadata preservation + +(ert-deftest test-pearl-save-local-view-creates-new-entry () + "A new name is saved with its filter and no metadata stamped in legacy mode." + (test-pearl-lv--with-store nil + (let ((pearl-accounts nil)) + (pearl--save-local-view "bugs" '(:labels ("bug") :open t)) + (let ((spec (cdr (assoc "bugs" pearl-local-views)))) + (should (equal (plist-get spec :filter) '(:labels ("bug") :open t))) + (should-not (plist-member spec :account)))))) + +(ert-deftest test-pearl-save-local-view-preserves-tracking-metadata () + "Re-saving a published local view keeps its :linear-view-* and provenance keys." + (test-pearl-lv--with-store + '(("team open" + :filter (:team "ENG" :open t) + :linear-view-id "view-123" + :linear-view-team-id "team-1" + :linear-view-shared t + :linear-view-url "https://linear.app/x/view/view-123" + :linear-view-synced-at "2026-06-01" + :account "acct-a" + :copied-from-view-id "src-9")) + (pearl--save-local-view "team open" '(:team "ENG" :state "In Progress")) + (let ((spec (cdr (assoc "team open" pearl-local-views)))) + ;; the edited field changed + (should (equal (plist-get spec :filter) '(:team "ENG" :state "In Progress"))) + ;; every other key survived + (should (equal (plist-get spec :linear-view-id) "view-123")) + (should (equal (plist-get spec :linear-view-team-id) "team-1")) + (should (eq (plist-get spec :linear-view-shared) t)) + (should (equal (plist-get spec :linear-view-url) + "https://linear.app/x/view/view-123")) + (should (equal (plist-get spec :linear-view-synced-at) "2026-06-01")) + (should (equal (plist-get spec :account) "acct-a")) + (should (equal (plist-get spec :copied-from-view-id) "src-9"))))) + +(ert-deftest test-pearl-save-local-view-updates-sort-order-keeping-rest () + "Sort/order update in place; an unrelated key is preserved." + (test-pearl-lv--with-store + '(("q" :filter (:open t) :sort updated :order desc :copied-from-view-id "s")) + (pearl--save-local-view "q" '(:open t) 'priority 'asc) + (let ((spec (cdr (assoc "q" pearl-local-views)))) + (should (eq (plist-get spec :sort) 'priority)) + (should (eq (plist-get spec :order) 'asc)) + (should (equal (plist-get spec :copied-from-view-id) "s"))))) + +(ert-deftest test-pearl-save-local-view-stamps-account-when-accounts-active () + "A new entry created under `pearl-accounts' is stamped with the active account." + (test-pearl-lv--with-store nil + (let ((pearl-accounts '(("acct-a" . ignored)))) + (cl-letf (((symbol-function 'pearl--current-account-context) + (lambda () '(:name "acct-a")))) + (pearl--save-local-view "mine" '(:assignee :me :open t)) + (should (equal (plist-get (cdr (assoc "mine" pearl-local-views)) :account) + "acct-a")))))) + +;;; pearl--require-local-view-account + +(ert-deftest test-pearl-require-account-legacy-is-inert () + "With no `pearl-accounts', the guard returns nil and never errors." + (let ((pearl-accounts nil)) + (should-not (pearl--require-local-view-account "q" '(:filter (:open t)))))) + +(ert-deftest test-pearl-require-account-matching-passes () + "A view tagged to the active account passes and returns the active name." + (let ((pearl-accounts '(("acct-a" . x)))) + (cl-letf (((symbol-function 'pearl--current-account-context) + (lambda () '(:name "acct-a")))) + (should (equal (pearl--require-local-view-account + "q" '(:account "acct-a" :filter (:open t))) + "acct-a"))))) + +(ert-deftest test-pearl-require-account-mismatch-refuses () + "A view tagged to another account signals a user-error." + (let ((pearl-accounts '(("acct-a" . x)))) + (cl-letf (((symbol-function 'pearl--current-account-context) + (lambda () '(:name "acct-a")))) + (should-error (pearl--require-local-view-account + "q" '(:account "acct-b" :filter (:open t))) + :type 'user-error)))) + +;;; pearl--resolve-local-view-name -- collision policy + +(ert-deftest test-pearl-resolve-name-no-collision-returns-name () + (test-pearl-lv--with-store '(("other" :filter (:open t))) + (should (equal (pearl--resolve-local-view-name "fresh") "fresh")))) + +(ert-deftest test-pearl-resolve-name-same-as-current-is-not-collision () + (test-pearl-lv--with-store '(("q" :filter (:open t))) + (should (equal (pearl--resolve-local-view-name "q" "q") "q")))) + +(ert-deftest test-pearl-resolve-name-collision-replace () + (test-pearl-lv--with-store '(("q" :filter (:open t))) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) "Replace"))) + (should (equal (pearl--resolve-local-view-name "q") "q"))))) + +(ert-deftest test-pearl-resolve-name-collision-cancel () + (test-pearl-lv--with-store '(("q" :filter (:open t))) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) "Cancel"))) + (should-not (pearl--resolve-local-view-name "q"))))) + +(ert-deftest test-pearl-resolve-name-collision-rename () + "Rename prompts a new name; a free name then resolves." + (test-pearl-lv--with-store '(("q" :filter (:open t))) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) "Rename")) + ((symbol-function 'read-string) + (lambda (&rest _) "q2"))) + (should (equal (pearl--resolve-local-view-name "q") "q2"))))) + +;;; pearl-edit-local-view -- rename carries metadata, drops the old name + +(ert-deftest test-pearl-edit-local-view-rename-preserves-metadata () + "Renaming a published local view moves it under the new name with its link intact." + (test-pearl-lv--with-store + '(("old" :filter (:open t) :linear-view-id "v-1" :account nil)) + (let ((pearl-accounts nil)) + (cl-letf (((symbol-function 'pearl--read-yes-no) (lambda (&rest _) nil)) + ((symbol-function 'completing-read) (lambda (&rest _) "keep")) + ((symbol-function 'read-string) (lambda (&rest _) "new"))) + (pearl-edit-local-view "old") + (should-not (assoc "old" pearl-local-views)) + (let ((spec (cdr (assoc "new" pearl-local-views)))) + (should spec) + (should (equal (plist-get spec :filter) '(:open t))) + (should (equal (plist-get spec :linear-view-id) "v-1"))))))) + +(provide 'test-pearl-local-views) +;;; test-pearl-local-views.el ends here |