nix/dotfiles/emacs/el/conduct.el

;;; el/conduct.el -*- lexical-binding: t; -*-

(defun conduct-run ()
  "Run a task or task group defined in the current project"
  (interactive)

  (let* (
         (config-data (conduct/load-config))
         (tasks (alist-get 'tasks config-data))
         (groups (alist-get 'groups config-data))
         (select-tasks (append (mapcar 'conduct/format-task-name tasks) nil))
         (select-groups (append (mapcar 'conduct/format-group-name groups) nil))
         (items (seq-remove #'conduct/is-running (append select-tasks select-groups)))
         (selected-name (conduct/extract-name-from-selection (completing-read "Task: " items)))
         (task-names (conduct/get-task-name selected-name config-data))
         (group-names (conduct/get-group-name selected-name config-data))
         (names (append task-names group-names)))
    (dolist (name names)
      (unless (conduct/get-task-buffer (conduct/get-named-task name config-data))
        (conduct/run-task (conduct/get-named-task name config-data))))))

(defun conduct-kill ()
  "Kill a defined project task"
  (interactive)

  (let* (
         (config-data (conduct/load-config))
         (tasks (alist-get 'tasks config-data))
         (groups (alist-get 'groups config-data))
         (select-tasks (seq-filter #'conduct/is-running (append (mapcar 'conduct/format-task-name tasks) nil)))
         (select-groups (append (mapcar 'conduct/format-group-name groups) nil))
         (items (append select-tasks select-groups))
         (selected-name (conduct/extract-name-from-selection (completing-read "Task: " items)))
         (task-names (conduct/get-task-name selected-name config-data))
         (group-names (conduct/get-group-name selected-name config-data))
         (names (append task-names group-names)))

    (dolist (name names)
      (conduct/kill-task (conduct/get-named-task name config-data)))))

(defun conduct-show ()
  "Kill a defined project task"
  (interactive)

  (let* (
         (config-data (conduct/load-config))
         (tasks (alist-get 'tasks config-data))
         (select-tasks (seq-filter #'conduct/is-running (append (mapcar 'conduct/format-task-name tasks) nil)))
         (selected-name (conduct/extract-name-from-selection (completing-read "Task: " select-tasks))))

    (switch-to-buffer (format "task-%s" selected-name))))

(defun conduct/create-task-path (task)
  "Generate a new path based on the project root and the path for TASK"
  (concat
   (file-name-as-directory (project-root (project-current)))
   (or (alist-get 'path task) ".")))


(defun conduct/load-config ()
  "Load the conduct.json config file from the current project root"
  (let* (
         (config-file (concat
                       (file-name-as-directory (project-root (project-current)))
                       "conduct.json")))
    (json-read-file config-file)))

(defun conduct/get-named-task (name data)
  "Return the task for NAME. NAME is assumed to be a string"
  (assoc (intern name) (alist-get 'tasks data)))

(defun conduct/get-task-name (name data)
  "Returns the name of the task as a single item list. If it exists in DATA"
  (when-let (name (assoc (intern name) (alist-get 'tasks data)))
    (list (symbol-name (car name)))))


(defun conduct/get-group-name (name data)
  "Returns a list of all tasks for the group named NAME in DATA"
  (append (cdr (assoc (intern name) (alist-get 'groups data))) nil))

(defun conduct/run-task (task)
  "Run the given task definition"
  (let* (
         (name (concat "task-" (symbol-name (car task))))
         (buffer (concat  "task-" (symbol-name (car task))))
         (raw-cmd (alist-get 'command (cdr task)))
         (task-cmd (concat "cd " (conduct/create-task-path (cdr task)) " && " raw-cmd))
         (command (list "/bin/sh" "-c" task-cmd))
         (process (make-process :name name :buffer buffer :command command :sentinel 'task-sentinel)))

    (message "Running task: %s" name)
    (with-current-buffer buffer
      (require 'shell)
      (shell-mode)
      (setq-local conduct-task-name name)
      (set-process-query-on-exit-flag process nil)
      (set-process-filter process 'comint-output-filter))
    buffer))

(defun conduct/get-task-buffer (task)
  "Get the buffer related to a TASK defintiion"
  (get-buffer (concat  "task-" (symbol-name (car task)))))

(defun conduct/kill-task (task)
  "Kill the process and buffer for a TASK"
  (if-let* ((buffer (conduct/get-task-buffer task))
            (process (get-buffer-process buffer)))
      (progn
        (kill-process (get-buffer-process buffer)))
    (message "Task buffer not found for %s" (alist-get 'name task))))

(defun conduct/format-group-name (group)
  "Format the name for GROUP that can be used in the popup selection"
  (concat
   (propertize (symbol-name (car group)) 'face 'outline-1)
   (propertize "|" 'invisible t)
   " "
   (propertize (mapconcat #'identity (cdr group) ", ") 'face 'org-archived)))

(defun conduct/extract-name-from-selection (selection)
  (car (split-string selection "|")))

(defun conduct/is-running (task-name)
  (let* (
         (process-name (concat "task-" (conduct/extract-name-from-selection task-name))))
    (member process-name (mapcar #'process-name (process-list)))))

(defun conduct/format-task-name (task)
  "Format the name for TASK to be used in the popup selection"
  (let* (
         (task-name (symbol-name (car task))))
    (concat
     (propertize task-name 'face 'bold)
     (propertize "|" 'invisible t)
     (propertize " ")
     (propertize (alist-get 'command (cdr task)) 'face 'org-archived))))

(defun check-signal (sig s)
  "Check the process signal against a value"
  (and (> (length s) (length sig)) (equal sig (substring s 0 (length sig)))))

(defun task-sentinel (process event)
  "Monitor the task process and close the buffer if it ends"
  (cond
   ((check-signal "finished" event)
    (message "Task ended: %s" (buffer-name (process-buffer process)))
    (kill-buffer (process-buffer process)))
   ((check-signal "exited" event) (kill-buffer (process-buffer process)))
   ((check-signal "deleted" event) (kill-buffer (process-buffer process)))
   ((check-signal "failed" event)
    (message "Task failed: %s" (buffer-name (process-buffer process)))
    (kill-buffer (process-buffer process)))
   ((check-signal "killed" event)
    (kill-buffer (process-buffer process)))
   (t (message (format "Process: %s had the event '%s'" process event)))))