diff options
| author | Craig Jennings <c@cjennings.net> | 2026-05-25 00:19:47 -0500 |
|---|---|---|
| committer | Craig Jennings <c@cjennings.net> | 2026-05-25 00:19:47 -0500 |
| commit | 56511a51afc66bc7efebee657bf040624defde65 (patch) | |
| tree | 72cf78aa7898e95111a901ee72e55075038edd87 | |
| parent | c2fc84a11a0db1df981fcb978a675c516afc2252 (diff) | |
| download | pearl-56511a51afc66bc7efebee657bf040624defde65.tar.gz pearl-56511a51afc66bc7efebee657bf040624defde65.zip | |
feat: add the unified ticket save model with save-issue and save-all
Editing a ticket meant remembering which per-field command to run: pearl-sync-current-issue for the description, pearl-sync-current-issue-title for the heading, pearl-edit-current-comment for a comment. Three fields, three commands, and no single way to edit several fields (or several tickets) and push them at once.
I added a layered save engine and two commands over it. pearl--run-field-save does the fetch, the three-way conflict gate, and the push for one field, emitting a single structured outcome instead of messaging from its callback. The three interactive sync commands are now thin wrappers over the per-field savers, so they keep working and gain the outcome. pearl-save-issue diffs the ticket at point and pushes only what changed. pearl-save-all scans the whole file, confirms once naming the field counts, and saves every diff in a sequential pass that continues past a per-ticket conflict. A queue runner keeps at most one conflict-resolution buffer live at a time.
I also fixed a correctness bug: a description push now advances both LINEAR-DESC-SHA256 (the markdown the remote gate hashes against) and LINEAR-DESC-ORG-SHA256 (the rendered-Org baseline the local scan uses). Advancing only the markdown hash left the Org hash stale, so the next local scan would flag a just-saved ticket as dirty again.
The conflict resolver gained an optional outcome callback so the engine can report cancel, use-local, use-remote, and the deferred smerge commit or abort as distinct outcomes. I removed the now-dead pearl--commit-sync-decision. The keybinding scheme and the transient menu retarget are a separate follow-up.
Spec: docs/ticket-save-model-spec.org.
| -rw-r--r-- | pearl.el | 626 | ||||
| -rw-r--r-- | tests/test-pearl-conflict.el | 2 | ||||
| -rw-r--r-- | tests/test-pearl-save.el | 324 |
3 files changed, 783 insertions, 169 deletions
@@ -1978,7 +1978,7 @@ resolved description or comment back into the buffer." (unless (string-empty-p org-text) (insert org-text "\n"))))) -(defun pearl--resolve-conflict (label local-md remote-md marker stored-prop apply-fn push-fn) +(defun pearl--resolve-conflict (label local-md remote-md marker stored-prop apply-fn push-fn &optional outcome-cb) "Interactively resolve a sync conflict on LABEL. LOCAL-MD and REMOTE-MD are the two diverged versions. MARKER anchors the org entry; STORED-PROP is the provenance property advanced on resolution (such as @@ -1989,12 +1989,19 @@ and a callback invoked with non-nil on a successful push. Resolutions (see `pearl--read-conflict-resolution'): `cancel' leaves both untouched; `use-local' pushes the local text and advances the hash on success; `use-remote' stashes the local text, writes Linear's version in, and advances -the hash with no push (the remote is already current). `rewrite' is the -deferred smerge flow -- for now it stashes the local text and redirects, so -nothing is lost." +the hash with no push (the remote is already current). `rewrite' opens an +smerge buffer; the reconciled text is applied and pushed on commit, or the +field is left in conflict on abort (the local text is stashed either way). + +OUTCOME-CB, when given, is called once with (STATUS REASON) after the +resolution settles, for the save engine: `cancel' -> (conflict cancelled), +`use-local' -> (pushed nil) or (failed push-failed), `use-remote' -> +\(resolved-remote nil), `rewrite' commit -> (pushed nil) or (failed +push-failed), `rewrite' abort -> (conflict aborted)." (pcase (pearl--read-conflict-resolution label) ('cancel - (message "Left %s untouched (refresh to see Linear's version)" label)) + (message "Left %s untouched (refresh to see Linear's version)" label) + (when outcome-cb (funcall outcome-cb 'conflict 'cancelled))) ('use-local (funcall push-fn local-md (lambda (ok) @@ -2002,14 +2009,17 @@ nothing is lost." (progn (org-entry-put marker stored-prop (secure-hash 'sha256 local-md)) - (message "Pushed your %s to Linear" label)) - (message "Failed to push %s" label))))) + (message "Pushed your %s to Linear" label) + (when outcome-cb (funcall outcome-cb 'pushed nil))) + (message "Failed to push %s" label) + (when outcome-cb (funcall outcome-cb 'failed 'push-failed)))))) ('use-remote (pearl--stash-conflict-text label local-md) (funcall apply-fn remote-md) (org-entry-put marker stored-prop (secure-hash 'sha256 remote-md)) (message "Took Linear's %s; your version is on the kill ring and in %s" - label pearl--conflict-backup-buffer)) + label pearl--conflict-backup-buffer) + (when outcome-cb (funcall outcome-cb 'resolved-remote nil))) ('rewrite (pearl--stash-conflict-text label local-md) (pearl--resolve-conflict-in-smerge @@ -2022,8 +2032,11 @@ nothing is lost." (progn (org-entry-put marker stored-prop (secure-hash 'sha256 reconciled)) - (message "Synced merged %s to Linear" label)) - (message "Failed to push merged %s" label))))))))) + (message "Synced merged %s to Linear" label) + (when outcome-cb (funcall outcome-cb 'pushed nil))) + (message "Failed to push merged %s" label) + (when outcome-cb (funcall outcome-cb 'failed 'push-failed)))))) + (lambda () (when outcome-cb (funcall outcome-cb 'conflict 'aborted))))))) ;;; Compose Buffer ;; @@ -2104,17 +2117,21 @@ sibling of `pearl--resolve-conflict-in-smerge'." (defvar-local pearl--conflict-on-finish nil "Callback invoked with the reconciled text when a conflict buffer commits.") +(defvar-local pearl--conflict-on-abort nil + "Thunk invoked when a conflict buffer is aborted, for save-outcome reporting.") + (defun pearl--conflict-has-markers-p (text) "Return non-nil if any git-style conflict markers remain in TEXT. Used to refuse a commit while the user has left a section unresolved." (and (string-match-p "^\\(<<<<<<<\\|=======\\|>>>>>>>\\)" text) t)) -(defun pearl--resolve-conflict-in-smerge (label local remote on-finish) +(defun pearl--resolve-conflict-in-smerge (label local remote on-finish &optional on-abort) "Open an smerge buffer to reconcile LOCAL vs REMOTE for LABEL. The user resolves the conflict markers with the usual `smerge-mode' commands, then \\[pearl--conflict-commit] hands the reconciled text to ON-FINISH and kills the buffer, while \\[pearl--conflict-abort] cancels (the local text is already -stashed). ON-FINISH runs only when no conflict markers remain." +stashed). ON-FINISH runs only when no conflict markers remain. ON-ABORT, when +given, is a thunk run on abort so the save engine can report the outcome." (require 'smerge-mode) (let ((buf (get-buffer-create (format "*pearl-merge: %s*" label)))) (with-current-buffer buf @@ -2123,6 +2140,7 @@ stashed). ON-FINISH runs only when no conflict markers remain." (goto-char (point-min)) (smerge-mode 1) (setq-local pearl--conflict-on-finish on-finish) + (setq-local pearl--conflict-on-abort on-abort) (local-set-key (kbd "C-c C-c") #'pearl--conflict-commit) (local-set-key (kbd "C-c C-k") #'pearl--conflict-abort) (setq-local header-line-format @@ -2144,11 +2162,15 @@ armed ON-FINISH callback and kills the buffer." (defun pearl--conflict-abort () "Abort the current pearl conflict buffer without pushing. -The local text was stashed before the buffer opened, so nothing is lost." +The local text was stashed before the buffer opened, so nothing is lost. Runs +the armed `pearl--conflict-on-abort' thunk (if any) so the save engine can +report the field as left in conflict." (interactive) - (kill-buffer (current-buffer)) - (message "Conflict resolution aborted; your text is on the kill ring and in %s" - pearl--conflict-backup-buffer)) + (let ((cb pearl--conflict-on-abort)) + (kill-buffer (current-buffer)) + (message "Conflict resolution aborted; your text is on the kill ring and in %s" + pearl--conflict-backup-buffer) + (when cb (funcall cb)))) (defun pearl--issue-body-at-point () "Return the description body of the Linear issue subtree at point. @@ -2277,137 +2299,41 @@ Callers wrap this in `save-excursion' when they must not move point." (unless (ignore-errors (org-back-to-heading t) t) (user-error "%s" (or message "Not on a Linear issue heading")))) -(defun pearl--commit-sync-decision (decision spec) - "Carry out DECISION for a gated text-field sync, per the SPEC plist. -DECISION is a `pearl--sync-decision' result. The description, title, and -comment syncs share this dispatch; they differ only in the SPEC values: - - :local local text being synced - :remote remote text just fetched - :marker marker at the entry whose drawer holds the hash - :prop SHA256 provenance property name - :label label for the conflict prompt - :apply FN (reconciled-text) writing it into the buffer - :push FN (text result-callback) performing the API push - :noop-message shown on `:noop' - :success-message shown after a successful `:push' - :fail-message shown on a failed `:push' - :after-push optional FN (result marker) for extra success bookkeeping - -The conflict path reuses `:push', adapting its result-callback to the -success-boolean `pearl--resolve-conflict' expects." - (let ((push (plist-get spec :push)) - (marker (plist-get spec :marker))) - (pcase decision - (:noop (message "%s" (plist-get spec :noop-message))) - (:conflict - (pearl--resolve-conflict - (plist-get spec :label) (plist-get spec :local) (plist-get spec :remote) - marker (plist-get spec :prop) (plist-get spec :apply) - (lambda (text cb) - (funcall push text (lambda (r) (funcall cb (plist-get r :success))))))) - (:push - (funcall push (plist-get spec :local) - (lambda (result) - (if (plist-get result :success) - (progn - (org-entry-put marker (plist-get spec :prop) - (secure-hash 'sha256 (plist-get spec :local))) - (when (plist-get spec :after-push) - (funcall (plist-get spec :after-push) result marker)) - (message "%s" (plist-get spec :success-message)) - (pearl--surface-buffer (marker-buffer marker))) - (message "%s" (plist-get spec :fail-message))))))))) - ;;;###autoload (defun pearl-sync-current-issue () "Push the description edited in the Org body of the issue at point to Linear. -Works from anywhere inside an issue subtree. The push is gated: if the body -is unchanged since the last fetch nothing is sent; if it was edited and the -remote is unchanged the edit is pushed and the provenance properties advance; -if both the body and the remote changed since the last fetch the push is -refused and the conflict reported (refresh to reconcile)." +Works from anywhere inside an issue subtree. A thin wrapper over the save +engine's description saver: an unchanged body sends nothing; an edit against an +unchanged remote is pushed and both description hashes advance; a both-changed +case is offered conflict resolution (cancel leaves it untouched)." (interactive) (save-excursion (pearl--goto-heading-or-error) - (let ((issue-id (org-entry-get nil "LINEAR-ID")) - (stored (org-entry-get nil "LINEAR-DESC-SHA256")) - (marker (point-marker))) - (unless issue-id - (user-error "Not on a Linear issue heading")) - (let* ((local-md (pearl--org-to-md (pearl--issue-body-at-point)))) - (if (string= (secure-hash 'sha256 local-md) (or stored "")) - (message "No description changes to sync for %s" issue-id) - (pearl--progress "Checking Linear for remote changes...") - (pearl--fetch-issue-description-async - issue-id - (lambda (remote) - (if (null remote) - (message "Could not fetch %s from Linear; not syncing" issue-id) - (pearl--commit-sync-decision - (pearl--sync-decision local-md stored (plist-get remote :description)) - (list - :local local-md - :remote (plist-get remote :description) - :marker marker - :prop "LINEAR-DESC-SHA256" - :label (format "%s description" issue-id) - :apply (lambda (md) - (org-with-point-at marker - (pearl--set-entry-body-at-point (pearl--md-to-org md)))) - :push (lambda (text cb) - (pearl--update-issue-description-async issue-id text cb)) - :noop-message (format "%s already matches Linear" issue-id) - :success-message (format "Synced description for %s to Linear" issue-id) - :fail-message (format "Failed to sync description for %s" issue-id) - :after-push (lambda (result m) - (when (plist-get result :updated-at) - (org-entry-put m "LINEAR-DESC-UPDATED-AT" - (plist-get result :updated-at)))))))))))))) + (unless (org-entry-get nil "LINEAR-ID") + (user-error "Not on a Linear issue heading")) + (let ((buf (current-buffer))) + (pearl--progress "Saving description...") + (pearl--save-description-field + (point-marker) + (lambda (outcome) (pearl--report-save-outcome outcome buf)))))) ;;;###autoload (defun pearl-sync-current-issue-title () "Push the title edited in the heading of the issue at point to Linear. -A separate path from the description sync, sharing the same conflict gate and -working from anywhere inside an issue subtree. Note the title is lossy: the -renderer strips square brackets, so the heading holds the stripped form and a -push sends that stripped title. Gated like the description sync: unchanged -title sends nothing; a local edit against an unchanged remote pushes and -advances the title provenance; both-changed refuses and reports the conflict." +A thin wrapper over the save engine's title saver, sharing the conflict gate +with the description sync and working from anywhere inside an issue subtree. +The title is lossy: the renderer strips square brackets, so the heading holds +the stripped form and a push sends that stripped title." (interactive) (save-excursion (pearl--goto-heading-or-error) - (let ((issue-id (org-entry-get nil "LINEAR-ID")) - (stored (org-entry-get nil "LINEAR-TITLE-SHA256")) - (marker (point-marker))) - (unless issue-id - (user-error "Not on a Linear issue heading")) - (let ((local-title (pearl--issue-title-at-point))) - (if (string= (secure-hash 'sha256 local-title) (or stored "")) - (message "No title changes to sync for %s" issue-id) - (pearl--progress "Checking Linear for remote title changes...") - (pearl--fetch-issue-title-async - issue-id - (lambda (remote) - (if (null remote) - (message "Could not fetch %s from Linear; not syncing" issue-id) - (pearl--commit-sync-decision - (pearl--sync-decision local-title stored (plist-get remote :title)) - (list - :local local-title - :remote (plist-get remote :title) - :marker marker - :prop "LINEAR-TITLE-SHA256" - :label (format "%s title" issue-id) - :apply (lambda (md) - (org-with-point-at marker - (org-back-to-heading t) - (org-edit-headline md))) - :push (lambda (text cb) - (pearl--update-issue-title-async issue-id text cb)) - :noop-message (format "%s title already matches Linear" issue-id) - :success-message (format "Synced title for %s to Linear" issue-id) - :fail-message (format "Failed to sync title for %s" issue-id))))))))))) + (unless (org-entry-get nil "LINEAR-ID") + (user-error "Not on a Linear issue heading")) + (let ((buf (current-buffer))) + (pearl--progress "Saving title...") + (pearl--save-title-field + (point-marker) + (lambda (outcome) (pearl--report-save-outcome outcome buf)))))) (defun pearl--replace-issue-subtree-at-point (issue) "Replace the issue subtree at point with a freshly formatted ISSUE entry. @@ -3280,6 +3206,396 @@ bot / external comment is `:read-only' -- edited locally but not pushable." (push c read-only))) (list :own (nreverse own) :read-only (nreverse read-only)))) +;;; Save engine (the save model's per-field savers) +;; +;; Each dirty field runs through `pearl--run-field-save', which performs the +;; fetch + the three-way `pearl--sync-decision' + the push (or conflict +;; resolution) and invokes its callback exactly once with a structured outcome +;; instead of messaging. The per-field savers below build the spec for a +;; title, description, or own comment. The interactive sync commands are thin +;; wrappers that run one saver and message its outcome; `pearl-save-issue' / +;; `pearl-save-all' (later) drive several savers through a queue and aggregate +;; the outcomes -- never message-scraping. + +(defun pearl--save-outcome-detail (label status reason) + "Return a human-readable detail string for LABEL at STATUS/REASON." + (pcase status + ('pushed (format "%s pushed" label)) + ('unchanged (format "%s unchanged" label)) + ('resolved-remote (format "%s took Linear's version" label)) + ('conflict (format "%s left in conflict (%s)" label (or reason "unresolved"))) + ('skipped (format "%s skipped (%s)" label (or reason "not pushable"))) + ('failed (format "%s failed (%s)" label (or reason "error"))) + (_ (format "%s: %s" label status)))) + +(defun pearl--save-outcome (spec status reason) + "Build a save-outcome plist for SPEC with STATUS and REASON. +SPEC is a field-save spec (see `pearl--run-field-save'). STATUS is one of +`pushed' `unchanged' `conflict' `resolved-remote' `skipped' `failed'. REASON +is nil or a symbol detailing a non-success outcome (`fetch-failed', +`push-failed', `cancelled', `aborted', `read-only', `viewer-unavailable', +`missing-property')." + (list :issue-id (plist-get spec :issue-id) + :identifier (plist-get spec :identifier) + :field (plist-get spec :field) + :comment-id (plist-get spec :comment-id) + :status status + :reason reason + :label (plist-get spec :label) + :message (pearl--save-outcome-detail (plist-get spec :label) status reason))) + +(defun pearl--save-field-push (spec text callback) + "Push TEXT for SPEC, advancing the provenance hash on success. +CALLBACK gets a `pushed' outcome after any :after-push bookkeeping runs, or a +`failed' / `push-failed' outcome when the update reports no success." + (let ((marker (plist-get spec :marker))) + (funcall (plist-get spec :push) text + (lambda (result) + (if (plist-get result :success) + (progn + (org-entry-put marker (plist-get spec :prop) + (secure-hash 'sha256 text)) + (when (plist-get spec :after-push) + (funcall (plist-get spec :after-push) result marker)) + (funcall callback (pearl--save-outcome spec 'pushed nil))) + (funcall callback (pearl--save-outcome spec 'failed 'push-failed))))))) + +(defun pearl--run-field-save (spec callback) + "Save one field per SPEC, invoking CALLBACK once with a save-outcome plist. +SPEC keys: :issue-id :identifier :field :comment-id :marker :prop :label +:local (current text) :stored (stored hash) :fetch (FN CB, calls CB with the +remote text or nil) :push (FN TEXT CB, calls CB with a (:success BOOL ...) +result) :apply (FN TEXT, writes reconciled text into the buffer) :after-push +\(optional FN RESULT MARKER). + +No-op fast path: when the local hash already equals :stored the field is +`unchanged' and no fetch fires. Otherwise the remote is fetched (nil -> +`failed' / `fetch-failed'), `pearl--sync-decision' runs, and the field is +pushed, taken from the remote, or sent through `pearl--resolve-conflict'. +CALLBACK fires exactly once, only after the final outcome is known -- including +the deferred smerge path." + (let* ((local (or (plist-get spec :local) "")) + (stored (or (plist-get spec :stored) ""))) + (if (string= (secure-hash 'sha256 local) stored) + (funcall callback (pearl--save-outcome spec 'unchanged nil)) + (funcall (plist-get spec :fetch) + (lambda (remote) + (if (null remote) + (funcall callback (pearl--save-outcome spec 'failed 'fetch-failed)) + (pcase (pearl--sync-decision local stored remote) + (:noop (funcall callback (pearl--save-outcome spec 'unchanged nil))) + (:push (pearl--save-field-push spec local callback)) + (:conflict + (pearl--resolve-conflict + (plist-get spec :label) local remote + (plist-get spec :marker) (plist-get spec :prop) + (plist-get spec :apply) + (lambda (text cb) + (funcall (plist-get spec :push) text + (lambda (r) (funcall cb (plist-get r :success))))) + (lambda (status reason) + (funcall callback (pearl--save-outcome spec status reason)))))))))))) + +(defun pearl--save-description-field (marker callback) + "Save the description of the issue subtree at MARKER, calling CALLBACK. +A push advances both `LINEAR-DESC-SHA256' (the markdown baseline used by the +remote conflict gate) and `LINEAR-DESC-ORG-SHA256' (the rendered-Org baseline +used by the local dirty scan), so the next scan sees the ticket as clean." + (org-with-point-at marker + (let* ((issue-id (org-entry-get nil "LINEAR-ID")) + (identifier (org-entry-get nil "LINEAR-IDENTIFIER")) + (local (pearl--org-to-md (pearl--issue-body-at-point))) + (spec (list + :issue-id issue-id :identifier identifier :field 'description + :comment-id nil :marker marker :prop "LINEAR-DESC-SHA256" + :local local :stored (org-entry-get nil "LINEAR-DESC-SHA256") + :label (format "%s description" (or identifier issue-id)) + :fetch (lambda (cb) + (pearl--fetch-issue-description-async + issue-id + (lambda (remote) (funcall cb (and remote (plist-get remote :description)))))) + :push (lambda (text cb) + (pearl--update-issue-description-async issue-id text cb)) + :apply (lambda (md) + (org-with-point-at marker + (pearl--set-entry-body-at-point (pearl--md-to-org md)))) + :after-push (lambda (result m) + (when (plist-get result :updated-at) + (org-entry-put m "LINEAR-DESC-UPDATED-AT" + (plist-get result :updated-at))))))) + (pearl--run-field-save + spec + (lambda (outcome) + ;; A push or use-remote leaves the buffer body current; resync the Org + ;; hash from it so the lossless local scan agrees with the markdown one. + (when (memq (plist-get outcome :status) '(pushed resolved-remote)) + (org-with-point-at marker + (org-entry-put marker "LINEAR-DESC-ORG-SHA256" + (secure-hash 'sha256 (pearl--issue-body-at-point))))) + (funcall callback outcome)))))) + +(defun pearl--save-title-field (marker callback) + "Save the issue title at MARKER, calling CALLBACK with the save outcome." + (org-with-point-at marker + (let* ((issue-id (org-entry-get nil "LINEAR-ID")) + (identifier (org-entry-get nil "LINEAR-IDENTIFIER")) + (spec (list + :issue-id issue-id :identifier identifier :field 'title + :comment-id nil :marker marker :prop "LINEAR-TITLE-SHA256" + :local (pearl--issue-title-at-point) + :stored (org-entry-get nil "LINEAR-TITLE-SHA256") + :label (format "%s title" (or identifier issue-id)) + :fetch (lambda (cb) + (pearl--fetch-issue-title-async + issue-id + (lambda (remote) (funcall cb (and remote (plist-get remote :title)))))) + :push (lambda (text cb) + (pearl--update-issue-title-async issue-id text cb)) + :apply (lambda (title) + (org-with-point-at marker + (org-back-to-heading t) + (org-edit-headline title)))))) + (pearl--run-field-save spec callback)))) + +(defun pearl--save-comment-field (marker viewer-id callback) + "Save the comment at MARKER, calling CALLBACK with the outcome. +VIEWER-ID is the resolved viewer id (already known by the caller). A comment +authored by anyone else is reported `skipped' / `read-only' with no network; +only the viewer's own comments are saved through the gate." + (org-with-point-at marker + (let* ((comment-id (org-entry-get nil "LINEAR-COMMENT-ID")) + (author-id (org-entry-get nil "LINEAR-COMMENT-AUTHOR-ID")) + (spec (list + :issue-id (org-entry-get nil "LINEAR-ID") + :identifier comment-id :field 'comment :comment-id comment-id + :marker marker :prop "LINEAR-COMMENT-SHA256" + :local (pearl--org-to-md (pearl--issue-body-at-point)) + :stored (org-entry-get nil "LINEAR-COMMENT-SHA256") + :label (format "comment %s" comment-id) + :fetch (lambda (cb) (pearl--fetch-comment-body-async comment-id cb)) + :push (lambda (text cb) (pearl--update-comment-async comment-id text cb)) + :apply (lambda (md) + (org-with-point-at marker + (pearl--set-entry-body-at-point (pearl--md-to-org md))))))) + (cond + ((null viewer-id) + (funcall callback (pearl--save-outcome spec 'skipped 'viewer-unavailable))) + ((not (pearl--comment-editable-p author-id viewer-id)) + (funcall callback (pearl--save-outcome spec 'skipped 'read-only))) + (t (pearl--run-field-save spec callback)))))) + +(defun pearl--report-save-outcome (outcome buffer) + "Message a single field-save OUTCOME and surface BUFFER on a push. +The reporter for the thin interactive wrappers (`pearl-sync-current-issue' and +friends), which save one field; `pearl-save-issue' / `pearl-save-all' +aggregate their own summaries instead." + (message "%s" (plist-get outcome :message)) + (when (memq (plist-get outcome :status) '(pushed resolved-remote)) + (pearl--surface-buffer buffer))) + +(defun pearl--run-save-queue (thunks callback) + "Run THUNKS sequentially; CALLBACK gets their outcomes, in order, at the end. +Each thunk is a function of one argument DONE, which it calls with a single +save-outcome when finished. The next thunk starts only after the current +thunk's DONE fires, so at most one conflict-resolution UI is ever live -- the +deferred smerge path pauses the queue until it commits or aborts. An empty +THUNKS list calls CALLBACK with nil immediately." + (let (outcomes run-next) + (setq run-next + (lambda (remaining) + (if (null remaining) + (funcall callback (nreverse outcomes)) + (funcall (car remaining) + (lambda (outcome) + (push outcome outcomes) + (funcall run-next (cdr remaining))))))) + (funcall run-next thunks))) + +(defun pearl--save-summary-message (outcomes) + "Return a one-line summary string for OUTCOMES, grouped by status. +A status that carries a reason (skipped / conflict / failed) shows the first +such reason next to its count." + (let ((counts (make-hash-table :test 'eq)) + (reasons (make-hash-table :test 'eq)) + parts) + (dolist (o outcomes) + (let ((s (plist-get o :status))) + (puthash s (1+ (gethash s counts 0)) counts) + (when (and (plist-get o :reason) (not (gethash s reasons))) + (puthash s (plist-get o :reason) reasons)))) + (dolist (s '(pushed resolved-remote unchanged conflict skipped failed)) + (let ((n (gethash s counts 0))) + (when (> n 0) + (push (if (gethash s reasons) + (format "%d %s (%s)" n s (gethash s reasons)) + (format "%d %s" n s)) + parts)))) + (if parts (string-join (nreverse parts) ", ") "nothing"))) + +(defun pearl--report-save-summary (outcomes buffer label) + "Message a one-line summary of OUTCOMES under LABEL. +Surface BUFFER when any field pushed. The shared close-out for +`pearl-save-issue' and `pearl-save-all'." + (let (pushed) + (dolist (o outcomes) + (when (memq (plist-get o :status) '(pushed resolved-remote)) + (setq pushed t))) + (message "%s: %s" label (pearl--save-summary-message outcomes)) + (when pushed (pearl--surface-buffer buffer)))) + +(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 +gates ownership inside `pearl--save-comment-field')." + (let (thunks) + (when (plist-get dirty :title) + (push (lambda (done) (pearl--save-title-field marker done)) thunks)) + (when (plist-get dirty :description) + (push (lambda (done) (pearl--save-description-field marker done)) thunks)) + (dolist (c (plist-get dirty :comment-candidates)) + (let ((cm (plist-get c :marker))) + (push (lambda (done) (pearl--save-comment-field cm viewer-id done)) thunks))) + (nreverse thunks))) + +(defun pearl--save-issue-at (marker buffer dirty viewer-id) + "Queue and run the DIRTY field saves for the issue at MARKER, then summarize. +VIEWER-ID is the resolved viewer id (or nil). BUFFER is surfaced if anything +was pushed. The summary is labelled with the issue identifier." + (let ((label (org-with-point-at marker + (or (org-entry-get nil "LINEAR-IDENTIFIER") + (org-entry-get nil "LINEAR-ID"))))) + (pearl--run-save-queue + (pearl--save-field-thunks marker dirty viewer-id) + (lambda (outcomes) + (pearl--report-save-summary outcomes buffer (format "Saved %s" label)))))) + +;;;###autoload +(defun pearl-save-issue () + "Save every changed field of the Linear issue at point in one pass. +Runs from anywhere inside an issue subtree. A local dirty scan (no network) +picks which of the title, description, and your own comments changed; the +viewer is resolved once, and only if comments are dirty; then each dirty field +is saved sequentially through its conflict gate and a single summary is +reported. A clean issue does no network at all." + (interactive) + (save-excursion + (pearl--goto-heading-or-error) + (unless (org-entry-get nil "LINEAR-ID") + (user-error "Not on a Linear issue heading")) + (let* ((marker (point-marker)) + (buffer (current-buffer)) + (dirty (pearl--issue-dirty-fields))) + (if (not (or (plist-get dirty :title) + (plist-get dirty :description) + (plist-get dirty :comment-candidates))) + (message "Nothing to save for %s" + (or (org-entry-get nil "LINEAR-IDENTIFIER") + (org-entry-get nil "LINEAR-ID"))) + (if (plist-get dirty :comment-candidates) + (pearl--viewer-async + (lambda (viewer) + (pearl--save-issue-at marker buffer dirty + (and viewer (plist-get viewer :id))))) + (pearl--save-issue-at marker buffer dirty nil)))))) + +(defun pearl--scan-all-dirty () + "Scan every issue subtree in the buffer; return ((MARKER . DIRTY) ...). +One entry per issue with any locally-changed field, in buffer order. No +network. This snapshots the work list at scan time -- edits made afterward +wait for the next save (each field's content is still re-read at push)." + (let (result) + (dolist (cell (pearl--issue-subtree-markers)) + (let* ((marker (cdr cell)) + (dirty (org-with-point-at marker (pearl--issue-dirty-fields)))) + (when (or (plist-get dirty :title) + (plist-get dirty :description) + (plist-get dirty :comment-candidates)) + (push (cons marker dirty) result)))) + (nreverse result))) + +(defun pearl--save-all-counts (scan viewer-id) + "Tally the dirty fields in SCAN, classifying comments with VIEWER-ID. +Returns a plist (:issues :titles :descriptions :own-comments +:read-only-comments)." + (let ((issues 0) (titles 0) (descriptions 0) (own 0) (read-only 0)) + (dolist (cell scan) + (let ((dirty (cdr cell))) + (setq issues (1+ issues)) + (when (plist-get dirty :title) (setq titles (1+ titles))) + (when (plist-get dirty :description) (setq descriptions (1+ descriptions))) + (let ((split (pearl--classify-comment-candidates + (plist-get dirty :comment-candidates) viewer-id))) + (setq own (+ own (length (plist-get split :own)))) + (setq read-only (+ read-only (length (plist-get split :read-only))))))) + (list :issues issues :titles titles :descriptions descriptions + :own-comments own :read-only-comments read-only))) + +(defun pearl--save-all-prompt (counts) + "Return the one-time confirmation prompt string for the dirty COUNTS plist." + (let* ((titles (plist-get counts :titles)) + (descriptions (plist-get counts :descriptions)) + (own (plist-get counts :own-comments)) + (read-only (plist-get counts :read-only-comments)) + (fields (+ titles descriptions own)) + (issues (plist-get counts :issues)) + parts) + (when (> titles 0) + (push (format "%d title%s" titles (if (= titles 1) "" "s")) parts)) + (when (> descriptions 0) + (push (format "%d description%s" descriptions (if (= descriptions 1) "" "s")) parts)) + (when (> own 0) + (push (format "%d comment%s" own (if (= own 1) "" "s")) parts)) + (format "Save %d field%s across %d issue%s? (%s%s) " + fields (if (= fields 1) "" "s") + issues (if (= issues 1) "" "s") + (if parts (string-join (nreverse parts) ", ") "0 fields") + (if (> read-only 0) + (format "; %d read-only comment%s skipped" + read-only (if (= read-only 1) "" "s")) + "")))) + +(defun pearl--save-all-run (scan buffer viewer-id) + "Confirm SCAN once, then save all its dirty fields and report. +VIEWER-ID gates comment ownership; BUFFER is surfaced if anything pushed. +Declining the prompt mutates nothing. The queue continues past a per-field +conflict, so one conflicted ticket does not stop the rest." + (if (not (y-or-n-p (pearl--save-all-prompt (pearl--save-all-counts scan viewer-id)))) + (message "save-all cancelled; nothing saved") + (let (thunks) + (dolist (cell scan) + (setq thunks (append thunks + (pearl--save-field-thunks (car cell) (cdr cell) viewer-id)))) + (pearl--run-save-queue + thunks + (lambda (outcomes) + (pearl--report-save-summary outcomes buffer "Saved all")))))) + +;;;###autoload +(defun pearl-save-all () + "Save every changed field across all Linear issues in the file, after one prompt. +A local dirty scan (no network for title/description; comment changed-candidates +found locally) builds the work list. When comment candidates exist and the +viewer cache is cold, one read-only viewer lookup runs so read-only comments are +counted -- no mutation before the prompt. A single confirmation names the field +counts; declining mutates nothing. On confirm the dirty fields save +sequentially, continuing past any per-field conflict, and one summary is +reported. A clean file does nothing." + (interactive) + (let* ((buffer (current-buffer)) + (scan (pearl--scan-all-dirty))) + (if (null scan) + (message "Nothing to save") + (let ((has-comments nil)) + (dolist (cell scan) + (when (plist-get (cdr cell) :comment-candidates) (setq has-comments t))) + (if (and has-comments (not pearl--cache-viewer)) + (pearl--viewer-async + (lambda (viewer) + (pearl--save-all-run scan buffer (and viewer (plist-get viewer :id))))) + (pearl--save-all-run scan buffer + (and pearl--cache-viewer + (plist-get pearl--cache-viewer :id)))))))) + (defun pearl--merge-issues-into-buffer (issues) "Merge normalized ISSUES into the current buffer by `LINEAR-ID'. Same-source refresh semantics: an existing issue still in ISSUES is re-rendered @@ -3801,47 +4117,23 @@ reported (refresh to reconcile)." (save-excursion (pearl--goto-heading-or-error "Not on a Linear comment") (let ((comment-id (org-entry-get nil "LINEAR-COMMENT-ID")) - (author-id (org-entry-get nil "LINEAR-COMMENT-AUTHOR-ID")) (stored (org-entry-get nil "LINEAR-COMMENT-SHA256")) - (marker (point-marker))) + (marker (point-marker)) + (buf (current-buffer))) (unless comment-id (user-error "Not on a Linear comment")) - ;; `pearl--issue-body-at-point' reads the text after the drawer and before - ;; the first child heading -- a comment subtree has that same shape, so the - ;; description path's body reader serves the comment body unchanged. + ;; No-op fast path before resolving the viewer: an unchanged comment + ;; costs no viewer lookup. `pearl--issue-body-at-point' reads the text + ;; after the drawer and before the first child heading -- a comment + ;; subtree has that shape, so it serves the comment body unchanged. (let ((local-md (pearl--org-to-md (pearl--issue-body-at-point)))) (if (string= (secure-hash 'sha256 local-md) (or stored "")) (message "No comment changes to sync") (pearl--viewer-async (lambda (viewer) - (cond - ((null viewer) - (message "Could not determine your Linear identity; not editing")) - ((not (pearl--comment-editable-p author-id (plist-get viewer :id))) - (message "You can only edit your own comments")) - (t - (pearl--progress "Checking Linear for remote changes...") - (pearl--fetch-comment-body-async - comment-id - (lambda (remote-md) - (if (null remote-md) - (message "Could not fetch the comment from Linear; not syncing") - (pearl--commit-sync-decision - (pearl--sync-decision local-md stored remote-md) - (list - :local local-md - :remote remote-md - :marker marker - :prop "LINEAR-COMMENT-SHA256" - :label "comment" - :apply (lambda (md) - (org-with-point-at marker - (pearl--set-entry-body-at-point (pearl--md-to-org md)))) - :push (lambda (text cb) - (pearl--update-comment-async comment-id text cb)) - :noop-message "Comment already matches Linear" - :success-message "Synced comment to Linear" - :fail-message "Failed to sync comment")))))))))))))) + (pearl--save-comment-field + marker (and viewer (plist-get viewer :id)) + (lambda (outcome) (pearl--report-save-outcome outcome buf)))))))))) ;;; Transient Menu diff --git a/tests/test-pearl-conflict.el b/tests/test-pearl-conflict.el index 03d8f31..138e622 100644 --- a/tests/test-pearl-conflict.el +++ b/tests/test-pearl-conflict.el @@ -212,7 +212,7 @@ (cl-letf (((symbol-function 'pearl--read-conflict-resolution) (lambda (_) 'rewrite)) ;; Emulate the user resolving the buffer and committing. ((symbol-function 'pearl--resolve-conflict-in-smerge) - (lambda (_label _local _remote on-finish) + (lambda (_label _local _remote on-finish &optional _on-abort) (funcall on-finish "merged text")))) (pearl--resolve-conflict "ENG-1 description" "local text" "remote text" marker "LINEAR-DESC-SHA256" diff --git a/tests/test-pearl-save.el b/tests/test-pearl-save.el index 24db264..802535b 100644 --- a/tests/test-pearl-save.el +++ b/tests/test-pearl-save.el @@ -27,6 +27,7 @@ ;;; Code: (require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) (defun test-pearl-save--issue () "A normalized issue with a description and one own comment (author-id u-craig)." @@ -38,8 +39,13 @@ (defmacro test-pearl-save--in-rendered (issue &rest body) "Render ISSUE into an org buffer, then run BODY with point at the start." (declare (indent 1)) + ;; `org-element-use-cache' nil: these tests do raw `insert' surgery and then + ;; `org-entry-put', which in batch makes the cache reconcile pathologically + ;; (seconds per call). Disabling it keeps the suite fast and deterministic; + ;; production never touches this binding. `(let ((pearl-state-to-todo-mapping '(("Todo" . "TODO"))) - (pearl-comment-sort-order 'newest-first)) + (pearl-comment-sort-order 'newest-first) + (org-element-use-cache nil)) (with-temp-buffer (insert (pearl--format-issue-as-org-entry ,issue)) (org-mode) @@ -119,5 +125,321 @@ (should (equal '("c2" "c3") (mapcar (lambda (c) (plist-get c :comment-id)) (plist-get r :read-only)))))) +;;; --run-field-save (the per-field save engine) + +(cl-defun test-pearl-save--engine (&key local stored remote (push-success t) resolution) + "Run `pearl--run-field-save' over a synthetic spec; return a results plist. +LOCAL/STORED/REMOTE drive the gate; PUSH-SUCCESS the update result; RESOLUTION +the conflict choice (stubbed). Returns (:outcome :fetched :pushed :applied +:hash) where :pushed / :applied are the texts handed to the stub closures and +:hash is the provenance property after the run." + (with-temp-buffer + (org-mode) + (insert "* Issue\n:PROPERTIES:\n:LINEAR-TEST-SHA256: " (or stored "") "\n:END:\nbody\n") + (goto-char (point-min)) + (let* ((marker (point-marker)) + (fetched 0) (pushed nil) (applied nil) outcome + (spec (list :issue-id "u" :identifier "ENG-1" :field 'description + :comment-id nil :marker marker :prop "LINEAR-TEST-SHA256" + :local local :stored stored :label "ENG-1 description" + :fetch (lambda (cb) (cl-incf fetched) (funcall cb remote)) + :push (lambda (text cb) + (push text pushed) + (funcall cb (list :success push-success))) + :apply (lambda (text) (push text applied))))) + (cl-letf (((symbol-function 'pearl--read-conflict-resolution) + (lambda (_l) resolution))) + (pearl--run-field-save spec (lambda (o) (setq outcome o)))) + (list :outcome outcome :fetched fetched + :pushed (nreverse pushed) :applied (nreverse applied) + :hash (org-entry-get marker "LINEAR-TEST-SHA256"))))) + +(ert-deftest test-pearl-engine-unchanged-skips-fetch () + "Local equals the stored hash: `unchanged', and no fetch fires." + (let* ((local "same text") + (r (test-pearl-save--engine :local local :stored (secure-hash 'sha256 local)))) + (should (eq 'unchanged (plist-get (plist-get r :outcome) :status))) + (should (= 0 (plist-get r :fetched))) + (should-not (plist-get r :pushed)))) + +(ert-deftest test-pearl-engine-clean-push-advances-hash () + "Local edited, remote still at baseline: `pushed' and the hash advances." + (let ((r (test-pearl-save--engine + :local "edited" :stored (secure-hash 'sha256 "baseline") :remote "baseline"))) + (should (eq 'pushed (plist-get (plist-get r :outcome) :status))) + (should (= 1 (plist-get r :fetched))) + (should (equal '("edited") (plist-get r :pushed))) + (should (string= (secure-hash 'sha256 "edited") (plist-get r :hash))))) + +(ert-deftest test-pearl-engine-converged-is-unchanged () + "Local moved off the baseline but remote already matches it: `unchanged', no push." + (let ((r (test-pearl-save--engine + :local "new text" :stored (secure-hash 'sha256 "baseline") :remote "new text"))) + (should (eq 'unchanged (plist-get (plist-get r :outcome) :status))) + (should (= 1 (plist-get r :fetched))) + (should-not (plist-get r :pushed)))) + +(ert-deftest test-pearl-engine-fetch-failure () + "A nil remote (fetch failed) reports `failed'/`fetch-failed', no push." + (let ((r (test-pearl-save--engine + :local "edited" :stored (secure-hash 'sha256 "baseline") :remote nil))) + (should (eq 'failed (plist-get (plist-get r :outcome) :status))) + (should (eq 'fetch-failed (plist-get (plist-get r :outcome) :reason))) + (should-not (plist-get r :pushed)))) + +(ert-deftest test-pearl-engine-push-failure-keeps-hash () + "A failed push reports `failed'/`push-failed' and leaves the hash untouched." + (let* ((stored (secure-hash 'sha256 "baseline")) + (r (test-pearl-save--engine + :local "edited" :stored stored :remote "baseline" :push-success nil))) + (should (eq 'failed (plist-get (plist-get r :outcome) :status))) + (should (eq 'push-failed (plist-get (plist-get r :outcome) :reason))) + (should (equal '("edited") (plist-get r :pushed))) + (should (string= stored (plist-get r :hash))))) + +(ert-deftest test-pearl-engine-conflict-cancel () + "Cancelling a conflict reports `conflict'/`cancelled', no push, hash intact." + (let* ((stored (secure-hash 'sha256 "baseline")) + (r (test-pearl-save--engine + :local "edited" :stored stored :remote "remote changed" :resolution 'cancel))) + (should (eq 'conflict (plist-get (plist-get r :outcome) :status))) + (should (eq 'cancelled (plist-get (plist-get r :outcome) :reason))) + (should-not (plist-get r :pushed)) + (should (string= stored (plist-get r :hash))))) + +(ert-deftest test-pearl-engine-conflict-use-local () + "Use-local pushes the local text and advances the hash to it." + (let ((r (test-pearl-save--engine + :local "edited" :stored (secure-hash 'sha256 "baseline") + :remote "remote changed" :resolution 'use-local))) + (should (eq 'pushed (plist-get (plist-get r :outcome) :status))) + (should (equal '("edited") (plist-get r :pushed))) + (should (string= (secure-hash 'sha256 "edited") (plist-get r :hash))))) + +(ert-deftest test-pearl-engine-conflict-use-remote () + "Use-remote applies the remote, advances the hash, and does not push." + (let ((r (test-pearl-save--engine + :local "edited" :stored (secure-hash 'sha256 "baseline") + :remote "remote changed" :resolution 'use-remote))) + (should (eq 'resolved-remote (plist-get (plist-get r :outcome) :status))) + (should-not (plist-get r :pushed)) + (should (equal '("remote changed") (plist-get r :applied))) + (should (string= (secure-hash 'sha256 "remote changed") (plist-get r :hash))))) + +;;; --save-description-field (advances both provenance hashes) + +(ert-deftest test-pearl-save-description-advances-both-hashes () + "A description push advances both the markdown and the Org provenance hashes, +so the next local dirty scan (which uses the Org hash) sees the ticket as clean." + (test-pearl-save--in-rendered (test-pearl-save--issue) + (re-search-forward "Original description\\.") + (end-of-line) + (insert " EDITED") + (goto-char (point-min)) + (re-search-forward "Original description") + (org-back-to-heading t) + (let ((marker (point-marker)) outcome) + (cl-letf (((symbol-function 'pearl--fetch-issue-description-async) + (lambda (_id cb) + (funcall cb (list :description "Original description." :updated-at "t0")))) + ((symbol-function 'pearl--update-issue-description-async) + (lambda (_id _md cb) (funcall cb '(:success t :updated-at "t1"))))) + (pearl--save-description-field marker (lambda (o) (setq outcome o)))) + (should (eq 'pushed (plist-get outcome :status))) + (org-with-point-at marker + (should (string= (secure-hash 'sha256 (pearl--issue-body-at-point)) + (org-entry-get nil "LINEAR-DESC-ORG-SHA256"))) + (should (string= (secure-hash 'sha256 (pearl--org-to-md (pearl--issue-body-at-point))) + (org-entry-get nil "LINEAR-DESC-SHA256"))) + ;; the push timestamp still lands via the after-push bookkeeping + (should (string= "t1" (org-entry-get nil "LINEAR-DESC-UPDATED-AT"))))))) + +;;; --run-save-queue (sequential runner) + +(ert-deftest test-pearl-save-queue-runs-in-order-collecting-outcomes () + "The queue runs thunks in order and hands the callback their outcomes in order." + (let ((order nil) (collected nil)) + (pearl--run-save-queue + (list (lambda (done) (push 'a order) (funcall done '(:status pushed :field a))) + (lambda (done) (push 'b order) (funcall done '(:status unchanged :field b))) + (lambda (done) (push 'c order) (funcall done '(:status skipped :field c)))) + (lambda (outcomes) (setq collected outcomes))) + (should (equal '(a b c) (nreverse order))) + (should (equal '(a b c) (mapcar (lambda (o) (plist-get o :field)) collected))))) + +(ert-deftest test-pearl-save-queue-waits-for-each-done () + "A thunk that defers its DONE blocks the next thunk until it fires." + (let ((started nil) (gate nil)) + (pearl--run-save-queue + (list (lambda (done) (push '1 started) (setq gate done)) ; defers + (lambda (done) (push '2 started) (funcall done '(:status pushed)))) + #'ignore) + ;; only the first thunk has started; the second waits on the deferred done + (should (equal '(1) started)) + (funcall gate '(:status pushed)) + (should (equal '(1 2) (nreverse started))))) + +(ert-deftest test-pearl-save-queue-empty-calls-back-empty () + "An empty queue calls back immediately with no outcomes." + (let ((called 'no)) + (pearl--run-save-queue nil (lambda (o) (setq called o))) + (should (null called)))) + +;;; pearl-save-issue (HTTP stubbed) + +(defmacro test-pearl-save--with-net (&rest body) + "Run BODY with the four issue network helpers stubbed to record calls. +Binds dynamic spies `title-pushes' / `desc-pushes' / `fetched' (lists/flags)." + (declare (indent 0)) + `(let ((title-pushes nil) (desc-pushes nil) (fetched nil)) + (cl-letf (((symbol-function 'pearl--update-issue-title-async) + (lambda (_id text cb) (push text title-pushes) + (funcall cb '(:success t :updated-at "t")))) + ((symbol-function 'pearl--update-issue-description-async) + (lambda (_id text cb) (push text desc-pushes) + (funcall cb '(:success t :updated-at "t"))))) + ,@body))) + +(ert-deftest test-pearl-save-issue-clean-makes-no-network-calls () + "A freshly rendered issue with no edits saves nothing and fetches nothing." + (test-pearl-save--in-rendered (test-pearl-save--issue) + (re-search-forward "Original description") + (test-pearl-save--with-net + (cl-letf (((symbol-function 'pearl--fetch-issue-description-async) + (lambda (&rest _) (setq fetched t))) + ((symbol-function 'pearl--fetch-issue-title-async) + (lambda (&rest _) (setq fetched t)))) + (pearl-save-issue) + (should-not fetched) + (should-not title-pushes) + (should-not desc-pushes))))) + +(ert-deftest test-pearl-save-issue-pushes-edited-description () + "An edited description is fetched, found clean-against-remote, and pushed." + (test-pearl-save--in-rendered (test-pearl-save--issue) + (re-search-forward "Original description\\.") + (end-of-line) + (insert " EDITED") + (goto-char (point-min)) + (re-search-forward "Original description") + (test-pearl-save--with-net + (cl-letf (((symbol-function 'pearl--fetch-issue-description-async) + (lambda (_id cb) (funcall cb '(:description "Original description." :updated-at "t0"))))) + (pearl-save-issue) + (should (= 1 (length desc-pushes))) + (should-not title-pushes))))) + +(ert-deftest test-pearl-save-issue-conflict-on-one-field-still-saves-the-other () + "Title pushes cleanly while the description conflicts (cancelled); the +description hash is left untouched and the title still saved." + (test-pearl-save--in-rendered (test-pearl-save--issue) + ;; edit both the title and the description + (re-search-forward "Fix the Bug") + (org-back-to-heading t) + (org-edit-headline "ENG-1: Fix the Cache Bug") + (re-search-forward "Original description\\.") + (end-of-line) + (insert " EDITED") + (goto-char (point-min)) + (re-search-forward "Original description") + (let ((desc-hash-before + (save-excursion (org-back-to-heading t) + (org-entry-get nil "LINEAR-DESC-SHA256")))) + (test-pearl-save--with-net + (cl-letf (((symbol-function 'pearl--fetch-issue-title-async) + ;; remote title unchanged -> clean push + (lambda (_id cb) (funcall cb '(:title "Fix the Bug" :updated-at "t0")))) + ((symbol-function 'pearl--fetch-issue-description-async) + ;; remote description drifted -> conflict + (lambda (_id cb) (funcall cb '(:description "Remote moved on." :updated-at "t1")))) + ((symbol-function 'pearl--read-conflict-resolution) + (lambda (_label) 'cancel))) + (pearl-save-issue) + (should (= 1 (length title-pushes))) + (should-not desc-pushes) + ;; the description hash is untouched by the cancelled conflict + (should (string= desc-hash-before + (save-excursion (org-back-to-heading t) + (org-entry-get nil "LINEAR-DESC-SHA256"))))))))) + +;;; pearl-save-all (file-wide scan + confirm + batch) + +(defmacro test-pearl-save--in-two-issues (&rest body) + "Render two issues (ENG-1, ENG-2; bodies \"Body.\") and run BODY at point-min." + (declare (indent 0)) + `(let ((pearl-state-to-todo-mapping '(("Todo" . "TODO"))) + (pearl-comment-sort-order 'newest-first) + (org-element-use-cache nil)) + (with-temp-buffer + (insert (pearl--format-issue-as-org-entry + '(:id "u1" :identifier "ENG-1" :title "one" :priority 2 + :state (:name "Todo") :description "Body."))) + (insert (pearl--format-issue-as-org-entry + '(:id "u2" :identifier "ENG-2" :title "two" :priority 2 + :state (:name "Todo") :description "Body."))) + (org-mode) + (goto-char (point-min)) + ,@body))) + +(ert-deftest test-pearl-save-all-clean-file-no-network-no-prompt () + "A clean file saves nothing, prompts nothing, and makes no network calls." + (test-pearl-save--in-two-issues + (let ((prompted nil) (fetched nil)) + (test-pearl-save--with-net + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) (setq prompted t) t)) + ((symbol-function 'pearl--fetch-issue-description-async) + (lambda (&rest _) (setq fetched t)))) + (pearl-save-all) + (should-not prompted) + (should-not fetched) + (should-not desc-pushes)))))) + +(ert-deftest test-pearl-save-all-confirm-saves-across-issues () + "With edits in both issues, confirming saves each description in one pass." + (test-pearl-save--in-two-issues + (while (re-search-forward "^Body\\.$" nil t) + (end-of-line) (insert " EDITED")) + (goto-char (point-min)) + (test-pearl-save--with-net + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t)) + ((symbol-function 'pearl--fetch-issue-description-async) + (lambda (_id cb) (funcall cb '(:description "Body." :updated-at "t0"))))) + (pearl-save-all) + (should (= 2 (length desc-pushes))))))) + +(ert-deftest test-pearl-save-all-decline-makes-no-mutation () + "Declining the confirmation prompt pushes nothing." + (test-pearl-save--in-two-issues + (while (re-search-forward "^Body\\.$" nil t) + (end-of-line) (insert " EDITED")) + (goto-char (point-min)) + (test-pearl-save--with-net + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) nil)) + ((symbol-function 'pearl--fetch-issue-description-async) + (lambda (_id cb) (funcall cb '(:description "Body." :updated-at "t0"))))) + (pearl-save-all) + (should-not desc-pushes))))) + +(ert-deftest test-pearl-save-all-malformed-issue-does-not-abort-batch () + "A heading without a LINEAR-ID is skipped by the scan; valid edits still save." + (test-pearl-save--in-two-issues + ;; clobber the first issue's LINEAR-ID so it drops out of the marker scan + (save-excursion + (goto-char (point-min)) + (re-search-forward ":LINEAR-ID:") + (beginning-of-line) (kill-line) (insert ":LINEAR-NOPE: x")) + ;; edit both descriptions + (goto-char (point-min)) + (while (re-search-forward "^Body\\.$" nil t) + (end-of-line) (insert " EDITED")) + (goto-char (point-min)) + (test-pearl-save--with-net + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t)) + ((symbol-function 'pearl--fetch-issue-description-async) + (lambda (_id cb) (funcall cb '(:description "Body." :updated-at "t0"))))) + (pearl-save-all) + ;; only the still-valid second issue saved + (should (= 1 (length desc-pushes))))))) + (provide 'test-pearl-save) ;;; test-pearl-save.el ends here |
