diff options
| -rw-r--r-- | README.org | 15 | ||||
| -rw-r--r-- | pearl.el | 149 | ||||
| -rw-r--r-- | tests/test-pearl-mapping.el | 28 | ||||
| -rw-r--r-- | tests/test-pearl-save.el | 75 | ||||
| -rw-r--r-- | tests/test-pearl-todo-keywords.el | 22 |
5 files changed, 209 insertions, 80 deletions
@@ -221,19 +221,12 @@ Only comments you authored are editable or deletable. Pearl refuses edits and de *** State and the TODO keyword -=pearl-state-to-todo-mapping= maps Linear state names to Org TODO keywords, so a fetched issue renders with a keyword you recognize: +A fetched issue renders with a TODO keyword derived from its Linear state name: the name is slugified (upcased, non-alphanumeric runs collapsed to hyphens), so "In Progress" becomes =IN-PROGRESS= and "Dev Review" becomes =DEV-REVIEW=. The buffer's =#+TODO= line is built from the real workflow states of the teams on display, so every keyword you see is a state that team actually has, partitioned active / done by Linear's state type. -#+begin_src emacs-lisp - (setq pearl-state-to-todo-mapping - '(("Todo" . "TODO") - ("In Progress" . "IN-PROGRESS") - ("In Review" . "IN-REVIEW") - ("Backlog" . "BACKLOG") - ("Blocked" . "BLOCKED") - ("Done" . "DONE"))) -#+end_src +You change a ticket's state two ways, both reconciled and pushed at the next save: -Make sure your =org-todo-keywords= include every keyword you map to. Change a ticket's state with =pearl-edit-state=, which reaches every state on the team -- including ones the keyword set doesn't cover. (Cycling the keyword to drive the state change directly, and deriving the keyword set from the team's real states, are planned follow-ups.) +- Cycle the keyword with =C-c C-t= (or =S-<right>= / =S-<left>=). The keyword you cycle to is matched back to a team state by the same slug rule, so cycling =TODO= → =IN-PROGRESS= moves the ticket to the "In Progress" state. A keyword no team state slugifies to can't be resolved, so that save is reported skipped. +- =pearl-edit-state= completes over every state on the team and writes the keyword for you. Use it to reach a state whose keyword you don't remember, or one the visible keyword set doesn't cover. ** The Org File :PROPERTIES: @@ -1530,12 +1530,6 @@ there is no network lookup here." ;;; Mapping Functions -(defun pearl--map-linear-state-to-org (state) - "Map Linear STATE name to an Org TODO keyword string. -STATE is the Linear state string." - (or (cdr (assoc state pearl-state-to-todo-mapping)) - "TODO")) ; Default fallback - (defun pearl--state-name-to-keyword (name) "Slugify a Linear state NAME to an Org TODO keyword. Upcased, each run of non-alphanumerics replaced by a single hyphen (alnum is @@ -2670,16 +2664,17 @@ locally so #D is accepted regardless of the user's `org-priority' settings." (defun pearl--set-heading-state (state-name state-id) "Update the heading at point to STATE-NAME / STATE-ID. -Rewrites the TODO keyword (mapped from STATE-NAME) and the LINEAR-STATE-NAME / -LINEAR-STATE-ID drawer properties. `org-after-todo-state-change-hook' is bound -to nil during the keyword change so programmatically setting the keyword does -not fire any todo-change hooks the user has installed." +Rewrites the TODO keyword (the slug of STATE-NAME, matching the derived +`#+TODO' header) and the LINEAR-STATE-NAME / LINEAR-STATE-ID drawer properties. +`org-after-todo-state-change-hook' is bound to nil during the keyword change so +programmatically setting the keyword does not fire any todo-change hooks the +user has installed." (save-excursion (org-back-to-heading t) (org-entry-put nil "LINEAR-STATE-NAME" state-name) (org-entry-put nil "LINEAR-STATE-ID" state-id) (let ((org-after-todo-state-change-hook nil)) - (org-todo (pearl--map-linear-state-to-org state-name))))) + (org-todo (pearl--state-name-to-keyword state-name))))) ;;;###autoload (defun pearl-edit-state (state-name) @@ -3251,15 +3246,45 @@ not dirty." #'string<) (sort (split-string base " " t) #'string<)))))) +(defun pearl--state-keyword-cycled-p () + "Non-nil when the heading's TODO keyword no longer matches the synced state. +Network-free: compares `org-get-todo-state' against the slug of +`LINEAR-STATE-NAME' (`pearl--state-name-to-keyword'). A heading with no +keyword or no recorded state name can't be judged cycled, so it returns nil. +The concrete state id the keyword resolves to is determined in the saver +(`pearl--resolve-keyword-to-state'), not here -- this scan stays local." + (let ((kw (org-get-todo-state)) + (name (org-entry-get nil "LINEAR-STATE-NAME"))) + (and kw name (not (string-empty-p name)) + (not (string= kw (pearl--state-name-to-keyword name)))))) + +(defun pearl--resolve-keyword-to-state (keyword team-id) + "Resolve KEYWORD to a TEAM-ID workflow state by slug match. +Returns a plist (:id :name :type) for the first state -- by `position' -- whose +name slugifies to KEYWORD, or nil when none match (a stale or hand-typed +keyword). Uses the cached team states; a failed or empty fetch yields nil." + (let (best best-pos) + (dolist (node (ignore-errors (pearl--team-states team-id))) + (when (string= keyword (pearl--state-name-to-keyword (cdr (assoc 'name node)))) + (let ((pos (or (cdr (assoc 'position node)) most-positive-fixnum))) + (when (or (null best) (< pos best-pos)) + (setq best (list :id (cdr (assoc 'id node)) + :name (cdr (assoc 'name node)) + :type (cdr (assoc 'type node))) + best-pos pos))))) + best)) + (defun pearl--issue-dirty-fields () "Return the locally-changed fields of the issue subtree at point, no network. A plist: `:title', `:description', `:priority', `:state', `:assignee', and `:labels' are booleans; `:comment-candidates' is the list from `pearl--changed-comment-candidates'. The structured-field checks compare each live value against its synced baseline (id/scalar only, no name resolution or -remote read). `:state' here is the picker arm only -- explicit -`LINEAR-STATE-ID' vs `LINEAR-STATE-ID-SYNCED'; the keyword-cycle arm is gated -on keyword derivation (a later task). This is Phase A of the two-phase save +remote read). `:state' has two arms: the picker arm (explicit +`LINEAR-STATE-ID' vs `LINEAR-STATE-ID-SYNCED') and the keyword-cycle arm +(`pearl--state-keyword-cycled-p' -- the keyword slug diverged from +`LINEAR-STATE-NAME'); either marks state dirty. This is Phase A of the +two-phase save scan -- comment ownership is classified separately once the viewer id is known (see `pearl--classify-comment-candidates')." (save-excursion @@ -3268,7 +3293,8 @@ scan -- comment ownership is classified separately once the viewer id is known (or (org-entry-get nil "LINEAR-TITLE-SHA256") ""))) :description (pearl--subtree-dirty-p) :priority (pearl--priority-dirty-p) - :state (pearl--id-baseline-dirty-p "LINEAR-STATE-ID" "LINEAR-STATE-ID-SYNCED") + :state (or (pearl--id-baseline-dirty-p "LINEAR-STATE-ID" "LINEAR-STATE-ID-SYNCED") + (pearl--state-keyword-cycled-p)) :assignee (pearl--id-baseline-dirty-p "LINEAR-ASSIGNEE-ID" "LINEAR-ASSIGNEE-ID-SYNCED") :labels (pearl--label-ids-dirty-p) :comment-candidates (pearl--changed-comment-candidates)))) @@ -3716,42 +3742,69 @@ The live value is the heading cookie's number, diffed against `LINEAR-PRIORITY'. (defun pearl--save-state-field (marker callback) "Save the workflow state of the issue subtree at MARKER, calling CALLBACK. -The picker arm: the explicit `LINEAR-STATE-ID' is diffed against -`LINEAR-STATE-ID-SYNCED'. A push sends `stateId'." +Two arms reach the live state id. Picker arm: the explicit `LINEAR-STATE-ID' +moved off `LINEAR-STATE-ID-SYNCED', and that id is the live value. +Keyword-cycle arm: the id is unmoved but the TODO keyword diverged from +`LINEAR-STATE-NAME', so the keyword resolves to a team state id by slug match +\(`pearl--resolve-keyword-to-state'). A keyword no team state matches can't be +resolved, so the save is skipped. A push sends `stateId'." (org-with-point-at marker (let* ((issue-id (org-entry-get nil "LINEAR-ID")) (identifier (org-entry-get nil "LINEAR-IDENTIFIER")) - (live (or (org-entry-get nil "LINEAR-STATE-ID") "")) - (remote-node nil) - (spec - (list - :issue-id issue-id :identifier identifier :field 'state - :marker marker :label (format "%s state" (or identifier issue-id)) - :live live - :baseline (org-entry-get nil "LINEAR-STATE-ID-SYNCED") - :equal #'string= - :live-display (or (org-entry-get nil "LINEAR-STATE-NAME") "") - :remote-display (lambda (_id) (pearl--node-state-name remote-node)) - :fetch-remote - (lambda (cb) - (pearl--fetch-issue-async - issue-id - (lambda (node) - (if (memq node '(:error :missing)) - (funcall cb :error) - (setq remote-node node) - (funcall cb (pearl--node-state-id node)))))) - :push - (lambda (cb) - (pearl--update-issue-async issue-id (list (cons "stateId" live)) cb)) - :commit-local - (lambda () (org-entry-put marker "LINEAR-STATE-ID-SYNCED" live)) - :commit-remote - (lambda (remote-id) - (org-with-point-at marker - (pearl--set-heading-state (pearl--node-state-name remote-node) remote-id)) - (org-entry-put marker "LINEAR-STATE-ID-SYNCED" remote-id))))) - (pearl--run-atomic-field-save spec callback)))) + (label (format "%s state" (or identifier issue-id))) + (explicit-id (or (org-entry-get nil "LINEAR-STATE-ID") "")) + (synced (org-entry-get nil "LINEAR-STATE-ID-SYNCED")) + (name (or (org-entry-get nil "LINEAR-STATE-NAME") "")) + (picker-dirty (pearl--id-baseline-dirty-p + "LINEAR-STATE-ID" "LINEAR-STATE-ID-SYNCED")) + (cycled (and (not picker-dirty) (pearl--state-keyword-cycled-p))) + (resolved (and cycled + (pearl--resolve-keyword-to-state + (org-get-todo-state) + (org-entry-get nil "LINEAR-TEAM-ID")))) + (live (if cycled (and resolved (plist-get resolved :id)) explicit-id)) + (live-name (if cycled (and resolved (plist-get resolved :name)) name)) + (remote-node nil)) + (if (and cycled (not resolved)) + ;; The keyword was cycled to one no team state slugifies to -- there's + ;; no id to push. Report it skipped rather than guessing. + (funcall callback + (pearl--save-outcome + (list :issue-id issue-id :identifier identifier + :field 'state :label label) + 'skipped 'unknown-keyword)) + (let ((spec + (list + :issue-id issue-id :identifier identifier :field 'state + :marker marker :label label + :live live + :baseline synced + :equal #'string= + :live-display live-name + :remote-display (lambda (_id) (pearl--node-state-name remote-node)) + :fetch-remote + (lambda (cb) + (pearl--fetch-issue-async + issue-id + (lambda (node) + (if (memq node '(:error :missing)) + (funcall cb :error) + (setq remote-node node) + (funcall cb (pearl--node-state-id node)))))) + :push + (lambda (cb) + (pearl--update-issue-async issue-id (list (cons "stateId" live)) cb)) + :commit-local + (lambda () + (org-with-point-at marker + (pearl--set-heading-state live-name live)) + (org-entry-put marker "LINEAR-STATE-ID-SYNCED" live)) + :commit-remote + (lambda (remote-id) + (org-with-point-at marker + (pearl--set-heading-state (pearl--node-state-name remote-node) remote-id)) + (org-entry-put marker "LINEAR-STATE-ID-SYNCED" remote-id))))) + (pearl--run-atomic-field-save spec callback)))))) (defun pearl--save-labels-field (marker callback) "Save the labels of the issue subtree at MARKER, calling CALLBACK. diff --git a/tests/test-pearl-mapping.el b/tests/test-pearl-mapping.el index 2a96163..b5faa3d 100644 --- a/tests/test-pearl-mapping.el +++ b/tests/test-pearl-mapping.el @@ -37,27 +37,13 @@ (pearl--todo-states-pattern-source nil)) ,@body)) -;;; pearl--map-linear-state-to-org - -(ert-deftest test-pearl-map-linear-state-to-org-mapped-returns-keyword () - "A Linear state present in the mapping returns its org keyword." - (test-pearl--with-mapping '(("Todo" . "TODO") ("In Progress" . "DOING")) - (should (string-equal "DOING" (pearl--map-linear-state-to-org "In Progress"))))) - -(ert-deftest test-pearl-map-linear-state-to-org-unmapped-defaults-todo () - "An unmapped Linear state falls back to TODO." - (test-pearl--with-mapping '(("Todo" . "TODO") ("Done" . "DONE")) - (should (string-equal "TODO" (pearl--map-linear-state-to-org "Triage"))))) - -(ert-deftest test-pearl-map-linear-state-to-org-nil-defaults-todo () - "A nil state falls back to TODO rather than erroring." - (test-pearl--with-mapping '(("Todo" . "TODO")) - (should (string-equal "TODO" (pearl--map-linear-state-to-org nil))))) - -;; pearl--map-org-state-to-linear (the keyword->state reverse map) was removed -;; with the org-sync push path in save-model-v2; the keyword-cycle save will -;; resolve through the team's states (the keyword-derivation task), not a flat -;; reverse mapping. +;; pearl--map-linear-state-to-org (the static name->keyword lookup) was removed +;; in the keyword-cycle save: the keyword is now always the slug of the state +;; name (`pearl--state-name-to-keyword'), matching the workspace-derived #+TODO +;; header, and the keyword->state-id direction resolves through the team's +;; states (`pearl--resolve-keyword-to-state'), not a flat mapping. The mapping +;; alist itself survives only as the source for `pearl--get-todo-states-pattern' +;; (tested below). ;;; pearl--get-todo-states-pattern diff --git a/tests/test-pearl-save.el b/tests/test-pearl-save.el index 1f4f273..22df84e 100644 --- a/tests/test-pearl-save.el +++ b/tests/test-pearl-save.el @@ -153,6 +153,21 @@ (org-entry-put nil "LINEAR-STATE-ID" "s2") (should (plist-get (pearl--issue-dirty-fields) :state)))) +(ert-deftest test-pearl-dirty-fields-state-keyword-cycle () + "Cycling the TODO keyword away from the synced state-name slug marks state dirty, +even when the explicit state id still matches its baseline." + (test-pearl-save--in-rendered (test-pearl-save--structured-issue) + (org-back-to-heading t) + (let ((org-after-todo-state-change-hook nil)) + (org-todo "DONE")) ; TODO -> DONE, id untouched + (should (plist-get (pearl--issue-dirty-fields) :state)))) + +(ert-deftest test-pearl-dirty-fields-state-fresh-keyword-not-dirty () + "A freshly rendered state (keyword equals the state-name slug) is not state dirty." + (test-pearl-save--in-rendered (test-pearl-save--structured-issue) + (org-back-to-heading t) + (should-not (plist-get (pearl--issue-dirty-fields) :state)))) + (ert-deftest test-pearl-dirty-fields-assignee-change () "An assignee id different from the synced baseline marks assignee dirty." (test-pearl-save--in-rendered (test-pearl-save--structured-issue) @@ -495,6 +510,66 @@ skipped (the remote push already landed), not signal." (should (string= "s2" pushed)) (should (string= "s2" (org-entry-get marker "LINEAR-STATE-ID-SYNCED"))))))) +(ert-deftest test-pearl-save-state-keyword-cycle-resolves-and-pushes () + "A keyword-cycled state (id unmoved) resolves the keyword to its team state id +by slug match, pushes that id, and writes the resolved name/id/baseline." + (test-pearl-save--in-rendered + '(:id "u" :identifier "ENG-1" :title "t" :priority 2 + :state (:id "s1" :name "Todo") :description "body") + (goto-char (point-min)) + (insert "#+TODO: TODO IN-PROGRESS | DONE\n") + (org-mode) ; re-init so the keywords take + (goto-char (point-min)) + (re-search-forward "ENG-1") + (org-back-to-heading t) + (org-entry-put nil "LINEAR-TEAM-ID" "team-1") + (progn + (let ((org-after-todo-state-change-hook nil)) + (org-todo "IN-PROGRESS")) ; cycle keyword, leave id = s1 + (let ((marker (point-marker)) outcome pushed) + (cl-letf (((symbol-function 'pearl--team-states) + (lambda (_tid) + '(((id . "s1") (name . "Todo") (type . "unstarted") (position . 1.0)) + ((id . "s2") (name . "In Progress") (type . "started") (position . 2.0))))) + ((symbol-function 'pearl--fetch-issue-async) + (lambda (_id cb) (funcall cb '((state (id . "s1") (name . "Todo")))))) + ((symbol-function 'pearl--update-issue-async) + (lambda (_id input cb) + (setq pushed (cdr (assoc "stateId" input))) + (funcall cb '(:success t))))) + (pearl--save-state-field marker (lambda (o) (setq outcome o))) + (should (eq 'pushed (plist-get outcome :status))) + (should (string= "s2" pushed)) + (should (string= "s2" (org-entry-get marker "LINEAR-STATE-ID"))) + (should (string= "In Progress" (org-entry-get marker "LINEAR-STATE-NAME"))) + (should (string= "s2" (org-entry-get marker "LINEAR-STATE-ID-SYNCED")))))))) + +(ert-deftest test-pearl-save-state-keyword-cycle-unknown-keyword-skips () + "A keyword no team state slugifies to cannot be resolved, so the save is skipped +with no push." + (test-pearl-save--in-rendered + '(:id "u" :identifier "ENG-1" :title "t" :priority 2 + :state (:id "s1" :name "Todo") :description "body") + (goto-char (point-min)) + (insert "#+TODO: TODO BLOCKED | DONE\n") + (org-mode) + (goto-char (point-min)) + (re-search-forward "ENG-1") + (org-back-to-heading t) + (org-entry-put nil "LINEAR-TEAM-ID" "team-1") + (progn + (let ((org-after-todo-state-change-hook nil)) + (org-todo "BLOCKED")) ; no team state slugifies to BLOCKED + (let ((marker (point-marker)) outcome (pushed :none)) + (cl-letf (((symbol-function 'pearl--team-states) + (lambda (_tid) + '(((id . "s1") (name . "Todo") (type . "unstarted") (position . 1.0))))) + ((symbol-function 'pearl--update-issue-async) + (lambda (_id _input cb) (setq pushed :called) (funcall cb '(:success t))))) + (pearl--save-state-field marker (lambda (o) (setq outcome o))) + (should (eq 'skipped (plist-get outcome :status))) + (should (eq :none pushed))))))) + (ert-deftest test-pearl-save-labels-clean-push-advances-baseline () "A changed label set with an unmoved remote pushes labelIds and advances the baseline." (test-pearl-save--in-rendered diff --git a/tests/test-pearl-todo-keywords.el b/tests/test-pearl-todo-keywords.el index 281beea..0555a4e 100644 --- a/tests/test-pearl-todo-keywords.el +++ b/tests/test-pearl-todo-keywords.el @@ -150,5 +150,27 @@ ;; SHIPPED is an org done-keyword, so it lands on the done side (should (re-search-forward "^#\\+TODO: *\\| SHIPPED$" nil t))))) +;;; --resolve-keyword-to-state (keyword -> team state id, save-time) + +(ert-deftest test-pearl-resolve-keyword-to-state-collision-first-by-position () + "When two state names slugify to the same keyword, the lower position wins." + (cl-letf (((symbol-function 'pearl--team-states) + (lambda (_tid) + '(((id . "s-hi") (name . "Dev Review") (type . "started") (position . 5.0)) + ((id . "s-lo") (name . "Dev-Review") (type . "started") (position . 2.0)))))) + (let ((r (pearl--resolve-keyword-to-state "DEV-REVIEW" "t1"))) + (should (string= "s-lo" (plist-get r :id))) + (should (string= "Dev-Review" (plist-get r :name))) + (should (string= "started" (plist-get r :type)))))) + +(ert-deftest test-pearl-resolve-keyword-to-state-no-match-or-empty-returns-nil () + "A keyword no state slugifies to yields nil, as does an empty/failed fetch." + (cl-letf (((symbol-function 'pearl--team-states) + (lambda (_tid) + '(((id . "s1") (name . "Todo") (type . "unstarted") (position . 1.0)))))) + (should-not (pearl--resolve-keyword-to-state "BLOCKED" "t1"))) + (cl-letf (((symbol-function 'pearl--team-states) (lambda (_tid) nil))) + (should-not (pearl--resolve-keyword-to-state "TODO" "t1")))) + (provide 'test-pearl-todo-keywords) ;;; test-pearl-todo-keywords.el ends here |