blob: 10902f1604c038507e9a252da72b98032e326607 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
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
|
