;;; test-pearl-grouping.el --- Tests for interactive grouping -*- 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 grouping the active view interactively (docs/interactive-grouping-spec.org):
;; the display<->value coercion and validation, the :client-group source
;; helper and the effective-grouping resolver, the in-place regroup (subtree
;; capture + heading-level shift + malformed-last), and the pearl-set-grouping
;; command.  Phase 1 covers the source/resolver plumbing.

;;; Code:

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

(defmacro test-pearl-grouping--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"))))
     (with-temp-buffer
       (insert ,content)
       (org-mode)
       (goto-char (point-min))
       ,@body)))

;;; display -> value coercion

(ert-deftest test-pearl-grouping-display-to-value-maps-status ()
  "The display label \"status\" coerces to Linear's `workflowState'."
  (should (equal (pearl--grouping-display-to-value "status") "workflowState")))

(ert-deftest test-pearl-grouping-display-to-value-identity-dimensions ()
  "Project/assignee/priority coerce to their own Linear grouping value."
  (should (equal (pearl--grouping-display-to-value "project") "project"))
  (should (equal (pearl--grouping-display-to-value "assignee") "assignee"))
  (should (equal (pearl--grouping-display-to-value "priority") "priority")))

(ert-deftest test-pearl-grouping-display-to-value-none-is-nil ()
  "The display label \"none\" coerces to nil (ungroup)."
  (should (null (pearl--grouping-display-to-value "none"))))

