;;; test-cockpit-python.el --- The test-cockpit package for python projects -*- lexical-binding: t; -*-

;; Author: Johannes Mueller <github@johannes-mueller.org>
;; URL: https://github.com/johannes-mueller/test-cockpit.el
;; License: GPLv3
;; SPDX-License-Identifier: GPL-3.0-only

;;; Commentary:

;; test-cockpit is a unified user interface for test runners of different
;; programming languages resp. their testing tools.  This is the module for the
;; pytest runner for the python programming language.

;;; Code:

(require 'test-cockpit)

(defcustom test-cockpit-python-uv-switches '("--all-extras" "--all-groups")
  "Additional switches to be applied to `uv run'."
  :group 'test-cockpit
  :type '(list string))

(defvar test-cockpit-python-build-ext-command "pip install -e . --no-deps"
  "The command to build the python extensions.")

(defclass test-cockpit-python-engine (test-cockpit--engine) ())

(cl-defmethod test-cockpit--test-project-command ((_obj test-cockpit-python-engine))
  "Implement test-cockpit--test-project-command." 'test-cockpit-python--test-project-command)

(cl-defmethod test-cockpit--test-module-command ((_obj test-cockpit-python-engine))
  "Implement test-cockpit--test-module-command." 'test-cockpit-python--test-module-command)

(cl-defmethod test-cockpit--test-function-command ((_obj test-cockpit-python-engine))
  "Implement test-cockpit--test-function-command." 'test-cockpit-python--test-function-command)

(cl-defmethod test-cockpit--transient-infix ((_obj test-cockpit-python-engine))
  "Implement test-cockpit--test-infix."
  (test-cockpit-python--infix))

(cl-defmethod test-cockpit--engine-current-module-string ((_obj test-cockpit-python-engine))
  "Implement test-cockpit--engine-current-module-string."
  (test-cockpit-python--choose-module))

(cl-defmethod test-cockpit--engine-current-function-string ((_obj test-cockpit-python-engine))
  "Implement test-cockpit--engine-current-function-string."
  (test-cockpit-python--test-function-path))

(cl-defmethod test-cockpit--engine-dape-last-test-config ((_obj test-cockpit-python-engine))
  "Implement the invokation of dape for the last test."
  (let* ((last-cmd (test-cockpit--last-interactive-test-command))
         (args (vconcat (pcase last-cmd
                          ('test-cockpit-test-project [])
                          ('test-cockpit-test-module `[,(test-cockpit--last-module-string)])
                          ('test-cockpit-test-function `[,(test-cockpit--last-function-string)]))
                        (oref (test-cockpit--retrieve-engine) last-args))))
  `(command "python"
    command-args ("-m" "debugpy.adapter" "--host" "127.0.0.1" "--port" :autoport)
    port :autoport :request "launch" :type "python" :module "pytest"
    :cwd ,(projectile-project-root)
    :args ,args
    :justMyCode nil :console "integratedTerminal" :showReturnValue t :stopOnEntry nil)))

(test-cockpit-register-project-type 'python-pip 'test-cockpit-python-engine)
(test-cockpit-register-project-type-alias 'python-pkg 'python-pip)
(test-cockpit-register-project-type-alias 'python-tox 'python-pip)
(test-cockpit-register-project-type-alias 'python-toml 'python-pip)


(defun test-cockpit-python--test-project-command (_ args)
  "Make the test project command from ARGS."
  (concat (test-cockpit-python--common-switches args)))

(defun test-cockpit-python--test-module-command (string args)
  "Make the test module command from STRING and ARGS."
  (concat (test-cockpit-python--common-switches args) " " string))

(defun test-cockpit-python--choose-module ()
  "Find the current test module."
  (when-let* ((file-name-path (buffer-file-name))
             ((string-prefix-p "test_" (file-name-nondirectory file-name-path))))
    (test-cockpit--strip-project-root file-name-path)))

(defun test-cockpit-python--test-function-command (string args)
  "Make the test function command from STRING and ARGS."
  (concat (test-cockpit-python--common-switches args) " " string))


(defconst test-cockpit--python-uv-prepend-args '("--python=" "--with="))

(defun test-cockpit-python--arg-uv-prepended-p (arg)
  "Non-nil if ARG is a uv prepended argument."
  (seq-find (lambda (cand) (string-prefix-p cand arg)) test-cockpit--python-uv-prepend-args))

(defun test-cockpit-python--cmd-prefix (args)
  "Add command prefix command if ARGS demands it."
  (cond ((member "build_ext" args) (concat test-cockpit-python-build-ext-command " && "))
        ((member "use-uv" args)
         (let ((prepended (append test-cockpit-python-uv-switches
                                  (seq-filter 'test-cockpit-python--arg-uv-prepended-p args))))
           (replace-regexp-in-string " +" " " (concat (string-join `("uv run" . ,prepended) " ") " "))))
        (t "")))

(defun test-cockpit-python--common-switches (args)
  "Extract the common python switches from ARGS."
  (concat (test-cockpit-python--cmd-prefix args)
          "pytest --color=yes"
          (test-cockpit--add-leading-space-to-switches
           (string-join (seq-remove (lambda (elt) (or (member elt '("use-uv" "build_ext"))
                                                      (test-cockpit-python--arg-uv-prepended-p elt)))
                                    args)
                        " "))))

(transient-define-argument test-cockpit-python--restrict-substring ()
  :description "Restrict to tests matching string"
  :class 'transient-option
  :key "-k"
  :argument "-k")

(transient-define-argument test-cockpit-python--python-version ()
  :description "use python version (uv)"
  :class 'transient-option
  :argument "--python=")

(transient-define-argument test-cockpit-python--with-package-directive ()
  :description "specify version of python package (uv)"
  :class 'transient-option
  :argument "--with=")

(transient-define-argument test-cockpit-python--marker-switch ()
  :description "Add marker switch "
  :class 'transient-option
  :key "-m"
  :argument "-m")

(transient-define-infix test-cockpit-python--choose-loglevel ()
  :class 'transient-switches
  :key "-l"
  :argument-format "--log-level=%s -rA"
  :argument-regexp "\\(--log-level=\\(debug\\|info\\|warn\\|error\\) -rA\\)"
  :choices '("debug" "info" "warn" "error")
  :description "log level")

(transient-define-infix test-cockpit-python--choose-verbose-level ()
  :class 'transient-switches
  :key "-v"
  :argument-format "%s"
  :argument-regexp "\\(-v\\|-vv\\|-vvv\\)$"
  :choices '("-v" "-vv" "-vvv")
  :description "verbosity level")

(transient-define-infix test-cockpit-python--choose-traceback ()
  :class 'transient-switches
  :key "-t"
  :argument-format "--tb=%s"
  :argument-regexp "--tb=\\(long\\|short\\|line\\|native\\|no\\)"
  :choices '("long" "short" "line" "native" "no")
  :description "show traceback style")

(defvar test-cockpit-python--using-uv nil)

(defun test-cockpit--use-uv-on-p ()
  "Non-nil if uv is not to be used."
  (member "use-uv" (transient-get-value)))

(defun test-cockpit-python--uv-available ()
  "Non-nil if uv is available."
  (executable-find "uv"))

(defun test-cockpit-python--infix ()
  "Setup the pytest specific test switches."
  (setq test-cockpit-python--using-uv (member "use-uv" (test-cockpit--last-switches)))
  [["Switches"
    ("-k" test-cockpit-python--restrict-substring)
    ("-f" "only lastly failed tests" "--last-failed")
    ("-x" "exit after first fail" "--exitfirst")
    ("-b" "build extensions before testing" "build_ext")
    ("-u" "use `uv run' to run pytest" "use-uv" :if test-cockpit-python--uv-available)
    ("-p" test-cockpit-python--python-version
     :if test-cockpit-python--uv-available
     :inapt-if-not test-cockpit--use-uv-on-p)
    ("-W" test-cockpit-python--with-package-directive
     :if test-cockpit-python--uv-available
     :inapt-if-not test-cockpit--use-uv-on-p)
    ("-m" test-cockpit-python--marker-switch)
    ("-M" "test type hints" "--mypy")]
   ["Output"
    (test-cockpit-python--choose-verbose-level)
    (test-cockpit-python--choose-loglevel)
    ("-c" "print coverage report" "--cov --cov-report=term-missing")
    ("-r" "report output of passed tests" "-rFP")
    ("-w" "don't output warnings" "--disable-warnings")
    ("-n" "don't capture output" "--capture=no")
    ("-L" "show locals in tracebacks" "--showlocals")
    (test-cockpit-python--choose-traceback)]])

(defun test-cockpit-python--find-last-unindented-line ()
  "Find the last unindented line from current point in current buffer."
  (save-excursion
    (end-of-line)
    (when (search-backward-regexp "^\\([[:alpha:]].*\\)$" nil t)
      (match-string 1))))

(defun test-cockpit-python--test-function-in-line (line)
  "Find a test function in LINE."
  (when (string-match "def[[:space:]]+\\(test_[[:word:]_]*\\)" line)
    (match-string 1 line)))

(defun test-cockpit-python--class-in-line (line)
  "Find a test class in LINE."
  (when (string-match "^class[[:space:]]+\\(Test[[:word:]_]*\\)\\((.*)\\)?:" line)
    (match-string 1 line)))

(defun test-cockpit-python--maybe-test-method (pos)
  "Determine the string of the method at POS to be tested, if any."
  (save-excursion
    (when (and (search-backward-regexp "def[[:space:]]+\\([[:alpha:]][[:word:]_]*\\)" nil t)
               (< pos (match-beginning 0))
               (string-prefix-p "test_" (match-string 1)))
      (concat "::" (match-string 1)))))

(defun test-cockpit-python--test-method-or-class (line pos)
  "Determine the current test at LINE and POS (class or method)."
  (when-let* ((test-class (test-cockpit-python--class-in-line line)))
    (concat test-class (test-cockpit-python--maybe-test-method pos))))

(defun test-cockpit-python--find-current-test ()
  "Determine the current test at point."
  (when-let* ((unindented-line (test-cockpit-python--find-last-unindented-line))
              (unindented-pos (match-beginning 0)))
    (or (test-cockpit-python--test-function-in-line unindented-line)
        (test-cockpit-python--test-method-or-class unindented-line unindented-pos))))

(defun test-cockpit-python--test-function-path ()
  "Determine the path to the test function at point."
  (when-let* ((file-name (buffer-file-name))
              ((string-prefix-p "test_" (file-name-nondirectory file-name))))
    (concat (test-cockpit--strip-project-root file-name)
            (when-let* ((test-function (test-cockpit-python--find-current-test)))
              (concat "::" test-function)))))

(provide 'test-cockpit-python)

;;; test-cockpit-python.el ends here
