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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

(define-module (generate-git-svg)
  #:use-module (srfi srfi-1) ;; map/reduce
  #:use-module (srfi srfi-19) ;; date
  #:use-module (srfi srfi-69) ;; hash-tables
  #:use-module (generate-svg-gregorian)
  #:use-module (generate-svg-discord)
  #:use-module (system-utils)
  #:export (generate-svg
            generate-days-table))

(define (day-up-project day project)
  (if (hash-table? day)
      (begin
        (hash-table-set! day
                         project
                         (+ 1 (hash-table-ref/default day
                                                      project
                                                      0)))
        day)
      (let ((table (make-hash-table)))
        (hash-table-set! table project 1)
        table)))

(define (day-total-count day)
  (if (hash-table? day)
      (hash-table-fold day (lambda (k v acc) (+ v acc)) 0)
      0))

(define (date->id date)
  (string-append (number->string (date-year date))
                 "-"
                 (number->string (date-year-day date))))

(define (unix->day unix)
  (date->id (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 (get-dates 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"
    (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 (unlines str) (if (string-null? str)
                          '()
                          (string-split str #\newline)))

(define* (generate-days-table year directory #:optional (days (make-hash-table)))
  (let* ((dates-str (get-dates year directory))
         (dates-number (map unix->day (map string->number dates-str))))
    (map (lambda (d)
           (hash-table-set! days d
                            (day-up-project
                             (hash-table-ref/default days d 0) directory))
           d)
         dates-number)
    days))

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

(define (make-tooltip day)
  (if (hash-table? day)
      (hash-table-fold day (lambda (k v acc)
                             (string-append
                              (if acc (string-append acc "\n") "")
                              (projectname k) ": " (number->string v)))
                       #f)
      "no commits"))

(define (rgba-number-str v)
  (number->string (inexact->exact (floor v))))
(define (rgba-string r g b a)
  (string-append "rgba(" (rgba-number-str r)
                 "," (rgba-number-str g)
                 "," (rgba-number-str b)
                 "," (number->string (exact->inexact  a)) ")"))

(define (generate-svg gen-fn year days)
  (let* ((max-val (hash-table-fold days (lambda (k v acc) (max (day-total-count v) acc)) 1)))
    (gen-fn
     year
     (lambda (date)
       (let* ((d (date->id date))
              (val (day-total-count (hash-table-ref/default days d #f)))
              (factor (exact->inexact (/ val max-val)))
              (tooltip (make-tooltip (hash-table-ref/default days d #f))))
         `(,(if (> val 0)
              `(fill ,(rgba-string (* factor 10)
                                   (* factor 245)
                                   (* factor 30)
                                   (if (> val 0) 1 0.8)))
              (if (eq? gen-fn generate-svg-discord)
                  '(fill "rgba(255,255,0,1)")
                  '(fill "rgba(100,100,100,0.9)")))
           ,(if (> val 0)
              `(class "day")
              `(class "day no-event"))
           (title ,tooltip)))))))