diff options
| author | Craig Jennings <c@cjennings.net> | 2026-05-25 20:26:50 -0500 |
|---|---|---|
| committer | Craig Jennings <c@cjennings.net> | 2026-05-25 20:26:50 -0500 |
| commit | 684068a81103e9a9dace2f5cc6fd49edc1f01ab1 (patch) | |
| tree | 1a38b043c64f77be4370aa9a9c82d6579fbb9a44 | |
| parent | 09cf1f02161aaef9bb1ad26907472bea52f53a24 (diff) | |
| download | pearl-684068a81103e9a9dace2f5cc6fd49edc1f01ab1.tar.gz pearl-684068a81103e9a9dace2f5cc6fd49edc1f01ab1.zip | |
feat(save): add the priority, state, and labels savers
These are three more savers on the atomic engine, each the same spec shape the assignee saver proved, with its own field handling. Priority reads the cookie's number, diffs it against LINEAR-PRIORITY, and pushes priority. State is the picker arm — the explicit LINEAR-STATE-ID against LINEAR-STATE-ID-SYNCED, pushing stateId, with use-remote rewriting the keyword and name from the fetched node (the keyword-cycle arm stays gated on the derivation task). Labels canonicalize the id set to a sorted space-joined string so the diff is order-insensitive, and push labelIds.
Canonicalizing labels to a string also keeps the missing-baseline check honest: an issue with no labels has a present-but-empty baseline, which a nil-vs-empty-list comparison would misread as a legacy file. A shared set of pearl--node-* helpers pulls each field out of the raw issue node.
I also fixed pearl--get-linear-priority-name, which mapped None to "Medium" — it now reads "None", so the conflict prompt names the priority honestly.
It's still not wired into save-issue — the next commit does that.
| -rw-r--r-- | pearl.el | 147 | ||||
| -rw-r--r-- | tests/test-pearl-mapping.el | 10 | ||||
| -rw-r--r-- | tests/test-pearl-save.el | 64 |
3 files changed, 215 insertions, 6 deletions
@@ -1674,7 +1674,7 @@ PRIORITY-NUM is 0=None, 1=Urgent, 2=High, 3=Medium, 4=Low." ((eq priority-num 2) "High") ((eq priority-num 3) "Medium") ((eq priority-num 4) "Low") - (t "Medium"))) + (t "None"))) (defun pearl--md-emphasis-to-org (s) "Convert markdown links / bold / italic in S to Org markup. @@ -3718,6 +3718,151 @@ Picker-authoritative: the live id is `LINEAR-ASSIGNEE-ID', diffed against (org-entry-put marker "LINEAR-ASSIGNEE-ID-SYNCED" remote-id))))) (pearl--run-atomic-field-save spec callback)))) +(defun pearl--node-priority (node) + "The priority number (0-4) of raw issue NODE." + (or (cdr (assoc 'priority node)) 0)) + +(defun pearl--node-state-id (node) + "The state id of raw issue NODE, or \"\"." + (or (cdr (assoc 'id (cdr (assoc 'state node)))) "")) + +(defun pearl--node-state-name (node) + "The state name of raw issue NODE, or \"\"." + (or (cdr (assoc 'name (cdr (assoc 'state node)))) "")) + +(defun pearl--node-label-ids (node) + "The sorted label ids of raw issue NODE." + (sort (mapcar (lambda (l) (or (cdr (assoc 'id l)) "")) + (pearl--node-list (cdr (assoc 'labels node)))) + #'string<)) + +(defun pearl--node-label-names (node) + "The label display names of raw issue NODE, comma-separated." + (mapconcat (lambda (l) (or (cdr (assoc 'name l)) "")) + (pearl--node-list (cdr (assoc 'labels node))) ", ")) + +(defun pearl--save-priority-field (marker callback) + "Save the priority of the issue subtree at MARKER, calling CALLBACK. +The live value is the heading cookie's number, diffed against `LINEAR-PRIORITY'." + (org-with-point-at marker + (let* ((issue-id (org-entry-get nil "LINEAR-ID")) + (identifier (org-entry-get nil "LINEAR-IDENTIFIER")) + (live (pearl--priority-number-at-point)) + (base-str (org-entry-get nil "LINEAR-PRIORITY")) + (spec + (list + :issue-id issue-id :identifier identifier :field 'priority + :marker marker :label (format "%s priority" (or identifier issue-id)) + :live live + :baseline (and base-str (string-to-number base-str)) + :equal #'eql + :live-display (pearl--get-linear-priority-name live) + :remote-display (lambda (n) (pearl--get-linear-priority-name n)) + :fetch-remote + (lambda (cb) + (pearl--fetch-issue-async + issue-id + (lambda (node) + (if (memq node '(:error :missing)) + (funcall cb :error) + (funcall cb (pearl--node-priority node)))))) + :push + (lambda (cb) + (pearl--update-issue-async issue-id (list (cons "priority" live)) cb)) + :commit-local + (lambda () (org-entry-put marker "LINEAR-PRIORITY" (number-to-string live))) + :commit-remote + (lambda (n) + (org-with-point-at marker (pearl--set-priority-cookie n)) + (org-entry-put marker "LINEAR-PRIORITY" (number-to-string n)))))) + (pearl--run-atomic-field-save spec callback)))) + +(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'." + (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)))) + +(defun pearl--save-labels-field (marker callback) + "Save the labels of the issue subtree at MARKER, calling CALLBACK. +The live id set is `LINEAR-LABEL-IDS', diffed order-insensitively against +`LINEAR-LABEL-IDS-SYNCED' (canonicalized to a sorted space-joined string). A +push sends `labelIds'." + (org-with-point-at marker + (let* ((issue-id (org-entry-get nil "LINEAR-ID")) + (identifier (org-entry-get nil "LINEAR-IDENTIFIER")) + (live-ids (sort (split-string + (or (org-entry-get nil "LINEAR-LABEL-IDS") "") " " t) + #'string<)) + (live (string-join live-ids " ")) + (base-str (org-entry-get nil "LINEAR-LABEL-IDS-SYNCED")) + (remote-node nil) + (spec + (list + :issue-id issue-id :identifier identifier :field 'labels + :marker marker :label (format "%s labels" (or identifier issue-id)) + :live live + :baseline (and base-str + (string-join (sort (split-string base-str " " t) #'string<) " ")) + :equal #'string= + :live-display (or (org-entry-get nil "LINEAR-LABELS") "[]") + :remote-display (lambda (_) (format "[%s]" (pearl--node-label-names 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 (string-join (pearl--node-label-ids node) " ")))))) + :push + (lambda (cb) + (pearl--update-issue-async + issue-id (list (cons "labelIds" (vconcat live-ids))) cb)) + :commit-local + (lambda () (org-entry-put marker "LINEAR-LABEL-IDS-SYNCED" live)) + :commit-remote + (lambda (remote-str) + (org-entry-put marker "LINEAR-LABEL-IDS" remote-str) + (org-entry-put marker "LINEAR-LABELS" + (format "[%s]" (pearl--node-label-names remote-node))) + (org-entry-put marker "LINEAR-LABEL-IDS-SYNCED" remote-str))))) + (pearl--run-atomic-field-save spec callback)))) + (defun pearl--save-field-thunks (marker dirty viewer-id) "Build the ordered save thunks for the DIRTY fields of the issue at MARKER. Title first, then description, then each changed comment candidate (VIEWER-ID diff --git a/tests/test-pearl-mapping.el b/tests/test-pearl-mapping.el index d9854cb..17eff82 100644 --- a/tests/test-pearl-mapping.el +++ b/tests/test-pearl-mapping.el @@ -124,11 +124,11 @@ outlive a change to `pearl-state-to-todo-mapping'." (should (string-equal "Medium" (pearl--get-linear-priority-name 3))) (should (string-equal "Low" (pearl--get-linear-priority-name 4)))) -(ert-deftest test-pearl-get-linear-priority-name-nil-and-unknown-default-medium () - "A nil, zero, or out-of-range priority falls back to Medium." - (should (string-equal "Medium" (pearl--get-linear-priority-name 0))) - (should (string-equal "Medium" (pearl--get-linear-priority-name nil))) - (should (string-equal "Medium" (pearl--get-linear-priority-name 99)))) +(ert-deftest test-pearl-get-linear-priority-name-none-and-unknown () + "Zero (None), nil, and out-of-range priorities read as None." + (should (string-equal "None" (pearl--get-linear-priority-name 0))) + (should (string-equal "None" (pearl--get-linear-priority-name nil))) + (should (string-equal "None" (pearl--get-linear-priority-name 99)))) ;;; pearl-get-priorities diff --git a/tests/test-pearl-save.el b/tests/test-pearl-save.el index edd2c2d..8df7b3b 100644 --- a/tests/test-pearl-save.el +++ b/tests/test-pearl-save.el @@ -397,6 +397,70 @@ the conflict choice (stubbed). Returns (:outcome :fetched :pushed :applied (should (string= "a2" pushed)) (should (string= "a2" (org-entry-get marker "LINEAR-ASSIGNEE-ID-SYNCED"))))))) +;;; --save-priority-field / --save-state-field / --save-labels-field + +(ert-deftest test-pearl-save-priority-clean-push-advances-baseline () + "A cookie-changed priority with an unmoved remote pushes and advances LINEAR-PRIORITY." + (test-pearl-save--in-rendered + '(:id "u" :identifier "ENG-1" :title "t" :priority 2 + :state (:id "s1" :name "Todo") :description "body") + (org-back-to-heading t) + (let ((org-priority-highest ?A) (org-priority-lowest ?D)) + (org-priority ?C)) ; [#B] (2) -> [#C] (3) + (let ((marker (point-marker)) outcome pushed) + (cl-letf (((symbol-function 'pearl--fetch-issue-async) + (lambda (_id cb) (funcall cb '((priority . 2))))) ; remote unmoved + ((symbol-function 'pearl--update-issue-async) + (lambda (_id input cb) + (setq pushed (cdr (assoc "priority" input))) + (funcall cb '(:success t))))) + (pearl--save-priority-field marker (lambda (o) (setq outcome o))) + (should (eq 'pushed (plist-get outcome :status))) + (should (eql 3 pushed)) + (should (string= "3" (org-entry-get marker "LINEAR-PRIORITY"))))))) + +(ert-deftest test-pearl-save-state-picker-clean-push-advances-baseline () + "A picker-changed state with an unmoved remote pushes stateId and advances the baseline." + (test-pearl-save--in-rendered + '(:id "u" :identifier "ENG-1" :title "t" :priority 2 + :state (:id "s1" :name "Todo") :description "body") + (org-back-to-heading t) + (org-entry-put nil "LINEAR-STATE-ID" "s2") ; the picker chose another state + (let ((marker (point-marker)) outcome pushed) + (cl-letf (((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-SYNCED"))))))) + +(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 + '(:id "u" :identifier "ENG-1" :title "t" :priority 2 + :state (:id "s1" :name "Todo") + :labels ((:id "l1" :name "bug") (:id "l2" :name "backend")) + :description "body") + (org-back-to-heading t) + (org-entry-put nil "LINEAR-LABEL-IDS" "l1 l3") ; dropped l2, added l3 + (let ((marker (point-marker)) outcome pushed) + (cl-letf (((symbol-function 'pearl--fetch-issue-async) + (lambda (_id cb) + (funcall cb '((labels (nodes ((id . "l1") (name . "bug")) + ((id . "l2") (name . "backend")))))))) + ((symbol-function 'pearl--update-issue-async) + (lambda (_id input cb) + (setq pushed (cdr (assoc "labelIds" input))) + (funcall cb '(:success t))))) + (pearl--save-labels-field marker (lambda (o) (setq outcome o))) + (should (eq 'pushed (plist-get outcome :status))) + (should (equal ["l1" "l3"] pushed)) + (should (string= "l1 l3" (org-entry-get marker "LINEAR-LABEL-IDS-SYNCED"))))))) + ;;; --save-description-field (advances both provenance hashes) (ert-deftest test-pearl-save-description-advances-both-hashes () |
