;;; cargo-mode.el --- Cargo Major Mode. Cargo is the Rust package manager -*- lexical-binding: t; -*-

;; MIT License
;;
;; Copyright (c) 2021 Ayrat Badykov
;;
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;;
;; The above copyright notice and this permission notice shall be included in all
;; copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.

;; Author: Ayrat Badykov <ayratin555@gmail.com>
;; URL: https://github.com/ayrat555/cargo-mode
;; Version  : 0.0.10
;; Keywords: tools
;; Package-Version: 0.0.10
;; Package-Revision: 33528954218f
;; Package-Requires: ((emacs "25.1"))

;;; Commentary:

;; Add a hook to the mode that you're using with Rust, for example, `rust-mode`:
;;
;; (add-hook 'rust-mode-hook 'cargo-minor-mode)
;;

;;; C-c a e - `cargo-execute-task` - List all available tasks and execute one of them.  As a bonus, you'll get a documentation string because `cargo-mode.el` parses shell output of `cargo --list` directly.
;;; C-c a t - `cargo-mode-test` - Run all tests in the project (`cargo test`).
;;; C-c a l - `cargo-mode-last-command` - Execute the last executed command.
;;; C-c a b - `cargo-mode-build` - Build the project (`cargo build`).
;;; C-c a o - `cargo-mode-test-current-buffer` - Run all tests in the current buffer.
;;; C-c a f - `cargo-mode-test-current-test` - Run the current test where pointer is located.
;;; C-c a c - `cargo-mode-clippy` - Run Clippy in the project (`cargo clippy`).
;;;
;;; Use `C-u` to add extra command line params before executing a command.

;;; Code:

