;;; yoke.el --- yoke packages in to your editing system  -*- lexical-binding: t; -*-
;; by C. Duckworth <acdw@acdw.net>
(provide 'yoke)
(require 'cl-lib)

(defgroup yoke nil
  "Customizations for yoke, a package manager thing."
  :group 'applications
  :prefix "yoke-")

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

(defun yoke-repo-local-p (repo)
  (string-match-p (rx bos (or "." "~" "/")) repo))

(defun yoke-repo-dir (pkg repo)
  (if (yoke-repo-local-p repo)
      (expand-file-name repo)
    (expand-file-name (format "%s" pkg) yoke-dir)))

(defun yoke-git (repo &optional dir)
  "Git REPO from the internet and put it into `yoke-dir'.
If DIR is passed, clone there; otherwise just clone.  Return the
directory created."
  (let ((dir (or dir (yoke-repo-dir (file-name-nondirectory repo) repo))))
    (unless (or (yoke-repo-local-p repo) (file-exists-p dir))
      (message "Downloading %S..." repo)
      (call-process "git" nil (get-buffer-create "*yoke*") nil
                    "clone" repo dir)
      (message "Downloading %S... done" repo))
    dir))

(defun yoke-lasso (pkg repo &optional load-path)
  "Add PKG to `load-path' so it can be used.
If PKG is not installed, install it from REPO.  Packages will be
installed to `yoke-dir'."
  (let* ((dir (yoke-repo-dir pkg repo)))
    (yoke-git repo dir)
    (cond
     ((file-exists-p dir)
      (when (or load-path dir)
        (add-to-list 'load-path (expand-file-name (or load-path dir))))
      ;; This bit is stolen from `straight'.
      (eval-and-compile (require 'autoload))
      (let ((generated-autoload-file
             (expand-file-name (format "%s-autoloads.el" pkg) 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 (user-error "Directory \"%s\" doesn't exist." dir)))
    dir))

(defun yoke-get (key args)
  "Get KEY's value from ARGS, or return nil.
Similar-ish to `plist-get', but works on non-proper plists."
  (cond
   ((null args) nil)
   ((eq key (car args)) (cadr args))
   (t (yoke-get key (cdr args)))))

(defmacro when1 (test &rest body)
  "Like `when', but return the value of the test."
  (declare (indent 1))
  (let ((g (gensym)))
    `(let ((,g ,test))
       (when ,g
         ,@body
         ,g))))

(defun delete2 (list &rest elems)
  "Delete each element of ELEMS, and the next item, from LIST."
  (let ((r nil))
    (while (consp list)
      (if (member (car list) elems)
          (setf list (cdr list))
        (setf r (cons (car list) r)))
      (setf list (cdr list)))
    (reverse r)))

(defun 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 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)))
  (if (eq features 'init)
      `(eval-after-init (lambda () ,@body))
    (unless (listp features)
      (setf features (list features)))
    (if (null features)
        (macroexp-progn body)
      (let* ((this (car features))
             (rest (cdr features)))
        `(with-eval-after-load ',this
           (eval-after ,rest ,@body))))))

(defun yoke-pkg-name (pkg)
  (intern (format "yoke:%s" pkg)))

(cl-defmacro yoke (pkg
                   &optional repo
                   &body body
                   &key
                   after                ; :after (FEATURE...)
                   depends              ; :depends ((PKG REPO)...)
                   load                 ; :load DIRECTORY
                   (when t whenp)       ; :when PREDICATE
                   (unless nil unlessp) ; :unless PREDICATE
                   &allow-other-keys)
  "Yoke a PKG into your Emacs session."
  (declare (indent 2))
  (let ((name (yoke-pkg-name pkg))
        (body (delete2 body
                       :depends :when :unless :after :load)))
    `(cl-block ,name
       (condition-case e
           (progn
             ,@(cond
                ((and whenp unlessp)
                 `((when (or (not ,when) ,unless)
                     (cl-return-from ,name nil))))
                (whenp `((unless ,when (cl-return-from ,name nil))))
                (unlessp `((when ,unless (cl-return-from ,name nil)))))
             ,@(cl-loop for (pkg* repo* load-path*) in depends
                        collect `(or (yoke-lasso ',pkg* ,repo* ,load-path*)
                                     (cl-return-from ,name nil)))
             ,@(cond
                (repo `((yoke-lasso ',pkg ,repo ,load)))
                (load `((add-to-list 'load-path ,load))))
             ,@(if after
                   `((eval-after ,after ,@body))
                 body))
         (:success ',pkg)
         (t (message "%s: %s" ',name e))))))

;;; Extras

(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 space)))
                     (+ space)
                     (group (+ (not space)))))
              1)))

(defun yoke-remove (pkg)
  "Remove package PKG from `yoke-dir'."
  (interactive (list (completing-read "Package: "
                                      (directory-files yoke-dir)
                                      (lambda (f)
                                        (not (or (string= f ".")
                                                 (string= f ".."))))
                                      :require-match)))
  (let ((dir (expand-file-name pkg yoke-dir)))
    (move-file-to-trash dir)
    (message "Package `%s' removed." pkg)))

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