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

(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 (make-hash-table)))
         (define project (assoc-ref d 'project))
         (define link (assoc-ref d 'link))
         (hash-table-set! days date-id
                          (increase-day-activity-project
                           current-activity-counter
                           project
                           link))
         date-id)
       data)
  days)

(define (increase-day-activity-project day project link)
  (if (hash-table? day)
      (let ()
        (define project-state (hash-table-ref/default day project (new-project-state link)))
        (define old-value (hash-table-ref project-state 'counter))
        (define old-links (hash-table-ref project-state 'links))
        (when link
          (hash-table-set! project-state 'links (cons link old-links)))
        (hash-table-set! project-state 'counter (+ 1 old-value))
        (hash-table-set! day project project-state)
        day)

      (let ((table (make-hash-table)))
        (hash-table-set! table project (new-project-state link))
        table)))

(define (new-project-state link)
  (alist->hash-table
   `((counter . 1)
     ,(if link
          `(links . (,link))
          `(links . ())) )))

(define (make-tooltip day)
  (if (hash-table? day)
      (hash-table-fold day (lambda (project project-state acc)
                             (define activity-count (hash-table-ref project-state 'counter))
                             (string-append
                              (if acc (string-append acc "\n") "")
                              (or 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) (+ (hash-table-ref v 'counter) acc)) 0)
      0))

(define (day-total-links day)
  (if (hash-table? day)
      (hash-table-fold day (lambda (k v acc)
                             (define links (hash-table-ref v 'links))
                             (if (null? links)
                                 acc
                                 (append links acc)))
                       '())
      '()))


(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)))
              (links (day-total-links (hash-table-ref/default days d #f)))
              (factor (/ 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)
           ,(if (null? links)
                `(_ . _)
                `(desc ,(links-to-text (delete-duplicates links))))))))))

(define (links-to-text links)
  (if (null? links)
      ""
      (string-append "link: " (car links) "\n"
                     (links-to-text (cdr links)))))