I set out to rewrite in Lisp the program "Visualize your local Git contributions with Go", which is described and listed at https://flaviocopes.com/go-git-contributions/
The aim is to generate a command-line program, which I called git-commits,
with two basic operations. The first recursively adds all ".git" folders
under a given folder to a stored list:
The second produces commit statistics for a user identified by email from the repositories in the stored list:
My final program is at: https://bitbucket.org/pclprojects/workspace/snippets/GzyRjK
The program uses some quicklisp installable libraries:
(load "~/quicklisp/setup.lisp") ; <1> (ql:quickload :cl-ansi-term :silent t) (ql:quickload :cl-git :silent t) ; <2> requires $ sudo apt install libgit2-dev (ql:quickload :local-time :silent t) (ql:quickload :uiop :silent t)
- I don't always use quicklisp, so I have to call setup first.
- "cl-git" requires the relevant library files to be installed.
The original tutorial does a good job of explaining the structure of the program, and I followed it closely in my version. Following are some notes about using the libraries.
Scanning Folders
The function below scans a given folder and its sub-folders, recursively, looking for
all ".git" folders. It avoids going into "vendor" and "node_modules" folders - I put
this in because the original author had done so. All the work is done in the
uiop function collect-sub*directories:
(defun recursive-scan-folder (folder) "Collects .git folders, printing and returning their names." (let ((result '())) (uiop:collect-sub*directories folder ; <1> (constantly t) ; <2> (lambda (filepath) ; <3> (and (uiop:directory-pathname-p filepath) (not (equalp "vendor" (first (last (pathname-directory filepath))))) (not (equalp "node_modules" (first (last (pathname-directory filepath))))))) (lambda (filepath) ; <4> (when (and (uiop:directory-pathname-p filepath) (equalp ".git" (first (last (pathname-directory filepath))))) (write-line (namestring filepath)) (push filepath result)))) (reverse result)))
- The function takes four arguments, the first being the base folder to begin the search.
-
The second argument says whether we should collect within this directory - we return
Tto search everywhere. - The third argument says whether we should recurse within this directory - we reject "vendor" and "node_modules".
-
The fourth argument checks if it has a ".git" directory, then writes out its name and collects it in
resultlist.
Analysing a Git Repository
Analysing the Git repository is fairly straightforward, thanks to the cl-git library.
(defun fill-commits (commits email filepath) "Add information from repository in filepath to commits hash-table." (cl-git:with-repository ; <1> (repository filepath) (let* ((ref (cl-git:repository-head repository))) ; <2> (dolist (reflog (cl-git:entries (cl-git:reflog ref))) ; <3> (let ((commit-email (getf (cl-git:committer reflog) :email)) ; <4> (commit-datetime (getf (cl-git:committer reflog) :time))) (when (equalp email commit-email) ; requested email did the commit (let ((days-ago (count-days-since-date commit-datetime))) (when days-ago ; only proceed if within last six months (incf (gethash (+ days-ago (calc-offset)) commits 0))))))))))
- Opens a repository in given filepath
- Finds HEAD of repository
- Retrieves a list of commit instances from the HEAD's references.
-
Information about the committer is held as a property list, so use
getfto retrieve:emailand:time.
Date/Time Processing
This program has a lot of date/time processing steps: we have to check if
commits are within the last six months, which day of the week they are on,
which month, etc. Like "cl-git", we rely on
local-time. A good example
is print-months:
(defun print-months () "Prints month names in first lines, determining month change in switching weeks." (write-string " ") (do* ((week (local-time:timestamp- (local-time:today) +DAYS-IN-LAST-SIX-MONTHS+ :day) ; <1> (local-time:timestamp+ week 7 :day)) ; <2> (month (local-time:timestamp-month week))) ; <3> ((local-time:timestamp> week (local-time:today)) ; <4> (write-line "")) ; (if (= (local-time:timestamp-month week) month) ; <5> (write-string " ") (progn ; print-month string (format t "~a " (local-time:format-timestring nil week :format '(:short-month))) ; <6> (setf month (local-time:timestamp-month week))))))
-
weekis set to the day six-months ago -
and
weekis advanced 7 days (1 week) at a time -
monthis first set to the month of the initialweek -
printing stopes when the
weekis greater than "today". -
checks if the current week's month is the same as the stored
month- if it is, we don't print a new name - otherwise, we can use a time format string to extract the month name
Coloured Terminal Output
Getting some coloured terminal output required some bigger changes to the original program. I decided to use another library, cl-ansi-term, which supports formatting of text output. One structural difference is that the library requires output for a whole line to be collected into a list, and then printed in one step.
I first adjusted the terminal width and created some styles:
(setf term:*terminal-width* 120) (term:update-style-sheet '((:small :black :b-white) (:medium :black :b-yellow) (:high :black :b-green) (:today :white :b-magenta) (:empty :default :b-default)))
The idea is that :small will be a "black text on white background" style for
commit counts from 1 to 4, etc: this library makes it very easy to set up
foreground/background colours for text.
To manage the collection of output strings and style, the print-cell function
is changed to get-cell which returns a list with the first value being the
string to display and the second value the name of the style to use. For
example: (get-cell 2 nil) returns (" 2 " :small).
(defun get-cell (value today) "Given a cell value, groups with style depending on value and today flag." (list (if (zerop value) " - " (format nil "~3d " value)) (cond ((and (< 0 value) (< value 5)) :small) ((and (<= 5 value) (< value 10)) :medium) ((<= 10 value) :high) (today :today) (t :empty))))
The print-cells function is adjusted to collect these pairs for each line,
and output them in one go at the end of the line:
(defun print-cells (columns) (print-months) (do ((j 6 (- j 1))) ((minusp j) ) (let ((line-defn '())) ; <1> (do ((i (+ +WEEKS-IN-LAST-SIX-MONTHS+ 1) (- i 1))) ((minusp i) (term:cat-print (reverse line-defn))) ; <2> (when (= i (+ +WEEKS-IN-LAST-SIX-MONTHS+ 1)) (push (get-day-col j) line-defn)) ; <3> (let ((col (gethash i columns))) (cond ((and col (zerop i) (= j (- (calc-offset) 1))) (push (get-cell (elt col j) t) line-defn)) ; <4> ((and col (> (length col) j)) (push (get-cell (elt col j) nil) line-defn)) ; <4> (t (push (get-cell 0 nil) line-defn)))))))) ; <4>
-
line-defnis a list to collect all the string-style pairs for printing -
at the end of a line,
cat-printis used to print the string-style pairs - collects the day-of-week name for the first column
-
these calls get the string-style pair for each cell in the row and add
them to
line-defn
Binary Executable
To create a binary, you should be able to simply write:
$ sbcl > (load "git-commits.lisp") > (sb-ext:save-lisp-and-die "git-commits" :executable t :save-runtime-options t :toplevel 'gitcommits:main)
but I get an error:
$ ./git-commits email peterlane@gmx.com
debugger invoked on a CL-GIT:GENERAL-ERROR in thread
#<THREAD tid=11724 "main thread" RUNNING {1001F78003}>:
Error :INVALID, libgit2 has not been initialized; you must call git_libgit2_init
Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.
restarts (invokable by number or by possibly-abbreviated name):
0: [ABORT] Exit from the current thread.
((:METHOD CFFI:TRANSLATE-FROM-FOREIGN (T CL-GIT::RETURN-VALUE-TYPE)) -1 #<unused argument>) [fast-method]
source: (ERROR (GETHASH RETURN-VALUE ERROR-CONDITIONS 'UNKNOWN-ERROR) :CODE
RETURN-VALUE :MESSAGE (CADR LAST-ERROR) :CLASS
(CAR LAST-ERROR))
0] 0
So, putting a call to (main) at the bottom of the file and using sbcl --script gits-commits.lisp is the way to go ...