diff options
| -rw-r--r-- | README.org | 7 | ||||
| -rw-r--r-- | pearl.el | 153 | ||||
| -rw-r--r-- | tests/test-integration-acceptance.el | 10 | ||||
| -rw-r--r-- | tests/test-pearl-assignee-labels.el | 121 | ||||
| -rw-r--r-- | tests/test-pearl-bugfixes.el | 25 | ||||
| -rw-r--r-- | tests/test-pearl-compose.el | 6 | ||||
| -rw-r--r-- | tests/test-pearl-fields.el | 73 | ||||
| -rw-r--r-- | tests/test-pearl-keymap.el | 19 | ||||
| -rw-r--r-- | tests/test-pearl-menu.el | 2 | ||||
| -rw-r--r-- | tests/test-pearl-output.el | 2 |
10 files changed, 129 insertions, 289 deletions
@@ -194,10 +194,9 @@ All issue commands work from anywhere inside an issue subtree. |-----------------------------------+--------------------------------------------------| | =pearl-sync-current-issue= | Push the edited description body | | =pearl-sync-current-issue-title= | Push the edited heading title | -| =pearl-set-priority= | Set None, Urgent, High, Medium, or Low | -| =pearl-set-state= | Set a workflow state from the issue's team | -| =pearl-set-assignee= | Set a team member as assignee | -| =pearl-set-labels= | Replace labels; empty selection clears them | +| =pearl-edit-state= | Pick a workflow state (pushed at next save) | +| =pearl-edit-assignee= | Pick a team member as assignee (at next save) | +| =pearl-edit-labels= | Pick labels; empty selection clears (at save) | | =pearl-add-comment= | Add a new Linear comment | | =pearl-edit-current-comment= | Push edits to one of your own comments | | =pearl-delete-current-comment= | Delete one of your own comments after confirming | @@ -2613,7 +2613,7 @@ the new comment is the viewer's own, so it renders editable." issue-id marker (pearl--org-to-md org)))))))) ;;;###autoload -(defun pearl-compose-current-description () +(defun pearl-edit-description () "Edit the description of the Linear issue at point in an Org compose buffer. Pops the current description into a focused buffer; C-c C-c writes it back into the issue body and syncs to Linear through the usual conflict gate, C-c C-k @@ -2718,10 +2718,6 @@ the generic mutation the field commands share." :updated-at (cdr (assoc 'updatedAt issue)))))) (lambda (_error _response _data) (funcall callback '(:success nil)))))) -(defconst pearl--priority-choices - '(("None" . 0) ("Urgent" . 1) ("High" . 2) ("Medium" . 3) ("Low" . 4)) - "Linear priority names mapped to their numeric API values.") - (defun pearl--set-priority-cookie (priority-num) "Set the Org priority cookie on the heading at point from PRIORITY-NUM. 1-4 map to #A-#D; 0 (None) removes the cookie. The priority range is bound @@ -2737,46 +2733,6 @@ locally so #D is accepted regardless of the user's `org-priority' settings." (4 (org-priority ?D)) (_ (org-priority 'remove)))))) -;;;###autoload -(defun pearl--push-issue-field (issue-id marker fields on-success success-message fail-message) - "Push FIELDS (an `issueUpdate' input alist) for ISSUE-ID. -On success, run the ON-SUCCESS thunk at MARKER, report SUCCESS-MESSAGE, and -surface the buffer; on failure report FAIL-MESSAGE. The shared push-and-report -tail of the field-setter commands (priority/state/assignee/labels)." - (pearl--update-issue-async - issue-id fields - (lambda (result) - (if (plist-get result :success) - ;; The push may complete after the buffer was killed; only touch it - ;; when it's still live, but still report the (remote) success. - (progn - (when (buffer-live-p (marker-buffer marker)) - (save-excursion - (goto-char marker) - (funcall on-success)) - (pearl--surface-buffer (marker-buffer marker))) - (message "%s" success-message)) - (message "%s" fail-message))))) - -(defun pearl-set-priority (priority-name) - "Set the priority of the Linear issue at point to PRIORITY-NAME. -Interactively, completes over None/Urgent/High/Medium/Low. Pushes the numeric -priority to Linear and rewrites the heading cookie on success. Works from -anywhere inside an issue subtree." - (interactive - (list (completing-read "Priority: " pearl--priority-choices nil t))) - (save-excursion - (pearl--goto-issue-heading-or-error) - (let ((issue-id (org-entry-get nil "LINEAR-ID")) - (priority-num (cdr (assoc priority-name pearl--priority-choices))) - (marker (point-marker))) - (unless priority-num - (user-error "Unknown priority: %s" priority-name)) - (pearl--push-issue-field - issue-id marker `(("priority" . ,priority-num)) - (lambda () (pearl--set-priority-cookie priority-num)) - (format "Set %s priority to %s" issue-id priority-name) - (format "Failed to set priority for %s" issue-id))))) (defun pearl--set-heading-state (state-name state-id) "Update the heading at point to STATE-NAME / STATE-ID. @@ -2792,11 +2748,12 @@ second push back to Linear." (org-todo (pearl--map-linear-state-to-org state-name))))) ;;;###autoload -(defun pearl-set-state (state-name) - "Set the workflow state of the Linear issue at point to STATE-NAME. -Interactively, completes over the issue team's workflow states. Pushes the -resolved state id to Linear and updates the heading keyword and drawer on -success. Works from anywhere inside an issue subtree." +(defun pearl-edit-state (state-name) + "Set the workflow state of the issue at point to STATE-NAME in the buffer. +Completes over the issue team's workflow states and writes the keyword, name, +and id. The change is reconciled and pushed at the next save, not immediately. +Works from anywhere inside an issue subtree. This picker reaches any state, +including one a TODO-keyword cycle can't express." (interactive (let ((team-id (save-excursion (when (ignore-errors (org-back-to-heading t) t) @@ -2808,20 +2765,15 @@ success. Works from anywhere inside an issue subtree." nil t)))) (save-excursion (pearl--goto-issue-heading-or-error) - (let* ((issue-id (org-entry-get nil "LINEAR-ID")) - (team-id (org-entry-get nil "LINEAR-TEAM-ID")) - (marker (point-marker)) + (let* ((team-id (org-entry-get nil "LINEAR-TEAM-ID")) (states (and team-id (pearl--team-states team-id))) (state (seq-find (lambda (s) (string= (cdr (assoc 'name s)) state-name)) states)) (state-id (and state (cdr (assoc 'id state))))) (unless state-id (user-error "No workflow state named %s in this team" state-name)) - (pearl--push-issue-field - issue-id marker `(("stateId" . ,state-id)) - (lambda () (pearl--set-heading-state state-name state-id)) - (format "Set %s state to %s" issue-id state-name) - (format "Failed to set state for %s" issue-id))))) + (pearl--set-heading-state state-name state-id) + (message "Set state to %s (save to push)" state-name)))) (defun pearl--team-collection-names (kind team-id) "Return the display labels of the KIND collection for TEAM-ID, for completion." @@ -2829,11 +2781,12 @@ success. Works from anywhere inside an issue subtree." (and team-id (pearl--team-collection kind team-id)))) ;;;###autoload -(defun pearl-set-assignee (assignee-name) - "Set the assignee of the Linear issue at point to ASSIGNEE-NAME. -Interactively, completes over the issue team's members. Resolves the name to -a user id, pushes it, and updates the assignee drawer on success. Works from -anywhere inside an issue subtree." +(defun pearl-edit-assignee (assignee-name) + "Set the assignee of the issue at point to ASSIGNEE-NAME in the buffer. +Completes over the issue team's members, resolves the name to a user id, and +writes the assignee drawer; the change is reconciled and pushed at the next +`pearl-save-issue' / `pearl-save-all', not immediately. Works from anywhere +inside an issue subtree." (interactive (let ((team-id (save-excursion (when (ignore-errors (org-back-to-heading t) t) @@ -2843,28 +2796,23 @@ anywhere inside an issue subtree." nil t)))) (save-excursion (pearl--goto-issue-heading-or-error) - (let* ((issue-id (org-entry-get nil "LINEAR-ID")) - (team-id (org-entry-get nil "LINEAR-TEAM-ID")) - (marker (point-marker)) + (let* ((team-id (org-entry-get nil "LINEAR-TEAM-ID")) (assignee-id (and team-id (pearl--resolve-team-id 'members assignee-name team-id)))) (unless assignee-id (user-error "No team member matching %s" assignee-name)) - (pearl--push-issue-field - issue-id marker `(("assigneeId" . ,assignee-id)) - (lambda () - (org-entry-put nil "LINEAR-ASSIGNEE-NAME" assignee-name) - (org-entry-put nil "LINEAR-ASSIGNEE-ID" assignee-id)) - (format "Set %s assignee to %s" issue-id assignee-name) - (format "Failed to set assignee for %s" issue-id))))) + (org-entry-put nil "LINEAR-ASSIGNEE-NAME" assignee-name) + (org-entry-put nil "LINEAR-ASSIGNEE-ID" assignee-id) + (message "Set assignee to %s (save to push)" assignee-name)))) ;;;###autoload -(defun pearl-set-labels (label-names) - "Set the labels of the Linear issue at point to LABEL-NAMES. -Interactively, completes (multiple) over the issue team's labels; an empty -selection clears the labels. Resolves each name to a label id, pushes the id -list, and updates the labels drawer on success. Works from anywhere inside an -issue subtree." +(defun pearl-edit-labels (label-names) + "Set the labels of the issue at point to LABEL-NAMES in the buffer. +Completes (multiple) over the issue team's labels; an empty selection clears +them. Resolves each name to a label id and writes the labels drawer plus the +`LINEAR-LABEL-IDS' live set; the change is reconciled and pushed at the next +`pearl-save-issue' / `pearl-save-all', not immediately. Works from anywhere +inside an issue subtree." (interactive (let ((team-id (save-excursion (when (ignore-errors (org-back-to-heading t) t) @@ -2874,23 +2822,18 @@ issue subtree." (pearl--team-collection-names 'labels team-id))))) (save-excursion (pearl--goto-issue-heading-or-error) - (let* ((issue-id (org-entry-get nil "LINEAR-ID")) - (team-id (org-entry-get nil "LINEAR-TEAM-ID")) - (marker (point-marker)) + (let* ((team-id (org-entry-get nil "LINEAR-TEAM-ID")) (label-ids (mapcar (lambda (name) (or (and team-id (pearl--resolve-team-id 'labels name team-id)) (user-error "No label matching %s" name))) label-names))) - (pearl--push-issue-field - issue-id marker `(("labelIds" . ,label-ids)) - (lambda () - (org-entry-put nil "LINEAR-LABELS" - (format "[%s]" (mapconcat #'identity label-names ", ")))) - (format "Set %s labels to %s" issue-id - (if label-names (mapconcat #'identity label-names ", ") "none")) - (format "Failed to set labels for %s" issue-id))))) + (org-entry-put nil "LINEAR-LABELS" + (format "[%s]" (mapconcat #'identity label-names ", "))) + (org-entry-put nil "LINEAR-LABEL-IDS" (string-join label-ids " ")) + (message "Set labels to %s (save to push)" + (if label-names (mapconcat #'identity label-names ", ") "none"))))) ;;; User-facing Commands (Async) @@ -2952,9 +2895,9 @@ page cap was hit. Pure function, no side effects." (insert (format "#+LINEAR-TRUNCATED: %s\n" (if truncated "yes" "no"))) ;; Affordance preamble (org comments -- not rendered content). (insert "#\n") - (insert "# Body = the issue description; edit it, then M-x pearl-sync-current-issue to push.\n") + (insert "# Body = the issue description; edit it, then M-x pearl-save-issue to push.\n") (insert "# Comments subtree = the thread; add with M-x pearl-add-comment.\n") - (insert "# Drawer fields change via M-x pearl-set-priority / -state / -assignee / -labels.\n") + (insert "# State/assignee/labels: M-x pearl-edit-state / -assignee / -labels; priority: the org cookie (C-c ,). All push at save.\n") (insert "# Refresh with M-x pearl-refresh-current-view (whole file) or -current-issue (one).\n") (insert "\n") @@ -4693,12 +4636,11 @@ body stay." ("e" "save ticket" pearl-save-issue) ("E" "save all" pearl-save-all)] ["Edit" - ("D" "edit description" pearl-compose-current-description) + ("D" "edit description" pearl-edit-description) ("M" "edit comment" pearl-edit-current-comment) - ("P" "edit priority" pearl-set-priority) - ("s" "edit state" pearl-set-state) - ("a" "edit assignee" pearl-set-assignee) - ("L" "edit labels" pearl-set-labels)] + ("s" "edit state" pearl-edit-state) + ("a" "edit assignee" pearl-edit-assignee) + ("L" "edit labels" pearl-edit-labels)] ["New" ("n" "new ticket" pearl-new-issue) ("c" "new comment" pearl-add-comment)] @@ -4737,10 +4679,10 @@ body stay." ;; verb-matched label (e.g. "edit priority") without pearl depending on ;; which-key. Lookups still resolve straight to the command. ;; -;; The labels follow the edit/new verbs even though some commands keep older -;; names (`pearl-compose-current-description', `pearl-set-state', and -;; `pearl-add-comment'); aligning the command names is a separate task. The -;; `d c' delete-comment slot is intentionally empty until that command exists. +;; The labels follow the edit/new verbs. The edit commands are named to match +;; (`pearl-edit-description', `pearl-edit-state', ...); the new-comment command +;; keeps its `pearl-add-comment' name pending that rename. Priority has no edit +;; command -- it is edited org-natively via the heading cookie (C-c , / S-up). (defvar pearl-save-map (let ((map (make-sparse-keymap))) @@ -4751,12 +4693,11 @@ body stay." (defvar pearl-edit-map (let ((map (make-sparse-keymap))) - (define-key map "d" (cons "edit description" #'pearl-compose-current-description)) + (define-key map "d" (cons "edit description" #'pearl-edit-description)) (define-key map "c" (cons "edit comment" #'pearl-edit-current-comment)) - (define-key map "p" (cons "edit priority" #'pearl-set-priority)) - (define-key map "s" (cons "edit state" #'pearl-set-state)) - (define-key map "a" (cons "edit assignee" #'pearl-set-assignee)) - (define-key map "l" (cons "edit labels" #'pearl-set-labels)) + (define-key map "s" (cons "edit state" #'pearl-edit-state)) + (define-key map "a" (cons "edit assignee" #'pearl-edit-assignee)) + (define-key map "l" (cons "edit labels" #'pearl-edit-labels)) map) "Pearl edit commands; a sub-keymap of `pearl-prefix-map'.") diff --git a/tests/test-integration-acceptance.el b/tests/test-integration-acceptance.el index f83c891..de5f0e7 100644 --- a/tests/test-integration-acceptance.el +++ b/tests/test-integration-acceptance.el @@ -37,7 +37,7 @@ ;; - pearl-refresh-current-view -> --merge-query-result (in-place merge) ;; - pearl-sync-current-issue -> --sync-decision -> --update-issue-description-async ;; - pearl-add-comment -> --create-comment-async -> --append-comment-to-issue -;; - pearl-set-priority -> --push-issue-field -> --update-issue-async +;; - edit the priority cookie + pearl-save-issue -> --save-priority-field -> --update-issue-async ;;; Code: @@ -77,6 +77,7 @@ because the description-update mutation contains both `IssueDescription' and (pageInfo (hasNextPage . :json-false) (endCursor . "c")))))) ('fetch-desc '((data (issue (description . "Original body.") + (priority . 2) (updatedAt . "2026-05-24T00:00:00.000Z"))))) ('comment-create '((data (commentCreate (success . t) @@ -189,11 +190,14 @@ because the description-update mutation contains both `IssueDescription' and (goto-char (point-min)) (should (re-search-forward "^\\*\\*\\* Comments$" nil t)) (should (re-search-forward "looks good" nil t)) - ;; --- set priority from inside the subtree --- + ;; --- edit the priority cookie, then save (reconcile-on-save) --- (goto-char (point-min)) (re-search-forward "First issue") + (org-back-to-heading t) + (let ((org-priority-highest ?A) (org-priority-lowest ?D)) + (org-priority ?A)) ; [#B] (2) -> [#A] (1) (setq test-integration--ops nil) - (pearl-set-priority "Urgent") + (pearl-save-issue) (should (memq 'issue-update test-integration--ops))))) (provide 'test-integration-acceptance) diff --git a/tests/test-pearl-assignee-labels.el b/tests/test-pearl-assignee-labels.el index 7a4a352..e7be619 100644 --- a/tests/test-pearl-assignee-labels.el +++ b/tests/test-pearl-assignee-labels.el @@ -19,10 +19,11 @@ ;;; Commentary: -;; Tests for the two drawer-field commands that resolve names to ids: -;; `pearl-set-assignee' and `pearl-set-labels'. They push via -;; the generic `--update-issue-async' and update the LINEAR-ASSIGNEE / LABELS -;; drawer. The resolver and the mutation are stubbed. +;; Tests for the two picker commands that resolve names to ids: +;; `pearl-edit-assignee' and `pearl-edit-labels'. As save-model-v2 +;; buffer-editors they write the LINEAR-ASSIGNEE / LABELS drawer (and the live +;; id sets) but do NOT push -- the change reconciles at the next save (the push +;; path is covered in test-pearl-save). The resolver is stubbed. ;;; Code: @@ -38,57 +39,38 @@ (goto-char (point-min)) ,@body)) -;;; set-assignee +;;; edit-assignee (buffer-editor: writes the drawer, no push) -(ert-deftest test-pearl-set-assignee-pushes-id-and-updates-drawer () - "Setting an assignee resolves the name, pushes the id, and updates the drawer." +(ert-deftest test-pearl-edit-assignee-writes-drawer-no-push () + "edit-assignee resolves the name, writes the drawer, and does not push." (let ((pushed nil)) (test-pearl--in-org "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-ASSIGNEE-ID: old\n:LINEAR-ASSIGNEE-NAME: Someone\n:END:\n" (cl-letf (((symbol-function 'pearl--resolve-team-id) (lambda (_kind _name _team &optional _force) "u9")) ((symbol-function 'pearl--update-issue-async) - (lambda (_id input cb) (setq pushed input) (funcall cb '(:success t))))) - (pearl-set-assignee "Craig") - (should (string= "u9" (cdr (assoc "assigneeId" pushed)))) + (lambda (&rest _) (setq pushed t)))) + (pearl-edit-assignee "Craig") + (should-not pushed) (should (string= "Craig" (org-entry-get nil "LINEAR-ASSIGNEE-NAME"))) (should (string= "u9" (org-entry-get nil "LINEAR-ASSIGNEE-ID"))))))) -(ert-deftest test-pearl-set-assignee-unresolvable-errors () - "An unresolvable assignee name signals a user error and pushes nothing." - (let ((pushed nil)) - (test-pearl--in-org - "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:END:\n" - (cl-letf (((symbol-function 'pearl--resolve-team-id) - (lambda (&rest _) nil)) - ((symbol-function 'pearl--update-issue-async) - (lambda (&rest _) (setq pushed t)))) - (should-error (pearl-set-assignee "Nobody") :type 'user-error) - (should-not pushed))))) +(ert-deftest test-pearl-edit-assignee-unresolvable-errors () + "An unresolvable assignee name signals a user error and writes nothing." + (test-pearl--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:END:\n" + (cl-letf (((symbol-function 'pearl--resolve-team-id) (lambda (&rest _) nil))) + (should-error (pearl-edit-assignee "Nobody") :type 'user-error)))) -(ert-deftest test-pearl-set-assignee-not-on-issue-errors () - "Setting an assignee outside a Linear issue heading signals a user error." +(ert-deftest test-pearl-edit-assignee-not-on-issue-errors () + "edit-assignee outside a Linear issue heading signals a user error." (test-pearl--in-org "* Plain heading\nno id\n" - (should-error (pearl-set-assignee "Craig") :type 'user-error))) - -(ert-deftest test-pearl-set-assignee-failure-preserves-drawer () - "A failed assignee push attempts the mutation but leaves the drawer unchanged." - (let (pushed) - (test-pearl--in-org - "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-ASSIGNEE-ID: old\n:LINEAR-ASSIGNEE-NAME: Someone\n:END:\n" - (cl-letf (((symbol-function 'pearl--resolve-team-id) - (lambda (_kind _name _team &optional _force) "u9")) - ((symbol-function 'pearl--update-issue-async) - (lambda (_id input cb) (setq pushed input) (funcall cb '(:success nil))))) - (pearl-set-assignee "Craig") - (should (string= "u9" (cdr (assoc "assigneeId" pushed)))) - (should (string= "Someone" (org-entry-get nil "LINEAR-ASSIGNEE-NAME"))) - (should (string= "old" (org-entry-get nil "LINEAR-ASSIGNEE-ID"))))))) + (should-error (pearl-edit-assignee "Craig") :type 'user-error))) -;;; set-labels +;;; edit-labels (buffer-editor: writes the drawer + live ids, no push) -(ert-deftest test-pearl-set-labels-pushes-ids-and-updates-drawer () - "Setting labels resolves each name, pushes the id list, and updates the drawer." +(ert-deftest test-pearl-edit-labels-writes-names-and-ids-no-push () + "edit-labels resolves each name, writes LINEAR-LABELS + LINEAR-LABEL-IDS, no push." (let ((pushed nil)) (test-pearl--in-org "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-LABELS: []\n:END:\n" @@ -96,47 +78,30 @@ (lambda (_kind name _team &optional _force) (pcase name ("bug" "l1") ("p1" "l2") (_ nil)))) ((symbol-function 'pearl--update-issue-async) - (lambda (_id input cb) (setq pushed input) (funcall cb '(:success t))))) - (pearl-set-labels '("bug" "p1")) - (should (equal '("l1" "l2") (cdr (assoc "labelIds" pushed)))) - (should (string= "[bug, p1]" (org-entry-get nil "LINEAR-LABELS"))))))) - -(ert-deftest test-pearl-set-labels-clear-pushes-empty () - "Clearing labels (empty list) pushes an empty id list and empties the drawer." - (let ((pushed 'unset)) - (test-pearl--in-org - "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-LABELS: [bug]\n:END:\n" - (cl-letf (((symbol-function 'pearl--update-issue-async) - (lambda (_id input cb) (setq pushed input) (funcall cb '(:success t))))) - (pearl-set-labels '()) - (should (equal '() (cdr (assoc "labelIds" pushed)))) - (should (string= "[]" (org-entry-get nil "LINEAR-LABELS"))))))) + (lambda (&rest _) (setq pushed t)))) + (pearl-edit-labels '("bug" "p1")) + (should-not pushed) + (should (string= "[bug, p1]" (org-entry-get nil "LINEAR-LABELS"))) + (should (string= "l1 l2" (org-entry-get nil "LINEAR-LABEL-IDS"))))))) -(ert-deftest test-pearl-set-labels-unresolvable-errors () - "An unresolvable label name signals a user error and pushes nothing." +(ert-deftest test-pearl-edit-labels-clear-writes-empty () + "Clearing labels writes an empty drawer and empty id set, no push." (let ((pushed nil)) (test-pearl--in-org - "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:END:\n" - (cl-letf (((symbol-function 'pearl--resolve-team-id) - (lambda (&rest _) nil)) - ((symbol-function 'pearl--update-issue-async) + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-LABELS: [bug]\n:LINEAR-LABEL-IDS: l1\n:END:\n" + (cl-letf (((symbol-function 'pearl--update-issue-async) (lambda (&rest _) (setq pushed t)))) - (should-error (pearl-set-labels '("ghost")) :type 'user-error) - (should-not pushed))))) - -(ert-deftest test-pearl-set-labels-failure-preserves-drawer () - "A failed labels push attempts the mutation but leaves the labels drawer unchanged." - (let (pushed) - (test-pearl--in-org - "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-LABELS: [bug]\n:END:\n" - (cl-letf (((symbol-function 'pearl--resolve-team-id) - (lambda (_kind name _team &optional _force) - (pcase name ("p1" "l2") (_ nil)))) - ((symbol-function 'pearl--update-issue-async) - (lambda (_id input cb) (setq pushed input) (funcall cb '(:success nil))))) - (pearl-set-labels '("p1")) - (should (equal '("l2") (cdr (assoc "labelIds" pushed)))) - (should (string= "[bug]" (org-entry-get nil "LINEAR-LABELS"))))))) + (pearl-edit-labels '()) + (should-not pushed) + (should (string= "[]" (org-entry-get nil "LINEAR-LABELS"))) + (should (string= "" (org-entry-get nil "LINEAR-LABEL-IDS"))))))) + +(ert-deftest test-pearl-edit-labels-unresolvable-errors () + "An unresolvable label name signals a user error and writes nothing." + (test-pearl--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:END:\n" + (cl-letf (((symbol-function 'pearl--resolve-team-id) (lambda (&rest _) nil))) + (should-error (pearl-edit-labels '("ghost")) :type 'user-error)))) (provide 'test-pearl-assignee-labels) ;;; test-pearl-assignee-labels.el ends here diff --git a/tests/test-pearl-bugfixes.el b/tests/test-pearl-bugfixes.el index caab884..7f5c635 100644 --- a/tests/test-pearl-bugfixes.el +++ b/tests/test-pearl-bugfixes.el @@ -151,30 +151,5 @@ (should-error (pearl-run-saved-query "bad") :type 'user-error) (should-not fetched)))) -;;; Bug: async issue callbacks must be harmless if the buffer is killed - -(ert-deftest test-pearl-push-issue-field-killed-buffer-no-signal () - "A field push whose buffer is killed before the success callback does not signal." - (let ((buf (generate-new-buffer "pearl-pif-kill"))) - (unwind-protect - (let (marker) - (with-current-buffer buf - (insert "* h\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nbody\n") - (org-mode) - (goto-char (point-min)) - (setq marker (point-marker))) - ;; The update stub kills the buffer, then reports success; the success - ;; callback must not run its buffer ops (or signal) on a dead buffer. - (cl-letf (((symbol-function 'pearl--update-issue-async) - (lambda (_id _fields cb) (kill-buffer buf) (funcall cb '(:success t))))) - ;; Must complete without signaling; the on-success thunk (which would - ;; error) must not run because the buffer is dead. - (pearl--push-issue-field - "a" marker '(("priority" . 2)) - (lambda () (error "on-success must not run against a dead buffer")) - "ok" "fail") - (should-not (buffer-live-p buf)))) - (when (buffer-live-p buf) (kill-buffer buf))))) - (provide 'test-pearl-bugfixes) ;;; test-pearl-bugfixes.el ends here diff --git a/tests/test-pearl-compose.el b/tests/test-pearl-compose.el index bda75cb..a96a9ca 100644 --- a/tests/test-pearl-compose.el +++ b/tests/test-pearl-compose.el @@ -22,7 +22,7 @@ ;; Tests for the shared compose buffer (`pearl--compose-in-buffer' and its ;; submit/abort/body helpers) and the two commands wired onto it: ;; `pearl-add-comment' (interactive composer path) and -;; `pearl-compose-current-description'. The body is extracted below a read-only +;; `pearl-edit-description'. The body is extracted below a read-only ;; header and converted Org->Markdown by the callers. ;;; Code: @@ -129,7 +129,7 @@ Binds `captured' to the value the on-finish receives (or `:none'). Stubs (should-not composed) (should (string= "literal body" sent)))))) -;;; compose-current-description wiring +;;; edit-description wiring (ert-deftest test-pearl-compose-description-seeds-body-and-syncs () "The description composer seeds the current body and, on submit, writes it back and syncs." @@ -141,7 +141,7 @@ Binds `captured' to the value the on-finish receives (or `:none'). Stubs (funcall on-finish "Edited description"))) ((symbol-function 'pearl-sync-current-issue) (lambda () (setq synced t)))) - (pearl-compose-current-description) + (pearl-edit-description) ;; seeded with the existing body (should (string= "Body." seeded)) ;; the edited text was written into the issue body, then synced diff --git a/tests/test-pearl-fields.el b/tests/test-pearl-fields.el index 3722486..2ad9679 100644 --- a/tests/test-pearl-fields.el +++ b/tests/test-pearl-fields.el @@ -86,38 +86,9 @@ (should (string-match-p "^\\*\\*\\* TODO Title" (thing-at-point 'line t))) (should-not (string-match-p "\\[#" (thing-at-point 'line t))))) -;;; pearl-set-priority - -(ert-deftest test-pearl-set-priority-pushes-and-updates-cookie () - "Setting priority pushes the numeric value and rewrites the cookie." - (let ((pushed nil)) - (test-pearl--in-org "*** TODO [#C] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\n" - (cl-letf (((symbol-function 'pearl--update-issue-async) - (lambda (_id input cb) (setq pushed input) (funcall cb '(:success t))))) - (re-search-forward "Title") - (pearl-set-priority "High") - (should (equal 2 (cdr (assoc "priority" pushed)))) - (goto-char (point-min)) - (should (string-match-p "\\[#B\\]" (thing-at-point 'line t))))))) - -(ert-deftest test-pearl-set-priority-not-on-issue-errors () - "Setting priority outside a Linear issue heading signals a user error." - (test-pearl--in-org "* Plain heading\nno id\n" - (should-error (pearl-set-priority "High") :type 'user-error))) - -(ert-deftest test-pearl-set-priority-failure-preserves-cookie () - "A failed priority push attempts the mutation but leaves the cookie unchanged." - (let (pushed) - (test-pearl--in-org "*** TODO [#C] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\n" - (cl-letf (((symbol-function 'pearl--update-issue-async) - (lambda (_id input cb) (setq pushed input) (funcall cb '(:success nil))))) - (re-search-forward "Title") - (pearl-set-priority "High") - ;; the push was attempted with the intended value ... - (should (equal 2 (cdr (assoc "priority" pushed)))) - ;; ... but the local cookie is still #C, not #B. - (goto-char (point-min)) - (should (string-match-p "^\\*\\*\\* TODO \\[#C\\] Title" (thing-at-point 'line t))))))) +;; pearl-set-priority is gone: priority is edited org-natively via the heading +;; cookie and reconciled at save (see test-pearl-save). The cookie writer +;; `pearl--set-priority-cookie' above is still exercised. ;;; --set-heading-state @@ -140,10 +111,10 @@ (pearl--set-heading-state "Done" "s3") (should-not fired))))) -;;; pearl-set-state +;;; pearl-edit-state (buffer-editor: writes the representation, no push) -(ert-deftest test-pearl-set-state-pushes-id-and-updates-heading () - "Setting state resolves the name to an id, pushes it, and updates the heading." +(ert-deftest test-pearl-edit-state-writes-heading-no-push () + "edit-state resolves the name, writes keyword/name/id, and does not push." (let ((pushed nil)) (test-pearl--in-org "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:END:\n" @@ -151,34 +122,18 @@ (lambda (_team) '(((id . "s1") (name . "Todo")) ((id . "s2") (name . "In Progress"))))) ((symbol-function 'pearl--update-issue-async) - (lambda (_id input cb) (setq pushed input) (funcall cb '(:success t))))) - (pearl-set-state "In Progress") - (should (string= "s2" (cdr (assoc "stateId" pushed)))) + (lambda (&rest _) (setq pushed t)))) + (pearl-edit-state "In Progress") + (should-not pushed) (goto-char (point-min)) (should (string-match-p "^\\*\\*\\* IN-PROGRESS " (thing-at-point 'line t))) - (should (string= "In Progress" (org-entry-get nil "LINEAR-STATE-NAME"))))))) + (should (string= "In Progress" (org-entry-get nil "LINEAR-STATE-NAME"))) + (should (string= "s2" (org-entry-get nil "LINEAR-STATE-ID"))))))) -(ert-deftest test-pearl-set-state-not-on-issue-errors () - "Setting state outside a Linear issue heading signals a user error." +(ert-deftest test-pearl-edit-state-not-on-issue-errors () + "edit-state outside a Linear issue heading signals a user error." (test-pearl--in-org "* Plain heading\nno id\n" - (should-error (pearl-set-state "Done") :type 'user-error))) - -(ert-deftest test-pearl-set-state-failure-preserves-keyword-and-drawer () - "A failed state push attempts the mutation but leaves the keyword and drawer unchanged." - (let (pushed) - (test-pearl--in-org - "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: team-1\n:LINEAR-STATE-ID: s1\n:LINEAR-STATE-NAME: Todo\n:END:\n" - (cl-letf (((symbol-function 'pearl--team-states) - (lambda (_t) '(((id . "s1") (name . "Todo")) - ((id . "s2") (name . "In Progress"))))) - ((symbol-function 'pearl--update-issue-async) - (lambda (_id input cb) (setq pushed input) (funcall cb '(:success nil))))) - (pearl-set-state "In Progress") - (should (string= "s2" (cdr (assoc "stateId" pushed)))) - (goto-char (point-min)) - (should (string-match-p "^\\*\\*\\* TODO " (thing-at-point 'line t))) - (should (string= "Todo" (org-entry-get nil "LINEAR-STATE-NAME"))) - (should (string= "s1" (org-entry-get nil "LINEAR-STATE-ID"))))))) + (should-error (pearl-edit-state "Done") :type 'user-error))) (provide 'test-pearl-fields) ;;; test-pearl-fields.el ends here diff --git a/tests/test-pearl-keymap.el b/tests/test-pearl-keymap.el index 260b6fa..7cfc603 100644 --- a/tests/test-pearl-keymap.el +++ b/tests/test-pearl-keymap.el @@ -45,15 +45,16 @@ Walks MAP looking for a labeled binding (\"label\" . COMMAND)." (should (keymapp pearl-prefix-map))) (ert-deftest test-pearl-prefix-map-resolves-leaf-commands () - "Each chord resolves to its command (existing names, not yet renamed)." + "Each chord resolves to its command." (should (eq 'pearl-save-issue (lookup-key pearl-prefix-map (kbd "s s")))) (should (eq 'pearl-save-all (lookup-key pearl-prefix-map (kbd "s a")))) - (should (eq 'pearl-compose-current-description (lookup-key pearl-prefix-map (kbd "e d")))) + (should (eq 'pearl-edit-description (lookup-key pearl-prefix-map (kbd "e d")))) (should (eq 'pearl-edit-current-comment (lookup-key pearl-prefix-map (kbd "e c")))) - (should (eq 'pearl-set-priority (lookup-key pearl-prefix-map (kbd "e p")))) - (should (eq 'pearl-set-state (lookup-key pearl-prefix-map (kbd "e s")))) - (should (eq 'pearl-set-assignee (lookup-key pearl-prefix-map (kbd "e a")))) - (should (eq 'pearl-set-labels (lookup-key pearl-prefix-map (kbd "e l")))) + (should (eq 'pearl-edit-state (lookup-key pearl-prefix-map (kbd "e s")))) + (should (eq 'pearl-edit-assignee (lookup-key pearl-prefix-map (kbd "e a")))) + (should (eq 'pearl-edit-labels (lookup-key pearl-prefix-map (kbd "e l")))) + ;; priority has no edit command (org-native cookie); e p is unbound + (should-not (lookup-key pearl-prefix-map (kbd "e p"))) (should (eq 'pearl-new-issue (lookup-key pearl-prefix-map (kbd "n t")))) (should (eq 'pearl-add-comment (lookup-key pearl-prefix-map (kbd "n c")))) (should (eq 'pearl-delete-current-issue (lookup-key pearl-prefix-map (kbd "d t")))) @@ -77,10 +78,10 @@ Walks MAP looking for a labeled binding (\"label\" . COMMAND)." (ert-deftest test-pearl-prefix-map-which-key-labels () "Leaf bindings carry the edit/new verb labels; sub-prefixes carry +labels." - (should (string= "edit priority" - (test-pearl-keymap--label-of pearl-edit-map 'pearl-set-priority))) + (should (string= "edit state" + (test-pearl-keymap--label-of pearl-edit-map 'pearl-edit-state))) (should (string= "edit description" - (test-pearl-keymap--label-of pearl-edit-map 'pearl-compose-current-description))) + (test-pearl-keymap--label-of pearl-edit-map 'pearl-edit-description))) (should (string= "new ticket" (test-pearl-keymap--label-of pearl-new-map 'pearl-new-issue))) (should (string= "new comment" diff --git a/tests/test-pearl-menu.el b/tests/test-pearl-menu.el index 8af4bb8..5964d31 100644 --- a/tests/test-pearl-menu.el +++ b/tests/test-pearl-menu.el @@ -64,7 +64,7 @@ menu entry that still points at it fails here." pearl-run-saved-query pearl-save-issue pearl-save-all - pearl-set-state + pearl-edit-state pearl-add-comment pearl-new-issue pearl-delete-current-issue)) diff --git a/tests/test-pearl-output.el b/tests/test-pearl-output.el index 6eafbb4..eb5c671 100644 --- a/tests/test-pearl-output.el +++ b/tests/test-pearl-output.el @@ -52,7 +52,7 @@ (should (string-match-p "^#\\+LINEAR-SOURCE: " out)) (should (string-match-p "^#\\+LINEAR-COUNT: 0$" out)) ;; affordance preamble is present as org comments, not content - (should (string-match-p "^# .*pearl-sync-current-issue" out)))) + (should (string-match-p "^# .*pearl-save-issue" out)))) (ert-deftest test-pearl-build-org-content-source-roundtrips () "The serialized source in the header reads back to the original plist." |