path: root/tests/test-pearl-saved-query-sync.el

;;; 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