aboutsummaryrefslogtreecommitdiffstats
path: root/webstats/stats.paren
blob: ca619389266eaf18ea7cdf164cbfe6b4a5a8d24c (plain)
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
;; -*- mode: lisp; -*-
;; (pushnew '(SLYNK:*STRING-ELISION-LENGTH* . nil) slynk:*slynk-pprint-bindings* :test #'equal)

(in-package :webstats-js)

(defun register-visit (data)
  (fetch "http://localhost/stats/visit"
            (create :method "POST"
                    :headers (create "Content-Type" "application/x-www-form-urlencoded")
                    :body (new (-u-r-l-search-params data)))))

(defun register-click (event)
  (when (or (= 1 (@ event which))
            (= 2 (@ event which)))
    (chain event (prevent-default))
    (let ((link (getprop event 'current-target 'href)))
      (chain
       (register-visit (create :click link
                               :page (@ document location href)))
       (finally (lambda ()
                  (if (or (= 2 (@ event which))
                          (eql (@ event target target) "_blank"))
                      (chain window (open link "_blank"))
                      (setf (@ window location href) link))))))))

(defun instrument-links ()
  (for-of (link ((@ document query-selector-all) "a"))
    (setf (@ link onclick) #'register-click)
    (setf (@ link onauxclick) #'register-click)))

(defun register-page-load ()
  (let ((data (create :title (@ document title)
                      :page (@ document location href)
                      :referer (@ document referrer))))
    (chain
     (register-visit data)
     (then (lambda (r)
             ((@ console log) r)
             ((@ r text))))
     (then (@ console log)))))

(defun response-to-json (response)
  (if (@ response ok)
      (chain response (json))
      (throw (new (-error "not 2XX resp")))))

(defun spaced-color (idx &optional (opacity 1))
  (concatenate 'string "hsl(" (* 137.506 idx) ",70%,55%," opacity ")"))

(defun plot (data)
  (new
   (u-plot
    (create
     :title "Site activity visits"
     :width 450
     :height 400
     :cursor (create sync (create key "moo"))
     :series (list (create label "Time")
                   (create label "visits" stroke "red")))
    data
    (chain document (get-element-by-id "graph")))))

(defun plot-site (data)
  (let ((bars ((@ u-plot paths bars)
               (create align 1 gap 0 size (list 0.8 -infinity)))))
    (new
     (u-plot
      (create
       :title "Individual Site activity visits"
       :width 450
       :height 400
       :cursor (create sync (create key "moo"))
       :series (list (create label "Time")
                     (create label "stats" stroke (spaced-color 0)
                             fill (spaced-color 0 0.2)
                             paths bars)
                     (create label "proxy" stroke (spaced-color 1)
                             fill (spaced-color 1 0.2)
                             paths bars)
                     (create label "blog" stroke (spaced-color 2)
                             fill (spaced-color 2 0.2)
                             paths bars)))
      data
      (chain document (get-element-by-id "graph"))))))

(add-event-listener
 "load"
 (lambda ()
   (instrument-links)
   (register-page-load)

   (ps:chain (fetch "/stats/metric.json?q=split")
             (then #'response-to-json)
             (then #'plot-site))))