wad

wad.el

;;; wad.el --- Opinionated emacs configuration inspired by Doom Emacs. -*- lexical-binding: t; -*-

(require 'cl-lib)

(defvar wad/modules (make-hash-table :test 'equal)
  "A table of enabled modules. Set by `wad/modules!' where the key
is a cons of (category . module) and the value is a plist of metadata
related to the module.")

(defvar wad/current-module nil)

(defvar wad/modules-dirs `(,(expand-file-name "modules/"))
  "A list of module root directories. Order determines priority.")

(defvar wad/module-init-file "init"
  "Basename of init files for modules.")

(defvar wad/module-config-file "config"
  "Basename of config files for modules.")

(defvar wad/module-packages-file "packages"
  "Basename of packages files for modules.")

(defvar wad/packages '()
  "A list of enabled packages. Each element is a sublist, whose CAR is the
package's name as a symbol, and whose CDR is the plist supplied to it's
`package!' declaration. Set by `wad/init-packages'.")

(defvar wad/packages-file "packages"
  "The basename of packages file for modules.")

(defvar wad/debug-p nil
  "If non-nil, wad will log more information.")

(defvar wad/local-dir (expand-file-name ".local/")
  "Root directory for local storage.")

(defmacro wad/log (format-string &rest args)
  "Log to *Messages* if `wad/debug-p' is on."
  `(when wad/debug-p
    (let ((inhibit-message (active-minibuffer-window)))
      (message ,format-string ,@args))))

(defun wad/path (&rest segments)
  "Constructs a file path from SEGMENTS. Ignoring nil."
  (if segments
      (let ((segments (delq nil segments)) dir)
	(while segments
	  (setq dir (expand-file-name (car segments) dir)
		segments (cdr segments)))
	dir)
    (wad/current-file!)))

(defun wad/current-file! ()
  "Returns the emacs lisp file this is called from."
  (cond ((bound-and-true-p byte-compile-current-file))
	 (load-file-name)
	 ((stringp (car-safe current-load-list))
	  (car current-load-list))
	 (buffer-file-name)
	 ((error "Cannot get this file-path"))))

(defun wad/current-directory! ()
  "Returns the directory of the emacs lisp file this is called from."
  (when-let (path (wad/current-file!))
    (directory-file-name (file-name-directory path))))

(defmacro wad/load! (filename &optional path noerror)
  "Load a file relative to the current executing file (`load-file-name')."
  (let* ((path (or path
		   (wad/current-directory!)
		   (error "Could not detect path to look for %s in" filename)))
	 (file (if path
		   `(expand-file-name ,filename ,path)
		 filename)))
    `(condition-case-unless-debug e
	 (let (file-name-handler-alist)
	   (load ,file ,noerror 'nomessage))
       (error "Could not load file"))))

(cl-defmacro wad/doplist! ((arglist plist &optional result) &rest body)
  "Loop over PLIST (property value) pair, evaluating BODY for each
pair. Then evaluating and returning RESULT."
  (declare (indent 1))
  (let ((seq (make-symbol "seq")))
    `(let ((,seq (copy-sequence ,plist)))
       (while ,seq
	 (let ((,(pop arglist) (pop ,seq))
	       (,(pop arglist) (pop ,seq)))
	   ,@body))
       result)))

(defmacro wad/plist-put! (plist &rest rest)
  "Set each PROP VALUE pair in REST to PLIST in-place."
  `(cl-loop for (prop value)
	    on (list ,@rest) by #'cddr
	    do ,(if (symbolp plist)
		    `(setq ,plist (plist-put ,plist prop value))
		  `(plist--put ,plist prop value))))

(defun wad/keyword-to-string (keyword)
  "Returns the string of KEYWORD (`keywordp') minus the leading colon."
  (declare (pure t) (side-effect-free t))
  (cl-check-type keyword keyword)
  (substring (symbol-name keyword) 1))

(defun wad/string-to-keyword (str)
  "Converts STR into a keywoord (`keywordp')."
  (declare (pure t) (side-effect-free t))
  (cl-check-type str string)
  (intern (concat ":" str)))

(defun wad/string-to-symbol (str)
  "Converts STR into a symbol (`symbolp')."
  (intern str))

(defun wad/github-url (repository)
  "Returns string of github url with provided PATH."
  (concat "https://github.com/" repository))

(defun wad/call-process (command &rest args)
  "Execute COMMAND with ARGS synchronously.

Returns (STATUS . OUTPUT) when it is done, where STATUS is the returned error
code of the process and OUTPUT is its stdout."
  (with-temp-buffer
    (cons (or (apply #'call-process command nil t nil (remq nil args))
	      -1)
	  (string-trim (buffer-string)))))

(defun wad/exec-process (command &rest args)
  "Execute COMMAND with ARGS synchronously.

Unlike `wad/call-process', this pipes output to `standard-output' on the fly to
simulate 'exec' in the shell, so batch scripts could run external programs
synchronously without sacrificing their output."
  (with-temp-buffer
    (cons (let ((process
                 (make-process :name "wad"
                               :buffer (current-buffer)
                               :command (cons command (remq nil args))
                               :connection-type 'pipe))
                done-p)
            (set-process-filter
             process (lambda (_process output)
                       (princ output (current-buffer))
                       (princ output)))
            (set-process-sentinel
             process (lambda (process _event)
                       (when (memq (process-status process) '(exit stop))
                         (setq done-p t))))
            (while (not done-p)
              (sit-for 0.1))
            (process-exit-status process))
          (string-trim (buffer-string)))))

(defun wad/module-log (category module format-string &rest args)
  (let* ((category (wad/keyword-to-string category))
	 (module (symbol-name module))
	(prefix (concat "[" category "/" module "]")))
    (wad/log (concat prefix " " format-string args))))

(defun wad/modules-list-map (fn list)
  "Apply FN to each module in LIST."
  (let ((modules (copy-sequence list))
	results category curr)
    (while modules
      (setq curr (pop modules))
      (cond ((keywordp curr)
	     (setq category curr))
	    ((null category)
	     (error "No module category specified for %s" curr))
	    (t (let ((module (if (listp curr) (car curr) curr))
		     (flags (if (listp curr) (cdr curr))))
		 (push (funcall fn category module
				:flags flags
				:path (wad/module-locate-path category module))
		       results)))))
    (nreverse results)))

(defun wad/modules-reset! ()
  "Resets modules to initial state."
  (clrhash wad/modules))

(defun wad/module-p (category module)
  "Returns t if CATEGORY MODULE is enabled."
  (declare (pure t) (side-effect-free t))
  (when-let (plist (gethash (cons category module) wad/modules))
    t))

(defun wad/module-from-current-path ()
  (wad/module-from-path (wad/current-file!)))

(defun wad/module-from-path (path)
  "Returns a cons cell (CATEGORY . MODULE) derived from PATH."
  (if wad/current-module
      wad/current-module
    (let* ((file-name-handler-alist nil)
	   (path (file-truename path)))
      (save-match-data
	(cond ((string-match "/modules/\\([^/]+\\)/\\([^/]+\\)\\(?:/.*\\)?$" path)
	       (when-let* ((category (wad/string-to-keyword (match-string 1 path)))
			   (module (wad/string-to-symbol (match-string 2 path))))
		 (if (wad/module-p category module)
		     (cons category module)))))))))

(defun wad/module-locate-path (category &optional module file)
  "Searches `wad/modules-dirs' to find the path to a module.

CATEGORY is a keyword and MODULE is a symbol. FILE is a string
that will be appended to the resulting path. If no path exists,
this returns nil, otherwise an absolute path.

This doesn't require the module to be enabled."
  (when (keywordp category)
    (setq category (wad/keyword-to-string category)))
  (when (and module (symbolp module))
    (setq module (symbol-name module)))
  (cl-loop with file-name-handler-alist = nil
           for default-directory in wad/modules-dirs
           for path = (concat category "/" module "/" file)
           if (file-exists-p path)
           return (file-truename path)))

(defun wad/module-set (category module &rest plist)
  "Enables a module by adding it to `wad/modules'.

CATEGORY is a keyword, MODULE is a symbol, PLIST is a plist that
accepts the following properties:

  :flags [SYMBOL LIST] list of enabled category flags
  :path  [STRING]      path to category root directory."
  (puthash (cons category module) plist wad/modules))

(defun wad/module-get (category module)
  "Get plist of module from `wad/modules' matching CATEGORY and MODULE.

CATEGORY is a keyword, MODULE is a symbol."
  (gethash (cons category module) wad/modules))

(defun wad/module-loader (file)
  "Return a closure that loads FILE from module.

The closure takes two arguments: a cons cell containing (CATEGORY . MODULE)
symbols, and the matching module plist."
  (declare (pure t) (side-effect-free t))
  (lambda (module plist)
    (let ((wad/current-module module)
	  (wad/current-flags (plist-get plist :flags)))
      (wad/load! file (plist-get plist :path) t))))

(defun wad/modules-map (fn &optional modules)
  "Apply FN to each module in `wad/modules'.

If MODULES is provided, will only apply FN to modules whose (CATEGORY . NAME)
is a member of MODULES. For example:

(wad/modules-map #'my-module-fn '((:core . foobar) (:tools . magit)))"
  (maphash
   (lambda (module plist)
     (if (or (null modules) (and modules (member module modules)))
	 (let ((category (car module))
	       (module (cdr module)))
	   (funcall fn category module plist))))
   wad/modules))

(defun wad/initialize-module (category module &optional plist)
  "Load module init.el for module with CATEGORY and MODULE."
  (wad/module-log category module "wad/initialize-module")
  (funcall (wad/module-loader wad/module-init-file)
	   (cons category module)
	   (or plist (wad/module-get category module))))

(defun wad/initialize-modules (&optional modules)
  "Initialize modules."
  (wad/modules-map #'wad/initialize-module modules))

(defun wad/initialize-module-packages (category module &optional plist)
  "Loads `wad/module-packages-file' for given module with CATEGORY and MODULE."
  (wad/module-log category module "wad/initialize-module-packages")
  (funcall (wad/module-loader wad/module-packages-file)
	   (cons category module)
	   plist))

(wad/initialize-module-packages :core 'straight)

(defun wad/configure-module (category module &optional plist)
  "Load module config.el for module with CATEGORY and MODULE."
  (wad/module-log category module "wad/configure-module")
  (funcall (wad/module-loader wad/module-config-file)
	   (cons category module)
	   (or plist (wad/module-get category module))))

(defmacro wad/modules! (&rest modules)
  "Bootstraps modules and populate `wad/modules'."
  `(progn
     (wad/modules-list-map
      (lambda (category module &rest plist)
	(if (plist-member plist :path)
	    (progn
	      (wad/log "Adding %s/%s to wad/modules" category module)
	      (apply #'wad/module-set category module plist))
	  (message "Could not find module for %s/%s" category module)))
      ,@(if (keywordp (car modules))
	    (list (list 'quote modules))
	  modules))
     wad/modules))

(defun wad/package-get (name &optional property)
  "Returns package plist matching NAME. Optionally, if a PROPERTY has
been provided, and is a member of the package plist, it will be returned.

Returns nil if the package does not exist, or the property does not
exist on the package plist, if provided."
  (let ((plist (cdr (assq name wad/packages))))
    (if property
	(plist-get plist property)
      plist)))

(defun wad/package-add (name plist)
  "Add package to `wad/packages', replacing any existing package."
  (setf (alist-get name wad/packages)
	(if (listp plist) plist (list plist))))

(defun wad/packages-reset! ()
  "Resets wad/packages to initial state."
  (setq wad/packages nil))

(defun wad/packages-for-module-map (fn &optional module)
  "Apply FN to each package in `wad/packages'.

If MODULE is provided, will only apply FN to package whose :modules includes
MODULE. For example:

(wad/packages-for-module-map #'install-package '(:core . straight))"
  (cl-loop for package in wad/packages
	   for name = (car package)
	   for modules = (wad/package-get name :modules)
	   when (if module (member module modules) t)
	   do (funcall fn name package)))

(defun wad/ensure-module-packages (category module &optional plist)
  "Ensures all packages are installed found in module matching MODULE,
where MODULE is (CATEGORY . NAME) cons cell. See `wad/modules' for more
information."
  (wad/packages-for-module-map
   (lambda (name &rest _)
     (wad/ensure-package name))
   (cons category module)))

(defun wad/ensure-modules-packages (&optional modules)
  "Initialize module and ensures it's packages are installed."
  (wad/modules-map #'wad/ensure-module-package modules))

(defun wad/ensure-package (name)
  "Ensures package is installed, previously declare using `wad/package!' by NAME."
  (let* ((package (wad/package-get name))
	 (recipe (plist-get package :recipe))
	 (fn (if (functionp recipe) recipe)))
    (message "ensure-package")
    (if package
	(if fn
	    (progn
	      (message "will try install")
	      (funcall fn name package))
	  (message "TODO - Found package but no recipe function"))
      nil)))

(defmacro wad/package! (name &rest plist &keys type priority)
  "Declare a package and how to install it (if applicable)."
  (declare (indent 'common-lisp-indent-function))
  `(let* ((name ',name)
	  (existing-plist (wad/package-get name))
	  (result (copy-sequence existing-plist))
	  (modules (wad/package-get name :modules))
	  (module ',(wad/module-from-current-path)))
     (unless (member module modules)
       (wad/plist-put! result :modules
		       (append modules (list module))))
     (wad/doplist! ((prop val) (list ,@plist) result)
       (unless (null val) (wad/plist-put! result prop val)))
     (wad/log "Adding package %s to wad/packages" name)
     (wad/package-add name result)
     wad/packages))

(defun wad/init! (&optional no-install-p)
  "Initializes modules found in `wad/modules'."
  (wad/modules-map
   (lambda (category module plist)
     (wad/module-log category module "wad/init")
     (wad/initialize-module category module plist)
     (wad/initialize-module-packages category module plist)
     (unless no-install-p
       (wad/ensure-module-packages category module plist)))))

(defun wad/config! ()
  "Configures modules found in `wad/modules'."
  (wad/modules-map #'wad/configure-module))

(defun wad! (&rest plist &keys skip-install skip-config)
  (wad/init! (plist-get plist :skip-install))
  (unless (plist-get plist :skip-config) (wad/config!)))

;; (wad/modules! :tools straight)
;; (wad!)

(provide 'wad)