diff options
| -rw-r--r-- | pearl.el | 110 | ||||
| -rw-r--r-- | tests/test-pearl-save.el | 109 |
2 files changed, 219 insertions, 0 deletions
@@ -3608,6 +3608,116 @@ Surface BUFFER when any field pushed. The shared close-out for (message "%s: %s" label (pearl--save-summary-message outcomes)) (when pushed (pearl--surface-buffer buffer)))) +(defun pearl--run-atomic-field-save (spec callback) + "Save one atomic (enum/relation) field per SPEC, calling CALLBACK once. +SPEC keys: :issue-id :identifier :field :marker :label; :live and :baseline +\(comparison values -- a nil :baseline is a legacy file with no synced +baseline); :equal (a comparator, default `equal'); :fetch-remote (FN CB; CB +gets the remote comparison value or `:error'); :push (FN CB; pushes :live, CB +gets a (:success BOOL) result); :commit-local (FN; advances the baseline to +:live, already in the buffer); :commit-remote (FN VALUE; writes VALUE into the +buffer and advances the baseline to it); :live-display (a prompt string) and +:remote-display (FN VALUE -> string). + +The atomic three-way, the sibling of `pearl--run-field-save' for non-text +fields: a missing baseline is `skipped'/`missing-property'; live equal to +baseline is `unchanged'; otherwise the remote is fetched (`:error' -> +`failed'/`fetch-failed') -- remote equal to live converges (advance baseline, +`unchanged'), remote equal to baseline is a clean push, anything else runs +`pearl--resolve-atomic-conflict'. No SHA hash and no smerge." + (let* ((live (plist-get spec :live)) + (baseline (plist-get spec :baseline)) + (equal-fn (or (plist-get spec :equal) #'equal)) + (push-then-commit + (lambda (cb) + (funcall (plist-get spec :push) + (lambda (r) + (when (plist-get r :success) + (funcall (plist-get spec :commit-local))) + (funcall cb (plist-get r :success))))))) + (cond + ((null baseline) + (funcall callback (pearl--save-outcome spec 'skipped 'missing-property))) + ((funcall equal-fn live baseline) + (funcall callback (pearl--save-outcome spec 'unchanged nil))) + (t + (funcall + (plist-get spec :fetch-remote) + (lambda (remote) + (cond + ((eq remote :error) + (funcall callback (pearl--save-outcome spec 'failed 'fetch-failed))) + ((funcall equal-fn remote live) + (funcall (plist-get spec :commit-local)) + (funcall callback (pearl--save-outcome spec 'unchanged nil))) + ((funcall equal-fn remote baseline) + (funcall push-then-commit + (lambda (ok) + (funcall callback + (pearl--save-outcome spec (if ok 'pushed 'failed) + (and (not ok) 'push-failed)))))) + (t + (pearl--resolve-atomic-conflict + (plist-get spec :label) + (plist-get spec :live-display) + (funcall (plist-get spec :remote-display) remote) + push-then-commit + (lambda () (funcall (plist-get spec :commit-remote) remote)) + (lambda (status reason) + (funcall callback (pearl--save-outcome spec status reason)))))))))))) + +(defun pearl--node-assignee-id (node) + "The assignee id of raw issue NODE, or \"\" when unassigned." + (or (cdr (assoc 'id (cdr (assoc 'assignee node)))) "")) + +(defun pearl--node-assignee-name (node) + "The assignee display name of raw issue NODE, or \"(unassigned)\"." + (or (cdr (assoc 'name (cdr (assoc 'assignee node)))) "(unassigned)")) + +(defun pearl--save-assignee-field (marker callback) + "Save the assignee of the issue subtree at MARKER, calling CALLBACK. +Picker-authoritative: the live id is `LINEAR-ASSIGNEE-ID', diffed against +`LINEAR-ASSIGNEE-ID-SYNCED'. A push sends `assigneeId' (`:null' unassigns)." + (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-ASSIGNEE-ID") "")) + (remote-node nil) + (spec + (list + :issue-id issue-id :identifier identifier :field 'assignee + :marker marker + :label (format "%s assignee" (or identifier issue-id)) + :live live + :baseline (org-entry-get nil "LINEAR-ASSIGNEE-ID-SYNCED") + :equal #'string= + :live-display (or (org-entry-get nil "LINEAR-ASSIGNEE-NAME") "(unassigned)") + :remote-display (lambda (_id) (pearl--node-assignee-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-assignee-id node)))))) + :push + (lambda (cb) + (pearl--update-issue-async + issue-id + (list (cons "assigneeId" (if (string-empty-p live) :null live))) + cb)) + :commit-local + (lambda () (org-entry-put marker "LINEAR-ASSIGNEE-ID-SYNCED" live)) + :commit-remote + (lambda (remote-id) + (org-entry-put marker "LINEAR-ASSIGNEE-ID" remote-id) + (org-entry-put marker "LINEAR-ASSIGNEE-NAME" + (pearl--node-assignee-name remote-node)) + (org-entry-put marker "LINEAR-ASSIGNEE-ID-SYNCED" remote-id))))) + (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-save.el b/tests/test-pearl-save.el index 36358ad..edd2c2d 100644 --- a/tests/test-pearl-save.el +++ b/tests/test-pearl-save.el @@ -288,6 +288,115 @@ the conflict choice (stubbed). Returns (:outcome :fetched :pushed :applied (should (equal '("remote changed") (plist-get r :applied))) (should (string= (secure-hash 'sha256 "remote changed") (plist-get r :hash))))) +;;; --run-atomic-field-save (the per-field engine for enum/relation fields) + +(cl-defun test-pearl-save--atomic (&key live baseline remote (push-success t) resolution) + "Drive `pearl--run-atomic-field-save' over a synthetic spec; return a results plist." + (let (outcome pushed committed-local committed-remote) + (cl-letf (((symbol-function 'pearl--read-atomic-conflict-resolution) + (lambda (_) resolution))) + (pearl--run-atomic-field-save + (list :issue-id "u" :identifier "ENG-1" :field 'assignee :marker nil + :label "ENG-1 assignee" :live live :baseline baseline :equal #'string= + :live-display (format "L:%s" live) + :remote-display (lambda (r) (format "R:%s" r)) + :fetch-remote (lambda (cb) (funcall cb remote)) + :push (lambda (cb) (setq pushed t) (funcall cb (list :success push-success))) + :commit-local (lambda () (setq committed-local t)) + :commit-remote (lambda (r) (setq committed-remote r))) + (lambda (o) (setq outcome o)))) + (list :status (plist-get outcome :status) :reason (plist-get outcome :reason) + :pushed pushed :local committed-local :remote committed-remote))) + +(ert-deftest test-pearl-atomic-missing-baseline-skips () + "A nil baseline (legacy file) is skipped with missing-property, no fetch." + (let ((r (test-pearl-save--atomic :live "b" :baseline nil :remote "x"))) + (should (eq 'skipped (plist-get r :status))) + (should (eq 'missing-property (plist-get r :reason))) + (should-not (plist-get r :pushed)))) + +(ert-deftest test-pearl-atomic-live-equals-baseline-unchanged () + "Live equal to baseline is unchanged (defensive; the scan shouldn't queue it)." + (let ((r (test-pearl-save--atomic :live "a" :baseline "a" :remote "x"))) + (should (eq 'unchanged (plist-get r :status))) + (should-not (plist-get r :pushed)))) + +(ert-deftest test-pearl-atomic-remote-converged-advances-no-push () + "Remote already equal to live converges: advance baseline, unchanged, no push." + (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote "b"))) + (should (eq 'unchanged (plist-get r :status))) + (should (plist-get r :local)) + (should-not (plist-get r :pushed)))) + +(ert-deftest test-pearl-atomic-clean-push () + "Remote unmoved from baseline: clean push, baseline advances to live." + (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote "a"))) + (should (eq 'pushed (plist-get r :status))) + (should (plist-get r :pushed)) + (should (plist-get r :local)))) + +(ert-deftest test-pearl-atomic-clean-push-failure () + "A failed clean push reports failed/push-failed and does not advance baseline." + (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote "a" + :push-success nil))) + (should (eq 'failed (plist-get r :status))) + (should (eq 'push-failed (plist-get r :reason))) + (should-not (plist-get r :local)))) + +(ert-deftest test-pearl-atomic-conflict-use-local () + "Remote moved differently: use-local pushes and advances." + (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote "c" + :resolution 'use-local))) + (should (eq 'pushed (plist-get r :status))) + (should (plist-get r :pushed)) + (should (plist-get r :local)))) + +(ert-deftest test-pearl-atomic-conflict-use-remote () + "Use-remote adopts the remote value, never pushes, reports resolved-remote." + (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote "c" + :resolution 'use-remote))) + (should (eq 'resolved-remote (plist-get r :status))) + (should-not (plist-get r :pushed)) + (should (string= "c" (plist-get r :remote))))) + +(ert-deftest test-pearl-atomic-conflict-cancel () + "Cancel leaves the field in conflict, pushes and commits nothing." + (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote "c" + :resolution 'cancel))) + (should (eq 'conflict (plist-get r :status))) + (should (eq 'cancelled (plist-get r :reason))) + (should-not (plist-get r :pushed)) + (should-not (plist-get r :local)) + (should-not (plist-get r :remote)))) + +(ert-deftest test-pearl-atomic-fetch-failure () + "A remote fetch error reports failed/fetch-failed." + (let ((r (test-pearl-save--atomic :live "b" :baseline "a" :remote :error))) + (should (eq 'failed (plist-get r :status))) + (should (eq 'fetch-failed (plist-get r :reason))))) + +;;; --save-assignee-field (the relation saver, end to end) + +(ert-deftest test-pearl-save-assignee-clean-push-advances-baseline () + "A picker-changed assignee with an unmoved remote pushes and advances the baseline." + (test-pearl-save--in-rendered + '(:id "u" :identifier "ENG-1" :title "t" :priority 2 + :state (:id "s1" :name "Todo") :assignee (:id "a1" :name "Craig") + :description "body") + (org-back-to-heading t) + (org-entry-put nil "LINEAR-ASSIGNEE-ID" "a2") ; the picker chose a new assignee + (let ((marker (point-marker)) outcome (pushed nil)) + (cl-letf (((symbol-function 'pearl--fetch-issue-async) + (lambda (_id cb) (funcall cb '((assignee (id . "a1") (name . "Craig")))))) + ((symbol-function 'pearl--update-issue-async) + (lambda (_id input cb) + (setq pushed (cdr (assoc "assigneeId" input))) + (funcall cb '(:success t))))) + (pearl--save-assignee-field marker (lambda (o) (setq outcome o))) + (should (eq 'pushed (plist-get outcome :status))) + (should (string= "a2" pushed)) + (should (string= "a2" (org-entry-get marker "LINEAR-ASSIGNEE-ID-SYNCED"))))))) + ;;; --save-description-field (advances both provenance hashes) (ert-deftest test-pearl-save-description-advances-both-hashes () |