diff options
| -rw-r--r-- | README.org | 2 | ||||
| -rw-r--r-- | pearl.el | 44 | ||||
| -rw-r--r-- | tests/test-pearl-format.el | 4 | ||||
| -rw-r--r-- | tests/test-pearl-labels.el | 193 |
4 files changed, 238 insertions, 5 deletions
@@ -229,7 +229,7 @@ How each field is edited: - *Title and description* -- type in the heading and the body. =pearl-edit-description= pops a focused compose buffer if you'd rather not edit inline. - *Priority* -- the Org priority cookie (=C-c ,=, or =S-up= / =S-down=). =[#A]/[#B]/[#C]/[#D]= are Urgent/High/Medium/Low; no cookie is None. - *State* -- =pearl-edit-state=, completing over the team's workflow states. -- *Assignee and labels* -- =pearl-edit-assignee= / =pearl-edit-labels=, completing over the team's members and labels. +- *Assignee and labels* -- =pearl-edit-assignee= / =pearl-edit-labels=, completing over the team's members and labels. Labels also render as Org tags on the heading (=:bug:backend:=), so you can filter, sparse-tree, and build agendas on them. The =:LINEAR-LABELS:= drawer stays the source of truth; hand-edited heading tags are ignored and rewritten from Linear on the next change or fetch, so change labels with =pearl-edit-labels=. - *Comments* -- edit your own in place, or =pearl-add-comment= for a new one. Picking a constrained field writes the value into the buffer and marks it changed; it doesn't push until you save. The display name or label text is there to read -- Pearl reconciles by the underlying id, and a refresh rewrites the display from the remote, so hand-editing the visible name has no effect. @@ -1535,6 +1535,32 @@ state-name-to-keyword mapping." "-+" "-+"))) (if (string-empty-p slug) "TODO" slug))) +(defun pearl--label-name-to-tag (name) + "Slugify a Linear label NAME to an Org tag. +Downcased, each run of characters outside [[:alnum:]_] replaced by a single +underscore (alnum is Unicode-aware, so accented and non-Latin letters survive), +with leading and trailing underscores trimmed. Org tags allow no hyphens or +spaces, unlike the TODO keywords `pearl--state-name-to-keyword' builds. A name +that slugifies to empty (all punctuation) returns the empty string; the caller +drops it from the heading and keeps it in the `:LINEAR-LABELS:' drawer." + (string-trim + (replace-regexp-in-string "[^[:alnum:]_]+" "_" (downcase (or name ""))) + "_+" "_+")) + +(defun pearl--label-tags (labels) + "Return the ordered, de-duplicated Org tags for a list of LABEL plists. +Each label's `:name' is slugified via `pearl--label-name-to-tag'; empty slugs +are dropped and duplicates removed, first occurrence winning, so two label +names that slugify to the same tag render it once at the first's position." + (let ((seen (make-hash-table :test 'equal)) + (tags '())) + (dolist (label labels) + (let ((tag (pearl--label-name-to-tag (plist-get label :name)))) + (unless (or (string-empty-p tag) (gethash tag seen)) + (puthash tag t seen) + (push tag tags)))) + (nreverse tags))) + (defun pearl--derive-todo-line (states) "Build the `#+TODO:' keyword string from an ordered STATES list. Each state is a plist with at least :name and :type. States whose :type is @@ -1804,11 +1830,13 @@ identifier prefix -- so an unedited heading is a no-op on title sync)." (plist-get issue :labels) ", ")) (label-ids (mapconcat (lambda (l) (or (plist-get l :id) "")) (plist-get issue :labels) " ")) + (tags (pearl--label-tags (plist-get issue :labels))) + (tag-string (if tags (concat " :" (string-join tags ":") ":") "")) (body-org (pearl--md-to-org description))) (concat - (format "** %s %s%s\n" todo + (format "** %s %s%s%s\n" todo (if (string-empty-p priority) "" (concat priority " ")) - heading-title) + heading-title tag-string) ":PROPERTIES:\n" (format ":LINEAR-ID: %s\n" (or (plist-get issue :id) "")) (format ":LINEAR-IDENTIFIER: %s\n" (or (plist-get issue :identifier) "")) @@ -2747,6 +2775,16 @@ inside an issue subtree." (org-entry-put nil "LINEAR-ASSIGNEE-ID" assignee-id) (message "Set assignee to %s (save to push)" assignee-name)))) +(defun pearl--set-heading-label-tags (tags) + "Replace the Org tags on the issue heading at point with TAGS, a list of strings. +Only the heading's tag set changes: the TODO keyword, priority cookie, title, +identifier prefix, body, and drawer are preserved. Pearl owns the entire +issue-heading tag set, so any hand-added tags are dropped. An empty TAGS list +clears the heading's tags. Point must be on or inside the issue heading." + (save-excursion + (org-back-to-heading t) + (org-set-tags tags))) + ;;;###autoload (defun pearl-edit-labels (label-names) "Set the labels of the issue at point to LABEL-NAMES in the buffer. @@ -2774,6 +2812,8 @@ inside an issue subtree." (org-entry-put nil "LINEAR-LABELS" (format "[%s]" (mapconcat #'identity label-names ", "))) (org-entry-put nil "LINEAR-LABEL-IDS" (string-join label-ids " ")) + (pearl--set-heading-label-tags + (pearl--label-tags (mapcar (lambda (n) (list :name n)) label-names))) (message "Set labels to %s (save to push)" (if label-names (mapconcat #'identity label-names ", ") "none"))))) diff --git a/tests/test-pearl-format.el b/tests/test-pearl-format.el index 53af2e7..491348a 100644 --- a/tests/test-pearl-format.el +++ b/tests/test-pearl-format.el @@ -51,7 +51,7 @@ so these tests no longer need a state mapping bound." "A full issue renders the heading and the namespaced LINEAR-* drawer." (test-pearl--with-default-mapping (let ((out (pearl--format-issue-as-org-entry (test-pearl--norm-full)))) - (should (string-match-p "^\\*\\* IN-PROGRESS \\[#B\\] ENG-42: Fix the Thing$" out)) + (should (string-match-p "^\\*\\* IN-PROGRESS \\[#B\\] ENG-42: Fix the Thing :bug:backend:$" out)) (should (string-match-p "^:LINEAR-ID: +uuid-1$" out)) (should (string-match-p "^:LINEAR-IDENTIFIER: +ENG-42$" out)) (should (string-match-p "^:LINEAR-STATE-NAME: +In Progress$" out)) @@ -168,7 +168,7 @@ sort together (org-sort on the parent) instead of being orphan headings." (test-pearl--with-default-mapping (let ((out (pearl--build-org-content (list (test-pearl--norm-full) (test-pearl--norm-bare))))) - (should (string-match-p "^\\*\\* IN-PROGRESS \\[#B\\] ENG-42: Fix the Thing$" out)) + (should (string-match-p "^\\*\\* IN-PROGRESS \\[#B\\] ENG-42: Fix the Thing :bug:backend:$" out)) (should (string-match-p "^\\*\\* TODO ENG-7: Bare Issue$" out))))) ;;; --restore-page-visibility diff --git a/tests/test-pearl-labels.el b/tests/test-pearl-labels.el new file mode 100644 index 0000000..0195b27 --- /dev/null +++ b/tests/test-pearl-labels.el @@ -0,0 +1,193 @@ +;;; 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)))) + +;;; rendering on the issue heading + +(defun test-pearl-labels--entry (labels) + "Render a minimal issue with LABELS 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))) + +(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))))) + +;;; 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-empty-clears () + "An empty tag set clears the heading's tags." + (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 |