;; -*- 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))))