;;; consult-dash.el --- Consult front-end for dash-docs  -*- lexical-binding: t; -*-

;; Copyright (C) 2022  Ravi R Kiran

;; Author: Ravi R Kiran <aine.marina@gmail.com>
;; Keywords: consult, dash

;; 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:

;; consult-dash is the only interface function

;; To do

;; - Segment matches per docset
;; - Avoid concatenating commands through the shell

;;; Code:

(require 'dash-docs)
(require 'subr-x)
(require 'thingatpt)

(defvar-local consult-dash-docsets nil
  "Docsets to use for this buffer")
(defvar consult-dash-sqlite-args "sqlite3 -list"
  "Sqlite command-line arguments")

(advice-add #'dash-docs-buffer-local-docsets :around
              (lambda (old-fun &rest args)
                (let ((old (apply old-fun args)))
                  (delq nil (delete-dups (append old consult-dash-docsets))))))

(defvar consult-dash--history nil
  "Previous queries for dash docs via consult")
(defvar consult-dash--docset-prefix "DOCSET:"
  "Prefix to identify docset boundaries")

(defun consult-dash--builder-one-docset (docset pattern)
  (let* ((query (dash-docs-sql-query (caddr docset)
                                     (dash-docs-sub-docset-name-in-pattern pattern
                                                                           (car docset))))
         (cmd (concat "echo " consult-dash--docset-prefix
                      (shell-quote-argument (car docset))
                      "; "
                      consult-dash-sqlite-args
                      " "
                      (shell-quote-argument (cadr docset))
                      " "
                      (shell-quote-argument query)
                      "; ")))
    cmd))

;; Is there a better way to run multiple commands when using consult--async-command?
(defun consult-dash--builder (input)
  (pcase-let ((`(,arg . ,opts) (consult--command-split input)))
    (unless (string-blank-p arg)
      (when-let* ((docsets (dash-docs-maybe-narrow-docsets arg))
                  (cmds (mapcar (lambda (ds) (consult-dash--builder-one-docset ds arg)) docsets)))
        (list :command (list "sh" "-c" (apply #'concat cmds))
              :highlight (cdr (consult--default-regexp-compiler arg 'basic)))))))

(defun consult-dash--with-buffer-context (func)
  "Ensure that FUNC is called with the correct buffer context"
  (let ((buf (current-buffer)))
    (lambda (&rest args)
      (with-current-buffer buf
        (apply func args)))))

(defvar consult-dash--current-docset nil
  "Stored current docset output for chunked calls to consult-dash--format")

(defun consult-dash--format (lines)
  (let ((candidates)
        (current-candidate))
    (save-match-data
      (dolist (str lines)
        (setq current-candidate (split-string str "|" t))
        (if (= 1 (length current-candidate))
            ;; FIXME: If we do not find the right prefix, we should raise an error
            (when (string-prefix-p consult-dash--docset-prefix str)
              (setq consult-dash--current-docset (substring str (length consult-dash--docset-prefix))))
          (let ((name (cadr current-candidate))
                (type (car current-candidate)))
            (add-face-text-property 0 (length name) 'consult-key nil name)
            (put-text-property 0 (length name) 'consult-dash-docset consult-dash--current-docset name)
            (push (list
                   (format "%s (%s)" name type)
                   consult-dash--current-docset
                   current-candidate)
                  candidates)))))
    (nreverse candidates)))

(defun consult-dash--group (candidate transform)
  (if transform
      candidate
    (get-text-property 0 'consult-dash-docset candidate)))

(defun consult-dash (&optional initial)
  (interactive)
  (dash-docs-create-common-connections)
  (dash-docs-create-buffer-connections)
  (setq consult-dash--current-docset nil)
  (when-let* ((builder (consult-dash--with-buffer-context #'consult-dash--builder))
              (search-result (consult--read
                              (consult--async-command builder
                                (consult--async-transform consult-dash--format)
                                (consult--async-highlight builder))
                              :prompt "Dash: "
                              :require-match t
                              :group #'consult-dash--group
                              :lookup #'consult--lookup-cdr
                              :initial (consult--async-split-initial initial)
                              :add-history (consult--async-split-thingatpt 'symbol)
                              :history '(:input consult-dash--history))))
    (dash-docs-browse-url search-result)))

(defun consult-dash-at-point ()
  (interactive)
  (consult-dash (thing-at-point 'symbol)))

(provide 'consult-dash)
;;; consult-dash.el ends here