path: root/tests/test-pearl-merge.el

;;; test-pearl-merge.el --- Tests for merge-by-LINEAR-ID refresh -*- 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 same-source refresh merge: `pearl--merge-issues-into-buffer'
;; updates existing issue subtrees in place by LINEAR-ID, appends new matches,
;; drops issues gone from the result, and protects unpushed local edits (it
;; neither overwrites nor drops a subtree whose body diverges from its stored
;; provenance hash).  Also covers the header refresh and the `--merge-query-result'
;; render boundary that drives `pearl-refresh-current-view'.

;;; Code:

(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))
(require 'testutil-request (expand-file-name "testutil-request.el"))
(require 'cl-lib)

(defmacro test-pearl-merge--in-org (content &rest body)
  "Run BODY in an org-mode temp buffer holding CONTENT."
  (declare (indent 1))
  `(let ((org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE"))))
     ;; the merge's derived-header rebuild gathers team states synchronously;
     ;; stub it so the merge tests stay network-free (the header then derives
     ;; from the displayed issues' own states)
     (cl-letf (((symbol-function 'pearl--team-states) (lambda (_team-id) nil)))
       (with-temp-buffer
         (insert ,content)
         (org-mode)
         (goto-char (point-min))
         ,@body))))

(defun test-pearl-merge--issue (id title desc)
  "A normalized issue plist with ID, TITLE, and DESC for merge input."
  (list :id id :identifier (concat "ENG-" id) :title title :description desc
        :priority 2 :url (concat "https://linear.app/x/" id)
        :updated-at "2026-05-23T03:00:00.000Z"
        :state (list :id "s1" :name "Todo" :type "unstarted")
        :team (list :id "t1" :key "ENG" :name "Engineering")))

(defun test-pearl-merge--raw (id title desc)
  "A raw issue node (json-read shape) with ID, TITLE, and DESC."
  `((id . ,id) (identifier . ,(concat "ENG-" id)) (title . ,title)
    (description . ,desc) (priority . 2) (url . ,(concat "https://linear.app/x/" id))
    (updatedAt . "2026-05-23T03:00:00.000Z")
    (state (id . "s1") (name . "Todo") (type . "unstarted"))
    (team (id . "t1") (key . "ENG") (name . "Engineering"))
    (labels (nodes . []))))

(defun test-pearl-merge--buffer (&rest issues)
  "A header plus the formatted ISSUES, as the active file would hold them."
  (concat "#+title: Linear — My open issues\n"
          "#+LINEAR-SOURCE: (:type filter :name \"My open issues\" :filter (:assignee :me))\n"
          "#+LINEAR-RUN-AT: 2026-05-01 09:00\n"
          "#+LINEAR-COUNT: 9\n"
          "#+LINEAR-TRUNCATED: no\n\n"
          (mapconcat #'pearl--format-issue-as-org-entry issues "")))

;;; --merge-issues-into-buffer

(ert-deftest test-pearl-merge-updates-existing-in-place ()
  "An existing issue still in the result is re-rendered from the fetch in place."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")
                                (test-pearl-merge--issue "b" "Beta" "Desc Beta."))
    (let ((counts (pearl--merge-issues-into-buffer
                   (list (test-pearl-merge--issue "a" "Alpha Renamed" "Desc Alpha.")
                         (test-pearl-merge--issue "b" "Beta" "Desc Beta.")))))
      (should (= 2 (plist-get counts :updated)))
      (should (= 0 (plist-get counts :added)))
      (should (= 0 (plist-get counts :dropped)))
      (should (= 0 (plist-get counts :skipped)))
      (goto-char (point-min))
      (should (re-search-forward "Alpha Renamed" nil t))
      (should-not (save-excursion (re-search-forward "^\\*\\*\\* .*Alpha$" nil t)))
      ;; Alpha still precedes Beta — order is stable.
      (goto-char (point-min))
      (let ((a (progn (re-search-forward "Alpha Renamed") (point)))
            (b (progn (re-search-forward "Beta") (point))))
        (should (< a b))))))

(ert-deftest test-pearl-merge-appends-new-issue ()
  "An issue new to the result is appended after the existing ones."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha."))
    (let ((counts (pearl--merge-issues-into-buffer
                   (list (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")
                         (test-pearl-merge--issue "b" "Beta" "Desc Beta.")))))
      (should (= 1 (plist-get counts :added)))
      (goto-char (point-min))
      (should (string= "a" (progn (re-search-forward "LINEAR-ID: *\\(.*\\)$") (match-string 1))))
      (should (re-search-forward "LINEAR-ID: *b" nil t))
      (goto-char (point-min))
      (should (< (progn (re-search-forward "Alpha") (point))
                 (progn (re-search-forward "Beta") (point)))))))

(ert-deftest test-pearl-merge-drops-absent-issue ()
  "A clean issue no longer in the result is dropped."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")
                                (test-pearl-merge--issue "b" "Beta" "Desc Beta."))
    (let ((counts (pearl--merge-issues-into-buffer
                   (list (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")))))
      (should (= 1 (plist-get counts :dropped)))
      (goto-char (point-min))
      (should (re-search-forward "Alpha" nil t))
      (goto-char (point-min))
      (should-not (re-search-forward "Beta" nil t)))))

(ert-deftest test-pearl-merge-keeps-unpushed-edit-on-update ()
  "An existing subtree with unpushed body edits is kept, not overwritten."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha."))
    ;; Dirty the body so its hash no longer matches the stored provenance.
    (goto-char (point-min))
    (re-search-forward "Desc Alpha\\.")
    (end-of-line)
    (insert " UNPUSHED EDIT")
    (let ((counts (pearl--merge-issues-into-buffer
                   (list (test-pearl-merge--issue "a" "Alpha Renamed" "Remote desc.")))))
      (should (= 1 (plist-get counts :skipped)))
      (should (= 0 (plist-get counts :updated)))
      (goto-char (point-min))
      ;; Local edit and old heading survive; the remote rename did not land.
      (should (re-search-forward "UNPUSHED EDIT" nil t))
      (goto-char (point-min))
      (should-not (re-search-forward "Alpha Renamed" nil t)))))

(ert-deftest test-pearl-merge-keeps-title-edited-issue ()
  "A subtree with an unpushed title edit (not a description edit) is kept too.
Merge must protect any locally-edited field, not only the description."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha."))
    (goto-char (point-min))
    (re-search-forward "Alpha")          ; the title word in the heading
    (insert " EDITED")                   ; dirty the title only; body untouched
    (let ((counts (pearl--merge-issues-into-buffer
                   (list (test-pearl-merge--issue "a" "Alpha Renamed" "Remote desc.")))))
      (should (= 1 (plist-get counts :skipped)))
      (should (= 0 (plist-get counts :updated)))
      (goto-char (point-min))
      (should (re-search-forward "Alpha EDITED" nil t))     ; local title edit kept
      (goto-char (point-min))
      (should-not (re-search-forward "Alpha Renamed" nil t))))) ; remote did not land

(ert-deftest test-pearl-merge-keeps-dirty-issue-absent-from-result ()
  "A dirty issue gone from the result is kept rather than dropped (no data loss)."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")
                                (test-pearl-merge--issue "b" "Beta" "Desc Beta."))
    (goto-char (point-min))
    (re-search-forward "Desc Alpha\\.")
    (end-of-line)
    (insert " UNPUSHED EDIT")
    (let ((counts (pearl--merge-issues-into-buffer
                   (list (test-pearl-merge--issue "b" "Beta" "Desc Beta.")))))
      (should (= 1 (plist-get counts :skipped)))
      (should (= 0 (plist-get counts :dropped)))
      (goto-char (point-min))
      (should (re-search-forward "UNPUSHED EDIT" nil t)))))

;;; touched-markers + per-subtree fold

(ert-deftest test-pearl-merge-returns-touched-markers-for-updated-and-added ()
  "The merge result carries one marker per re-rendered or appended subtree,
and each marker lands on the CORRECT heading (not the next subtree).
A previous bug: the alist marker is insertion-type t (correct for
later subtrees), so reusing it captured the post-replace advance and
folded the wrong subtree.  The fix copies the marker as type-nil
before the replace so it stays anchored to the heading."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc.")
                                (test-pearl-merge--issue "b" "Beta" "Desc."))
    (let* ((counts (pearl--merge-issues-into-buffer
                    (list (test-pearl-merge--issue "a" "Alpha Renamed" "Desc.")
                          (test-pearl-merge--issue "b" "Beta" "Desc.")
                          (test-pearl-merge--issue "c" "Gamma" "Desc."))))
           (markers (plist-get counts :touched-markers)))
      ;; 2 updated + 1 added = 3 markers
      (should (= 3 (length markers)))
      ;; Resolve each marker to the LINEAR-ID at its heading.  The set must
      ;; match exactly {a, b, c}: a and b were updated, c was added.
      (let ((ids (mapcar (lambda (m)
                           (save-excursion
                             (goto-char m)
                             (org-back-to-heading t)
                             (org-entry-get nil "LINEAR-ID")))
                         markers)))
        (should (equal (sort (copy-sequence ids) #'string<)
                       '("a" "b" "c")))))))

(ert-deftest test-pearl-merge-skipped-issues-do-not-add-to-touched-markers ()
  "A locally-edited subtree the merge kept (skipped) is not in :touched-markers.
The fold should leave kept subtrees exactly as the user had them, so they
must not appear in the marker list the fold iterates."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")
                                (test-pearl-merge--issue "b" "Beta" "Desc Beta."))
    ;; Mark the "a" subtree dirty by editing its description.
    (goto-char (point-min))
    (re-search-forward "Desc Alpha.")
    (replace-match "Desc Alpha (locally edited).")
    (let* ((counts (pearl--merge-issues-into-buffer
                    (list (test-pearl-merge--issue "a" "Alpha" "Desc Alpha.")
                          (test-pearl-merge--issue "b" "Beta Renamed" "Desc Beta."))))
           (markers (plist-get counts :touched-markers)))
      (should (= 1 (plist-get counts :skipped))) ; a was kept
      (should (= 1 (plist-get counts :updated))) ; b was re-rendered
      ;; Only one marker, and it sits on the "b" subtree.
      (should (= 1 (length markers)))
      (save-excursion
        (goto-char (car markers))
        (org-back-to-heading t)
        (should (equal "b" (org-entry-get nil "LINEAR-ID")))))))

;;; pearl--fold-subtree-at-marker

(ert-deftest test-pearl-fold-subtree-at-marker-folds-heading-content ()
  "Folding a subtree leaves the heading visible and hides the content."
  (let ((pearl-fold-after-update t))
    (test-pearl-merge--in-org
        (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Body line."))
      (goto-char (point-min))
      (re-search-forward "^\\*\\* ")
      (beginning-of-line)
      (let ((heading-pos (point)))
        (pearl--fold-subtree-at-marker (copy-marker heading-pos))
        ;; The heading itself is visible
        (goto-char heading-pos)
        (should-not (invisible-p (point)))
        ;; A position inside the body is now invisible
        (re-search-forward "Body line.")
        (should (invisible-p (point)))))))

(ert-deftest test-pearl-fold-touched-subtrees-no-op-when-disabled ()
  "With `pearl-fold-after-update' nil, the fold helper does nothing."
  (let ((pearl-fold-after-update nil))
    (test-pearl-merge--in-org
        (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Body."))
      (goto-char (point-min))
      (re-search-forward "^\\*\\* ")
      (beginning-of-line)
      (let ((m (copy-marker (point))))
        (pearl--fold-touched-subtrees (list m))
        ;; Body stays visible
        (re-search-forward "Body")
        (should-not (invisible-p (point)))))))

(ert-deftest test-pearl-fold-subtree-at-marker-tolerates-nil-marker ()
  "A nil or dead marker is a silent no-op rather than erroring."
  (let ((pearl-fold-after-update t))
    (test-pearl-merge--in-org
        (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Body."))
      (should-not (pearl--fold-subtree-at-marker nil)))))

(ert-deftest test-pearl-merge-updates-rich-description-issue-in-place ()
  "An unedited issue with lossy markdown (a heading) is updated, not skipped.
Regression: the dirty check round-tripped Org back to markdown and mistook a
lossy round-trip (# heading -> bold, *italic* -> **bold**) for a local edit, so
refresh silently skipped every rich-text issue."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer
       (test-pearl-merge--issue "a" "Alpha" "# Heading\n\nSome body text."))
    (let ((counts (pearl--merge-issues-into-buffer
                   (list (test-pearl-merge--issue "a" "Alpha Renamed"
                                                  "# Heading\n\nSome body text.")))))
      (should (= 1 (plist-get counts :updated)))
      (should (= 0 (plist-get counts :skipped)))
      (goto-char (point-min))
      (should (re-search-forward "Alpha Renamed" nil t)))))

(ert-deftest test-pearl-subtree-dirty-p-rich-description-unedited-not-dirty ()
  "A freshly rendered subtree with lossy-markdown description is not dirty unedited."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer
       (test-pearl-merge--issue "a" "Alpha" "# Heading\n\nSome body text."))
    (goto-char (point-min))
    (re-search-forward "^\\*\\* ")
    (beginning-of-line)
    (should-not (pearl--subtree-dirty-p))))

(ert-deftest test-pearl-subtree-dirty-p-empty-description-not-dirty ()
  "An issue with an empty description is not dirty.
Regression: body extraction overshot an empty body into the next issue's
subtree, so every description-less issue read as a local edit."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer
       (test-pearl-merge--issue "a" "Alpha" "")
       (test-pearl-merge--issue "b" "Beta" "Desc Beta."))
    (goto-char (point-min))
    (re-search-forward "^\\*\\* ")
    (beginning-of-line)
    (should (string= "" (pearl--entry-body-at-point)))
    (should-not (pearl--subtree-dirty-p))))

(ert-deftest test-pearl-subtree-dirty-p-edited-body-is-dirty ()
  "Editing the rendered body still marks the subtree dirty (edit detection holds)."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer
       (test-pearl-merge--issue "a" "Alpha" "# Heading\n\nSome body text."))
    (goto-char (point-min))
    (re-search-forward "Some body text\\.")
    (end-of-line)
    (insert " LOCAL EDIT")
    (goto-char (point-min))
    (re-search-forward "^\\*\\* ")
    (beginning-of-line)
    (should (pearl--subtree-dirty-p))))

