diff options
| -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 () |