diff options
Diffstat (limited to 'tests/test-pearl-saved-query-sync.el')
| -rw-r--r-- | tests/test-pearl-saved-query-sync.el | 379 |
1 files changed, 379 insertions, 0 deletions
diff --git a/tests/test-pearl-saved-query-sync.el b/tests/test-pearl-saved-query-sync.el new file mode 100644 index 0000000..7a40566 --- /dev/null +++ b/tests/test-pearl-saved-query-sync.el @@ -0,0 +1,379 @@ +;;; test-pearl-saved-query-sync.el --- Tests for syncing saved queries to Linear views -*- 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 `pearl-sync-saved-query-to-linear' and its helpers +;; (`pearl--sync-scope-candidates', `pearl--find-view-by-name-in-scope', +;; `pearl--customview-create-async', `pearl--customview-update-async', +;; `pearl--save-query-mark-synced', `pearl--sync-record-or-orphan-error'). +;; See docs/saved-query-sync-spec.org. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el" + (file-name-directory + (or load-file-name buffer-file-name)))) +(require 'testutil-request (expand-file-name "testutil-request.el" + (file-name-directory + (or load-file-name buffer-file-name)))) +(require 'cl-lib) + +;;; pearl--sync-scope-candidates + +(ert-deftest test-pearl-sync-scope-candidates-default-with-filter-team () + "When the filter has `:team X', the default candidate is the team-shared row." + (let* ((teams '(((id . "team-eng-id") (key . "ENG") (name . "Engineering")) + ((id . "team-mkt-id") (key . "MKT") (name . "Marketing")))) + (cands (pearl--sync-scope-candidates teams "ENG"))) + (should (string= "[ Team: Engineering, visible to the team ]" (caar cands))) + (let ((plist (cdar cands))) + (should (equal "team-eng-id" (plist-get plist :team-id))) + (should (equal "Engineering" (plist-get plist :team-name))) + (should (eq t (plist-get plist :shared)))))) + +(ert-deftest test-pearl-sync-scope-candidates-default-personal-no-filter-team () + "Without `:team' in the filter, the default candidate is Personal." + (let* ((teams '(((id . "team-eng-id") (key . "ENG") (name . "Engineering")))) + (cands (pearl--sync-scope-candidates teams nil))) + (should (string= "[ Personal, only I see it ]" (caar cands))) + (let ((plist (cdar cands))) + (should (null (plist-get plist :team-id))) + (should (equal "Personal" (plist-get plist :team-name))) + (should (null (plist-get plist :shared)))))) + +(ert-deftest test-pearl-sync-scope-candidates-unknown-filter-team-falls-back-to-personal () + "An unknown `:team' key in the filter falls back to Personal as the default." + (let* ((teams '(((id . "id-a") (key . "A") (name . "Apple")))) + (cands (pearl--sync-scope-candidates teams "GONE"))) + (should (string= "[ Personal, only I see it ]" (caar cands))))) + +(ert-deftest test-pearl-sync-scope-candidates-no-duplicate-default-row () + "The default candidate appears only once even when it matches a real row." + (let* ((teams '(((id . "team-eng-id") (key . "ENG") (name . "Engineering")))) + (cands (pearl--sync-scope-candidates teams "ENG")) + (count (cl-count "[ Team: Engineering, visible to the team ]" cands + :key #'car :test #'string=))) + (should (= 1 count)))) + +(ert-deftest test-pearl-sync-scope-candidates-includes-personal-and-both-team-rows () + "The list carries one Personal row plus two rows per team." + (let* ((teams '(((id . "id-a") (key . "A") (name . "Apple")) + ((id . "id-b") (key . "B") (name . "Banana")))) + (cands (pearl--sync-scope-candidates teams nil))) + ;; 1 personal + 2 teams x 2 rows = 5 + (should (= 5 (length cands))) + (dolist (display '("[ Personal, only I see it ]" + "[ Team: Apple, visible to the team ]" + "[ Team: Apple, only I see it ]" + "[ Team: Banana, visible to the team ]" + "[ Team: Banana, only I see it ]")) + (should (cl-find display cands :key #'car :test #'string=))))) + +(ert-deftest test-pearl-sync-scope-candidates-no-meaningless-personal-shared () + "No `[ Personal, visible to the team ]' row exists -- it would be meaningless." + (let* ((teams '(((id . "id-a") (key . "A") (name . "Apple")))) + (cands (pearl--sync-scope-candidates teams nil))) + (should-not (cl-find "[ Personal, visible to the team ]" cands + :key #'car :test #'string=)))) + +(ert-deftest test-pearl-sync-scope-candidates-teams-sorted-alphabetically () + "Non-default team rows appear in alphabetical order by team name." + (let* ((teams '(((id . "id-z") (key . "Z") (name . "Zebra")) + ((id . "id-a") (key . "A") (name . "Apple")) + ((id . "id-m") (key . "M") (name . "Mango")))) + (cands (pearl--sync-scope-candidates teams nil)) + (displays (mapcar #'car cands)) + (apple-pos (cl-position "[ Team: Apple, visible to the team ]" + displays :test #'string=)) + (mango-pos (cl-position "[ Team: Mango, visible to the team ]" + displays :test #'string=)) + (zebra-pos (cl-position "[ Team: Zebra, visible to the team ]" + displays :test #'string=))) + (should (and apple-pos mango-pos zebra-pos + (< apple-pos mango-pos) + (< mango-pos zebra-pos))))) + +;;; pearl--find-view-by-name-in-scope + +(ert-deftest test-pearl-find-view-by-name-in-scope-matches-team-shared () + "Finds a view by name + matching team id + shared flag." + (let ((views '(((id . "v1") (name . "A") (shared . t) + (team (id . "t1"))) + ((id . "v2") (name . "A") (shared . :json-false) + (team (id . "t1"))) + ((id . "v3") (name . "B") (shared . t) + (team . nil))))) + (should (equal "v1" (cdr (assoc 'id + (pearl--find-view-by-name-in-scope + views "A" "t1" t))))) + (should (equal "v2" (cdr (assoc 'id + (pearl--find-view-by-name-in-scope + views "A" "t1" nil))))))) + +(ert-deftest test-pearl-find-view-by-name-in-scope-matches-personal () + "Finds a personal (no team) view when scope matches." + (let ((views '(((id . "v1") (name . "A") (shared . :json-false) + (team . nil))))) + (should (equal "v1" (cdr (assoc 'id + (pearl--find-view-by-name-in-scope + views "A" nil nil))))))) + +(ert-deftest test-pearl-find-view-by-name-in-scope-no-match-returns-nil () + "Returns nil when nothing matches name or scope." + (let ((views '(((id . "v1") (name . "A") (shared . t) + (team (id . "t1")))))) + (should (null (pearl--find-view-by-name-in-scope views "A" "t2" t))) + (should (null (pearl--find-view-by-name-in-scope views "Other" "t1" t))) + (should (null (pearl--find-view-by-name-in-scope views "A" nil nil))))) + +;;; pearl--customview-create-async + +(ert-deftest test-pearl-customview-create-async-success () + "A successful `customViewCreate' invokes the callback with `:success' t and the view." + (testutil-linear-with-response + '((data + (customViewCreate + (success . t) + (customView (id . "view-uuid") (name . "X") + (shared . :json-false) (team))))) + (let (result) + (pearl--customview-create-async + "X" nil nil + '(("state" ("type" ("nin" . ["completed"])))) + (lambda (r) (setq result r))) + (should (eq t (plist-get result :success))) + (should (equal "view-uuid" + (cdr (assoc 'id (plist-get result :view)))))))) + +(ert-deftest test-pearl-customview-create-async-failure () + "A non-success `customViewCreate' invokes the callback with `:success' nil." + (testutil-linear-with-response + '((data (customViewCreate (success . :json-false) (customView)))) + (let (result) + (pearl--customview-create-async + "X" nil nil '() (lambda (r) (setq result r))) + (should-not (plist-get result :success))))) + +;;; pearl--customview-update-async + +(ert-deftest test-pearl-customview-update-async-success () + "A successful `customViewUpdate' invokes the callback with `:success' t." + (testutil-linear-with-response + '((data + (customViewUpdate + (success . t) + (customView (id . "view-uuid") (name . "X") + (shared . t) + (team (id . "team-id")))))) + (let (result) + (pearl--customview-update-async + "view-uuid" '() (lambda (r) (setq result r))) + (should (eq t (plist-get result :success)))))) + +(ert-deftest test-pearl-customview-update-async-failure () + "A non-success `customViewUpdate' invokes the callback with `:success' nil." + (testutil-linear-with-response + '((data (customViewUpdate (success . :json-false) (customView)))) + (let (result) + (pearl--customview-update-async + "view-uuid" '() (lambda (r) (setq result r))) + (should-not (plist-get result :success))))) + +;;; pearl--save-query-mark-synced + +(ert-deftest test-pearl-save-query-mark-synced-adds-the-four-keys () + "After mark-synced, the entry carries `:linear-view-id', `-team-id', `-shared', `-synced-at'." + (let ((pearl-saved-queries + (copy-tree '(("Q" :filter (:open t)))))) + (cl-letf (((symbol-function 'customize-save-variable) (lambda (_ _) nil))) + (pearl--save-query-mark-synced "Q" "team-uuid" t "view-uuid")) + (let ((spec (cdr (assoc "Q" pearl-saved-queries)))) + (should (equal "view-uuid" (plist-get spec :linear-view-id))) + (should (equal "team-uuid" (plist-get spec :linear-view-team-id))) + (should (eq t (plist-get spec :linear-view-shared))) + (should (stringp (plist-get spec :linear-view-synced-at))) + ;; Original filter survives + (should (equal '(:open t) (plist-get spec :filter)))))) + +(ert-deftest test-pearl-save-query-mark-synced-preserves-sort-and-order () + "Mark-synced doesn't drop `:sort' or `:order' from the entry." + (let ((pearl-saved-queries + (copy-tree '(("Q" :filter (:open t) :sort updated :order desc))))) + (cl-letf (((symbol-function 'customize-save-variable) (lambda (_ _) nil))) + (pearl--save-query-mark-synced "Q" nil nil "view-uuid")) + (let ((spec (cdr (assoc "Q" pearl-saved-queries)))) + (should (eq 'updated (plist-get spec :sort))) + (should (eq 'desc (plist-get spec :order)))))) + +(ert-deftest test-pearl-save-query-mark-synced-personal-nil-team () + "Personal scope persists `:linear-view-team-id' as nil and `:linear-view-shared' nil." + (let ((pearl-saved-queries + (copy-tree '(("Q" :filter (:open t)))))) + (cl-letf (((symbol-function 'customize-save-variable) (lambda (_ _) nil))) + (pearl--save-query-mark-synced "Q" nil nil "view-uuid")) + (let ((spec (cdr (assoc "Q" pearl-saved-queries)))) + (should (null (plist-get spec :linear-view-team-id))) + (should (null (plist-get spec :linear-view-shared)))))) + +(ert-deftest test-pearl-save-query-mark-synced-unknown-name-signals-user-error () + "Mark-synced on a name that doesn't exist signals a `user-error'." + (let ((pearl-saved-queries '())) + (should-error + (pearl--save-query-mark-synced "Q" nil nil "view-uuid") + :type 'user-error))) + +(ert-deftest test-pearl-save-query-mark-synced-overwrites-prior-sync-metadata () + "Re-syncing an already-synced entry overwrites the four `:linear-view-*' keys." + (let ((pearl-saved-queries + (copy-tree '(("Q" :filter (:open t) + :linear-view-id "OLD-id" + :linear-view-team-id "OLD-team" + :linear-view-shared :json-false + :linear-view-synced-at "1970-01-01T00:00:00Z"))))) + (cl-letf (((symbol-function 'customize-save-variable) (lambda (_ _) nil))) + (pearl--save-query-mark-synced "Q" "NEW-team" t "NEW-id")) + (let ((spec (cdr (assoc "Q" pearl-saved-queries)))) + (should (equal "NEW-id" (plist-get spec :linear-view-id))) + (should (equal "NEW-team" (plist-get spec :linear-view-team-id))) + (should (eq t (plist-get spec :linear-view-shared))) + (should-not (equal "1970-01-01T00:00:00Z" + (plist-get spec :linear-view-synced-at)))))) + +;;; pearl--sync-record-or-orphan-error + +(ert-deftest test-pearl-sync-record-orphan-error-names-view-id-on-persist-failure () + "When persist fails, the message names the orphan view id explicitly." + (let ((msg nil)) + (cl-letf (((symbol-function 'pearl--save-query-mark-synced) + (lambda (&rest _) (error "disk full"))) + ((symbol-function 'message) + (lambda (fmt &rest args) + (setq msg (apply #'format fmt args))))) + (let ((result (pearl--sync-record-or-orphan-error + "Q" nil nil "ORPHAN-UUID-XYZ" "Synced"))) + (should (null result)) + (should (string-match-p "ORPHAN-UUID-XYZ" msg)))))) + +(ert-deftest test-pearl-sync-record-orphan-error-success-returns-t-and-includes-view-id () + "When persist succeeds, the helper returns t and the message names the view id." + (let ((msg nil)) + (cl-letf (((symbol-function 'pearl--save-query-mark-synced) + (lambda (&rest _) t)) + ((symbol-function 'message) + (lambda (fmt &rest args) + (setq msg (apply #'format fmt args))))) + (let ((result (pearl--sync-record-or-orphan-error + "Q" nil nil "view-uuid" "Synced"))) + (should (eq t result)) + (should (string-match-p "view-uuid" msg)) + (should (string-match-p "Q" msg)) + (should (string-match-p "Synced" msg)))))) + +(ert-deftest test-pearl-sync-record-orphan-error-includes-scope-label-when-given () + "An optional SCOPE-LABEL is appended in brackets to the success message." + (let ((msg nil)) + (cl-letf (((symbol-function 'pearl--save-query-mark-synced) + (lambda (&rest _) t)) + ((symbol-function 'message) + (lambda (fmt &rest args) + (setq msg (apply #'format fmt args))))) + (pearl--sync-record-or-orphan-error + "Q" nil nil "view-uuid" "Synced" "[ Team: Eng, visible to the team ]") + (should (string-match-p "Team: Eng" msg))))) + +(ert-deftest test-pearl-sync-record-orphan-error-update-verb-rewrites-failure-text () + "The failure message uses the lowercase verb (\"updated\") on an update path." + (let ((msg nil)) + (cl-letf (((symbol-function 'pearl--save-query-mark-synced) + (lambda (&rest _) (error "disk full"))) + ((symbol-function 'message) + (lambda (fmt &rest args) + (setq msg (apply #'format fmt args))))) + (pearl--sync-record-or-orphan-error + "Q" nil nil "view-uuid" "Updated") + (should (string-match-p "updated on Linear" msg))))) + +;;; pearl--sync-saved-query-await — timeout detection + +(ert-deftest test-pearl-sync-saved-query-await-marks-timeout-when-callback-misses () + "A callback that never fires returns `(:success nil :timeout t)' rather than nil." + (let ((pearl-request-timeout 0.05)) ; ~50ms is plenty to fall through the wait loop + (cl-letf (((symbol-function 'noop-async) + (lambda (&rest _ignored) nil))) ; never invokes callback + (let ((result (pearl--sync-saved-query-await #'noop-async))) + (should (eq t (plist-get result :timeout))) + (should-not (plist-get result :success)))))) + +(ert-deftest test-pearl-sync-saved-query-await-returns-callback-result-on-completion () + "When the callback fires, the helper returns that result verbatim (no timeout flag)." + (cl-letf (((symbol-function 'sync-fire-async) + (lambda (cb) (funcall cb (list :success t :view '((id . "X"))))))) + (let ((result (pearl--sync-saved-query-await #'sync-fire-async))) + (should (eq t (plist-get result :success))) + (should-not (plist-get result :timeout))))) + +;;; Re-sync normalizes a stored `:json-false' shared flag — guards the silent flip + +(ert-deftest test-pearl-sync-resync-normalizes-json-false-shared-to-personal () + "Re-sync of an entry with `:linear-view-shared :json-false' must NOT flip it shared. +`:json-false' is truthy in Elisp, so a stored `:json-false' would slip past +`(if shared t :json-false)' in the encoder and silently make the view team-shared." + (let ((pearl-saved-queries + (copy-tree '(("Q" :filter (:open t) + :linear-view-id "view-id" + :linear-view-team-id nil + :linear-view-shared :json-false + :linear-view-synced-at "2026-01-01T00:00:00Z")))) + (captured-input nil)) + (cl-letf (((symbol-function 'pearl--all-teams) (lambda () '())) + ((symbol-function 'pearl--validate-issue-filter) (lambda (_) t)) + ((symbol-function 'pearl--build-issue-filter) + (lambda (_) '(("state" ("type" ("nin" . ["completed"])))))) + ((symbol-function 'pearl--progress) (lambda (&rest _) nil)) + ((symbol-function 'message) (lambda (&rest _) nil)) + ((symbol-function 'customize-save-variable) (lambda (_ _) nil)) + ((symbol-function 'pearl--customview-update-async) + (lambda (_view-id input cb) + (setq captured-input input) + (funcall cb (list :success t + :view '((id . "view-id") + (shared . :json-false))))))) + (pearl-sync-saved-query-to-linear "Q") + (let ((shared-value (cdr (assoc "shared" captured-input)))) + (should (eq :json-false shared-value)))))) + +;;; Cache-shape parity — pearl-get-teams-async and pearl--all-teams must agree + +(ert-deftest test-pearl-get-teams-async-query-fetches-key () + "`pearl-get-teams-async' must fetch `key' so it can't poison the cache. +Both `pearl-get-teams-async' and `pearl--all-teams' write +`pearl--cache-teams', and downstream callers read `key' from cached +teams. If the async path queried only `id name', a fetch sequence +async→sync would leave the cache without `key' and silently break +team-key lookups." + (let (captured-query) + (cl-letf (((symbol-function 'pearl--graphql-request-async) + (lambda (query &rest _) (setq captured-query query)))) + (pearl-get-teams-async) + (should captured-query) + (should (string-match-p "key" captured-query))))) + +(provide 'test-pearl-saved-query-sync) +;;; test-pearl-saved-query-sync.el ends here |