;;; --update-source-header

(ert-deftest test-pearl-merge-update-source-header-rewrites-count ()
  "The header refresh updates the count and truncation lines in place."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha."))
    (pearl--update-source-header 5 t)
    (goto-char (point-min))
    (should (re-search-forward "^#\\+LINEAR-COUNT: 5$" nil t))
    (goto-char (point-min))
    (should (re-search-forward "^#\\+LINEAR-TRUNCATED: yes$" nil t))))

;;; --merge-query-result (render boundary)

(ert-deftest test-pearl-merge-query-result-merges-and-updates-header ()
  "An ok result normalizes its raw nodes, merges them, and refreshes the count."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha."))
    (let ((source '(:type filter :name "My open issues" :filter (:assignee :me)))
          (result (pearl--make-query-result
                   'ok :issues (list (test-pearl-merge--raw "a" "Alpha Renamed" "Desc Alpha.")
                                      (test-pearl-merge--raw "c" "Gamma" "Desc Gamma.")))))
      (pearl--merge-query-result result source)
      (goto-char (point-min))
      (should (re-search-forward "Alpha Renamed" nil t))
      (should (re-search-forward "Gamma" nil t))
      (goto-char (point-min))
      (should (re-search-forward "^#\\+LINEAR-COUNT: 2$" nil t)))))

(ert-deftest test-pearl-merge-query-result-empty-leaves-buffer ()
  "An empty result leaves the buffer unchanged rather than dropping everything."
  (test-pearl-merge--in-org
      (test-pearl-merge--buffer (test-pearl-merge--issue "a" "Alpha" "Desc Alpha."))
    (let ((source '(:type filter :name "My open issues" :filter (:assignee :me)))
          (before (buffer-string)))
      (pearl--merge-query-result (pearl--make-query-result 'empty) source)
      (should (string= before (buffer-string))))))

(provide 'test-pearl-merge)
;;; test-pearl-merge.el ends here