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

;;; test-pearl-output.el --- Tests for the active-file output 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 active-file output model: the filter summary, the
;; source-tracking header (with the affordance preamble) written by
;; `--build-org-content', reading the active source back from a buffer, and
;; `pearl-refresh-current-view' re-running the recorded source.

;;; Code:

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

;;; --summarize-filter

(ert-deftest test-pearl-summarize-filter-fields ()
  "A filter plist summarizes its set dimensions in a readable string."
  (let ((s (pearl--summarize-filter '(:assignee :me :open t :state "In Progress"))))
    (should (string-match-p "assignee" s))
    (should (string-match-p "open" s))
    (should (string-match-p "In Progress" s))))

(ert-deftest test-pearl-summarize-filter-empty ()
  "An empty filter summarizes as all issues."
  (should (string-match-p "all" (pearl--summarize-filter nil))))

;;; --build-org-content with a source

(ert-deftest test-pearl-build-org-content-source-header ()
  "With a source, the header carries the title, serialized source, and count."
  (let* ((source '(:type filter :name "My open issues" :filter (:assignee :me :open t)))
         (out (pearl--build-org-content '() source)))
    (should (string-match-p "^#\\+title: Linear — My open issues$" out))
    (should (string-match-p "^#\\+LINEAR-SOURCE: " out))
    (should (string-match-p "^#\\+LINEAR-COUNT: 0$" out))
    ;; the help header (default on) carries the cues now; the raw `#' affordance
    ;; comments are gone
    (should (string-match-p "^\\* Pearl Help$" out))
    (should-not (string-match-p "^# " out))))

(ert-deftest test-pearl-build-org-content-emits-priorities-range ()
  "The header pins the priority range to Linear's A-D (highest A, lowest D) so
cookie cycling reaches Low regardless of the user's global `org-priority-lowest'."
  (let ((out (pearl--build-org-content '() '(:type filter :name "X" :filter nil))))
    (should (string-match-p "^#\\+PRIORITIES: A D D$" out))))

(ert-deftest test-pearl-build-org-content-source-roundtrips ()
  "The serialized source in the header reads back to the original plist."
  (let* ((source '(:type filter :name "Bugs" :filter (:labels ("bug") :open t)))
         (out (pearl--build-org-content '() source)))
    (with-temp-buffer
      (insert out)
      (should (equal source (pearl--read-active-source))))))

(ert-deftest test-pearl-build-org-content-default-source-back-compat ()
  "Called with no source, the content still has a title and no entries."
  (let ((out (pearl--build-org-content '())))
    (should (string-match-p "^#\\+title:" out))
    (should-not (string-match-p "^\\*\\*\\* " out))))

;;; --build-org-content grouping (issueGrouping -> Org sections)

(ert-deftest test-pearl-build-org-content-flat-startup-show2levels ()
  "An ungrouped view folds to show2levels and renders issues at level 2."
  (let* ((issues '((:id "1" :identifier "SE-1" :title "One"
                    :state (:name "Started" :type "started") :priority 0)))
         (source '(:type view :name "Flat" :id "v1"))
         (out (pearl--build-org-content issues source)))
    (should (string-match-p "^#\\+STARTUP: show2levels$" out))
    (should (string-match-p "^\\*\\* STARTED " out))
    (should-not (string-match-p "^\\*\\*\\* " out))))

(ert-deftest test-pearl-build-org-content-grouped-sections-and-startup ()
  "A grouped view folds to show3levels, emits a level-2 group heading per group
in Linear board order (state type rank), and renders issues at level 3 under them."
  (let* ((issues '((:id "1" :identifier "SE-1" :title "One"
                    :state (:name "Started" :type "started") :priority 0)
                   (:id "2" :identifier "SE-2" :title "Two"
                    :state (:name "Backlog" :type "backlog") :priority 0)
                   (:id "3" :identifier "SE-3" :title "Three"
                    :state (:name "Started" :type "started") :priority 0)))
         (source '(:type view :name "By status" :id "v1" :group "workflowState"))
         (out (pearl--build-org-content issues source)))
    (should (string-match-p "^#\\+STARTUP: show3levels$" out))
    (should (string-match-p "^\\*\\* Started$" out))
    (should (string-match-p "^\\*\\* Backlog$" out))
    ;; Issues live at level 3 under the group headings.
    (should (string-match-p "^\\*\\*\\* STARTED " out))
    ;; Board order: Backlog (backlog-type) sorts before Started (started-type),
    ;; regardless of which appeared first in the input.
    (should (< (string-match "^\\*\\* Backlog$" out)
               (string-match "^\\*\\* Started$" out)))
    ;; The first group heading carries no LINEAR-ID, so save/merge skip it: it
    ;; sits ahead of the first issue drawer.
    (let ((first-group (string-match "^\\*\\* Backlog$" out))
          (next-id (string-match "LINEAR-ID:" out)))
      (should first-group)
      (should (< first-group next-id)))))

(ert-deftest test-pearl-build-org-content-grouped-source-roundtrips ()
  "A grouped view's source (with :group) reads back from the rendered header."
  (let* ((source '(:type view :name "By project" :id "v1" :group "project"))
         (out (pearl--build-org-content '() source)))
    (with-temp-buffer
      (insert out)
      (should (equal source (pearl--read-active-source))))))

(ert-deftest test-pearl-build-org-content-title-uses-view-name-verbatim ()
  "The view name in the file title matches Linear's capitalization verbatim,
independent of `pearl-title-case-headings' (which governs issue headings only)."
  (let ((case-fold-search nil)             ; strict so casing actually matters
        (source '(:type filter :name "my open bugs" :filter nil)))
    (let ((pearl-title-case-headings t))
      (should (string-match-p "^#\\+title: Linear — my open bugs$"
                              (pearl--build-org-content '() source))))
    (let ((pearl-title-case-headings nil))
      (should (string-match-p "^#\\+title: Linear — my open bugs$"
                              (pearl--build-org-content '() source))))))

;;; --build-org-content help header (`pearl-help-header')

(ert-deftest test-pearl-help-header-string-content ()
  "The help header is a folded \"* Pearl\" heading carrying the
edit-then-save reminder, key cues, the priority legend, and how to hide it.
It has no LINEAR-ID, so save and merge skip it."
  (let ((s (pearl--help-header-string)))
    (should (string-match-p "^\\* Pearl Help$" s))
    (should (string-match-p "^:VISIBILITY: folded$" s))
    (should (string-match-p "save" s))                ; edit-then-save / key cue
    (should (string-match-p "\\[#A\\] Urgent" s))     ; priority legend ends...
    (should (string-match-p "\\[#D\\] Low" s))        ; ...A through D
    (should (string-match-p "never sent to Linear" s)) ; local-only note
    (should (string-match-p "pearl-help-header" s))   ; how to turn it off
    (should-not (string-match-p "LINEAR-ID" s))))

(ert-deftest test-pearl-help-header-reflects-prefix ()
  "The key cues use the live `pearl-keymap-prefix'; a nil prefix points at M-x
instead of printing a bogus chord."
  (let ((pearl-keymap-prefix "C-c l"))
    (should (string-match-p "C-c l s" (pearl--help-header-string))))
  (let* ((pearl-keymap-prefix nil)
         (s (pearl--help-header-string)))
    (should (string-match-p "M-x" s))
    (should-not (string-match-p "nil s" s))))

(ert-deftest test-pearl-build-org-content-help-header-on ()
  "With `pearl-help-header' non-nil, the folded help heading is emitted and the
raw `#' affordance comments are not."
  (let* ((pearl-help-header t)
         (out (pearl--build-org-content '() '(:type filter :name "X" :filter nil))))
    (should (string-match-p "^\\* Pearl Help$" out))
    (should (string-match-p "^:VISIBILITY: folded$" out))
    (should-not (string-match-p "^# " out))))

(ert-deftest test-pearl-build-org-content-help-header-off ()
  "With `pearl-help-header' nil, neither the help heading nor the `#' comments
appear -- a minimal preamble of just the machine keywords."
  (let* ((pearl-help-header nil)
         (out (pearl--build-org-content '() '(:type filter :name "X" :filter nil))))
    (should-not (string-match-p "Pearl" out))
    (should-not (string-match-p "^# " out))
    (should (string-match-p "^#\\+title:" out))))

;;; --hide-preamble overlay (`pearl-hide-preamble')

(defun test-pearl-output--sample-content ()
  "Render a sample Linear buffer string for the overlay tests."
  (pearl--build-org-content
   '((:id "i1" :identifier "ENG-1" :title "one" :priority 1
      :state (:name "In Progress") :team (:id "t1")))
   '(:type filter :name "My open work" :filter (:assignee :me :open t))))

(ert-deftest test-pearl-preamble-summary-face-defined ()
  "The summary face exists for styling the collapsed preamble."
  (should (facep 'pearl-preamble-summary)))

(ert-deftest test-pearl-preamble-region-spans-keywords ()
  "`pearl--preamble-region' covers point-min through the first heading."
  (with-temp-buffer
    (insert (test-pearl-output--sample-content))
    (org-mode)
    (let ((region (pearl--preamble-region)))
      (should region)
      (should (= (car region) (point-min)))
      (should (string-prefix-p "* " (buffer-substring-no-properties
                                     (cdr region) (+ (cdr region) 2)))))))

(ert-deftest test-pearl-preamble-summary-composes-fields ()
  "The summary reads the view name, count, and run-at time from the buffer."
  (with-temp-buffer
    (insert (test-pearl-output--sample-content))
    (org-mode)
    (goto-char (point-min))
    (let ((s (pearl--preamble-summary)))
      (should (string-prefix-p "Pearl - My open work" s))
      (should (string-match-p " · 1" s))          ; one rendered issue
      (should (string-match-p "·" s)))))

(ert-deftest test-pearl-preamble-summary-names-the-account ()
  "In accounts mode the summary names the active account after Pearl, so two
buffers from different workspaces read differently."
  (with-temp-buffer
    (insert (pearl--build-org-content
             '((:id "i1" :identifier "ENG-1" :title "one" :priority 1
                :state (:name "In Progress") :team (:id "t1")))
             '(:type filter :name "My open work" :filter (:assignee :me :open t))
             nil nil "deepsat"))
    (org-mode)
    (goto-char (point-min))
    (should (string-prefix-p "Pearl - deepsat - My open work" (pearl--preamble-summary)))))

(ert-deftest test-pearl-hide-preamble-lays-one-tagged-overlay ()
  "With the option on, one tagged display overlay covers the preamble; applying
twice keeps exactly one (idempotent); off removes it.  Buffer text is untouched."
  (cl-flet ((pearl-ovs () (seq-filter (lambda (o) (overlay-get o 'pearl-preamble))
                                      (overlays-in (point-min) (point-max)))))
    (let ((pearl-hide-preamble t))
      (with-temp-buffer
        (insert (test-pearl-output--sample-content))
        (org-mode)
        (let ((text-before (buffer-string)))
          (pearl--hide-preamble)
          (should (= 1 (length (pearl-ovs))))
          (let ((ov (car (pearl-ovs))))
            (should (overlay-get ov 'display))
            (should (string-match-p "Pearl - My open work" (overlay-get ov 'display))))
          (pearl--hide-preamble)                   ; idempotent
          (should (= 1 (length (pearl-ovs))))
          (should (string-equal text-before (buffer-string)))  ; text untouched
          (let ((pearl-hide-preamble nil))         ; off removes it
            (pearl--hide-preamble)
            (should (= 0 (length (pearl-ovs))))))))))

;;; --read-active-source

(ert-deftest test-pearl-read-active-source-absent ()
  "A buffer with no source header reads back nil."
  (with-temp-buffer
    (insert "#+title: something\n\n* a heading\n")
    (should-not (pearl--read-active-source))))

;;; refresh-current-view

(ert-deftest test-pearl-refresh-current-view-reruns-source ()
  "Refresh reads the recorded filter source and merges the re-run result."
  (let ((ran nil) (merged-source nil)
        (source '(:type filter :name "My open issues" :filter (:assignee :me :open t))))
    (with-temp-buffer
      (insert (format "#+title: Linear — My open issues\n#+LINEAR-SOURCE: %s\n\n"
                      (prin1-to-string source)))
      (org-mode)
      (cl-letf (((symbol-function 'pearl--query-issues-async)
                 (lambda (_filter cb)
                   (setq ran t)
                   (funcall cb (pearl--make-query-result 'ok :issues nil))))
                ((symbol-function 'pearl--merge-query-result)
                 (lambda (_result src) (setq merged-source src))))
        (pearl-refresh-current-view)
        (should ran)
        (should (equal source merged-source))))))

(ert-deftest test-pearl-refresh-current-view-no-source-errors ()
  "Refresh with no recorded source signals a user error."
  (with-temp-buffer
    (insert "#+title: plain\n")
    (org-mode)
    (should-error (pearl-refresh-current-view) :type 'user-error)))

;;; malformed / unknown source headers

(ert-deftest test-pearl-read-active-source-malformed-is-nil ()
  "A syntactically malformed #+LINEAR-SOURCE: line reads back nil, not a reader error."
  (with-temp-buffer
    (insert "#+title: x\n#+LINEAR-SOURCE: (:type filter :filter (:assignee\n\n")
    (should-not (pearl--read-active-source))))

(ert-deftest test-pearl-refresh-current-view-malformed-source-errors ()
  "A malformed source header surfaces the no-source user error, not a reader error."
  (with-temp-buffer
    (insert "#+title: x\n#+LINEAR-SOURCE: (:type filter :filter (:assignee\n")
    (org-mode)
    (should-error (pearl-refresh-current-view) :type 'user-error)))

(ert-deftest test-pearl-refresh-current-view-unknown-type-errors ()
  "A source with a valid but unknown :type signals the unknown-type user error."
  (with-temp-buffer
    (insert (format "#+title: x\n#+LINEAR-SOURCE: %s\n"
                    (prin1-to-string '(:type bogus :name "x"))))
    (org-mode)
    (should-error (pearl-refresh-current-view) :type 'user-error)))

(ert-deftest test-pearl-source-header-roundtrips-special-chars ()
  "A source name/filter with quotes, parens, colons, and non-ASCII round-trips."
  (let ((source '(:type filter
                  :name "Bugs: \"urgent\" (P1) — café"
                  :filter (:labels ("a:b" "(paren)" "naïve")))))
    (with-temp-buffer
      (insert (pearl--build-org-content '() source))
      (should (equal source (pearl--read-active-source))))))

;;; --update-org-from-issues surfaces the result

(ert-deftest test-pearl-update-org-surfaces-fresh-buffer ()
  "With no buffer visiting the file, the write creates one and surfaces it."
  (let* ((tmp (make-temp-file "pearl-out" nil ".org"))
         (pearl-org-file-path tmp)
         (surfaced nil))
    (unwind-protect
        (progn
          (when (find-buffer-visiting tmp) (kill-buffer (find-buffer-visiting tmp)))
          (cl-letf (((symbol-function 'pearl--surface-buffer)
                     (lambda (b) (setq surfaced b))))
            (pearl--update-org-from-issues '() '(:type filter :name "X" :filter nil) nil))
          (should (bufferp surfaced))
          (should (buffer-live-p surfaced))
          (should (string= (file-truename tmp)
                           (file-truename (buffer-file-name surfaced)))))
      (when (find-buffer-visiting tmp) (kill-buffer (find-buffer-visiting tmp)))
      (ignore-errors (delete-file tmp)))))

(ert-deftest test-pearl-update-org-surfaces-existing-buffer ()
  "With a clean buffer visiting the file, the update surfaces that buffer."
  (let* ((tmp (make-temp-file "pearl-out" nil ".org"))
         (pearl-org-file-path tmp)
         (surfaced nil)
         (buf (find-file-noselect tmp)))
    (unwind-protect
        (progn
          (with-current-buffer buf (set-buffer-modified-p nil))
          (cl-letf (((symbol-function 'pearl--surface-buffer)
                     (lambda (b) (setq surfaced b))))
            (pearl--update-org-from-issues '() '(:type filter :name "X" :filter nil) nil))
          (should (eq surfaced buf)))
      (when (buffer-live-p buf)
        (with-current-buffer buf (set-buffer-modified-p nil))
        (kill-buffer buf))
      (ignore-errors (delete-file tmp)))))

;;; --update-org-from-issues on a dirty buffer (prompted: discard / merge / cancel)

(defconst test-pearl-output--issue
  '(:id "u" :identifier "ENG-1" :title "Hello" :priority 2 :state (:name "Todo"))
  "A minimal normalized issue for the dirty-buffer branch tests.")

(defmacro test-pearl-output--with-dirty-buffer (choice &rest body)
  "Run BODY with a modified buffer visiting a temp active file and the dirty
refresh prompt stubbed to return CHOICE.  BUF and TMP are bound in BODY."
  (declare (indent 1))
  `(let* ((tmp (make-temp-file "pearl-dirty" nil ".org"))
          (pearl-org-file-path tmp)
          (buf (find-file-noselect tmp)))
     (unwind-protect
         (with-current-buffer buf
           (insert "DIRTYMARKER not yet saved\n")   ; buffer is now modified
           (cl-letf (((symbol-function 'pearl--surface-buffer) #'ignore)
                     ((symbol-function 'pearl--dirty-refresh-choice)
                      (lambda (_path) ,choice)))
             ,@body))
       (when (buffer-live-p buf)
         (with-current-buffer buf (set-buffer-modified-p nil))
         (kill-buffer buf))
       (ignore-errors (delete-file tmp)))))

(ert-deftest test-pearl-update-org-dirty-discard-rebuilds ()
  "Choosing discard rebuilds the buffer from the fetch and clears the edits."
  (test-pearl-output--with-dirty-buffer ?d
    (pearl--update-org-from-issues (list test-pearl-output--issue)
                                   '(:type filter :name "X" :filter nil) nil)
    (should-not (buffer-modified-p))
    (should-not (string-match-p "DIRTYMARKER" (buffer-string)))
    (should (string-match-p "ENG-1" (buffer-string)))))

(ert-deftest test-pearl-update-org-dirty-cancel-leaves-buffer ()
  "Choosing cancel leaves the dirty buffer untouched."
  (test-pearl-output--with-dirty-buffer ?q
    (pearl--update-org-from-issues (list test-pearl-output--issue)
                                   '(:type filter :name "X" :filter nil) nil)
    (should (buffer-modified-p))
    (should (string-match-p "DIRTYMARKER" (buffer-string)))
    (should-not (string-match-p "ENG-1" (buffer-string)))))

(ert-deftest test-pearl-update-org-dirty-merge-routes-to-merge ()
  "Choosing merge routes to the by-LINEAR-ID merge instead of a rebuild."
  (let ((merged nil))
    (test-pearl-output--with-dirty-buffer ?m
      (cl-letf (((symbol-function 'pearl--merge-issues-into-buffer)
                 (lambda (_issues &optional _grouping) (setq merged t) '(:updated 1 :added 0 :dropped 0 :skipped 0)))
                ((symbol-function 'pearl--update-source-header) #'ignore)
                ((symbol-function 'pearl--update-derived-todo-header) #'ignore)
                ((symbol-function 'pearl-highlight-comments) #'ignore)
                ((symbol-function 'pearl--restore-page-visibility) #'ignore))
        (pearl--update-org-from-issues (list test-pearl-output--issue)
                                       '(:type filter :name "X" :filter nil) nil))
      (should merged)
      ;; merge does not rebuild, so the marker is not wiped by a full replace
      (should (string-match-p "DIRTYMARKER" (buffer-string))))))

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