2024-10-24: Visualising Local Git Contributions

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: 

(asdf:load-system "cl-ansi-term")           ; <1>
(ql:quickload "cl-git" :silent t)           ; <2>
(asdf:load-system "local-time")
(asdf:load-system "trivia")
(asdf:load-system "uiop")
  1. using asdf:load-system works in all cases, but
  2. "cl-git" emits warnings, so I use ql:quickload for its silent feature.

Note, "cl-git" requires the libgit library, so: 

$ sudo apt install libgit2-dev

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)))
  1. The function takes four arguments, the first being the base folder to begin the search.
  2. The second argument says whether we should collect within this directory - we return T to search everywhere.
  3. The third argument says whether we should recurse within this directory - we reject "vendor" and "node_modules".
  4. The fourth argument checks if it has a ".git" directory, then writes out its name and collects it in result list.

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))))))))))
  1. Opens a repository in given filepath
  2. Finds HEAD of repository
  3. Retrieves a list of commit instances from the HEAD's references.
  4. Information about the committer is held as a property list, so use getf to retrieve :email and :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))))))
  1. week is set to the day six-months ago
  2. and week is advanced 7 days (1 week) at a time
  3. month is first set to the month of the initial week
  4. printing stopes when the week is greater than "today".
  5. checks if the current week's month is the same as the stored month - if it is, we don't print a new name
  6. 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>
  1. line-defn is a list to collect all the string-style pairs for printing
  2. at the end of a line, cat-print is used to print the string-style pairs
  3. collects the day-of-week name for the first column
  4. these calls get the string-style pair for each cell in the row and add them to line-defn

Top Level

For the top level, because we only have two simple commands, a simple pattern-match is enough to call the relevant function, add or email. The handler catches errors, and displays a simple message in each case. 

(defun main ()
  "CLI start point"
  (handler-case                                 ; <1>
    (trivia:match
      (uiop:command-line-arguments)             ; <2>
      ((list "add" folder) (scan folder))       ; <3>
      ((list "email" address) (stats address))
      (otherwise                                ; <4>
        (write-line "gits-commits: Visualise your git commits")
        (write-line "gits-commits add FOLDER - adds all .git repos under FOLDER for scanning")
        (write-line "gits-commits email EMAIL - generates statistics for added repos by given email")))
    (cl-git:not-found-error (e)                 ; <5> 
                            (format t "~a~&" e)
                            (format t "Suggest deleting dot file and re-adding repositories.~&"))
    (t ()                                       ; <6>
       (write-line "Error: there was an error in running the program."))))
  1. Prepare to catch any errors
  2. match on the list of command-line arguments
  3. case one is the "add" command
  4. case three shows some help information
  5. Handle a typical git error
  6. Handle all other errors

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 when I try to run the binary: 

$ ./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 --load gits-commits.lisp is the way to go ...