;;; yoke.el --- make your editor work for YOU         -*- lexical-binding: t; -*-
;; Copyright (C) 2022 C. Duckworth <acdw@acdw.net>

;;; Commentary:

;; What's the most basic functionality of a package manager?  In my view, all a
;; package manager should do is fetch packages from wherever they are, and
;; provide the system with a method of accessing those packages' functionality.
;; In Emacs, this means downloading packages from the Internet and adding their
;; directories to `load-path'.  That's what `yoke' tries to do.
;;
;; In fact, that's /all/ `yoke' tries to do, on the package front.  It doesn't
;; automatically fetch dependencies.  It doesnt' do much else of anything
;; --- hell, it doesn't have to generate autoloads or build the dang source
;; files if you don't want it to.  /I/ have it do those things because I like a
;; few creature comforts, but you can turn 'em off.
;;
;; Instead of focusing too much on installing packages, `yoke' works harder to
;; group---to "yoke together," if you will---related configurations together, à
;; la `use-package' or `setup'.  I used both of those packages before and found
;; each somewhat lacking, and what I really wanted was a fancy `progn' that I
;; could put whatever I want inside.  So that's basically what `yoke' is.  It's
;; a configuration macro that automatically fetches packages from their repos
;; and tells Emacs where they are, then executes its body in a `cl-block' for
;; ... reasons.  That's it.

;;; Code:

(require 'cl-lib)

;;; Customization options

(defgroup yoke nil
  "Customizations for `yoke'."
  :group 'applications
  :prefix "yoke-")

