;;; rutils-lib.el --- R utilities common functions                -*- lexical-binding: t; -*-

;; Copyright (C) 2021-2024  Shuguang Sun

;; Author: Shuguang Sun <shuguang79@qq.com>
;; Created: 2021/06/25
;; URL: https://github.com/ShuguangSun/rutils
;; Keywords: convenience

;; 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; General stuffs used in multiple files.

;;; Code:

(eval-when-compile
  (require 'cl-lib))

(require 'ess-inf)
(require 'ess-r-mode)
(require 'subr-x)
(require 'json)
(require 'transient)

(defgroup rutils nil
  "R utilities with transient menu."
  :group 'rutils
  :prefix "rutils")


;;; * Process handling

(defun rutils--r-processes ()
  "Return the list of live R process objects known to ESS."
  (let (procs)
    (dolist (entry (if (boundp 'ess-process-name-list) ess-process-name-list))
      (let ((proc (and (car entry) (get-process (car entry)))))
        (when (process-live-p proc)
          (push proc procs))))
    (nreverse procs)))

(defun rutils--current-r-process ()
  "Return the R process rutils commands should be sent to.
Prefer the process bound to the current buffer, then the first live
process from `ess-process-name-list'.  Return nil if none is
available."
  (let ((proc (and (bound-and-true-p ess-local-process-name)
                   (get-process ess-local-process-name))))
    (or (and (process-live-p proc) proc)
        (car (rutils--r-processes)))))

(defun rutils-send-r (cmd &optional buffer)
  "Send CMD (an R command string) to an R process.
If BUFFER is non-nil, evaluate CMD and display the output in BUFFER.
Otherwise send CMD to the R process buffer without switching windows.
Signal a `user-error' if no R process is available."
  (let ((proc (rutils--current-r-process)))
    (unless proc
      (user-error "No R process is running; start one with M-x ess-r"))
    (if buffer
        (ess-execute cmd (get-buffer-create buffer))
      (ess-send-string proc cmd t))
    proc))


;;; * Argument translation (transient args -> R call arguments)

(defun rutils--r-quote (value)
  "Return VALUE as an R expression.
The literal string \"NULL\" maps to the R NULL object; anything else
is turned into an R string literal via `prin1-to-string'."
  (if (equal value "NULL")
      "NULL"
    (prin1-to-string value)))

(defun rutils--spec-arg-to-r (name type values)
  "Turn VALUES for one command-spec option into an R argument snippet.
NAME is the R argument name (a symbol), TYPE its spec type, and
VALUES the list of raw values from transient (already stripped of the
argument prefix)."
  (if (eq type 'boolean)
      (concat (symbol-name name) "=TRUE")
    (if (> (length values) 1)
        (concat (symbol-name name) "=c("
                (mapconcat #'rutils--r-quote values ", ") ")")
      (concat (symbol-name name) "=" (rutils--r-quote (car values))))))

(defun rutils--args-to-r-call (args spec-args)
  "Translate transient ARGS into an R call argument string.
ARGS is a list of strings as returned by `transient-args'.  SPEC-ARGS
is the :args list of a command spec (see `rutils-define-rcommand');
each element is (RNAME :key K :type T :arg A ...) where RNAME is the
R argument name (a symbol) and the rest is a plist.  Arguments that
share an RNAME (e.g. `--cran=' and `--remote=' both mapping to
`packages') are merged into a single value.  The order of the
resulting arguments follows the first occurrence in ARGS.  Return the
argument string, or nil if ARGS is empty or nothing matches SPEC-ARGS."
  (when args
    (let (order values-by-name)
      (dolist (arg args)
        (let ((spec-arg
               (cl-find-if (lambda (spec)
                             (string-prefix-p (plist-get (cdr spec) :arg) arg))
                           spec-args)))
          (when spec-arg
            (let ((rname (car spec-arg)))
              (unless (member rname order)
                (push rname order))
              (push (substring arg (length (plist-get (cdr spec-arg) :arg)))
                    (alist-get rname values-by-name))))))
      (let ((parts
             (mapcar (lambda (rname)
                       (let ((spec-arg
                              (cl-find-if (lambda (spec) (eq (car spec) rname))
                                          spec-args)))
                         (rutils--spec-arg-to-r
                          rname
                          (plist-get (cdr spec-arg) :type)
                          (nreverse (alist-get rname values-by-name)))))
                     (nreverse order))))
        (and parts (string-join parts ", "))))))


;;; * Table-driven command definitions

(defun rutils--command-label (prefix)
  "Return a display label for command PREFIX, e.g. `Init' for `rutils-renv-init'."
  (capitalize (replace-regexp-in-string ".*-" "" (symbol-name prefix))))

(defun rutils--arg-name->infix-symbol (prefix arg-spec)
  "Return the transient infix symbol for ARG-SPEC of command PREFIX."
  (let ((stem (replace-regexp-in-string "[^A-Za-z0-9]" ""
                                        (plist-get (cdr arg-spec) :arg))))
    (intern (format "%s--%s" prefix stem))))

(defun rutils--arg-spec-to-infix (prefix arg-spec)
  "Return a `transient-define-infix' form for ARG-SPEC of command PREFIX.
ARG-SPEC is (RNAME :key K :type T :arg A [:desc D] [:choices C])."
  (let* ((argname (plist-get (cdr arg-spec) :arg))
         (key (plist-get (cdr arg-spec) :key))
         (desc (or (plist-get (cdr arg-spec) :desc) ""))
         (type (plist-get (cdr arg-spec) :type))
         (choices (plist-get (cdr arg-spec) :choices))
         (multi (plist-get (cdr arg-spec) :multi-value))
         (infix (rutils--arg-name->infix-symbol prefix arg-spec)))
    (cond
     ((eq type 'boolean)
      `(transient-define-infix ,infix ()
         :description ,desc
         :class 'transient-switch
         :key ,key
         :argument ,argname))
     ((eq type 'choice)
      `(transient-define-infix ,infix ()
         :description ,desc
         :class 'transient-option
         :key ,key
         :argument ,argname
         :choices ',choices
         ,@(when multi '(:multi-value t))))
     ((eq type 'package)
      `(transient-define-infix ,infix ()
         :description ,desc
         :class 'transient-option
         :key ,key
         :argument ,argname
         :reader 'rutils-read-cran-package-list
         :multi-value t))
     (t
      `(transient-define-infix ,infix ()
         :description ,desc
         :class 'transient-option
         :key ,key
         :argument ,argname
         ,@(when (eq type 'directory) '(:reader 'transient-read-directory))
         ,@(when (eq type 'file) '(:reader 'transient-read-file))
         ,@(when multi '(:multi-value t)))))))

(defmacro rutils-define-rcommand (prefix &rest spec)
  "Define a transient rutils command for the R call PREFIX.
SPEC is a plist with keys:
:r-call the R call (e.g. \"renv::init\"), :group the transient menu
group label, :key the menu key, :doc the prefix docstring, :label an
optional display label, :buffer an optional output buffer name, and
:args the list of argument specs.  Each argument spec is
\(RNAME :key K :type T :arg A [:desc D] [:reader R] [:choices C])
where RNAME is the R argument name and T one of `boolean', `string',
`directory', `file', `choice' or `package'.
The macro expands into one transient infix per argument, a
`-run' command that translates `transient-args' into R named
arguments and sends them, and the transient prefix menu."
  (declare (indent 1))
  (let* ((r-call (plist-get spec :r-call))
         (group (plist-get spec :group))
         (key (plist-get spec :key))
         (doc (plist-get spec :doc))
         (label (or (plist-get spec :label) (rutils--command-label prefix)))
         (buffer (plist-get spec :buffer))
         (args (plist-get spec :args))
         (run-fn (intern (format "%s-run" prefix)))
         (infix-forms (mapcar (lambda (a) (rutils--arg-spec-to-infix prefix a))
                              args))
         (layout-args (mapcar (lambda (a) (rutils--arg-name->infix-symbol prefix a))
                              args)))
    `(progn
       ,@infix-forms
       (defun ,run-fn (&optional args)
         ,(format "Invoke %s with ARGS if provided." r-call)
         (interactive (if current-prefix-arg
                          nil
                        (list (transient-args ',prefix))))
         (rutils-send-r
          (concat ,r-call "("
                  (or (rutils--args-to-r-call args ',args) "") ")")
          ,buffer))
       (transient-define-prefix ,prefix ()
         ,doc
         ["Arguments"
          ,@layout-args]
         [[,group
           (,key ,label ,run-fn)]]))))


;;; * CRAN package completion

(defvar rutils--cran-package-cache nil
  "Cached CRAN package list used by `rutils-read-cran-package-list'.")

(defun rutils-read-cran-package-list (prompt _initial-input _history)
  "Read a CRAN package name with completion, using PROMPT.
The completion list is fetched once from the R process via
`available.packages()' and cached in `rutils--cran-package-cache'.
Fall back to a plain `read-string' if the list cannot be obtained."
  (unless rutils--cran-package-cache
    (condition-case nil
        (setq rutils--cran-package-cache
              (and (bound-and-true-p ess-local-process-name)
                   (fboundp 'ess-get-words-from-vector)
                   (ess-get-words-from-vector
                    "print(rownames(available.packages()), max=1e6)\n")))
      (error nil)))
  (if rutils--cran-package-cache
      (completing-read prompt rutils--cran-package-cache nil nil)
    (read-string prompt)))


(provide 'rutils-lib)
;; Local variables:
;; package-lint-main-file: "rutils.el"
;; end:
;;; rutils-lib.el ends here