root/data-source-git.scm

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
(define-module (data-source-git)
  #:use-module (srfi srfi-1) ;; map/reduce
  #:use-module (srfi srfi-19) ;; date
  #:use-module (srfi srfi-69) ;; hash-tables
  #:use-module (system-utils)
  #:export (data-source-git))


(define (unix->day unix)
  (time-monotonic->date (make-time 'time-monotonic 0 unix)))

(define (git-log-str directory start end)
  (cdr (with-error-to-string*
        (lambda ()
          (shell-command-to-string*
           "git" "--git-dir" directory
           "log" "--pretty=format:%at"
           (string-append "--after=" start)
           (string-append "--before=" end))))))

(define (data-source-git year directory)
  ;; TODO shift year based on calendar
  (let* ((start-date (make-date 0 0 0 0 1 1 year 0))
         (end-date (make-date 0 0 0 0 31 12 (+ year 1) 0))
         (start (date->string start-date "~s"))
         (end (date->string end-date "~s"))
         (result-str (git-log-str directory start end)))
    ;; shitty workaround that allows giving "repo/.git" or "repo"
    (define activities-unix-dates
      (if (string-null? result-str)
         (let ((non-bare-str
                (git-log-str
                 (string-append directory file-name-separator-string ".git")
                 start
                 end)))
           (unlines non-bare-str))
         (unlines result-str)))
    (define project (projectname directory))
    (map (lambda (d)
           (define date-str d)
           (define u (unix->day (string->number date-str)))
           `((date . ,u)
             (project . ,project)
             (git-directory . ,directory)))
         activities-unix-dates)))

(define (unlines str) (if (string-null? str)
                          '()
                          (string-split str #\newline)))

(define (projectname dir)
  (let ((name (basename dir)))
    (if (string=? name ".git")
        (basename (dirname dir))
        name)))