diff options
| -rw-r--r-- | pearl.el | 105 | ||||
| -rw-r--r-- | tests/test-pearl-grouping.el | 58 | ||||
| -rw-r--r-- | tests/test-pearl-output.el | 18 |
3 files changed, 157 insertions, 24 deletions
@@ -1288,7 +1288,8 @@ display name) so the assignee @-tag can use the short form." (when raw (list :id (cdr (assoc 'id raw)) :name (cdr (assoc 'name raw)) - :type (cdr (assoc 'type raw))))) + :type (cdr (assoc 'type raw)) + :position (cdr (assoc 'position raw))))) (defun pearl--normalize-team (raw) "Normalize a Linear team alist RAW to a plist, or nil." @@ -1609,7 +1610,7 @@ populated list renders them, not just the single-issue refresh." issues(filter: $filter, first: $first, after: $after, orderBy: $orderBy) { nodes { id identifier title description priority url updatedAt - state { id name type } + state { id name type position } assignee { id name displayName email } team { id key name } project { id name } @@ -1625,7 +1626,7 @@ populated list renders them, not just the single-issue refresh." "query Issue($id: String!) { issue(id: $id) { id identifier title description priority url updatedAt - state { id name type } + state { id name type position } assignee { id name displayName email } team { id key name } project { id name } @@ -1766,20 +1767,67 @@ view. Returns nil for a grouping pearl doesn't section (see (t (format "Cycle %s" (plist-get cycle :number)))))) (_ nil))) +(defconst pearl--state-type-order + '(("triage" . 0) ("backlog" . 1) ("unstarted" . 2) + ("started" . 3) ("completed" . 4) ("canceled" . 5)) + "Rank of each Linear workflow-state type, matching the board's column order. +Used as the primary key when ordering `workflowState' group sections; the +state's `position' breaks ties within a type.") + +(defun pearl--state-type-rank (type) + "Return the board-order rank of a workflow-state TYPE (unknown sorts last)." + (or (cdr (assoc type pearl--state-type-order)) 6)) + +(defun pearl--priority-group-rank (priority) + "Return the group-order rank of a Linear PRIORITY number. +Urgent first .. Low, then None last -- matching how Linear orders a +priority-grouped board. A nil or 0 priority is None." + (pcase priority (1 0) (2 1) (3 2) (4 3) (_ 4))) + +(defun pearl--order-groups (grouping groups) + "Order GROUPS, a list of (LABEL . ISSUES), by GROUPING's natural order. +`workflowState' orders by (state type rank, state position) so the sections +match Linear's board columns; `priority' orders Urgent..None; every other +dimension sorts alphabetically by label. The sort is stable, so issues that +tie on the key keep their first-appearance order." + (pcase grouping + ("workflowState" + (sort (copy-sequence groups) + (lambda (a b) + (let* ((sa (plist-get (cadr a) :state)) + (sb (plist-get (cadr b) :state)) + (ra (pearl--state-type-rank (plist-get sa :type))) + (rb (pearl--state-type-rank (plist-get sb :type)))) + (if (/= ra rb) + (< ra rb) + (< (or (plist-get sa :position) 0) + (or (plist-get sb :position) 0))))))) + ("priority" + (sort (copy-sequence groups) + (lambda (a b) + (< (pearl--priority-group-rank (plist-get (cadr a) :priority)) + (pearl--priority-group-rank (plist-get (cadr b) :priority)))))) + (_ + (sort (copy-sequence groups) + (lambda (a b) (string< (downcase (or (car a) "")) (downcase (or (car b) "")))))))) + (defun pearl--group-issues (issues grouping) "Partition ISSUES into ordered groups by GROUPING. -Returns a list of (LABEL . ISSUES): groups in first-appearance order, and within -each group the issues keep their input order so the view's configured sort -survives inside every section. Returns nil when GROUPING isn't sectioned (see -`pearl--view-grouping-active-p'), signaling the caller to render the flat list." +Returns a list of (LABEL . ISSUES) ordered by `pearl--order-groups' (Linear's +board order for `workflowState'/`priority', alphabetical otherwise); within each +group the issues keep their input order so the view's configured sort survives. +Returns nil when GROUPING isn't sectioned (see `pearl--view-grouping-active-p'), +signaling the caller to render the flat list." (when (pearl--view-grouping-active-p grouping) (let ((order '()) (table (make-hash-table :test 'equal))) (dolist (issue issues) (let ((label (pearl--view-group-label issue grouping))) (unless (gethash label table) (push label order)) (push issue (gethash label table)))) - (mapcar (lambda (label) (cons label (nreverse (gethash label table)))) - (nreverse order))))) + (pearl--order-groups + grouping + (mapcar (lambda (label) (cons label (nreverse (gethash label table)))) + (nreverse order)))))) (defun pearl--view-issues-query () "GraphQL query running a Custom View's own filter server-side, by view id. @@ -1795,7 +1843,7 @@ and so isn't applied by the connection alone (see issues(first: $first, after: $after, sort: $sort, filter: $filter) { nodes { id identifier title description priority url updatedAt - state { id name type } + state { id name type position } assignee { id name displayName email } team { id key name } project { id name } @@ -2894,6 +2942,7 @@ identifier prefix -- so an unedited heading is a no-op on title sync)." (format ":LINEAR-STATE-ID-SYNCED: %s\n" (or (plist-get state :id) "")) (format ":LINEAR-STATE-NAME: %s\n" (or (plist-get state :name) "")) (format ":LINEAR-STATE-TYPE: %s\n" (or (plist-get state :type) "")) + (format ":LINEAR-STATE-POSITION: %s\n" (or (plist-get state :position) "")) (format ":LINEAR-ASSIGNEE-ID: %s\n" (or (plist-get assignee :id) "")) (format ":LINEAR-ASSIGNEE-ID-SYNCED: %s\n" (or (plist-get assignee :id) "")) (format ":LINEAR-ASSIGNEE-NAME: %s\n" (or (plist-get assignee :name) "")) @@ -7011,6 +7060,18 @@ GROUPING outside the drawer-backed set yields nil." (string-to-number (or (org-entry-get nil "LINEAR-PRIORITY") "0")))) (_ nil))) +(defun pearl--buffer-issue-group-rep () + "Return a minimal issue plist for group ordering, read from the drawer at point. +Carries just the fields `pearl--order-groups' needs -- the state type/position +and the priority -- so a buffer regroup orders its sections the same way the +render path does. Point must be on the issue heading." + (let ((pos (org-entry-get nil "LINEAR-STATE-POSITION")) + (pri (org-entry-get nil "LINEAR-PRIORITY"))) + (list :state (list :type (org-entry-get nil "LINEAR-STATE-TYPE") + :position (and pos (not (string-empty-p pos)) + (string-to-number pos))) + :priority (and pri (not (string-empty-p pri)) (string-to-number pri))))) + (defun pearl--subtree-contains-issue-p (beg end) "Return non-nil when the region BEG..END holds an issue heading (a `LINEAR-ID')." (save-excursion @@ -7054,6 +7115,7 @@ grouped. Returns t, or `no-issues' when there are none." ;; A level-2 issue (flat buffer): already canonical level 2. ((and id (not (string-empty-p id))) (push (list :label (pearl--buffer-issue-group-label grouping) + :rep (pearl--buffer-issue-group-rep) :text (buffer-substring-no-properties beg end)) issues)) ;; A level-2 group heading (contains issues): descend, capture each @@ -7073,6 +7135,7 @@ grouped. Returns t, or `no-issues' when there are none." (iend (save-excursion (org-end-of-subtree t t) (point))) (lvl (org-current-level))) (push (list :label (pearl--buffer-issue-group-label grouping) + :rep (pearl--buffer-issue-group-rep) :text (pearl--shift-heading-levels (buffer-substring-no-properties ibeg iend) (- 2 lvl))) @@ -7088,15 +7151,25 @@ grouped. Returns t, or `no-issues' when there are none." (delete-region content-beg parent-end) (goto-char content-beg) (if grouping - (let ((order '()) (table (make-hash-table :test 'equal))) + (let ((order '()) (table (make-hash-table :test 'equal)) + (reps (make-hash-table :test 'equal))) (dolist (it issues) (let ((label (plist-get it :label))) - (unless (gethash label table) (push label order)) + (unless (gethash label table) + (push label order) + (puthash label (plist-get it :rep) reps)) (push it (gethash label table)))) - (dolist (label (nreverse order)) - (insert (format "** %s\n" label)) - (dolist (it (nreverse (gethash label table))) - (insert (pearl--shift-heading-levels (plist-get it :text) 1))))) + ;; Order the sections the same way the render path does: a + ;; one-rep group per label fed through `pearl--order-groups'. + (let ((ordered (pearl--order-groups + grouping + (mapcar (lambda (l) (cons l (list (gethash l reps)))) + (nreverse order))))) + (dolist (g ordered) + (let ((label (car g))) + (insert (format "** %s\n" label)) + (dolist (it (nreverse (gethash label table))) + (insert (pearl--shift-heading-levels (plist-get it :text) 1))))))) (dolist (it issues) (insert (plist-get it :text)))) (dolist (m malformed) (insert m)) diff --git a/tests/test-pearl-grouping.el b/tests/test-pearl-grouping.el index a30bcc1..5bcae1d 100644 --- a/tests/test-pearl-grouping.el +++ b/tests/test-pearl-grouping.el @@ -354,5 +354,63 @@ SE-1 has a comment subtree; SE-2 has no assignee.") (should (string-match-p "^\\*\\* Apollo$" out)) (should-not (string-match-p "^\\*\\* In Progress$" out)))) +;;; group ordering (board order, not first-appearance) + +(ert-deftest test-pearl-order-groups-workflowstate-by-type-then-position () + "workflowState groups order by state type rank, then position within a type." + (let ((groups (list (cons "In Progress" (list '(:state (:type "started" :position 3.0)))) + (cons "Icebox" (list '(:state (:type "backlog" :position 1.0)))) + (cons "Done" (list '(:state (:type "completed" :position 5.0)))) + (cons "Inbox" (list '(:state (:type "backlog" :position 2.0))))))) + (should (equal (mapcar #'car (pearl--order-groups "workflowState" groups)) + '("Icebox" "Inbox" "In Progress" "Done"))))) + +(ert-deftest test-pearl-order-groups-priority-urgent-first-none-last () + "priority groups order Urgent..Low, then None last." + (let ((groups (list (cons "None" (list '(:priority 0))) + (cons "High" (list '(:priority 2))) + (cons "Urgent" (list '(:priority 1))) + (cons "Low" (list '(:priority 4)))))) + (should (equal (mapcar #'car (pearl--order-groups "priority" groups)) + '("Urgent" "High" "Low" "None"))))) + +(ert-deftest test-pearl-order-groups-other-dimension-alphabetical () + "A dimension with no board order (project) sorts alphabetically by label." + (let ((groups (list (cons "Zeta" (list '(:project (:name "Zeta")))) + (cons "alpha" (list '(:project (:name "alpha"))))))) + (should (equal (mapcar #'car (pearl--order-groups "project" groups)) + '("alpha" "Zeta"))))) + +(ert-deftest test-pearl-group-issues-orders-by-board-order () + "pearl--group-issues sections by board order even when input order differs." + (let ((issues (list '(:id "a" :state (:name "In Progress" :type "started" :position 3.0)) + '(:id "b" :state (:name "Icebox" :type "backlog" :position 1.0))))) + (should (equal (mapcar #'car (pearl--group-issues issues "workflowState")) + '("Icebox" "In Progress"))))) + +(defconst test-pearl-grouping--positioned + (concat + "#+LINEAR-SOURCE: (:type filter :name \"F\" :filter (:open t))\n\n" + "* F\n" + "** TODO SE-1: Alpha\n:PROPERTIES:\n:LINEAR-ID: i1\n" + ":LINEAR-STATE-NAME: In Progress\n:LINEAR-STATE-TYPE: started\n:LINEAR-STATE-POSITION: 3.0\n:END:\nBody.\n" + "** TODO SE-2: Beta\n:PROPERTIES:\n:LINEAR-ID: i2\n" + ":LINEAR-STATE-NAME: Icebox\n:LINEAR-STATE-TYPE: backlog\n:LINEAR-STATE-POSITION: 1.0\n:END:\nBody.\n") + "Flat buffer where first-appearance (In Progress, Icebox) differs from board +order (Icebox before In Progress).") + +(ert-deftest test-pearl-regroup-orders-sections-by-board-order () + "Regrouping by status orders the sections by Linear's board order, not arrival." + (test-pearl-grouping--in-org test-pearl-grouping--positioned + (should (eq (pearl--regroup-issue-subtrees "workflowState") t)) + (should (equal (test-pearl-grouping--group-headings) '("Icebox" "In Progress"))))) + +(ert-deftest test-pearl-format-issue-renders-state-position () + "The issue drawer carries LINEAR-STATE-POSITION so an offline regroup can order." + (let ((out (pearl--format-issue-as-org-entry + '(:id "x" :identifier "SE-9" :title "T" + :state (:name "S" :type "started" :position 2.5))))) + (should (string-match-p "LINEAR-STATE-POSITION:[[:space:]]+2\\.5" out)))) + (provide 'test-pearl-grouping) ;;; test-pearl-grouping.el ends here diff --git a/tests/test-pearl-output.el b/tests/test-pearl-output.el index 55f7886..1035ff2 100644 --- a/tests/test-pearl-output.el +++ b/tests/test-pearl-output.el @@ -90,7 +90,7 @@ cookie cycling reaches Low regardless of the user's global `org-priority-lowest' (ert-deftest test-pearl-build-org-content-grouped-sections-and-startup () "A grouped view folds to show3levels, emits a level-2 group heading per group -in first-appearance order, and renders issues at level 3 under them." +in Linear board order (state type rank), and renders issues at level 3 under them." (let* ((issues '((:id "1" :identifier "SE-1" :title "One" :state (:name "Started" :type "started") :priority 0) (:id "2" :identifier "SE-2" :title "Two" @@ -104,14 +104,16 @@ in first-appearance order, and renders issues at level 3 under them." (should (string-match-p "^\\*\\* Backlog$" out)) ;; Issues live at level 3 under the group headings. (should (string-match-p "^\\*\\*\\* STARTED " out)) - ;; First-appearance order: SE-1 (Started) before SE-2 (Backlog). - (should (< (string-match "^\\*\\* Started$" out) - (string-match "^\\*\\* Backlog$" out))) - ;; The group heading carries no LINEAR-ID, so save/merge skip it. - (let ((started (string-match "^\\*\\* Started$" out)) + ;; Board order: Backlog (backlog-type) sorts before Started (started-type), + ;; regardless of which appeared first in the input. + (should (< (string-match "^\\*\\* Backlog$" out) + (string-match "^\\*\\* Started$" out))) + ;; The first group heading carries no LINEAR-ID, so save/merge skip it: it + ;; sits ahead of the first issue drawer. + (let ((first-group (string-match "^\\*\\* Backlog$" out)) (next-id (string-match "LINEAR-ID:" out))) - (should started) - (should (< started next-id))))) + (should first-group) + (should (< first-group next-id))))) (ert-deftest test-pearl-build-org-content-grouped-source-roundtrips () "A grouped view's source (with :group) reads back from the rendered header." |