(ert-deftest test-pearl-grouping-display-to-value-unknown-errors ()
  "An unknown display label signals a `user-error'."
  (should-error (pearl--grouping-display-to-value "sideways") :type 'user-error))

;;; validation

(ert-deftest test-pearl-check-grouping-valid ()
  "nil (none) and the four interactive grouping values pass."
  (should (pearl--check-grouping nil))
  (should (pearl--check-grouping "workflowState"))
  (should (pearl--check-grouping "project"))
  (should (pearl--check-grouping "priority")))

(ert-deftest test-pearl-check-grouping-cycle-rejected ()
  "`cycle' is deferred from interactive grouping (not in the drawer)."
  (should-error (pearl--check-grouping "cycle") :type 'user-error))

(ert-deftest test-pearl-check-grouping-unknown-rejected ()
  "An unknown grouping value signals a `user-error'."
  (should-error (pearl--check-grouping "bogus") :type 'user-error))

;;; source helper

(ert-deftest test-pearl-source-with-grouping-filter ()
  "A filter records the interactive grouping under :client-group."
  (let ((out (pearl--source-with-grouping '(:type filter :name "x") "workflowState")))
    (should (equal (plist-get out :client-group) "workflowState"))))

(ert-deftest test-pearl-source-with-grouping-view-keeps-server-group ()
  "A view records :client-group, leaving its server :group untouched."
  (let ((out (pearl--source-with-grouping
              '(:type view :name "v" :id "vid" :group "project")
              "assignee")))
    (should (equal (plist-get out :client-group) "assignee"))
    (should (equal (plist-get out :group) "project"))))

(ert-deftest test-pearl-source-with-grouping-none-clears ()
  "Grouping value nil (none) removes :client-group so the source falls back."
  (let ((out (pearl--source-with-grouping
              '(:type view :name "v" :id "vid" :group "project" :client-group "assignee")
              nil)))
    (should-not (plist-member out :client-group))
    (should (equal (plist-get out :group) "project"))))

;;; effective-grouping resolver

(ert-deftest test-pearl-effective-grouping-view-client-overrides-server ()
  "A view's :client-group overrides its server :group."
  (should (equal (pearl--effective-grouping
                  '(:type view :group "project" :client-group "assignee"))
                 "assignee")))

(ert-deftest test-pearl-effective-grouping-view-server-only ()
  "A view with no :client-group renders by its server :group."
  (should (equal (pearl--effective-grouping '(:type view :group "project"))
                 "project")))

(ert-deftest test-pearl-effective-grouping-view-neither-is-nil ()
  "A view with neither key has no effective grouping (flat)."
  (should (null (pearl--effective-grouping '(:type view :name "v")))))

(ert-deftest test-pearl-effective-grouping-filter-client ()
  "A filter renders by its :client-group."
  (should (equal (pearl--effective-grouping '(:type filter :client-group "workflowState"))
                 "workflowState")))

(ert-deftest test-pearl-effective-grouping-none-cleared-falls-to-server ()
  "After none clears :client-group, a view falls back to its server :group."
  (let ((src (pearl--source-with-grouping
              '(:type view :group "project" :client-group "assignee") nil)))
    (should (equal (pearl--effective-grouping src) "project"))))

;;; header persistence

(ert-deftest test-pearl-grouping-client-group-roundtrips-in-header ()
  "Writing a source with :client-group is read back by `pearl--read-active-source'."
  (test-pearl-grouping--in-org
      (concat
       "#+LINEAR-SOURCE: (:type filter :name \"x\" :filter (:open t))\n\n"
       "* x\n")
    (pearl--write-linear-source-header
     (pearl--source-with-grouping '(:type filter :name "x" :filter (:open t))
                                  "workflowState"))
    (should (equal (plist-get (pearl--read-active-source) :client-group)
                   "workflowState"))))

;;; in-place regroup core (phase 2)

(defconst test-pearl-grouping--flat
  (concat
   "#+LINEAR-SOURCE: (:type filter :name \"F\" :filter (:open t))\n\n"
   "* F\n"
   "** TODO SE-1: Alpha\n:PROPERTIES:\n:LINEAR-ID: i1\n"
   ":LINEAR-STATE-NAME: In Progress\n:LINEAR-PROJECT-NAME: Apollo\n"
   ":LINEAR-ASSIGNEE-NAME: Eric\n:LINEAR-PRIORITY: 2\n:END:\n"
   "Body alpha.\n"
   "*** Comments\n"
   "**** Comment by Someone\n:PROPERTIES:\n:LINEAR-COMMENT-ID: c1\n:END:\nA comment.\n"
   "** TODO SE-2: Beta\n:PROPERTIES:\n:LINEAR-ID: i2\n"
   ":LINEAR-STATE-NAME: Todo\n:LINEAR-PROJECT-NAME: Apollo\n"
   ":LINEAR-PRIORITY: 1\n:END:\n"
   "Body beta.\n")
  "A flat two-issue buffer with drawer fields for status/project/assignee/priority.
SE-1 has a comment subtree; SE-2 has no assignee.")

(defun test-pearl-grouping--issue-level (id)
  "Return the heading level of the issue with LINEAR-ID = ID, or nil."
  (save-excursion
    (goto-char (point-min))
    (catch 'found
      (while (re-search-forward "^\\*+ " nil t)
        (when (equal (org-entry-get nil "LINEAR-ID") id)
          (throw 'found (org-current-level))))
      nil)))

(defun test-pearl-grouping--group-headings ()
  "Return the level-2 non-issue headings (group labels) in document order."
  (let (out)
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward "^\\*\\* \\(.*\\)$" nil t)
        ;; Capture the heading text before `org-entry-get', whose internal
        ;; regex clobbers the match data.
        (let ((text (match-string-no-properties 1)))
          (unless (org-entry-get nil "LINEAR-ID")
            (push text out)))))
    (nreverse out)))

(ert-deftest test-pearl-shift-heading-levels-demote ()
  "A +1 shift adds a star to every heading line, leaving body lines alone."
  (should (equal (pearl--shift-heading-levels "** H\n:PROPERTIES:\n:X: 1\n:END:\nbody\n*** C\n" 1)
                 "*** H\n:PROPERTIES:\n:X: 1\n:END:\nbody\n**** C\n")))

(ert-deftest test-pearl-shift-heading-levels-promote ()
  "A -1 shift removes a star from every heading line."
  (should (equal (pearl--shift-heading-levels "*** H\nbody\n**** C\n" -1)
                 "** H\nbody\n*** C\n")))

(ert-deftest test-pearl-shift-heading-levels-zero-is-identity ()
  "A zero delta returns the text unchanged."
  (should (equal (pearl--shift-heading-levels "** H\nbody\n" 0) "** H\nbody\n")))

(ert-deftest test-pearl-regroup-flat-by-status ()
  "Grouping a flat buffer by status sections issues under level-2 group headings."
  (test-pearl-grouping--in-org test-pearl-grouping--flat
    (should (eq (pearl--regroup-issue-subtrees "workflowState") t))
    (should (equal (test-pearl-grouping--group-headings) '("In Progress" "Todo")))
    (should (= (test-pearl-grouping--issue-level "i1") 3))
    (should (= (test-pearl-grouping--issue-level "i2") 3))))

(ert-deftest test-pearl-regroup-flat-by-project-single-group ()
  "Grouping by a shared dimension puts both issues under one group heading."
  (test-pearl-grouping--in-org test-pearl-grouping--flat
    (should (eq (pearl--regroup-issue-subtrees "project") t))
    (should (equal (test-pearl-grouping--group-headings) '("Apollo")))
    (should (= (test-pearl-grouping--issue-level "i1") 3))
    (should (= (test-pearl-grouping--issue-level "i2") 3))))

(ert-deftest test-pearl-regroup-unset-dimension-bucket ()
  "An issue with no value for the dimension lands in the \"No X\" bucket."
  (test-pearl-grouping--in-org test-pearl-grouping--flat
    (should (eq (pearl--regroup-issue-subtrees "assignee") t))
    (should (member "No assignee" (test-pearl-grouping--group-headings)))))

(ert-deftest test-pearl-regroup-priority-bucket-label ()
  "Priority grouping uses the Linear priority names (High, Urgent)."
  (test-pearl-grouping--in-org test-pearl-grouping--flat
    (should (eq (pearl--regroup-issue-subtrees "priority") t))
    (should (equal (sort (copy-sequence (test-pearl-grouping--group-headings)) #'string<)
                   '("High" "Urgent")))))

(ert-deftest test-pearl-regroup-none-flattens ()
  "Ungrouping a grouped buffer returns issues to level 2 with no group headings."
  (test-pearl-grouping--in-org test-pearl-grouping--flat
    (pearl--regroup-issue-subtrees "workflowState")
    (should (eq (pearl--regroup-issue-subtrees nil) t))
    (should (null (test-pearl-grouping--group-headings)))
    (should (= (test-pearl-grouping--issue-level "i1") 2))
    (should (= (test-pearl-grouping--issue-level "i2") 2))))

(ert-deftest test-pearl-regroup-grouped-to-different-dimension ()
  "Regrouping an already-grouped buffer by a new dimension re-buckets the issues."
  (test-pearl-grouping--in-org test-pearl-grouping--flat
    (pearl--regroup-issue-subtrees "workflowState")
    (should (eq (pearl--regroup-issue-subtrees "project") t))
    (should (equal (test-pearl-grouping--group-headings) '("Apollo")))
    (should (= (test-pearl-grouping--issue-level "i1") 3))
    (should (= (test-pearl-grouping--issue-level "i2") 3))))

(ert-deftest test-pearl-regroup-roundtrips-flat ()
  "Group then ungroup restores the flat shape and keeps both issues."
  (test-pearl-grouping--in-org test-pearl-grouping--flat
    (pearl--regroup-issue-subtrees "workflowState")
    (pearl--regroup-issue-subtrees nil)
    (should (= (test-pearl-grouping--issue-level "i1") 2))
    (should (= (test-pearl-grouping--issue-level "i2") 2))
    (should (equal (sort (mapcar #'car (pearl--issue-subtree-markers)) #'string<)
                   '("i1" "i2")))))

(ert-deftest test-pearl-regroup-preserves-local-edits ()
  "Regroup moves subtrees byte-for-byte: an unsaved body edit survives."
  (test-pearl-grouping--in-org test-pearl-grouping--flat
    (goto-char (point-min))
    (search-forward "Body alpha.")
    (replace-match "Body alpha EDITED LOCALLY.")
    (should (eq (pearl--regroup-issue-subtrees "workflowState") t))
    (goto-char (point-min))
    (should (search-forward "Body alpha EDITED LOCALLY." nil t))
    ;; the comment child rode along under the regrouped issue
    (should (= (test-pearl-grouping--issue-level "i1") 3))
    (goto-char (point-min))
    (should (search-forward "A comment." nil t))))

(ert-deftest test-pearl-regroup-keeps-malformed-subtree-last ()
  "A non-issue level-2 subtree is kept, placed after the issue groups."
  (test-pearl-grouping--in-org
      (concat test-pearl-grouping--flat
              "** Stray non-issue heading\nSome notes.\n")
    (should (eq (pearl--regroup-issue-subtrees "workflowState") t))
    (let ((headings (test-pearl-grouping--group-headings)))
      (should (member "Stray non-issue heading" headings))
      ;; the stray heading sorts after the real group headings
      (should (equal (car (last headings)) "Stray non-issue heading")))))

(ert-deftest test-pearl-regroup-no-issues ()
  "An issue-free buffer reports `no-issues' and is left alone."
  (test-pearl-grouping--in-org
      "#+LINEAR-SOURCE: (:type filter :name \"F\" :filter nil)\n\n* F\n"
    (should (eq (pearl--regroup-issue-subtrees "workflowState") 'no-issues))))

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