;;; blue-transient.el --- BLUE build system transient interface -*- lexical-binding: t -*-
;;
;; Copyright © 2025 Sergio Pastor Pérez

;;; Commentary:

;; Transient interface for the BLUE.
;;
;; This module is based on:
;; https://github.com/gavv/transient-compile

;;; License:

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

;;; Code:

(require 'blue)
(require 'blue-complete)

(require 'cl-generic)
(require 'cus-edit) ; For `custom-button' face.
(require 'eieio)
(require 'seq)
(require 'transient)
(require 'wid-edit) ; For `widget-field' face.


;;; Configuration.

(defcustom blue-transient-menu-columns-limit nil
  "If non-nil, limits maximum allowed number of menu columns.
Used by `blue-transient--menu-columns'."
  :group 'blue-transient
  :type '(choice (const :tag "Unlimited" nil)
                 (integer :tag "Limit")))

(defcustom blue-transient-options-min-rows 5
  "If non-nil, ensures that the options menu has that many rows."
  :group 'blue-transient
  :type '(choice (const :tag "Unlimited" nil)
                 (integer :tag "Limit")))

(defcustom blue-transient-command-argument-min-rows 7
  "If non-nil, ensures that the command argument menu has that many rows."
  :group 'blue-transient
  :type '(choice (const :tag "Unlimited" nil)
                 (integer :tag "Limit")))

(defface blue-transient-selection
  '((t :inherit blue-hint-highlight))
  "Face used to highlight selections."
  :group 'blue-transient)

(defface blue-transient-selection-suffix
  '((t :inherit transient-argument))
  "Face used to highlight suffixes."
  :group 'blue-transient)

(defface blue-transient-selection-suffix-value
  '((t :inherit transient-value))
  "Face used to highlight suffix values."
  :group 'blue-transient)


;;; Internal variables.

(defvar blue-transient-group-fallback 'unknown
  "The name of the fallback group for targets without group.")

(defvar blue-transient--command-chain nil
  "List of BLUE command strings.")

;; NOTE: -1 means no selection.
(defvar blue-transient--selected-index -1
  "Current element from `blue-transient--command-chain'.")

(defvar blue-transient--selected-argument-index 0
  "Current argument from `blue-transient--command-chain' selected command.")

(defconst blue-transient--keychar-table
  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
  "Valid characters used to form the keys to dispatch commands.

This is used to create the `blue-transient' menu.")

;; FIXME: if this holds the menu, it should be resetted everytime this module is
;; reloaded, that will avoid the inconsistent state where the transient does not
;; get evaluated and remains with the stub definition.
(defvar blue-transient--menu-expresion nil
  "Last evaluated transient.

This is used to prevent reevaluating the same transient, losing any
possible saved state.")


;;; History.

(defvar blue-transient--history nil
  "Command prompt history stack for `blue-transient--command-chain'.")

(defvar blue-transient--history-index 0
  "Current history element from `blue-transient--history'.")

(defvar blue-transient--undo-stack nil
  "Undo stack for `blue-transient--command-chain'.")

(defvar blue-transient--redo-stack nil
  "Redo stack for `blue-transient--command-chain'.")

(defun blue-transient--save-state ()
  "Save current state of `blue-transient--command-chain' to the undo stack."
  (push (copy-tree blue-transient--command-chain) blue-transient--undo-stack)
  (setq blue-transient--redo-stack nil)) ; Clear redo when new change happens.

(defun blue-transient--set-and-setup ()
  "Set and setup function `blue-transient--menu'.
This save the current transient state for future invocations
`transient-set'.  And refreshes the menu `transient-setup'."
  (transient-set)
  (transient-setup (oref transient-current-prefix command)))

(defun blue-transient-undo ()
  "Undo last change to `blue-transient--command-chain'."
  (interactive)
  (when blue-transient--undo-stack
    (push (copy-tree blue-transient--command-chain) blue-transient--redo-stack)
    (setq blue-transient--command-chain (pop blue-transient--undo-stack))
    ;; Adjust command selection.
    (setq blue-transient--selected-index (min blue-transient--selected-index
                                              (1- (length blue-transient--command-chain))))
    (blue-transient--set-and-setup)))

(defun blue-transient-redo ()
  "Redo last undone change to `blue-transient--command-chain'."
  (interactive)
  (when blue-transient--redo-stack
    (push (copy-tree blue-transient--command-chain) blue-transient--undo-stack)
    (setq blue-transient--command-chain (pop blue-transient--redo-stack))
    (blue-transient--set-and-setup)))

(defun blue-transient-previous-history ()
  "Set `blue-transient--command-chain' to previous recorded command."
  (interactive)
  (let ((prev (1+ blue-transient--history-index))
        (hist-length (length blue-transient--history)))
    (when (> prev hist-length)
      (message (propertize "End of history; no successing item"
                           'face 'minibuffer-prompt))
      (setq prev hist-length))
    (setq blue-transient--history-index prev)
    (setq blue-transient--command-chain (nth blue-transient--history-index
                                             blue-transient--history))
    (blue-transient--set-and-setup)))

(defun blue-transient-next-history ()
  "Set `blue-transient--command-chain' to next recorded command."
  (interactive)
  (let ((next (1- blue-transient--history-index)))
    (when (< next 0)
      (message (propertize "Beginning of history; no preceding item"
                           'face 'minibuffer-prompt))
      (setq next 0))
    (setq blue-transient--history-index next)
    (setq blue-transient--command-chain (nth blue-transient--history-index
                                             blue-transient--history))
    (blue-transient--set-and-setup)))


;;; Command selection.

(defun blue-transient--command-index-1 (&optional skip-arguments)
  "Utility to remove 1 from  `blue-transient--selected-index' respecting bounds.

If SKIP-ARGUMENTS is non-nil, jump to next command."
  (let* ((selected-command (blue-transient--selected-command))
         (selected-command-length (length selected-command))
         (previous-command (blue-transient--previous-command))
         (previous-command-length (length previous-command)))
    (cond
     ((and (not skip-arguments)
           (> selected-command-length 1)
           (> blue-transient--selected-argument-index 0))
      (setq blue-transient--selected-argument-index
            (1- blue-transient--selected-argument-index)))
     (t
      (setq blue-transient--selected-index (max (1- blue-transient--selected-index)
                                                -1)
            blue-transient--selected-argument-index (1- previous-command-length))))))

(defun blue-transient--command-index+1 (&optional skip-arguments)
  "Utility to add 1 from `blue-transient--selected-index' respecting bounds.

If SKIP-ARGUMENTS is non-nil, jump to previous command."
  (let* ((selected-command (blue-transient--selected-command))
         (selected-command-length (length selected-command)))
    (cond
     ((and (not skip-arguments)
           (> selected-command-length 1)
           (< blue-transient--selected-argument-index (1- selected-command-length)))
      (setq blue-transient--selected-argument-index
            (1+ blue-transient--selected-argument-index)))
     (t
      (setq blue-transient--selected-index (min (1+ blue-transient--selected-index)
                                                (1- (length blue-transient--command-chain)))
            blue-transient--selected-argument-index 0)))))

(defun blue-transient--select-first ()
  "Select first command from `blue-transient--command-chain'."
  (interactive)
  (when blue-transient--command-chain
    (setq blue-transient--selected-index 0
          blue-transient--selected-argument-index 0)
    (blue-transient--set-and-setup)))

(defun blue-transient--select-previous ()
  "Select previous command from `blue-transient--command-chain'."
  (interactive)
  (when blue-transient--command-chain
    (blue-transient--command-index-1)
    (blue-transient--set-and-setup)))

(defun blue-transient--select-next ()
  "Select next command for argument operation from `blue-transient--command-chain'."
  (interactive)
  (when blue-transient--command-chain
    (blue-transient--command-index+1)
    (blue-transient--set-and-setup)))

(defun blue-transient--select-last ()
  "Select last command for argument operation from `blue-transient--command-chain'."
  (interactive)
  (when blue-transient--command-chain
    (setq blue-transient--selected-index (1- (length blue-transient--command-chain)))
    (let* ((selected-command (blue-transient--selected-command))
           (argument-lenght (length selected-command)))
      (setq blue-transient--selected-argument-index (1- argument-lenght)))
    (blue-transient--set-and-setup)))


;;; State getters.

(defun blue-transient--selected-command ()
  "Get the selected command from the `blue-transient' menu prompt."
  (unless (< blue-transient--selected-index 0)
    (nth blue-transient--selected-index blue-transient--command-chain)))

(defun blue-transient--previous-command ()
  "Get the previous command from the `blue-transient' menu prompt."
  (unless (< blue-transient--selected-index 1)
    (nth (1- blue-transient--selected-index) blue-transient--command-chain)))

(defun blue-transient--selected-command-suffixes ()
  "Get the selected command arguments suffixes from the menu prompt."
  (when-let* ((selected-command (blue-transient--selected-command)))
    (mapcar #'caddr
            (blue-transient--arguments-menu (car selected-command)))))

(defun blue-transient--selected-command-suffixes-values ()
  "Get the selected command arguments suffixes values from the menu prompt."
  (let ((args (transient-get-value))
        (selected-command-suffixes (blue-transient--selected-command-suffixes)))
    (seq-filter (lambda (arg)
                  (let ((arg-prefix (concat (string-trim-right arg "=.*") "=")))
                    (member arg-prefix selected-command-suffixes)))
                args)))

(defun blue-transient--selected-command-suffix-arguments (_)
  "Helper function to group last command arguments in transient suffixes."
  (if-let* ((selected-command (car (blue-transient--selected-command)))
            (suffixes (blue-transient--arguments-menu selected-command))
            ;; Make each menu entry a vector. Each vector will be a column.
            (columns (blue-transient--split-elements-smart suffixes)))
      (transient-parse-suffixes 'transient--prefix columns)
    (transient-parse-suffixes
     'transient--prefix
     '([(:info (propertize "No arguments" 'face 'shadow) :format "%d")]))))

(defun blue-transient--get-option-arguments ()
  "Retrieve values of options for the current transient prefix."
  (let* ((prefix (oref transient-current-prefix command))
         (column 0)
         results
         (get-row
          (lambda (col)
            (let ((row 0)
                  ;; Since `transient-get-suffix' signals and error when the
                  ;; requested location is out of bounds, we need a way to
                  ;; detect if the out of bounds came from the column or the
                  ;; row, to let the column loop know if it should move to the
                  ;; next column or if there are no more columns. If any thing
                  ;; has been found, it means that the column is valid so the
                  ;; outer loop should try with the next one.
                  found-any)
              (while-let ((suffix (ignore-errors (transient-get-suffix
                                                  prefix `(1 ,col ,row))))
                          (argument (plist-get (cdr suffix) :argument)))
                (push argument results)
                (setq row (1+ row)
                      found-any t))
              found-any))))
    (while (funcall get-row column)
      (setq column (1+ column)))
    results))


;;; Command chain manipulation.

(defun blue-transient--insert-nth (n elem lst)
  "Return a new LST with ELEM inserted at position N (0-based).
If N is 0, insert at the front.  If N >= length of LIST, append ELEM at
the end."
  (cond
   ((null lst)
    (list elem))
   ((= n 0)
    (cons elem lst))
   (t
    (cons (car lst)
          (blue-transient--insert-nth (1- n) elem (cdr lst))))))

(defun blue-transient--del ()
  "Delete the selected argument or command in `blue-transient--command-chain'."
  (interactive)
  (let ((selected-index blue-transient--selected-index)
        (selected-argument-index blue-transient--selected-argument-index))
    (unless (or (not blue-transient--command-chain)
                (< selected-index 0))
      (blue-transient--save-state)
      (blue-transient--command-index-1)
      (if (> selected-argument-index 0)
          ;; Remove selected argument.
          (let* ((selected-command (blue-transient--selected-command))
                 (selected-command* (seq-remove-at-position selected-command
                                                            selected-argument-index))
                 (cleaned-chain (seq-remove-at-position blue-transient--command-chain
                                                        selected-index)))
            (setq blue-transient--command-chain
                  (blue-transient--insert-nth selected-index
                                              selected-command*
                                              cleaned-chain)))
        ;; Remove entire command.
        (setq blue-transient--command-chain
              (seq-remove-at-position blue-transient--command-chain
                                      selected-index)))
      (blue-transient--set-and-setup))))

(defun blue-transient--kill ()
  "Delete `blue-transient--command-chain' chain from selection."
  (interactive)
  (let ((selected-index blue-transient--selected-index)
        (selected-argument-index blue-transient--selected-argument-index))
    (unless (not blue-transient--command-chain)
      (blue-transient--save-state)
      (blue-transient--command-index-1)
      (let ((head (seq-take blue-transient--command-chain (1+ selected-index))))
        (if (> selected-argument-index 0)
            ;; Remove from selected argument.
            (let* ((selected-command (blue-transient--selected-command))
                   (selected-command* (seq-take selected-command
                                                selected-argument-index))
                   (cleaned-head (seq-remove-at-position head
                                                         selected-index)))
              (setq blue-transient--command-chain
                    (blue-transient--insert-nth selected-index
                                                selected-command*
                                                cleaned-head)))
          ;; Remove from selected command.
          (setq blue-transient--command-chain (butlast head))))
      (blue-transient--set-and-setup))))

(defun blue-transient--clear ()
  "Clean command prompt."
  (interactive)
  (when blue-transient--command-chain
    (blue-transient--save-state)
    (setq blue-transient--command-chain nil
          blue-transient--selected-index -1)
    (blue-transient--set-and-setup)))

(defun blue-transient--run ()
  "Run BLUE commands."
  (interactive)
  (transient-set) ; Save the current transient state for future invocations.
  (let* ((args (transient-args (oref transient-current-prefix command)))
         (comint-flip (transient-arg-value "flip" args))
         (default-options (blue--normalize-options blue-default-options))
         (option-args (blue-transient--get-option-arguments))
         ;; Remove command arguments from `args'.
         (options (append default-options
                          (seq-filter (lambda (arg)
                                        (seq-some (lambda (option)
                                                    (string-prefix-p option
                                                                     arg))
                                                  option-args))
                                      args)))
         (is-interactive (blue--any-interactive-p blue-transient--command-chain))
         (comint (xor is-interactive comint-flip))
         (known-build-dirs (blue--cache-get-build-dirs default-directory))
         (build--dir-arg (transient-arg-value "--build-directory=" args))
         (blue--build-dir (or build--dir-arg
                              (seq-find (lambda (dir)
                                          (transient-arg-value dir args))
                                        known-build-dirs)))
         (commands (mapcar (lambda (token)
                             (string-join token " "))
                           blue-transient--command-chain))
         (input (string-join commands " -- "))
         (full-input (string-join
                      (cons blue-binary
                            (append (when options options)
                                    (list input)))
                      " ")))
    (let ((last-hist (car blue-transient--history)))
      ;; Avoid not pushing consecutive duplicates.
      (unless (equal blue-transient--command-chain last-hist)
        (push (copy-tree blue-transient--command-chain) blue-transient--history)))
    ;; Bring `blue--build-dir' to the from of the list so it's ordered by usage.
    (blue--cache-add-current-build-dir)
    (blue--compile full-input comint)))

(defun blue-transient--prompt-args ()
  "Helper for prompting BLUE command arguments."
  (interactive)
  (if (< blue-transient--selected-index 0)
      (message (propertize "No command selected"
                           'face 'minibuffer-prompt))
    (let* ((selected-command (blue-transient--selected-command))
           (head (seq-take blue-transient--command-chain blue-transient--selected-index))
           (tail (seq-drop blue-transient--command-chain (1+ blue-transient--selected-index)))
           (selected-command-string (string-join selected-command " "))
           (selected-command-prompt (concat selected-command-string " "))
           (initial-contents (when selected-command-string
                               (propertize selected-command-prompt
                                           'face 'shadow
                                           'read-only t
                                           'rear-nonsticky t)))
           ;; HACK: `blue-transient--setup-minibuffer' fills the completion table
           ;; from user input, this is why here we use `initial-contents'
           (input (minibuffer-with-setup-hook #'blue-transient--setup-minibuffer
                    (read-from-minibuffer "args=" initial-contents nil nil nil)))
           (args (string-trim-left input selected-command-prompt))
           (selected-command* (append selected-command (list args))))
      (blue-transient--save-state)
      (setq blue-transient--command-chain
            (append head (list selected-command*) tail)))))

(defun blue-transient--free-type ()
  "Helper for prompting for input to add to BLUE commands."
  (interactive)
  (let* ((input (minibuffer-with-setup-hook #'blue-transient--setup-minibuffer
                  (read-from-minibuffer "Input: " nil nil nil nil))))
    (blue-transient--save-state)
    (setq blue-transient--command-chain
          (append blue-transient--command-chain
                  (list (list input))))))


;;; Key assignment utilities.

(defun blue-transient--remove-prefix (prefix words)
  "Remove PREFIX from WORDS."
  (mapcar
   (lambda (word)
     (string-trim-left word prefix))
   words))

(defun %blue-transient--simplify-keys (keys)
  "Helper function to create a fixed-point for key simplification."
  (let ((head (car keys))
        (tail (cdr keys)))
    (if tail
        (cons head (blue-transient--simplify-keys
                    (blue-transient--remove-prefix head tail)))
      keys)))

(defun blue-transient--simplify-keys (keys)
  "Given a list of KEYS, trim prefixes used by previous keys.

This function only looks forward, so almost certainly you want to pass an
alphabetically ordered list as argument.

The function searches a fixed point, which means that it will retry until it
gets the simplest key combination."
  (let* ((simple-keys (%blue-transient--simplify-keys keys))
         (fixed-point (equal keys simple-keys)))
    (if fixed-point
        simple-keys
      (blue-transient--simplify-keys simple-keys))))

(defun blue-transient--assign-keys (words)
  "Assign a valid key combination for a transient menu to each word in WORDS.

Ensure that no word ocuppies the same key combination, try to fallback
otherwise."
  (let* ((assignments
          (seq-reduce ; Use an accumulator to keep track of assigned keys.
           (lambda (acc word)
             (let* ((used (mapcar #'cadr acc))
                    (key (apply #'string
                                (seq-reduce ; Find unused prefix.
                                 (lambda (acc ch)
                                   (let* ((prev (apply #'string acc))
                                          (prefix (concat prev (char-to-string ch))))
                                     (string-to-list
                                      (if (or (string-empty-p prev)
                                              (member prev used))
                                          prefix
                                        prev))))
                                 (string-to-list word)
                                 nil))))
               (unless key
                 (error "No unused character available in %s" word))
               (append acc `((,word ,key)))))
           (sort words)
           nil))
         (keys (mapcar #'cadr assignments))
         (simple-keys (blue-transient--simplify-keys keys))
         (simple-assignments (seq-mapn (lambda (assignment simple-prefix)
                                         (pcase-let ((`(,word _) assignment))
                                           `(,word ,simple-prefix)))
                                       assignments simple-keys)))
    ;; Add fallback key if simplification removed assigned key.  The accumulator
    ;; is required to update the list of used keys as the fallbacks are
    ;; assigned.
    (seq-reduce
     (lambda (acc assignment)
       (pcase-let ((`(,word ,key) assignment))
         (if (string-empty-p key)
             (let* ((used (append (mapcar #'cadr acc)
                                  simple-keys))
                    (capital-prefix (string (capitalize (seq-first word))))
                    (fallback-key
                     (if (member capital-prefix used)
                         (string
                          (seq-find
                           (lambda (ch)
                             (not (member (char-to-string ch) used)))
                           blue-transient--keychar-table))
                       capital-prefix)))
               (append acc `((,word ,fallback-key))))
           (append acc (list assignment)))))
     simple-assignments
     nil)))


;;; Transient classes.

(defclass blue-transient--command-argument (transient-option) ()
  "Class used for BLUE command arguments that can take a value.")

(defclass blue-transient--build-directory (transient-switch) ()
  "Class used for selected BLUE build directories.")

;; Command argument handling.

(cl-defmethod transient-infix-set :after ((obj blue-transient--command-argument) value)
  "Setter for the class symbol `blue-transient--command-argument'.

This function is meant for side effects, it is responsible of keeping
`blue-transient--command-chain' sync with the selected command argument
suffixes."
  (blue-transient--save-state)
  (let* ((argument-prefix (oref obj argument))
         (selected-command (blue-transient--selected-command))
         (selected-command-args (cdr selected-command))
         ;; Remove the ones controled value.
         (selected-command-args* (seq-remove
                                  (lambda (arg)
                                    (string-prefix-p argument-prefix arg))
                                  selected-command-args))
         (arg-val (if value
                      (list (concat argument-prefix value))
                    '()))
         (merged-args (seq-uniq (append selected-command-args*
                                        arg-val)))
         (selected-command* (cons (car selected-command) merged-args))
         (cleaned-chain (seq-remove-at-position blue-transient--command-chain
                                                blue-transient--selected-index)))
    (setq blue-transient--command-chain
          (blue-transient--insert-nth blue-transient--selected-index
                                      selected-command*
                                      cleaned-chain))
    (unless value
      (setq blue-transient--selected-argument-index
            (min blue-transient--selected-argument-index
                 (1- (length selected-command-args)))))))

;; Build directory handling.

(cl-defmethod transient-infix-set :after ((_ blue-transient--build-directory) value)
  "Setter for the class symbol `blue-transient--build-directory'.

This function is meant for side effects, it is responsible of keeping
`blue--build-dir' sync with the selected build directory."
  (setq blue--build-dir value)
  ;; Make completion work from selected build dir.
  (blue--set-default-directory (blue--get-build-dir)))


;;; Menu building.

(defun blue-transient--menu-columns (items)
  "Return bounded menu column count from ITEMS.

Takes assoc list returned by `blue-transient--build-menu'."
  (let* ((categories (mapcar #'car items))
         (longest-category (seq-max (mapcar #'length categories)))
         (command-invokes (mapcar #'cadr (seq-mapcat #'cdr items)))
         (longest-invoke (seq-max (mapcar #'length command-invokes)))
         (max-width (max longest-category longest-invoke))
         (max-columns (max (/ (frame-width) max-width)
                           1))) ; At least 1 column.
    (if (and blue-transient-menu-columns-limit
             (> blue-transient-menu-columns-limit 0))
        (min blue-transient-menu-columns-limit
             max-columns)
      max-columns)))

(defun blue-transient--group-commands (categories category-keys)
  "Group commands by CATEGORIES and assign CATEGORY-KEYS."
  (mapcar
   (lambda (category)
     (let* ((category-name (car category))
            (category-commands (cdr category))
            (category-command-invocations (blue--get-command-invocations category-commands))
            (category-command-keys (blue-transient--assign-keys category-command-invocations)))
       (append
        (list (capitalize category-name))
        (mapcar
         (lambda (command)
           (let* ((command-name (alist-get 'invoke command))
                  (command-key
                   (if (> (length category-commands) 1)
                       (concat (cadr (assoc category-name category-keys))
                               (cadr (assoc command-name category-command-keys)))
                     (cadr (assoc command-name category-command-keys))))
                  (command-synopsis (alist-get 'synopsis command)))
             `(,command-key
               ,(capitalize command-name)
               (lambda () ,command-synopsis (interactive)
                 (blue-transient--save-state)
                 (let ((command-chain (if blue-transient--command-chain
                                          (blue-transient--insert-nth
                                           (1+ blue-transient--selected-index)
                                           '(,command-name)
                                           blue-transient--command-chain)
                                        '((,command-name)))))
                   (setq blue-transient--command-chain command-chain)
                   (blue-transient--command-index+1 t)
                   (blue-transient--set-and-setup))))))
         category-commands))))
   categories))

(defun blue-transient--build-menu (commands)
  "Build transient menu for BLUE COMMANDS."
  (let* ((categories (blue--get-command-categories commands))
         (category-keys (blue-transient--assign-keys categories))
         (commands-by-category
          (mapcar
           (lambda (category)
             (cons category
                   (seq-filter
                    (lambda (command)
                      (string-equal (alist-get 'category command)
                                    category))
                    commands)))
           categories))
         (grouped-commands
          (blue-transient--group-commands commands-by-category
                                          category-keys)))
    ;; Make each menu entry a vector.
    (mapcar (lambda (item)
              (apply #'vector item))
            grouped-commands)))

(defun blue-transient--split-elements (n lst)
  "Helper to split list LST of elements in N groups."
  ;; Round up to ensure odd length lists are computed properly.
  (let* ((columns (seq-split lst
                             (ceiling (/ (length lst) (float n)))))
         (vector-columns (mapcar (lambda (item)
                                   (apply #'vector item))
                                 columns)))
    vector-columns))

(defun blue-transient--entry-length (entry)
  "Helper to compute the length of the visible text from menu ENTRY."
  (let* ((visible-text (car (seq-split entry 3)))
         (visible-sizes (mapcar #'length visible-text))
         (len (+ (apply #'+ visible-sizes)
                 4))) ; Account for decorators such as parenthesis and spaces.
    len))

(defun blue-transient--max-group-width (group)
  "Helper to compute the max width of the visible text from the menu GROUP."
  (apply #'max
         (mapcar (lambda (entry)
                   (blue-transient--entry-length entry))
                 group)))

(defun blue-transient--compute-max-groups (n lst min-height fr-width)
  "Recursive helper to compute how many groups fit the screen.

N is an accumulator to count the number of groups of the current iteration.
LST is the list to split into groups.
MIN-HEIGHT is the minimum numbers of row to have per group.
FR-WIDTH serves to restrict the span width wise of the groups."
  (let* ((min-height (or min-height 0))
         (fr-width (or fr-width
                       (frame-width)))
         (groups (blue-transient--split-elements n lst))
         (max-widths (mapcar #'blue-transient--max-group-width groups))
         (menu-width (+ (apply #'+ max-widths)
                        (* (1- (length groups))
                           2))) ; Account for spaces between groups.
         (menu-height (apply #'max (mapcar #'length groups))))
    (if (or (> menu-width fr-width)
            (< menu-height min-height))
        (1- n)
      (blue-transient--compute-max-groups (1+ n) lst min-height fr-width))))

(defun blue-transient--split-elements-smart (lst)
  "Helper to split list LST of elements in a number of groups which fits screen."
  (blue-transient--split-elements
   (blue-transient--compute-max-groups
    1 lst blue-transient-command-argument-min-rows (frame-width))
   lst))

(defun blue-transient--propertize-value-arg (arg selected)
  "Helper to propertize a transient ARG of the form `arg=val'.

SELECTED controls the face properties to apply."
  (let* ((split (string-split arg "="))
         (arg (concat (car split) "="))
         (val (string-join (cdr split)
                           "="))
         (properties (if selected
                         '(:underline t)
                       '(:weight regular))))
    (concat (propertize arg 'face `(:inherit blue-transient-selection-suffix ,@properties))
            (propertize val 'face `(:inherit blue-transient-selection-suffix-value ,@properties)))))

(defun blue-transient--menu-heading ()
  "Dynamic header for BLUE transient."
  (let* ((selected-command (blue-transient--selected-command))
         (selected-command-suffixes (blue-transient--selected-command-suffixes-values))
         (head (seq-take blue-transient--command-chain blue-transient--selected-index))
         (tail (seq-drop blue-transient--command-chain (1+ blue-transient--selected-index)))
         (propertized-head (mapcar (lambda (tokens)
                                     (propertize (string-join tokens " ")
                                                 'face 'widget-field))
                                   head))
         (propertized-selection
          (when selected-command
            (string-join
             (seq-map-indexed
              (lambda (token i)
                (if (= i blue-transient--selected-argument-index)
                    (if (member token selected-command-suffixes)
                        (blue-transient--propertize-value-arg token t)
                      (propertize token 'face '(:inherit blue-transient-selection :underline t)))
                  (if (member token selected-command-suffixes)
                      (blue-transient--propertize-value-arg token nil)
                    (propertize token 'face '(:inherit blue-transient-selection :weight regular)))))
              selected-command)
             (propertize " " 'face 'widget-field))))
         (propertized-tail (mapcar (lambda (tokens)
                                     (propertize (string-join tokens " ")
                                                 'face 'widget-field))
                                   tail))
         (commands (seq-remove #'null
                               (append propertized-head
                                       (list propertized-selection)
                                       propertized-tail)))
         (input (string-join commands (propertize " -- " 'face 'widget-field)))
         (header (propertize "Commands:" 'face 'bold))
         (header* (if propertized-selection
                      (concat header "  ")
                    (concat header " "
                            (propertize ">" 'face 'blue-transient-selection)))))
    (concat header* input
            (propertize "\n" 'face '(:inherit widget-field :extend t)))))

(defun blue-transient--argument-menu-entry (prefix key option class)
  "Create a transient argument entry from BLUE option.

PREFIX is will be concatenated to the KEY.
CLASS will be set for the returned transient infix."
  (when-let* ((labels (blue--get-option-labels option)))
    (let* ((formated-label (blue--format-option-label option nil))
           (raw-label (blue--format-option-label option t))
           (doc (alist-get 'doc option))
           (autocomplete (alist-get 'autocomplete option))
           (autocomplete-type (alist-get 'type autocomplete))
           (choices (cond
                     ((string-equal autocomplete-type "set")
                      (alist-get 'values autocomplete))
                     ((string-equal autocomplete-type "system-name")
                      blue-complete-target-names)))
           (reader (cond
                    ((string-equal autocomplete-type "directory")
                     #'transient-read-directory)
                    ((string-equal autocomplete-type "file")
                     #'transient-read-file))))
      `(,(concat prefix key)
        ,(capitalize raw-label)
        ,formated-label
        :summary ,doc
        :choices ,choices
        :reader ,reader
        ,@(if class `(:class ,class))))))

(defun blue-transient--arguments-menu (command-name)
  "Build transient menu for BLUE COMMAND-NAME arguments."
  (when-let* ((commands (car blue--data))
              (command (blue--get-command command-name commands))
              (options (alist-get 'options command))
              (option-labels (seq-mapcat
                              #'(lambda (option)
                                  (let ((labels (blue--get-option-labels option)))
                                    (append (car labels) (cdr labels))))
                              options))
              (option-keys (blue-transient--assign-keys option-labels)))
    (let ((options-menu
           (mapcar
            (lambda (option)
              (let* ((label (blue--format-option-label option t))
                     (key (cadr (assoc-string label option-keys))))
                (blue-transient--argument-menu-entry
                 "--" key option 'blue-transient--command-argument)))
            options)))
      options-menu)))


;;; UI.

(defun blue-transient--setup-minibuffer ()
  "Setup keybindings and completion for minibuffer prompt."
  (use-local-map (copy-keymap (current-local-map)))
  (define-key (current-local-map) (kbd "TAB")
              #'completion-at-point)
  ;; NOTE: `corfu--minibuffer-on` won't enable `corfu-mode'
  ;; if `completion-at-point-functions` isn't local.
  (add-hook 'completion-at-point-functions
            #'blue-completion-at-point nil t))

;; This function is defined at run-time during the evaluation of
;; `blue-transient'. Let's declare it here to silence the byte-compilation
;; warning.
(declare-function blue-transient--menu "blue-transient" ())

;;;###autoload
(defun blue-transient ()
  "Open transient menu for BLUE.

Invoked with universal prefix argument '\\[universal-argument]', prompt
for a directory to use when running `blue'.

The following steps are performed:

 - For each command, a unique key sequence is assigned.

 - Transient menu is built.  See `blue-transient--menu-heading' and
   `blue-transient--menu-columns' for altering its appearance.

 - Transient menu is opened.  Now we wait until selects target using its
   key sequence, or cancels operation.

After that, `blue-transient' closes menu and returns, while the command
keeps running in the compilation buffer."
  (interactive)
  (blue--check-blue-binary)
  (blue--ensure-cache)
  (setq blue-transient--history-index 0
        blue--blueprint (blue--find-blueprint))
  (let* ((blue-transient-menu 'blue-transient--menu)
         (build-dir (car (blue--determine-build-dir))))
    (setq blue--build-dir build-dir
          blue--data (blue--get-data blue--blueprint))
    ;; Make completion work from selected build dir.
    (blue--set-default-directory (blue--get-build-dir))
    ;; Bring `blue--build-dir' to the from of the list so it's ordered by usage.
    (blue--cache-add-current-build-dir)
    ;; Rebuild menu.
    (let* ((commands (car blue--data))
           (options (caddr blue--data))
           (option-labels (seq-mapcat
                                #'(lambda (option)
                                    (let ((labels (blue--get-option-labels option)))
                                      (append (car labels) (cdr labels))))
                                options))
           (option-keys (blue-transient--assign-keys option-labels))
           ;; Update `build-dirs' since cache could have been updated in the
           ;; previous lines.
           (build-dirs (blue--cache-get-build-dirs blue--blueprint))
           (indices (number-sequence 1 (length build-dirs)))
           (transient `(transient-define-prefix ,blue-transient-menu ()
                         :incompatible '(,(cons "--build-directory="
                                                build-dirs))
                         :init-value
                         (lambda (obj)
                           (let* ((selected-command-suffixes
                                   (blue-transient--selected-command-suffixes))
                                  (selected-command-args-values
                                   (cdr (blue-transient--selected-command)))
                                  (value (and (slot-boundp obj 'value)
                                              ;; Already set because the live
                                              ;; object is cloned from the
                                              ;; prototype, were the set (if
                                              ;; any) value is stored.
                                              (oref obj value)))
                                  (selected-build-dir (seq-find
                                                       (lambda (arg)
                                                         (member arg ',build-dirs))
                                                       value
                                                       ,build-dir))
                                  ;; Removed selected command suffixes from
                                  ;; state since those should follow what
                                  ;; `blue-transient--command-chain' specifies
                                  ;; instead of the saved state.
                                  (cleaned-value (seq-remove
                                                  (lambda (arg)
                                                    (let ((arg-prefix (concat (string-trim-right arg "=.*") "=")))
                                                      (member arg-prefix selected-command-suffixes)))
                                                  value))
                                  ;; Ensure that a build dir and selected
                                  ;; command suffixes present in
                                  ;; `blue-transient--command-chain' are set.
                                  (value* (append
                                           (cons selected-build-dir
                                                 selected-command-args-values)
                                           cleaned-value)))
                             ;; Make sure the `blue--build-dir' is in sync with
                             ;; the selected build directory.
                             (setq blue--build-dir selected-build-dir)
                             (oset obj value value*)))
                         [:description
                          blue-transient--menu-heading
                          :class
                          transient-columns
                          [("M-p" "Previous prompt" blue-transient-previous-history)]
                          [("M-n" "Next prompt" blue-transient-next-history)]]
                         ["Options"
                          :class
                          transient-columns
                          ,@(let* ((filtered-options
                                    (seq-remove ; Remove build directory since it's handled specially.
                                     (lambda (option)
                                       (let* ((long-labels (cdr (blue--get-option-labels option))))
                                         (member "build-directory" long-labels)))
                                     options))
                                   (options-menu
                                    (mapcar
                                     (lambda (option)
                                       (let* ((label (blue--format-option-label option t))
                                              (key (cadr (assoc-string label option-keys))))
                                         (blue-transient--argument-menu-entry "-" key option nil)))
                                     filtered-options))
                                   (grouped-options-menu
                                    (blue-transient--split-elements
                                     (blue-transient--compute-max-groups
                                      1
                                      options-menu
                                      blue-transient-options-min-rows
                                      (- (frame-width) 25)) ; Give some margin for the controls group.
                                     options-menu)))
                              grouped-options-menu)
                          [("," "Selected command args"
                            blue-transient--prompt-args
                            :transient t)
                           ("!" "Free-type" blue-transient--free-type :transient t)
                           ("^" "Comint flip" "flip")]]
                         ;; Build dirs.
                         ["Build directory"
                          ;; NOTE: this switch won't add the directory to
                          ;; `blue--cache-list' is this the desired behavior?
                          ("-b" "Build directory" "--build-directory="
                           :prompt "Build directory: "
                           :reader
                           (lambda (&rest _)
                             (blue--prompt-dir t nil)))
                          ,@(seq-mapn (lambda (idx build-dir)
                                        (list
                                         (concat " " (number-to-string idx)) "" build-dir
                                         :format "%k %v"
                                         :class 'blue-transient--build-directory))
                                      indices build-dirs)]
                         [:description
                          (lambda ()
                            (if-let* ((selected-command (car (blue-transient--selected-command)))
                                      (invisible-separator ?\u2063)
                                      (separator (make-string 2 invisible-separator))
                                      (propertized-selected-command
                                       (if (display-graphic-p)
                                           ;; HACK: This is done because we are
                                           ;; using the ':box' face attribute
                                           ;; with a negative value to prevent
                                           ;; the height of the line to jump
                                           ;; when switching from no selection
                                           ;; (which does not have a box) to
                                           ;; selection.  To the commands we are
                                           ;; concatenating invisible separators
                                           ;; to prevent the box from being too
                                           ;; close to the text.
                                           (propertize
                                            (format "%s%s%s" separator selected-command separator)
                                            'face '(:inherit blue-hint-highlight :box (-1 . -1)))
                                         ;; Boxes are not supported in terminal
                                         ;; so let's use ':inverse-video'.
                                         (propertize
                                          selected-command
                                          'face '(:inherit blue-hint-highlight :inverse-video t)))))
                                (concat propertized-selected-command
                                        (propertize " arguments" 'face 'bold))
                              "No selected command"))
                          :class
                          transient-columns
                          :setup-children
                          blue-transient--selected-command-suffix-arguments]
                         ;; Command selector.
                         [[("C-a" "        " blue-transient--select-first :transient t)
                           ("<home>" "First" blue-transient--select-first :transient t)]
                          [("C-b" "     " blue-transient--select-previous :transient t)
                           ("<left>" "<-" blue-transient--select-previous :transient t)]
                          [("C-f" "      " blue-transient--select-next :transient t)
                           ("<right>" "->" blue-transient--select-next :transient t)]
                          [("C-e" "" blue-transient--select-last :transient t)
                           ("<end>" "Last" blue-transient--select-last :transient t)]]
                         ;; Commands.
                         ["Commands"
                          ,@(blue-transient--build-menu commands)
                          ;; Controls.
                          [("DEL" "Del" blue-transient--del :transient t)
                           ("C-k" "Kill" blue-transient--kill :transient t)
                           ("C-l" "Clear" blue-transient--clear :transient t)
                           ("_" "  Undo" blue-transient-undo :transient t)
                           ("M-_" "Redo" blue-transient-redo :transient t)]
                          [("RET" ,(propertize "Run" 'face 'custom-button) blue-transient--run)]])))
      ;; Only evaluate menu if it has changed since the last invocation. This
      ;; ensures that any saved state (eg.: `transient-set') is preserved.
      ;; Reevaluating means creating a new object which will not have the stored
      ;; state.
      (unless (equal transient blue-transient--menu-expresion)
        (setq blue-transient--menu-expresion transient)
        (eval transient))
      ;; Open menu.
      (funcall blue-transient-menu))))

(provide 'blue-transient)
;;; blue-transient.el ends here.