(require 'subr-x)

(defcustom cargo-path-to-bin
  nil
  "Path to the cargo executable."
  :type 'file
  :group 'cargo-mode)

(defcustom cargo-mode-use-comint t
  "If t `compile' runs with comint option paramater."
  :type 'boolean
  :group 'cargo-mode)

(defcustom cargo-mode-command-test "test"
  "Subcommand used by `cargo-mode-test'."
  :type 'string
  :group 'cargo-mode)

(defcustom cargo-mode-command-build "build"
  "Subcommand used by `cargo-mode-build'."
  :type 'string
  :group 'cargo-mode)

(defcustom cargo-mode-command-clippy "clippy"
  "Subcommand used by `cargo-mode-clippy'."
  :type 'string
  :group 'cargo-mode)

(defcustom cargo-mode-default-params '()
  "List of commands and their corresponding default parameters.

Each element can be either:
- (COMMAND . PARAMS) where COMMAND is string
- ((COMMAND ALIAS1 ALIAS2 ...) . PARAMS) where COMMAND, ALIAS1, etc are strings
PARAMS is a string."
  :type '(alist :key-type (choice
                            (repeat :tag "List of commands" string)
                            (string :tag "Single command"))
                :value-type (string :tag "Parameter string"))
  :group 'cargo-mode)

(defconst cargo-mode-test-mod-regexp "^[[:space:]]*mod[[:space:]]+[[:word:][:multibyte:]_][[:word:][:multibyte:]_[:digit:]]*[[:space:]]*{")

(defconst cargo-mode-test-regexp "^[[:space:]]*fn[[:space:]]*"
  "Regex to find Rust unit test function.")

(defvar cargo-mode--last-command nil "Last cargo command.")

(defun cargo-mode--find-bin ()
  "Find the full path to cargo, referencing cargo-path-to-bin first"
  (or cargo-path-to-bin (or (if (>= emacs-major-version 27)
                                (executable-find "cargo" t) (executable-find "cargo"))
                            "~/.cargo/bin/cargo")))

(define-derived-mode cargo-compilation-mode compilation-mode "Cargo"
  "Major mode for the Cargo buffer."
  (message "using custom mode")
  (setq buffer-read-only t)
  (setq-local truncate-lines t)
  (if cargo-mode-use-comint
    (compilation-shell-minor-mode))
  (local-set-key (kbd "q") 'kill-buffer-and-window)
  (local-set-key (kbd "g") 'cargo-mode-last-command))

(defun cargo-mode--fetch-cargo-tasks (project-root)
  "Fetch list of raw commands from shell for project in PROJECT-ROOT."
  (let* ((default-directory (or project-root default-directory))
         (cmd (concat (shell-quote-argument (cargo-mode--find-bin)) " --list"))
         (tasks-string (shell-command-to-string cmd))
         (tasks (butlast (cdr (split-string tasks-string "\n")))))
    (delete-dups tasks)))

(defun cargo-mode--available-tasks (project-root)
  "List all available tasks in PROJECT-ROOT."
  (let* ((raw_tasks (cargo-mode--fetch-cargo-tasks project-root))
         (commands (mapcar #'cargo-mode--split-command raw_tasks)))
    (cargo-mode--format-commands commands)))

(defun cargo-mode--format-commands (commands)
  "Format and concat all COMMANDS."
  (let ((max-length (cargo-mode--max-command-length (car commands) (cdr commands))))
    (mapcar
     (lambda (command) (cargo-mode--concat-command-and-doc command max-length))
     commands)))

(defun cargo-mode--concat-command-and-doc (command-with-doc max-command-length)
  "Concat the COMMAND-WITH-DOC with calcutated.
Space between them is based on MAX-COMMAND-LENGTH."
  (let* ((command (car command-with-doc))
        (doc (cdr command-with-doc))
        (command-length (length command))
        (whitespaces-number (- (+ max-command-length 1) command-length))
        (whitespaces-string (make-string whitespaces-number ?\s)))
    (concat command whitespaces-string "# " doc)))

(defun cargo-mode--split-command (raw-command)
  "Split command and doc string in RAW-COMMAND."
  (let* ((command-words (split-string raw-command))
         (command (car command-words))
         (doc-words (cdr command-words))
         (doc (concat (mapconcat #'identity doc-words " "))))
    (cons command doc)))

(defun cargo-mode--max-command-length (first-arg more-args)
  "Recursively find the longest command.
The current element is FIRST-ARG, remaining args are MORE-ARGS."
  (if more-args
      (let ((max-rest (cargo-mode--max-command-length (car more-args) (cdr more-args)))
            (first-arg-length (length (car first-arg))))
	(if (> first-arg-length max-rest)
	    first-arg-length
	  max-rest))
    (length (car first-arg))))

(defun cargo-mode--start (name command project-root &optional prompt)
  "Start the `cargo-mode` process with NAME and return the created process.
Cargo command is COMMAND.
The command is started from directory PROJECT-ROOT.
If PROMPT is non-nil, modifies the command."
  (let* ((path-to-bin (shell-quote-argument (cargo-mode--find-bin)))
         (cmd (cargo-mode--assemble-command-string path-to-bin command prompt))
         (default-directory (or project-root default-directory)))
    (cargo-mode--start-cmd name cmd project-root)))

(defun cargo-mode--start-cmd (name cmd project-root)
  "Start the `cargo-mode` process with NAME and return the created process."
  (let* ((buffer (concat "*cargo-mode " name "*")))
    (save-some-buffers (not compilation-ask-about-save)
                       (lambda ()
                         (and project-root
                              buffer-file-name
                              (string-prefix-p project-root (file-truename buffer-file-name)))))
    (setq cargo-mode--last-command (list name cmd project-root))
    (compilation-start cmd 'cargo-compilation-mode)
    (get-buffer-process buffer)))

(defun cargo-mode--project-directory ()
  "Find the project directory."
  (let ((closest-path (or buffer-file-name default-directory)))
    (locate-dominating-file closest-path "Cargo.toml")))

(defun cargo-mode--current-mod ()
  "Return the current mod."
  (save-excursion
    (when (search-backward-regexp cargo-mode-test-mod-regexp nil t)
      (let* ((line (buffer-substring-no-properties (line-beginning-position)
                                                   (line-end-position)))
             (line (string-trim-left line))
             (lines (split-string line " \\|{"))
             (mod (cadr lines)))
        mod))))

(defun cargo-mode--defun-at-point-p ()
  "Find fn at point."
  (string-match cargo-mode-test-regexp
                (buffer-substring-no-properties (line-beginning-position)
                                                (line-end-position))))

(defun cargo-mode--current-test ()
  "Return the current test."
  (save-excursion
    (unless (cargo-mode--defun-at-point-p)
      (if beginning-of-defun-function
          (beginning-of-defun-raw)
          (user-error "%s needs a supported major mode like rust-mode or rustic-mode"
		      this-command)))
    (beginning-of-line)
    (search-forward "fn ")
    (let* ((line (buffer-substring-no-properties (point)
                                                 (line-end-position)))
           (lines (split-string line "("))
           (function-name (car lines)))
      function-name)))

(defun cargo-mode--current-test-fullname ()
  "Return the current test's fullname."
  (let ((mod-name (cargo-mode--current-mod)))
    (if mod-name
        (concat mod-name
                "::"
                (cargo-mode--current-test))
      (cargo-mode--current-test))))

(defun cargo-mode--default-params-testfn (key candidate)
  "Check all of KEY when deciding whether we've found a CANDIDATE match."
  (cond ((stringp key) (equal candidate key))
        ((consp key) (seq-contains-p key candidate))))

(defun cargo-mode--default-params-for (cmd)
  "Find default params for CMD."
  (alist-get cmd cargo-mode-default-params nil nil
             #'cargo-mode--default-params-testfn))

(defun cargo-mode--assemble-command-string (cargo command prefix)
  "Prompt for additional CARGO params and assemble the COMMAND string.
If PREFIX is non-nil, then show a prompt - prefilled with default
params if they exist.
If PREFIX is nil, and default params are set, add the default params.
If PREFIX is nil, and no default params are set, pass back the command
to run with no additions.
."
  (let ((base-cmd (concat cargo " " command))
        (default-params (cargo-mode--default-params-for command)))
    (if prefix
        (let  ((params (read-string (concat "additional cargo command params for `" command "`: ") default-params)))
          (concat base-cmd " " params))
      (if default-params
          (concat base-cmd " " default-params)
        base-cmd))))

;;;###autoload
(defun cargo-mode-execute-task (&optional prefix)
  "Select and execute cargo task.
If PREFIX is non-nil, prompt for additional params."
  (interactive "P")
  (let* ((project-root (cargo-mode--project-directory))
         (available-commands (cargo-mode--available-tasks project-root))
         (selected-command (completing-read "select cargo command: " available-commands))
         (command-without-doc (car (split-string selected-command))))
    (cargo-mode--start "execute" command-without-doc project-root prefix)))

;;;###autoload
(defun cargo-mode-test (&optional prefix)
  "Run the `cargo test` command.
If PREFIX is non-nil, prompt for additional params."
  (interactive "P")
  (let ((project-root (cargo-mode--project-directory)))
    (cargo-mode--start "test" cargo-mode-command-test project-root prefix)))

;;;###autoload
(defun cargo-mode-build (&optional prefix)
  "Run the `cargo build` command.
If PREFIX is non-nil, prompt for additional params."
  (interactive "P")
  (let ((project-root (cargo-mode--project-directory)))
    (cargo-mode--start "execute" cargo-mode-command-build project-root prefix)))

;;;###autoload
(defun cargo-mode-clippy (&optional prefix)
  "Run the `cargo clippy` command.
If PREFIX is non-nil, prompt for additional params."
  (interactive "P")
  (let ((project-root (cargo-mode--project-directory)))
    (cargo-mode--start "clippy" cargo-mode-command-clippy project-root prefix)))

;;;###autoload
(defun cargo-mode-test-current-buffer (&optional prefix)
  "Run the cargo test for the current buffer.
If PREFIX is non-nil, prompt for additional params."
  (interactive "P")
  (let* ((project-root (cargo-mode--project-directory))
        (current-mod (print (cargo-mode--current-mod)))
        (command (concat cargo-mode-command-test " "  current-mod)))
    (cargo-mode--start "test" command project-root prefix)))

;;;###autoload
(defun cargo-mode-test-current-test (&optional prefix)
  "Run the Cargo test command for the current test.
If PREFIX is non-nil, prompt for additional params."
  (interactive "P")
  (let* ((project-root (cargo-mode--project-directory))
         (test-name (cargo-mode--current-test-fullname))
         (command (concat cargo-mode-command-test " " test-name)))
    (cargo-mode--start "test" command project-root prefix)))

;;;###autoload
(defun cargo-mode-last-command ()
  "Re-execute the last `cargo-mode` task."
  (interactive)
  (if cargo-mode--last-command
      (apply #'cargo-mode--start-cmd cargo-mode--last-command)
    (message "Last command is not found.")))

(defvar cargo-mode-command-map
  (let ((km (make-sparse-keymap)))
    (define-key km (kbd "b") 'cargo-mode-build)
    (define-key km (kbd "e") 'cargo-mode-execute-task)
    (define-key km (kbd "l") 'cargo-mode-last-command)
    (define-key km (kbd "t") 'cargo-mode-test)
    (define-key km (kbd "o") 'cargo-mode-test-current-buffer)
    (define-key km (kbd "f") 'cargo-mode-test-current-test)
    (define-key km (kbd "c") 'cargo-mode-clippy)
    km)
  "Cargo-mode keymap after prefix.")
(fset 'cargo-mode-command-map cargo-mode-command-map)

(defvar cargo-minor-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "C-c a") 'cargo-mode-command-map)
    map)
  "Cargo-map keymap.")

;;;###autoload
(define-minor-mode cargo-minor-mode
  "Cargo minor mode.  Used for holding keybindings for `cargo-mode'.
\\{cargo-minor-mode-map}"
  :init-value nil
  :lighter " cargo"
  :keymap cargo-minor-mode-map)

(provide 'cargo-mode)
;;; cargo-mode.el ends here
