;;; test-pearl-todo-keywords.el --- Tests for deriving TODO keywords from states -*- lexical-binding: t; -*- ;; Copyright (C) 2026 Craig Jennings ;; Author: Craig Jennings ;; 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 . ;;; Commentary: ;; Tests for the pure derivation helpers behind the workspace-derived #+TODO ;; line: `pearl--state-name-to-keyword' (slugify a Linear state name to an Org ;; keyword) and `pearl--derive-todo-line' (an ordered state list to the ;; "ACTIVE... | DONE..." keyword string). ;;; Code: (require 'test-bootstrap (expand-file-name "test-bootstrap.el")) ;;; --state-name-to-keyword (slugify) (ert-deftest test-pearl-state-name-to-keyword-spaces-and-case () "Spaces become hyphens and the name is upcased." (should (string= "DEV-REVIEW" (pearl--state-name-to-keyword "Dev Review"))) (should (string= "IN-PROGRESS" (pearl--state-name-to-keyword "In Progress"))) (should (string= "TODO" (pearl--state-name-to-keyword "Todo")))) (ert-deftest test-pearl-state-name-to-keyword-punctuation-runs () "A run of non-alphanumerics collapses to a single hyphen; edges trimmed." (should (string= "PM-ACCEPTANCE" (pearl--state-name-to-keyword "PM Acceptance"))) (should (string= "BACKLOG-PRIORITIZED" (pearl--state-name-to-keyword "Backlog (prioritized)")))) (ert-deftest test-pearl-state-name-to-keyword-unicode-preserved () "Unicode letters are kept (alnum is Unicode-aware), not stripped." (should (string= "ÅNGSTRÖM" (pearl--state-name-to-keyword "Ångström")))) (ert-deftest test-pearl-state-name-to-keyword-empty-slug-falls-back () "An all-symbol name (empty slug) falls back to TODO, as does the empty string." (should (string= "TODO" (pearl--state-name-to-keyword "!!!"))) (should (string= "TODO" (pearl--state-name-to-keyword "")))) ;;; --derive-todo-line (ert-deftest test-pearl-derive-todo-line-partitions-by-type () "Completed/canceled/duplicate states go after the bar; the rest before it." (should (string= "TODO IN-PROGRESS | DONE CANCELED" (pearl--derive-todo-line '((:name "Todo" :type "unstarted") (:name "In Progress" :type "started") (:name "Done" :type "completed") (:name "Canceled" :type "canceled")))))) (ert-deftest test-pearl-derive-todo-line-dedups-by-slug () "Two names slugifying to the same keyword list it once (first-seen)." (should (string= "DEV-REVIEW |" (pearl--derive-todo-line '((:name "Dev Review" :type "started") (:name "Dev-Review" :type "started")))))) (ert-deftest test-pearl-derive-todo-line-preserves-input-order () "Within each side, the caller's order is preserved." (should (string= "BACKLOG TODO IN-PROGRESS | DONE" (pearl--derive-todo-line '((:name "Backlog" :type "backlog") (:name "Todo" :type "unstarted") (:name "In Progress" :type "started") (:name "Done" :type "completed")))))) (ert-deftest test-pearl-derive-todo-line-empty-is-hardcoded-fallback () "An empty state list yields the hardcoded default so the file stays valid." (should (string= "TODO IN-PROGRESS IN-REVIEW BACKLOG BLOCKED | DONE" (pearl--derive-todo-line '())))) ;;; --gather-header-states (teams first-seen, states by position) (ert-deftest test-pearl-gather-header-states-orders-by-team-then-position () "Teams come in first-seen order; within a team, states sort by position." (cl-letf (((symbol-function 'pearl--team-states) (lambda (tid) (pcase tid ("t1" '(((id . "s2") (name . "In Progress") (type . "started") (position . 2.0)) ((id . "s1") (name . "Todo") (type . "unstarted") (position . 1.0)))) ("t2" '(((id . "s3") (name . "Done") (type . "completed") (position . 9.0)))))))) (let* ((issues (list (list :team '(:id "t1") :state '(:name "Todo" :type "unstarted")) (list :team '(:id "t2") :state '(:name "Done" :type "completed")))) (line (pearl--derive-todo-line (pearl--gather-header-states issues)))) (should (string= "TODO IN-PROGRESS | DONE" line))))) (ert-deftest test-pearl-gather-header-states-covers-failed-team () "A team whose fetch returns nil is skipped, but its issues' own states still appear." (cl-letf (((symbol-function 'pearl--team-states) (lambda (_tid) nil))) (let* ((issues (list (list :team '(:id "t9") :state '(:name "Grooming" :type "backlog")))) (line (pearl--derive-todo-line (pearl--gather-header-states issues)))) (should (string-match-p "GROOMING" line))))) ;;; --build-org-content with a derived #+TODO (ert-deftest test-pearl-build-org-content-derives-todo-from-states () "With a states list, the #+TODO line is derived (not the hardcoded default)." (let ((out (pearl--build-org-content '() '(:type filter :name "X" :filter nil) nil '((:name "Todo" :type "unstarted") (:name "Dev Review" :type "started") (:name "Done" :type "completed"))))) (should (string-match-p "^#\\+TODO: TODO DEV-REVIEW \\| DONE$" out)))) (ert-deftest test-pearl-build-org-content-no-states-keeps-fallback () "With no states (nil), the #+TODO line stays the hardcoded default." (let ((out (pearl--build-org-content '() '(:type filter :name "X" :filter nil) nil nil))) (should (string-match-p "^#\\+TODO: TODO IN-PROGRESS IN-REVIEW BACKLOG BLOCKED \\| DONE$" out)))) ;;; --update-derived-todo-header (merge-refresh, final-buffer scan) (ert-deftest test-pearl-update-derived-todo-header-covers-buffer-headings () "The header rebuild scans the final buffer so every visible heading is declared." (let ((org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) (with-temp-buffer (insert "#+STARTUP: show2levels\n#+TODO: TODO | DONE\n\n" "* View\n" "** IN-PROGRESS Issue A\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-STATE-TYPE: started\n:END:\n" "** DONE Issue B\n:PROPERTIES:\n:LINEAR-ID: b\n:LINEAR-STATE-TYPE: completed\n:END:\n") (org-mode) ;; no team states passed -- the rebuild comes purely from the buffer scan (pearl--update-derived-todo-header '()) (goto-char (point-min)) (should (re-search-forward "^#\\+TODO: IN-PROGRESS \\| DONE$" nil t))))) (ert-deftest test-pearl-update-derived-todo-header-classifies-legacy-by-done-keyword () "A retained heading with no STATE-TYPE drawer is classified by org-done-keywords." (let ((org-todo-keywords '((sequence "TODO" "|" "SHIPPED")))) (with-temp-buffer (insert "#+STARTUP: show2levels\n#+TODO: TODO | SHIPPED\n\n" "* View\n" "** SHIPPED Old Issue\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\n") ; no STATE-TYPE (org-mode) (pearl--update-derived-todo-header '()) (goto-char (point-min)) ;; SHIPPED is an org done-keyword, so it lands on the done side (should (re-search-forward "^#\\+TODO: *\\| SHIPPED$" nil t))))) ;;; --resolve-keyword-to-state (keyword -> team state id, save-time) (ert-deftest test-pearl-resolve-keyword-to-state-collision-first-by-position () "When two state names slugify to the same keyword, the lower position wins." (cl-letf (((symbol-function 'pearl--team-states) (lambda (_tid) '(((id . "s-hi") (name . "Dev Review") (type . "started") (position . 5.0)) ((id . "s-lo") (name . "Dev-Review") (type . "started") (position . 2.0)))))) (let ((r (pearl--resolve-keyword-to-state "DEV-REVIEW" "t1"))) (should (string= "s-lo" (plist-get r :id))) (should (string= "Dev-Review" (plist-get r :name))) (should (string= "started" (plist-get r :type)))))) (ert-deftest test-pearl-resolve-keyword-to-state-no-match-or-empty-returns-nil () "A keyword no state slugifies to yields nil, as does an empty/failed fetch." (cl-letf (((symbol-function 'pearl--team-states) (lambda (_tid) '(((id . "s1") (name . "Todo") (type . "unstarted") (position . 1.0)))))) (should-not (pearl--resolve-keyword-to-state "BLOCKED" "t1"))) (cl-letf (((symbol-function 'pearl--team-states) (lambda (_tid) nil))) (should-not (pearl--resolve-keyword-to-state "TODO" "t1")))) (provide 'test-pearl-todo-keywords) ;;; test-pearl-todo-keywords.el ends here