coleslaw/plugins/git-versioned.lisp

plugins/git-versioned.lisp (1653 bytes)
1 (defpackage :coleslaw-git-versioned
2   (:use :cl)
3   (:import-from :coleslaw
4                 #:*config*
5                 #:run-lines)
6   (:import-from :uiop #:ensure-directory-pathname))
7 
8 (in-package :coleslaw-git-versioned)
9 
10 (defconstant +nothing-to-commit+ 1
11   "Error code when git-commit has nothing staged to commit.")
12 
13 ;; These have their symbol-functions set in order to close over the src-dir
14 ;; variable.
15 (defun git-versioned ()
16   "Run all git commands as specified in the .coleslawrc.")
17 (defun command (args)
18   "Automatically git commit and push the blog to remote."
19   (declare (ignore args)))
20 
21 (defun enable (src-dir &rest commands)
22   "Define git-versioned functions at runtime."
23   (setf (symbol-function 'git-versioned)
24         (lambda ()
25           (loop for fsym in commands
26                 do (funcall (symbol-function (intern (symbol-name fsym)
27                                                      :coleslaw-git-versioned))))))
28   (setf (symbol-function 'command)
29         (lambda (args)
30           (run-lines src-dir
31                      (format nil "git ~A" args)))))
32 (defmethod coleslaw:deploy :before (staging)
33   (declare (ignore staging))
34   (git-versioned))
35 
36 (defun stage () (command "stage -A"))
37 (defun commit (&optional (commit-message "Automatic commit."))
38   (handler-case (command (format nil "commit -m '~A'" commit-message))
39     (uiop/run-program:subprocess-error (error)
40       (case (uiop/run-program:subprocess-error-code error)
41         (+nothing-to-commit+ (format t "Nothing to commit. Error ~d"
42                                      +nothing-to-commit+))
43         (otherwise (error error))))))
44 
45 (defun upload ()
46   (command "push"))