(defcustom yoke-dir (locate-user-emacs-file "yoke")
  "Where to put yoked packages."
  :type 'file)

(defcustom yoke-get-default-fn #'yoke-get-git
  "Default function to get packages with."
  :type 'function)

(defvar yoke-buffer "*yoke*"
  "Buffer to use for yoke process output.")

(defvar yoke-dirs nil
  "List of directories managed by `yoke'.")

;;; GET YOKED

(defmacro yoke (package
                &rest body)
  "Yoke PACKAGE to work with your Emacs.
Execute BODY afterward.

\(fn (PACKAGE [REPO REPO-KEYWORDS]) [BODY-KEYWORDS] BODY...)"
  (declare (indent 1))
  (let* (;; State
         (pkg (cond ((consp package) (car package))
                    (:else package)))
         (url (cond ((consp package) (cdr package))
                    (:else nil)))
         (pname (intern (format "yoke:%s" pkg)))
         (dirvar '$yoke-dir)
         ;; Keyword args --- TODO: Naming could probably be better.
         (after (plist-get body :after))
         (depends (plist-get body :depends))
         (whenp (plist-member body :when))
         (unlessp (plist-member body :unless))
         (when (cond (whenp (plist-get body :when))
                     (:else t)))
         (unless (cond (unlessp (plist-get body :unless))
                       (:else nil)))
         (autoload (cond ((plist-member body :autoload)
                          (plist-get body :autoload))
                         (:else t)))
         (pre (plist-get body :pre))
         ;; Body
         (body (cl-loop for (this next) on body by #'cddr
                        unless (keywordp this)
                        append (list this next) into ret
                        finally return (cond ((eq (car (last ret)) nil)
                                              (butlast ret))
                                             (:else ret))))
         (r (gensym)))
    `(let ((,r (cl-block ,pname
(condition-case err
                     (progn
                       ;; Pass `:when' or `:unless' clauses
                       ,@(cond
                          ((and whenp unlessp)
                           `((when (or (not ,when) ,unless)
                               (cl-return-from ,pname
                                 (format "%s (abort) :when %S :unless %S"
                                         ',pname ',when ',unless)))))
                          (whenp
                           `((unless ,when (cl-return-from ,pname
                                             (format "%s (abort) :when %S"
                                                     ',pname ',when)))))
                          (unlessp
                           `((when ,unless (cl-return-from ,pname
                                             (format "%s (abort) :unless %S"
                                                     ',pname ',unless))))))
                       ;; Evaluate `:pre' forms
                       ,@pre
                       ;; Get prerequisite packages
                       ,@(cl-loop
                          for (pkg* . yoke-get-args) in depends
                          collect `(or
                                    (let* ((pkg-spec (yoke-get ,@yoke-get-args
                                                               :dir ,(format "%s" pkg*)))
                                           (dir (expand-file-name (or (plist-get (cdr pkg-spec) :load)
                                                                      "")
                                                                  (car pkg-spec))))
                                      (and dir
                                           ,@(if autoload
                                                 `((yoke-generate-autoloads ',pkg* dir))
                                               '(t))
                                           (add-to-list 'yoke-dirs dir nil #'string=)))
                                    (cl-return-from ,pname
                                      (format "Error fetching prerequiste: %s"
                                              ',pkg*))))
                       ;; Download the package, generate autoloads
                       ,@(when url
                           `((let* ((pkg-spec (yoke-get ,@url :dir ,(format "%s" pkg)))
                                    (,dirvar  (expand-file-name (or (plist-get (cdr pkg-spec) :load)
                                                                    "")
                                                                (car pkg-spec))))
                               ,@(when autoload
                                   `((yoke-generate-autoloads ',pkg ,dirvar)))
                               (add-to-list 'yoke-dirs ,dirvar nil #'string=))))
                       ;; Evaluate the body, optionally after the features in `:after'
                       ,@(cond (after
                                `((yoke-eval-after ,after ,@body)))
                               (:else body)))
                   (:success ',package)
                   (t (message "%s: %s (%s)" ',pname (car err) (cdr err))
                      nil)))))
       (when (stringp ,r) (message "%S" ,r))
       ,r)))

(defun yoke-get (url &rest args)
  "\"Get\" URL and and put it in DIR, then add DIR to `load-path'.
URL can be a string or a list of the form (TYPE URL).  The
download will be dispatched to the TYPE, or to
`yoke-get-default-fn' if only a string is given.
ARGS is a plist with the following possible keys:

:dir DIRECTORY  --- the directory to put the URL.
:load DIRECTORY --- the directory (relative to the download path)
                    to add to `load-path'.
:type TYPE      --- one of `http', `git', or `file' --- how to
                    download URL."
  (let* ((dir (plist-get args :dir))
         (load (plist-get args :load))
         (type (or (plist-get args :type)))
         (path (cond
                ((eq type 'http) (yoke-get-http url dir))
                ((or (eq type 'git)
                     (string-match-p (rx bos "git:") url))
                 (yoke-get-git url dir))
                ((or (eq type 'file)
                     (string-match-p (rx bos (or "file:" "~" "/")) url))
                 (yoke-get-file url dir))
                ((stringp url)
                 (funcall yoke-get-default-fn url dir))
                (:else (error "Uknown URL type: %S" url)))))
    (cond
     ((file-exists-p path)
      (add-to-list 'load-path (expand-file-name (or load "") path))
      (cons path args))
     (:else (error "Directory \"%s\" doesn't exist." path)
            nil))))

(defun yoke-get--guess-directory (path &optional dir)
  "Guess directory from PATH and DIR, and return it.
If DIR is present and relative, resolve it relative to
`yoke-dir', or if it's absolute, leave it as-is.  If DIR is
absent, return the final component of PATH resolved relative to
`yoke-dir'."
  (expand-file-name (or dir (file-name-nondirectory path))
                    yoke-dir))

(defun yoke-get-http (url &optional dir)
  "Download URL to DIR and return its directory.
If DIR isn't given, it's guessed from the final component of the
URL's path and placed under `yoke-dir'."
  (let* ((dir (yoke-get--guess-directory url dir))
         (basename (file-name-nondirectory url))
         ;; XXX: Is this the best idea?? PROBABLY NOT!!!  Ideally I'd have
         ;; a parameter (either dynamic var or passed in) that would give the
         ;; name of the downloaded file.  But that would take a bit of
         ;; re-engineering, I think.  So for now, it stays thus.
         (filename (expand-file-name
                    (replace-regexp-in-string
                     (rx "-" (+ digit)             ; major version
                         (+ (group "." (+ digit))) ; following version numbers
                         (group "." (+ (not space)))) ; extension
                     "\\2"
                     basename)
                    dir)))
    (cond ((file-exists-p filename)
           dir)
          (:else
           (message "Downloading %s..." url)
           (with-current-buffer (let ((url-debug t))
                                  (url-retrieve-synchronously url))
             (condition-case e
                 (progn
                   (goto-char (point-min))
                   (delete-region (point) (+ 1 (re-search-forward "^$")))
                   (make-directory dir :parents)
                   (write-file filename 1)
                   (message "Downloading %s... Done" url))
               (:success dir)
               (t (signal (car e) (cdr e)))))))))

(defun yoke-get-git (repo &optional dir)
  "Clone REPO to DIR and return its directory.
If DIR isn't given, it's guessed from the repo's name and put
under `yoke-dir'.  Return the cloned directory's name on success,
or nil on failure."
  (let ((dir (yoke-get--guess-directory repo dir)))
    (cond ((file-exists-p dir)
           dir)
          (:else
           (message "Cloning %s..." repo)
           (pcase (call-process "git" nil (get-buffer-create yoke-buffer) nil
                                "clone" repo dir)
             (0 (message "Cloning %s... Done" repo)
                dir)
             (_ (message "Cloning %s... Error!  See buffer %s for output."
                         repo yoke-buffer)
                nil))))))

(defun yoke-get-file (file &optional _dir)
  "Add FILE's directory to `load-dir'.
_DIR is ignored."
  (file-name-directory file))

(defun yoke-generate-autoloads (package dir)
  "Generate autoloads for PACKAGE in DIR."
  ;; Shamelessly stolen from `straight'.
  (eval-and-compile (require 'autoload))
  (let ((generated-autoload-file
         (expand-file-name (format "%s-autoloads.el" package) dir))
        (backup-inhibited t)
        (version-control 'never)
        (message-log-max nil)
        (inhibit-message t))
    (unless (file-exists-p generated-autoload-file)
      (let ((find-file-hook nil)
            (write-file-functions nil)
            (debug-on-error nil)
            (left-margin 0))
        (if (fboundp 'make-directory-autoloads)
            (make-directory-autoloads dir generated-autoload-file)
          (and (fboundp 'update-directory-autoloads)
               (update-directory-autoloads dir)))))
    (when-let ((buf (find-buffer-visiting generated-autoload-file)))
      (kill-buffer buf))
    (load generated-autoload-file :noerror :nomessage)
    t))

;;; Evaluating forms after features

(defun yoke--eval-after-init (fn)
  "Evaluate FN after inititation, or now if Emacs is initialized.
FN is called with no arguments."
  (if after-init-time
      (funcall fn)
    (add-hook 'after-init-hook fn)))

(defmacro yoke-eval-after (features &rest body)
  "Evaluate BODY, but only after loading FEATURES.
FEATURES can be an atom or a list; as an atom it works like
`with-eval-after-load'.  The special feature `init' will evaluate
BODY after Emacs is finished initializing."
  (declare (indent 1)
           (debug (form def-body)))
  (unless (listp features)
    (setf features (list features)))
  (if (null features)
      (macroexp-progn body)
    (let* ((this (car features))
           (rest (cdr features)))
      (cond ((eq this 'init)
             `(yoke--eval-after-init
               (lambda () (yoke-eval-after ,rest ,@body))))
            (:else
             `(with-eval-after-load ',this
                (yoke-eval-after ,rest ,@body)))))))

;;; Integration

(defun yoke-imenu-insinuate ()
  "Insinuate `yoke' forms for `imenu'."
  (require 'imenu)
  (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal)
        (list (rx (: "(yoke" (+ space) (? "(")
                     (group (+ (not (or "(" " " "\t" "\n"))))
                     (* any)))
              1)))

;;; Package maintenance

(defvar yoke--all "*all*"
  "Value that `yoke--prompt-for-package' uses for all packages.")

(defun yoke--choose-packages (prompt &optional onep)
  "Choose from all of yoke's installed packages."
  (funcall (if onep #'completing-read #'completing-read-multiple)
           prompt
           (cons yoke--all yoke-dirs)
           nil :require-match nil nil
           (unless onep yoke--all)))

(defun yoke--choices (&optional selections)
  "Either the SELECTIONS given, or all of `yoke-dirs'.
If `yoke--all' is part of SELECTIONS, or if it's not given,
return the full list of `yoke-dirs'."
  (cond ((or (null selections)
             (member yoke--all selections))
         yoke-dirs)
        (:else selections)))

(defun yoke-compile (&rest packages)
  "Compile all elisp files in `yoke-dirs'."
  (interactive (yoke--choose-packages "Compile packages: "))
  (dolist (dir (yoke--choices packages))
    (byte-recompile-directory dir 0)))

(defun yoke-update-autoloads (&rest packages)
  "Update the autoloads in PACKAGES' directories."
  (interactive (yoke--choose-packages "Generate autoloads for packages: "))
  (dolist (dir (yoke--choices packages))
    (message "Generating autoloads for %s..." dir)
    (yoke-generate-autoloads (file-name-nondirectory dir) dir)
    (message "Generating autoloads for %s... Done" dir)))

(defun yoke-remove (dir)
  "Remove DIR from `yoke-dir'."
  (interactive
   (list (completing-read "Remove: " yoke-dirs
                          nil :require-match)))
  (delete-directory dir :recursive :trash))

(provide 'yoke)
;;; yoke.el ends here