diff options
| -rw-r--r-- | pearl.el | 54 | ||||
| -rw-r--r-- | tests/test-pearl-grouping.el | 146 |
2 files changed, 200 insertions, 0 deletions
@@ -4498,6 +4498,60 @@ view's server order is honored); every other source uses `:sort'/`:order'." (cons (plist-get source :client-sort) (plist-get source :client-order)) (cons (plist-get source :sort) (plist-get source :order)))) +(defconst pearl--grouping-choices + '(("status" . "workflowState") + ("project" . "project") + ("assignee" . "assignee") + ("priority" . "priority") + ("none" . nil)) + "Interactive grouping dimensions: (DISPLAY . `issueGrouping' VALUE). +DISPLAY is what `pearl-set-grouping' completes; VALUE is the Linear +`issueGrouping' the render path speaks, or nil for \"none\" (ungroup). `cycle' +is intentionally absent: it isn't rendered into the issue drawer (see +`pearl--format-issue-as-org-entry'), so an offline client-side regroup can't +read it -- deferred until cycle drawer fields land.") + +(defun pearl--grouping-display-to-value (display) + "Coerce a DISPLAY grouping label to its `issueGrouping' value (or nil). +Signals a `user-error' for a label outside `pearl--grouping-choices'." + (let ((cell (assoc display pearl--grouping-choices))) + (unless cell + (user-error "Unknown grouping %s; use one of %s" + display (mapconcat #'car pearl--grouping-choices "/"))) + (cdr cell))) + +(defun pearl--check-grouping (value) + "Validate a grouping VALUE; signal a `user-error' on an unknown one. +Returns t when VALUE is nil (none) or one of the interactive grouping values +\(`pearl--grouping-choices'). `cycle' and any other unsupported value are +rejected -- the render path treats them as flat, but the interactive command +refuses them before writing the header." + (let ((allowed (delq nil (mapcar #'cdr pearl--grouping-choices)))) + (when (and value (not (member value allowed))) + (user-error "Unknown grouping %s; use %s or none" + value (mapconcat #'car (butlast pearl--grouping-choices) "/")))) + t) + +(defun pearl--source-with-grouping (source value) + "Return SOURCE with grouping VALUE recorded under `:client-group'. +VALUE is an `issueGrouping' string for all source types (uniform key); a view's +own server `:group' is left intact so clearing the override restores it. A nil +VALUE (none) removes `:client-group' entirely, so `pearl--effective-grouping' +falls back to the server `:group' (a view) or to flat (a filter)." + (if value + (plist-put (copy-sequence source) :client-group value) + (cl-loop for (k v) on source by #'cddr + unless (eq k :client-group) append (list k v)))) + +(defun pearl--effective-grouping (source) + "Return the `issueGrouping' value SOURCE should render by, or nil for flat. +An interactive `:client-group' overrides a view's server `:group'; with no +override, a view uses its `:group' and a filter is flat. Every grouping +consumer (render, merge, append, refresh) reads through this so a refresh +reproduces the layout on screen rather than the server grouping." + (or (plist-get source :client-group) + (plist-get source :group))) + ;;; Sentinel infrastructure for filter / pick-one prompts ;; ;; These sentinel constants and helpers back the prompt UX shared by diff --git a/tests/test-pearl-grouping.el b/tests/test-pearl-grouping.el new file mode 100644 index 0000000..10902f1 --- /dev/null +++ b/tests/test-pearl-grouping.el @@ -0,0 +1,146 @@ +;;; 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")))) + +(provide 'test-pearl-grouping) +;;; test-pearl-grouping.el ends here |