;;; test-pearl-save.el --- Tests for the unified ticket save model -*- lexical-binding: t; -*-

;; Copyright (C) 2026 Craig Jennings

;; Author: Craig Jennings <c@cjennings.net>

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Tests for the unified ticket save model (see
;; docs/ticket-save-model-spec.org).  Phase 1: the local dirty scanners
;; (`pearl--issue-dirty-fields', `pearl--changed-comment-candidates') and the
;; viewer-based ownership classifier (`pearl--classify-comment-candidates').

;;; 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)."
  '(:id "u" :identifier "ENG-1" :title "fix the bug" :priority 2
    :state (:name "Todo") :description "Original description."
    :comments ((:id "c1" :author "Craig" :author-id "u-craig"
                :created-at "2026-05-24T00:00:00.000Z" :body "my comment"))))

(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)
         (org-element-use-cache nil))
     (with-temp-buffer
       (insert (pearl--format-issue-as-org-entry ,issue))
       (org-mode)
       (goto-char (point-min))
       ,@body)))

;;; --issue-dirty-fields (Phase A, local)

(ert-deftest test-pearl-dirty-fields-clean-issue ()
  "A freshly rendered issue has no dirty fields and no comment candidates."
  (test-pearl-save--in-rendered (test-pearl-save--issue)
    (re-search-forward "Original description")
    (let ((d (pearl--issue-dirty-fields)))
      (should-not (plist-get d :title))
      (should-not (plist-get d :description))
      (should-not (plist-get d :comment-candidates)))))

(ert-deftest test-pearl-dirty-fields-title-edit ()
  "Editing the heading title (past the identifier prefix) marks the title dirty."
  (test-pearl-save--in-rendered (test-pearl-save--issue)
    (re-search-forward "Fix the Bug")
    (org-back-to-heading t)
    (org-edit-headline "ENG-1: Fix the Cache Bug")
    (let ((d (pearl--issue-dirty-fields)))
      (should (plist-get d :title))
      (should-not (plist-get d :description)))))

(ert-deftest test-pearl-dirty-fields-description-edit ()
  "Editing the body marks the description dirty, not the title."
  (test-pearl-save--in-rendered (test-pearl-save--issue)
    (re-search-forward "Original description\\.")
    (end-of-line)
    (insert " EDITED")
    (let ((d (pearl--issue-dirty-fields)))
      (should (plist-get d :description))
      (should-not (plist-get d :title)))))

(ert-deftest test-pearl-dirty-fields-lossy-description-stays-clean ()
  "A description whose markdown is lossy under org->md is not falsely dirty (HP1)."
  (test-pearl-save--in-rendered
      '(:id "u" :identifier "ENG-2" :title "t" :priority 3
        :state (:name "Todo") :description "# Heading\nbody text")
    (re-search-forward "body text")
    (should-not (plist-get (pearl--issue-dirty-fields) :description))))

(ert-deftest test-pearl-dirty-fields-comment-candidate ()
  "An edited comment surfaces as a candidate carrying its id and author-id."
  (test-pearl-save--in-rendered (test-pearl-save--issue)
    ;; edit the comment body
    (re-search-forward "my comment")
    (end-of-line)
    (insert " edited")
    ;; scan from inside the issue body (not the comment)
    (goto-char (point-min))
    (re-search-forward "Original description")
    (let ((cands (plist-get (pearl--issue-dirty-fields) :comment-candidates)))
      (should (= 1 (length cands)))
      (should (string= "c1" (plist-get (car cands) :comment-id)))
      (should (string= "u-craig" (plist-get (car cands) :author-id))))))

(ert-deftest test-pearl-dirty-fields-unedited-comment-no-candidate ()
  "An unedited comment is not a candidate."
  (test-pearl-save--in-rendered (test-pearl-save--issue)
    (re-search-forward "Original description")
    (should-not (plist-get (pearl--issue-dirty-fields) :comment-candidates))))

;;; --classify-comment-candidates (Phase B, by viewer id)

(ert-deftest test-pearl-classify-comment-candidates ()
  "Candidates split into own (author = viewer) and read-only (everyone else)."
  (let* ((cands '((:comment-id "c1" :author-id "u-craig")
                  (:comment-id "c2" :author-id "u-other")
                  (:comment-id "c3" :author-id "")))   ; bot/external: not own
         (r (pearl--classify-comment-candidates cands "u-craig")))
    (should (equal '("c1") (mapcar (lambda (c) (plist-get c :comment-id))
                                   (plist-get r :own))))
    (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--entry-body-at-point))
                         (org-entry-get nil "LINEAR-DESC-ORG-SHA256")))
        (should (string= (secure-hash 'sha256 (pearl--org-to-md (pearl--entry-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