root/generate-data-svg.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
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
(define-module (generate-data-svg)
  #: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 (generate-svg
            generate-days-table))

(define* (generate-days-table year data #:optional (days (make-hash-table)))
  (map (lambda (d)
         (define date-id (date->id (assoc-ref d 'date)))
         (define current-activity-counter (hash-table-ref/default days date-id 0))
         (define project (assoc-ref d 'project))
         (hash-table-set! days date-id
                          (increase-day-activity-project
                           current-activity-counter project))
         date-id)
       data)
  days)

(define (increase-day-activity-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 (make-tooltip day)
  (if (hash-table? day)
      (hash-table-fold day (lambda (project activity-count acc)
                             (string-append
                              (if acc (string-append acc "\n") "")
                              project ": " (number->string activity-count)))
                       #f)
      "no activity"))

(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 (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 template year days)
  (define gen-fn (assoc-ref template 'fn))
  (define theme (assoc-ref template 'theme))
  (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)))
              `(fill ,(assoc-ref theme 'day-bg)))
           ,(if (> val 0)
              `(class "day")
              `(class "day no-event"))
           (title ,tooltip)))))))