;;; test-pearl-labels.el --- Tests for label-to-tag slugify and tag set -*- 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 pure helpers behind "Linear labels as Org tags"
;; (docs/labels-as-org-tags-spec.org): `pearl--label-name-to-tag' slugifies one
;; label name to an Org tag, and `pearl--label-tags' turns a list of label
;; plists into the ordered, de-duplicated tag set for a heading.

;;; Code:

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

;;; pearl--label-name-to-tag

(ert-deftest test-pearl-label-name-to-tag-downcases-and-slugs ()
  "A label name downcases; spaces and other non-tag chars become single underscores."
  (should (string= "bug" (pearl--label-name-to-tag "Bug")))
  (should (string= "needs_review" (pearl--label-name-to-tag "Needs Review")))
  (should (string= "ui_ux" (pearl--label-name-to-tag "UI/UX")))
  (should (string= "backend_api" (pearl--label-name-to-tag "backend/api")))
  (should (string= "p1" (pearl--label-name-to-tag "P1"))))

(ert-deftest test-pearl-label-name-to-tag-preserves-unicode-alnum ()
  "Unicode letters survive (alnum is Unicode-aware), downcased."
  (should (string= "naïve_café" (pearl--label-name-to-tag "naïve café"))))

(ert-deftest test-pearl-label-name-to-tag-collapses-runs-and-trims ()
  "Runs of non-tag characters collapse to one underscore; leading/trailing are trimmed."
  (should (string= "a_b" (pearl--label-name-to-tag "  a // b  ")))
  (should (string= "x" (pearl--label-name-to-tag "_x_"))))

(ert-deftest test-pearl-label-name-to-tag-punctuation-only-is-empty ()
  "A name with no tag-legal characters slugifies to the empty string."
  (should (string= "" (pearl--label-name-to-tag "///")))
  (should (string= "" (pearl--label-name-to-tag "")))
  (should (string= "" (pearl--label-name-to-tag nil))))

;;; pearl--label-tags

