;;; 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)
  "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)
      (add-to-list '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 ELEM and the next item from LIST."
  (let ((r nil))
    (while (consp list)
      (if (member (car list) elems)
          (setq list (cdr list))
        (setq r (cons (car list) r)))
      (setq list (cdr list)))
    (reverse r)))

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

(cl-defmacro yoke (pkg
                   &optional repo
                   &body body
                   &key
                   requires             ; :requires ((PKG REPO)...)
                   dest                 ; :dest DESTINATION
                   (when t whenp)       ; :when PREDICATE
                   (unless nil unlessp)	; :unless PREDICATE
                   &allow-other-keys)
  "Yoke a PKG into your Emacs session."
  (declare (indent defun))
  (let ((name (yoke-pkg-name pkg)))
    `(cl-block ,name
       (condition-case e
           (let ((*yoke-name* ',name)
                 (*yoke-repo* ,repo)
                 (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo))))
             ,@(list (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) in requires
                        collect `(or (yoke-lasso ',pkg ,repo)
                                     (cl-return-from ,name nil)))
             ,@(when repo `((yoke-lasso ',pkg ,repo)))
             ,@(delete2 body :requires :when :unless))
             (t (message "%s: %S" ',name e))))))