cl-pest/pest.lisp

;; PROMPT_COMMAND='export PS1="$(pest)"'

(defun string-assoc (key alist)
  "Shortcut function over :test #'equal for working with TOML alists"
  (cdr (assoc key alist :test #'equal)))

(defun find-config ()
  (let ((config-paths (list
		       (concatenate 'string (uiop:getenv "HOME") "/.config/pest/config.toml")
		       "/etc/pest/config.toml"
		       (concatenate 'string (uiop:getenv "PWD") "./config"))))
    (loop for path-str in config-paths
	  do (if (probe-file path-str)
		 (return-from find-config path-str)))))

(defun config-parse (&optional path)
  (let ((config-path (if path path (find-config))))
    (if config-path
	(with-open-file (fh config-path :direction :input)
			   (let ((file-content (with-output-to-string (out)
						 (loop for line = (read-line fh nil)
						       while line
						       do (format out "~a~%" line)))))
			     (clop:parse file-content)))
	(clop:parse "
[git]
display_head = false
display_branch = false
git_prefix = \"\"
[git.colors]
fg = [0, 120, 50]
bg = [0, 0, 0]

[prompt]
display_user = false
user_suffix = \"\"
display_hostname = false
hostname_suffix = \"\"
display_pwd = true
pwd_suffix = \"\"
prompt_char = \" λ \"
[prompt.colors]
fg = [255, 255, 255]
bg = [0, 0, 0]
"))))
			   
(defvar *config* NIL)

(defun parse-colors (alist)
  "Given an alist containing the fg and bg lists, extract and flatten the rgb color ints into chlorophyll rgb-colors
   Returns a list with two elements, the fg chlorophyll rgb object and the bg object"
  ;; TODO let assignment can be made more compact via lambda for extracting from toml alist eg. with arg "fg" or "bg"
  (let ((colors
	  (list
	   (string-assoc "fg" (string-assoc "colors" alist))
	   (string-assoc "bg" (string-assoc "colors" alist)))))
    (loop for rgb-list in colors
	  collect (destructuring-bind (r g b) rgb-list
		    (chlorophyll:create-rgb-color r g b)))))
  
;; Battery
(defvar *display-battery* NIL)

;; Git
(defvar *display-git* NIL)
(defvar *git-string* NIL)
(defvar *git-style* NIL)

(defun make-style (config key)
  "Given a valid TOML config and key, make the chlorophyll style object for the git status string"
  (let ((rgb-colors (parse-colors (string-assoc key config))))
    (chlorophyll:new-style
		       :bold T
		       :foreground (first rgb-colors)
		       :background (second rgb-colors))))

(defun check-git-enabled (config)
  (if (or
       (string-assoc "display_head" (string-assoc "git" config))
       (string-assoc "display_branch" (string-assoc "git" config)))
      T))

(defun check-git-dir ()
  (if (probe-file (pathname (concatenate 'string (get-pwd) "/.git")))
      T
      NIL))

(defun make-git-string (config)
  "Emit string that contains git information to be printed. Assumes if called that git info is enabled."
  (if (probe-file (pathname (concatenate 'string (get-pwd) "/.git")))
      (let ((git-string NIL))
	(if (string-assoc "display_head" (string-assoc "git" config))
	    (setf git-string (concatenate 'string git-string (legit:current-commit "." :short T))))
	(if (string-assoc "display_branch" (string-assoc "git" config))
	    (progn
	      (if (string-assoc "display_head" (string-assoc "git" config))
		  (setf git-string (concatenate 'string git-string "|" (legit:current-branch "." :short T)))
		  (setf git-string (concatenate 'string git-string (legit:current-branch "." :short T)))))) ;; This is messy
	(setf git-string (concatenate 'string (string-assoc "git_prefix" (string-assoc "git" config)) git-string))
	git-string)))

;; Prompt
(defvar *prompt-style* NIL)

(defun get-user ()
  (uiop:getenv "USER"))

(defun get-hostname ()
  (machine-instance))

;; Regex Scanners
;; TODO $HOME rendered as /home/user as opposed to ~
(defvar *home-scan* (ppcre:create-scanner (concatenate 'string "^" (format NIL "~a" (user-homedir-pathname)))))

(defun get-pwd ()
  (ppcre:regex-replace *home-scan* (uiop:getenv "PWD") "~/"))

(defun make-prompt-string (config)
  "Given config options, produce prompt string (eg: user@hostname:dir terminator)"
  (let ((prompt-alist (string-assoc "prompt" config))
	(prompt-string NIL))
    (if (string-assoc "display_user" prompt-alist)
	(setf prompt-string (concatenate 'string prompt-string (get-user) (string-assoc "user_suffix" prompt-alist))))
    (if (string-assoc "display_hostname" prompt-alist)
	(setf prompt-string (concatenate 'string prompt-string (get-hostname) (string-assoc "hostname_suffix" prompt-alist))))
    (if (string-assoc "display_pwd" prompt-alist)
	(setf prompt-string (concatenate 'string prompt-string (get-pwd) (string-assoc "pwd_suffix" prompt-alist))))
    prompt-string))
	

(defun reload-config ()
  (setf *config* (config-parse))
  (setf *prompt-style* (make-style *config* "prompt"))
  (if (check-git-enabled *config*)
      (setf *git-style* (make-style *config* "git"))))

(defun render-prompt ()
  "After resolving all config parsing and string generation, render the prompt output here. Produces a stylized string"
  (format T "~A" (chlorophyll:stylize *prompt-style* (make-prompt-string *config*)))
  (if (and (check-git-enabled *config*) (check-git-dir))
      (format T " ~A" (chlorophyll:stylize *git-style* (make-git-string *config*))))
  (format T "~A" (string-assoc "prompt_char" (string-assoc "prompt" *config*))))

(defun main ()
  (reload-config)
  (render-prompt))