(ert-deftest test-pearl-label-tags-maps-in-order ()
  "Each label's :name slugifies; order is preserved."
  (should (equal '("bug" "backend")
                 (pearl--label-tags '((:id "1" :name "Bug") (:id "2" :name "Backend"))))))

(ert-deftest test-pearl-label-tags-dedupes-collisions-first-wins ()
  "Two names that slugify the same render one tag, at the first's position."
  (should (equal '("a_b")
                 (pearl--label-tags '((:name "A/B") (:name "A B"))))))

(ert-deftest test-pearl-label-tags-drops-empty-slugs ()
  "A punctuation-only label contributes no tag."
  (should (equal '("bug")
                 (pearl--label-tags '((:name "Bug") (:name "///"))))))

(ert-deftest test-pearl-label-tags-empty-input ()
  "No labels yields no tags."
  (should (null (pearl--label-tags nil))))

;;; pearl--assignee-tag

(ert-deftest test-pearl-assignee-tag-prefixes-and-slugs ()
  "An assignee renders as an @-prefixed, slugified Org tag."
  (should (string= "@eric" (pearl--assignee-tag '(:name "Eric"))))
  (should (string= "@eric_smith" (pearl--assignee-tag '(:name "Eric Smith")))))

(ert-deftest test-pearl-assignee-tag-prefers-display-name ()
  "The tag uses Linear's short displayName (its @-mention handle), not the name
field -- which is the full email for teammates who never set a display name."
  (should (string= "@nerses"
                   (pearl--assignee-tag '(:name "Nerses Ohanyan" :display-name "nerses"))))
  (should (string= "@vrezh_mikayelyan"
                   (pearl--assignee-tag '(:name "vrezh.mikayelyan@deepsat.com"
                                          :display-name "vrezh.mikayelyan")))))

(ert-deftest test-pearl-assignee-tag-falls-back-to-name ()
  "With no displayName, the tag slugs the name."
  (should (string= "@eric_bell" (pearl--assignee-tag '(:name "Eric Bell")))))

(ert-deftest test-pearl-assignee-tag-short-keeps-first-segment ()
  "With `pearl-assignee-tag-short' on, only the first name (before the first dot
or space) is kept, so a firstname.lastname handle shortens to just the first."
  (let ((pearl-assignee-tag-short t))
    (should (string= "@vrezh" (pearl--assignee-tag '(:display-name "vrezh.mikayelyan"))))
    (should (string= "@eric" (pearl--assignee-tag '(:name "Eric Bell"))))
    ;; A single-token handle is unchanged.
    (should (string= "@nerses" (pearl--assignee-tag '(:display-name "nerses"))))))

(ert-deftest test-pearl-assignee-tag-short-off-keeps-full-handle ()
  "Off by default: the full slugified handle is kept."
  (should (string= "@vrezh_mikayelyan"
                   (pearl--assignee-tag '(:display-name "vrezh.mikayelyan")))))

(ert-deftest test-pearl-normalize-user-captures-display-name ()
  "The normalized user carries Linear's displayName so the @-tag can use the
short handle while the drawer keeps the fuller name."
  (let ((u (pearl--normalize-user '((id . "u1") (name . "Nerses Ohanyan")
                                    (displayName . "nerses") (email . "n@x")))))
    (should (string= "nerses" (plist-get u :display-name)))
    (should (string= "Nerses Ohanyan" (plist-get u :name)))))

(ert-deftest test-pearl-assignee-tag-nil-when-unassigned ()
  "No assignee yields no tag."
  (should-not (pearl--assignee-tag nil)))

(ert-deftest test-pearl-assignee-tag-nil-when-disabled ()
  "With `pearl-show-assignee' off, no tag is produced even for a real assignee."
  (let ((pearl-show-assignee nil))
    (should-not (pearl--assignee-tag '(:name "Eric")))))

(ert-deftest test-pearl-assignee-tag-empty-slug-is-nil ()
  "A name that slugifies to empty (all punctuation) yields no tag."
  (should-not (pearl--assignee-tag '(:name "///"))))

;;; rendering on the issue heading

(defun test-pearl-labels--entry (labels &optional assignee)
  "Render a minimal issue with LABELS (and optional ASSIGNEE) via
`pearl--format-issue-as-org-entry'."
  (pearl--format-issue-as-org-entry
   (list :id "u" :identifier "ENG-1" :title "Fix the thing"
         :priority 2 :state '(:name "Todo") :labels labels :assignee assignee)))

(ert-deftest test-pearl-format-issue-renders-label-tags ()
  "Labels render as Org tags on the issue heading; the drawer keeps the names."
  (let ((out (test-pearl-labels--entry '((:id "1" :name "Bug") (:id "2" :name "Backend")))))
    (should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing :bug:backend:$" out))
    (should (string-match-p "^:LINEAR-LABELS: +\\[Bug, Backend\\]$" out))))

(ert-deftest test-pearl-format-issue-no-labels-no-tags ()
  "An issue with no labels gets no tag string on the heading."
  (let ((out (test-pearl-labels--entry nil)))
    (should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing$" out))))

(ert-deftest test-pearl-format-issue-label-tag-collision-renders-once ()
  "Two labels that slugify the same render one tag; the drawer keeps both names."
  (let ((out (test-pearl-labels--entry '((:name "A/B") (:name "A B")))))
    (should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing :a_b:$" out))
    (should (string-match-p "^:LINEAR-LABELS: +\\[A/B, A B\\]$" out))))

(ert-deftest test-pearl-format-issue-empty-slug-label-not-on-heading ()
  "A punctuation-only label is absent from the heading but present in the drawer."
  (let ((out (test-pearl-labels--entry '((:name "Bug") (:name "///")))))
    (should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing :bug:$" out))
    (should (string-match-p "^:LINEAR-LABELS: +\\[Bug, ///\\]$" out))))

(ert-deftest test-pearl-format-issue-tags-do-not-corrupt-title-sync ()
  "With tags present, the title at point is still the bare title (no tags/keyword/prefix)."
  (with-temp-buffer
    (insert (test-pearl-labels--entry '((:name "Bug") (:name "Backend"))))
    (org-mode)
    (goto-char (point-min))
    (re-search-forward "^\\*\\* ")
    (should (string= "Fix the thing" (pearl--issue-title-at-point)))))

(ert-deftest test-pearl-format-issue-renders-assignee-tag-before-labels ()
  "The assignee renders as the leading @-tag, ahead of the label tags."
  (let ((out (test-pearl-labels--entry '((:name "Bug")) '(:name "Eric"))))
    (should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing :@eric:bug:$" out))))

(ert-deftest test-pearl-format-issue-assignee-tag-only ()
  "An assigned issue with no labels gets just the @-tag."
  (let ((out (test-pearl-labels--entry nil '(:name "Eric"))))
    (should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing :@eric:$" out))))

(ert-deftest test-pearl-format-issue-assignee-tag-disabled ()
  "With `pearl-show-assignee' off, the heading carries no @-tag."
  (let* ((pearl-show-assignee nil)
         (out (test-pearl-labels--entry '((:name "Bug")) '(:name "Eric"))))
    (should (string-match-p "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing :bug:$" out))
    (should-not (string-match-p "@eric" out))))

(ert-deftest test-pearl-format-issue-assignee-tag-does-not-corrupt-title-sync ()
  "The assignee tag stays outside the hashed title span, like label tags."
  (with-temp-buffer
    (insert (test-pearl-labels--entry '((:name "Bug")) '(:name "Eric")))
    (org-mode)
    (goto-char (point-min))
    (re-search-forward "^\\*\\* ")
    (should (string= "Fix the thing" (pearl--issue-title-at-point)))))

;;; pearl--set-heading-label-tags

(ert-deftest test-pearl-set-heading-label-tags-replaces-preserving-the-rest ()
  "Replacing the tag set leaves the keyword, cookie, title, and identifier intact."
  (with-temp-buffer
    (insert "** TODO [#B] ENG-1: Fix the thing :old:\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nbody\n")
    (org-mode)
    (goto-char (point-min))
    (re-search-forward "^\\*\\* ")
    (pearl--set-heading-label-tags '("bug" "backend"))
    (goto-char (point-min))
    (should (re-search-forward "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing[ \t]+:bug:backend:$" nil t))
    ;; drawer and body untouched
    (should (string= "a" (org-entry-get nil "LINEAR-ID")))))

(ert-deftest test-pearl-set-heading-label-tags-preserves-assignee-tag ()
  "Rewriting the label tags keeps the @-assignee tag (pearl owns label tags, but
the assignee tag is a separate namespace) and drops other stale tags."
  (with-temp-buffer
    (insert "** TODO [#B] ENG-1: Fix the thing :@eric:old:\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nbody\n")
    (org-mode)
    (goto-char (point-min))
    (re-search-forward "^\\*\\* ")
    (pearl--set-heading-label-tags '("bug" "backend"))
    (goto-char (point-min))
    (should (re-search-forward "^\\*\\* TODO \\[#B\\] ENG-1: Fix the thing[ \t]+:@eric:bug:backend:$" nil t))
    (should-not (save-excursion (goto-char (point-min)) (re-search-forward ":old:" nil t)))))

(ert-deftest test-pearl-set-heading-label-tags-empty-clears ()
  "An empty tag set clears the heading's label tags (the @-assignee tag, if any,
is kept -- it isn't a label)."
  (with-temp-buffer
    (insert "** TODO [#B] ENG-1: Fix :bug:\n")
    (org-mode)
    (goto-char (point-min))
    (re-search-forward "^\\*\\* ")
    (pearl--set-heading-label-tags nil)
    (goto-char (point-min))
    (should (re-search-forward "^\\*\\* TODO \\[#B\\] ENG-1: Fix[ \t]*$" nil t))
    (should-not (save-excursion (goto-char (point-min)) (re-search-forward ":bug:" nil t)))))

;;; pearl-edit-labels rewrites both the drawer and the heading tags

(ert-deftest test-pearl-edit-labels-rewrites-heading-tags-and-drawer ()
  "Picking labels updates the drawer and rewrites the heading tags, dropping stale ones."
  (cl-letf (((symbol-function 'pearl--resolve-team-id)
             (lambda (_type name _team) (concat "id-" name))))
    (with-temp-buffer
      (insert "** TODO ENG-1: Fix :stale:\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: t1\n:LINEAR-LABELS: [old]\n:LINEAR-LABEL-IDS: x\n:END:\n")
      (org-mode)
      (goto-char (point-min))
      (re-search-forward "^\\*\\* ")
      (pearl-edit-labels '("Bug" "Backend"))
      (should (string= "[Bug, Backend]" (org-entry-get nil "LINEAR-LABELS")))
      (should (string= "id-Bug id-Backend" (org-entry-get nil "LINEAR-LABEL-IDS")))
      (goto-char (point-min))
      (should (re-search-forward "^\\*\\* TODO ENG-1: Fix[ \t]+:bug:backend:$" nil t))
      (should-not (save-excursion (goto-char (point-min)) (re-search-forward ":stale:" nil t))))))

(ert-deftest test-pearl-edit-labels-clear-removes-tags-and-empties-drawer ()
  "Clearing the selection removes heading tags and sets the drawer to []."
  (with-temp-buffer
    (insert "** TODO ENG-1: Fix :bug:\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-TEAM-ID: t1\n:LINEAR-LABELS: [Bug]\n:LINEAR-LABEL-IDS: id-Bug\n:END:\n")
    (org-mode)
    (goto-char (point-min))
    (re-search-forward "^\\*\\* ")
    (pearl-edit-labels nil)
    (should (string= "[]" (org-entry-get nil "LINEAR-LABELS")))
    (should (string= "" (org-entry-get nil "LINEAR-LABEL-IDS")))
    (should-not (save-excursion (goto-char (point-min)) (re-search-forward ":bug:" nil t)))))

;;; save isolation -- a tag edit is never a dirty field

(ert-deftest test-pearl-label-tags-edit-is-not-a-dirty-field ()
  "Hand-editing the heading tags does not mark the issue's labels dirty.
The dirty scan reads the LABEL-IDS drawer, not the heading tags, so a tag-only
change is never treated as a pushable edit."
  (with-temp-buffer
    (insert (test-pearl-labels--entry '((:id "lbl-1" :name "Bug"))))
    (org-mode)
    (goto-char (point-min))
    (re-search-forward "^\\*\\* ")
    ;; freshly rendered: LABEL-IDS == LABEL-IDS-SYNCED, so not dirty
    (should-not (pearl--label-ids-dirty-p))
    ;; hand-add a stray heading tag; the drawer is untouched
    (org-set-tags '("bug" "manual"))
    (should-not (pearl--label-ids-dirty-p))))

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