;;; test-pearl-commands.el --- Tests for pearl user commands -*- 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 the interactive commands.  Their input sources (completing-read,
;; read-string) and the network/file boundaries are stubbed so the dispatch
;; and orchestration logic runs: the list-issues result handling, project
;; dispatch, the new-issue input-building, and the connection/setup checks.

;;; Code:

(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))
(require 'testutil-request (expand-file-name "testutil-request.el"))
(require 'cl-lib)

;;; pearl-list-issues

(ert-deftest test-pearl-list-issues-ok-writes-all-issues ()
  "On an ok result, every server-returned issue is written (no client filter)."
  (let ((written nil))
    (cl-letf (((symbol-function 'pearl--query-issues-async)
               (lambda (_filter cb &optional _order)
                 (funcall cb (pearl--make-query-result
                              'ok :issues '(((identifier . "A")) ((identifier . "B")))))))
              ((symbol-function 'pearl--update-org-from-issues)
               (lambda (issues &optional _source _truncated) (setq written issues))))
      (pearl-list-issues)
      (should (= 2 (length written))))))

(ert-deftest test-pearl-list-issues-empty-skips-write ()
  "An empty result messages the user and does not overwrite the file."
  (let ((wrote nil))
    (cl-letf (((symbol-function 'pearl--query-issues-async)
               (lambda (_filter cb &optional _order)
                 (funcall cb (pearl--make-query-result 'empty :issues nil))))
              ((symbol-function 'pearl--update-org-from-issues)
               (lambda (&rest _) (setq wrote t))))
      (pearl-list-issues)
      (should-not wrote))))

(ert-deftest test-pearl-list-issues-error-skips-write ()
  "A failed query messages and does not write."
  (let ((wrote nil))
    (cl-letf (((symbol-function 'pearl--query-issues-async)
               (lambda (_filter cb &optional _order)
                 (funcall cb (pearl--make-query-result
                              'request-failed :message "boom"))))
              ((symbol-function 'pearl--update-org-from-issues)
               (lambda (&rest _) (setq wrote t))))
      (pearl-list-issues)
      (should-not wrote))))

(ert-deftest test-pearl-list-issues-project-id-adds-project-filter ()
  "A project id is compiled into the issue filter passed to the fetch."
  (let (captured-filter)
    (cl-letf (((symbol-function 'pearl--query-issues-async)
               (lambda (filter _cb &optional _order) (setq captured-filter filter)))
              ((symbol-function 'pearl--update-org-from-issues) #'ignore))
      (pearl-list-issues "proj-1")
      (should (equal '(("id" ("eq" . "proj-1"))) (cdr (assoc "project" captured-filter)))))))

;;; pearl-list-issues-by-project

(ert-deftest test-pearl-list-issues-by-project-dispatches-with-project-id ()
  "Selecting a team and project forwards the project id to list-issues."
  (let ((pid 'unset)
        (pearl-default-team-id nil))
    (cl-letf (((symbol-function 'pearl-select-team) (lambda () '((id . "t1"))))
              ((symbol-function 'pearl-select-project)
               (lambda (_t) '((id . "p1") (name . "Platform"))))
              ((symbol-function 'pearl-list-issues) (lambda (project-id) (setq pid project-id))))
      (pearl-list-issues-by-project)
      (should (string-equal "p1" pid)))))

(ert-deftest test-pearl-list-issues-by-project-no-team-stops ()
  "With no team selected, list-issues is not called."
  (let ((called nil)
        (pearl-default-team-id nil))
    (cl-letf (((symbol-function 'pearl-select-team) (lambda () nil))
              ((symbol-function 'pearl-list-issues) (lambda (&rest _) (setq called t))))
      (pearl-list-issues-by-project)
      (should-not called))))

;;; pearl-new-issue

(ert-deftest test-pearl-new-issue-success-returns-issue ()
  "new-issue builds the input, sends it, and returns the created issue."
  (let ((pearl-default-team-id "team-1"))
    (cl-letf (((symbol-function 'read-string)
               (lambda (prompt &rest _) (if (string-prefix-p "Issue title" prompt) "My Issue" "")))
              ((symbol-function 'completing-read)
               (lambda (prompt &rest _)
                 (cond ((string-prefix-p "State" prompt) "Todo")
                       ((string-prefix-p "Priority" prompt) "Medium")
                       ((string-prefix-p "Label category" prompt) "All")
                       (t ""))))
              ((symbol-function 'pearl-get-states)
               (lambda (_t) '(((id . "s1") (name . "Todo")))))
              ((symbol-function 'pearl-get-team-members) (lambda (_t) '()))
              ((symbol-function 'pearl-get-issue-types) (lambda (_t) '()))
              ((symbol-function 'pearl-select-project) (lambda (_t) nil))
              ((symbol-function 'pearl--graphql-request)
               (lambda (_q &optional _v)
                 '((data (issueCreate (success . t)
                                      (issue (id . "i1") (identifier . "ENG-1") (title . "My Issue"))))))))
      (should (string-equal "ENG-1" (cdr (assoc 'identifier (pearl-new-issue))))))))

(ert-deftest test-pearl-new-issue-no-team-stops ()
  "new-issue stops cleanly when no team is selected."
  (let ((pearl-default-team-id nil))
    (cl-letf (((symbol-function 'pearl-select-team) (lambda () nil)))
      (should (progn (pearl-new-issue) t)))))

;;; pearl-test-connection / check-setup

(ert-deftest test-pearl-test-connection-success-runs ()
  "test-connection completes on a successful viewer response."
  (testutil-linear-with-response '((data (viewer (id . "u") (name . "Me"))))
    (should (progn (pearl-test-connection) t))))

(ert-deftest test-pearl-check-setup-with-key-tests-connection ()
  "check-setup runs the connection test when an API key is set."
  (let ((pearl-api-key "k") (called nil))
    (cl-letf (((symbol-function 'pearl-test-connection) (lambda () (setq called t))))
      (pearl-check-setup)
      (should called))))

(ert-deftest test-pearl-check-setup-without-key-skips-test ()
  "check-setup does not run the connection test without an API key."
  (let ((pearl-api-key nil) (called nil))
    (cl-letf (((symbol-function 'pearl-test-connection) (lambda () (setq called t))))
      (pearl-check-setup)
      (should-not called))))

(provide 'test-pearl-commands)
;;; test-pearl-commands.el ends here