cl-deck-builder2/src/toolkit/git.lisp

#|

src/toolkit/git.lisp

Tools For Working with git repository information

e.g. commit id, commit author, message, date, etc.

TODO Use INFERIOR-SHELL? Turns out it just calls UIOP:RUN-PROGRAM...

|#

(in-package #:cl-deck-builder2.toolkit.git)

(defparameter *git-directory*
  (relative-pathname ".git")
  "The base path to the directory we run git in during UIOP:RUN-PROGRAM.")

(defparameter +git-binary+
  (format nil "git --no-pager --git-dir ~a" *git-directory*)
  "The full git command line, with *GIT-DIRECTORY* passed in already. What could go wrong?")

(defparameter +git-log+
  (concatenate 'string
               +git-binary+
               " log --format=\"%h%nAuthor: %an%nDate: %cD%n%s%n%b%n----\"")
  "Full command line to git log.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun git-revision ()
  "Query git rev-parse for the current HEAD revision id."
  (let ((command
          (concatenate 'string
                       +git-binary+
                       " rev-parse --short HEAD")))
    (string-trim '(#\Newline)
                 (uiop:run-program command :output :string :error-output nil))))

(defun git-log ()
  "Query git log into a somewhat parseable format."
  (cl-ppcre:split
   "\\n+----\\n"
   (uiop:run-program +git-log+ :output :string)))

;; Not terrible...
(defun parse-git-log (msg)
  "Split the output of GIT-MESSAGES-LIST into an actual LIST.

ARGUMENTS
MSG  The output of GIT-MESSAGES-LIST.

SEE GIT-LOG"
  (let ((state :in-commit)
        (c '()))
    (loop for line in (split-sequence:split-sequence #\Newline msg) do
      (case state
        (:in-commit (setf (getf c :commit) line
                          state :in-author))
        (:in-author (setf (getf c :author) line
                          state :in-date))
        (:in-date (setf (getf c :date) line
                        state :in-subject))
        (:in-subject (setf (getf c :subject) line
                           state :in-message))
        (:in-message (setf (getf c :message)
                           (format nil "~a~a~%"
                                   (getf c :message "")
                                   line)))))
    c))