#| This file is a part of timeliner project. Copyright (c) 2014 Innokenty Enikeev (me@enikesha.net) |# (in-package :cl-user) (restas:define-module #:timeliner.web (:use :cl :parenscript #:timeliner.utils)) (in-package #:timeliner.web) (restas::register-pkgmodule-traits 'timeliner.web :render-method (lambda () (make-instance 'timeliner.web::renderer))) ;; Cron (defvar *run-cron* t "Controls if starting a web should run cron tasks") (defvar *crons* (list (list #'timeliner.locations:on-cron '(:minute 0 :hour *)) (list #'timeliner.twitter:on-cron '(:minute 1 :hour *)) (list #'timeliner.foursquare:on-cron '(:minute 5 :hour *)) (list #'timeliner.financisto:on-cron '(:minute 0 :hour 7))) "List of cron functions with their schedules") (defvar *cron-timers* nil) (defmethod restas:initialize-module-instance :before ((module (eql #.*package*)) context) (restas:with-context context (alexandria:when-let (file (probe-file "config.lisp")) (load file)) (cl-mongo:mongo :host "10.8.0.6") (cl-mongo:db.use "timeline") (when *run-cron* (restas:context-add-variable context '*cron-timers* (loop for (function schedule) in *crons* collect (clon:schedule-function function (clon:make-scheduler (apply #'clon:make-typed-cron-schedule schedule) :allow-now-p t) :thread t)))))) (defmethod restas:finalize-module-instance :after ((module (eql #.*package*)) context) (let ((timers (restas:context-symbol-value context '*cron-timers*))) (mapcar #'trivial-timers::unschedule-timer timers))) ;; Static file path (defparameter *resources* (merge-pathnames "resources/" (asdf:component-pathname (asdf:find-system '#:timeliner)))) ;; Rendering (defgeneric finalize-page (data) (:documentation "Final rendering step")) (defgeneric render-route-data (route data) (:documentation "Process route-specific data")) (setf (who:html-mode) :html5) (defclass renderer () ()) (defun scripts (&rest scripts) (who:with-html-output-to-string (out) (loop for s in scripts do (who:htm (:script :src (restas:genurl 'static/js :file s)))))) (defun css (&rest files) (who:with-html-output-to-string (out) (loop for f in files do (who:htm (:link :href (restas:genurl 'static/css :file f) :rel "stylesheet"))))) (defmethod finalize-page ((data list)) (who:with-html-output-to-string (out nil :prologue t) (:html (:head (:meta :charset "utf-8") (:meta :http-equiv "X-UA-Compatible" :content "IE=edge") (:meta :name "viewport" :content "width=device-width, initial-scale=1") (:title (who:str (getf data :title))) (who:str (apply #'css (list* "bootstrap.min.css" "bootstrap-theme.min.css" "timeliner.css" (getf data :styles))))) (:body (who:str (getf data :menu)) (:div :class "container" (who:str (getf data :content))) (:div :id "modal" :class "modal fade" :tabindex "-1" :role "dialog" :aria-hidden "true") (who:str (apply #'scripts (list* "jquery.min.js" "bootstrap.min.js" (getf data :scripts)))) (who:str (getf data :inline-scripts)))))) (defun menu (route) (who:with-html-output-to-string (out) (:div :class "navbar navbar-inverse navbar-fixed-top" :role "navigation" (:div :class "container" (:div :class "navbar-header" (:button :type "button" :class "navbar-toggle" :data-toggle "collapse" :data-target ".navbar-collapse" (:span :class "sr-only" "Toggle navigation") (:span :class "icon-bar") (:span :class "icon-bar") (:span :class "icon-bar")) (:a :class "navbar-brand" :href (restas:genurl 'index) "Timeliner")) (:div :class "collapse navbar-collapse" (:ul :class "nav navbar-nav" (:li :class (case route ('index "active")) (:a :href (restas:genurl 'index) "Home")) (:li :class (case route ('about "active")) (:a :href (restas:genurl 'about) "About")))))))) (defmethod render-route-data (route data) (list* :menu (menu route) :title (getf data :title "Timeliner") data)) (defmethod restas:render-object ((designer renderer) (object list)) (let ((full-data (render-route-data (restas:route-symbol restas:*route*) object))) (finalize-page full-data))) (restas:define-route index ("") (list)) (restas:define-route day ("day/:date") (list :date date)) (defmethod tag/script (body) (who:with-html-output-to-string (out) (:script :type "text/javascript" (who:str body)))) (defmethod render-route-data ((route (eql 'index)) data) (call-next-method route (list :title "Main - Timeliner" :styles '("leaflet.css" "bootstrap-datepicker.css") :scripts '("moment.min.js" "bootstrap-datepicker.js" "bootstrap-datepaginator.min.js" "leaflet-src.js" "underscore.js" "backbone.js" "timeliner.js") :content (who:with-html-output-to-string (out) (:div :class "row" (:div :class "col-sm-12" (:div :id "paginator"))) (:div :class "row" (:div :class "col-sm-6" (:div :id "events" :class "list-group" (:a :class "list-group-item" "Loading"))) (:div :class "col-sm-6" (:div :id "map")))) :inline-scripts (tag/script (ps ($ (lambda () (chain *timeliner (start (lisp (getf data :date))))))))))) (defmethod render-route-data ((route (eql 'day)) data) (render-route-data 'index data)) (restas:define-route about ("about/") (list :title "About Timeliner" :content (who:with-html-output-to-string (out) (:h1 "About")))) (restas:define-route api/events ("api/events/" :method :GET :content-type "application/json") (let* ((start (or (ignore-errors (ms->ts (parse-integer (hunchentoot:get-parameter "start")))) (local-time:today))) (end (or (ignore-errors (ms->ts (parse-integer (hunchentoot:get-parameter "end")))) (local-time:timestamp+ start 1 :day)))) (with-output-to-string (stream) (yason:encode (cl-mongo:docs (cl-mongo:db.sort "events" ($between "ts" start end) :field "ts" :limit 2000)) stream)))) (restas:define-route api/events/delete ("api/events/:id" :method :DELETE :content-type "application/json") (cl-mongo:db.delete "events" (cl-mongo:$ "_id" (cl-mongo::make-bson-oid :oid (crypto:hex-string-to-byte-array id)))) "OK") (defparameter +timeliner.css+ (css-lite:css (("body") (:padding-top "70px" :padding-bottom "30px")) (("#map") (:height "600px" :border-radius "6px")) (("#events") (:height "600px" :overflow-y "scroll")) (("#paginator") (:margin-bottom "10px")))) (restas:define-route static/css ("css/:file" :content-type "text/css") (cond ((equal file "timeliner.css") +timeliner.css+) (t (merge-pathnames (format nil "css/~A" file) *resources*)))) ;;; parenscript macros (defpsmacro ! (&rest method-calls) `(chain ,@method-calls)) (defparameter +timeliner.js+ (ps ;; Base app structure (setf (@ window *timeliner) (create *models (create) *collections (create) *views (create) dispatcher (! _ (clone (@ *backbone *events))) :start (lambda (date) (var router (new ((@ *timeliner *router)))) (var events (new ((@ *timeliner *collections *events)))) (setf (@ *timeliner events) events) (setf (@ events url) (lisp (restas:genurl 'api/events))) (new ((@ *timeliner *views *paginator) (create :el "#paginator" :date date))) (new ((@ *timeliner *views *events) (create :el "#events" :collection events))) (new ((@ *timeliner *views *map) (create :el "#map" :collection events))) (! router (on "route:home" (lambda () (var today (! (moment) (format "YYYY-MM-DD"))) (! router (navigate (+ "day/" today) (create :trigger t :replace t)))))) (! router (on "route:day" (lambda (day) (! events (fetch (create :reset t :data (create :start (! (moment day "YYYY-MM-DD") (value-of))))))))) (! *backbone history (start (create push-state t))) (setf (@ *timeliner router) router)))) ;; * Router (setf (@ *timeliner *router) (! *backbone *router (extend (create :routes (create "" "home" "day/:day" "day"))))) ;; * Models (setf (@ *timeliner *models *state) (! *backbone *model (extend (create :defaults (create :day nil))))) (setf (@ *timeliner *models *event) (! *backbone *model (extend (create id-attribute "_id" :defaults (create :ts nil :type nil :title nil :loc nil))))) ;; * Collections (setf (@ *timeliner *collections *events) (! *backbone *collection (extend (create :model (@ *timeliner *models *event))))) ;; * Views ;; ** Dialog box (setf (@ *timeliner *views *dialog) (! *backbone *view (extend (create class-name "modal-dialog modal-sm" buttons (list (create :text "Cancel" :class "btn-default" :event "cancel" :attrs (create :data-dismiss "modal")) (create :text "Ok" :class "btn-primary" :event "ok")) initialize (lambda (opts) (! _ (extend this (! _ (pick (or opts (create)) "title" "body" "buttons"))))) render-button (lambda (btn) (var $btn ($ (who-ps-html (:button :class "btn" (@ btn text))))) (var self this) (when (@ btn class) (! $btn (add-class (@ btn class)))) (when (@ btn attrs) (! $btn (attr (@ btn attrs)))) (! $btn (on "click" (lambda (e) (when (@ btn event) (! self (trigger (+ "button:" (@ btn event))))) (! ($ "#modal") (modal "hide"))))) $btn) render (lambda () (! this $el (html (who-ps-html (:div :class "modal-content" (:div :class "modal-header" (:h4 :class "modal-title" (@ this title))) (:div :class "modal-body" (@ this body)) (:div :class "modal-footer"))))) (var self this) (! this $el (find ".modal-footer") (append (loop for b in (@ self buttons) collect (! self (render-button b))))) this) show (lambda () (! ($ "#modal") (html (! this (render) el)) (modal)) this))))) ;; ** DeleteEventDialog (setf (@ *timeliner *views *delete-event) (! *timeliner *views *dialog (extend (create title "Delete event?" body "Are you sure you want to delete event?" buttons (list (create :text "Cancel" :class "btn-default" :event "cancel" :attrs (create :data-dismiss "modal")) (create :text "Delete" :class "btn-danger" :event "delete")))))) ;; ** Event (setf (@ *timeliner *views *event) (! *backbone *view (extend (create tag-name "a" class-name "list-group-item" :events (create "click" "select" "dblclick" "delete") initialize (lambda () (! this (listen-to (@ this model) "change" (@ this render))) (! this (listen-to (@ this model) "destroy" (@ this remove)))) icon-class (lambda () (case (! this model (get :type)) (:place "glyphicon glyphicon-map-marker") (:finance "glyphicon glyphicon-usd") (:checkin "glyphicon glyphicon-ok-circle") (:twitter "glyphicon glyphicon-pencil"))) render (lambda () (! this $el (attr (create :href "#" :data-type (! this model (get :type))))) (! this $el (html (who-ps-html (:span :class "label label-info pull-right" (:span :class "glyphicon glyphicon-time") " " (! (moment (! this model (get :ts))) (format "HH:mm"))) (:span :class (! this (icon-class))) " " (! this model (get :title))))) this) select (lambda (e) (! e (prevent-default)) (! this $el (siblings) (remove-class "active") (end) (add-class "active")) (! *timeliner dispatcher (trigger "event:selected" (@ this model)))) delete (lambda (e) (! this (listen-to-once (! (new (@ *timeliner *views *delete-event)) (show)) "button:delete" (lambda () (! this model (destroy)))))))))) ;; ** Events (setf (@ *timeliner *views *events) (! *backbone *view (extend (create initialize (lambda () (! this (listen-to (@ this collection) "reset" (@ this render)))) render-one (lambda (event) (var item-view (new ((@ *timeliner *views *event) (create :model event)))) (! this $el (append (@ (! item-view (render)) $el)))) render (lambda () (! this $el (empty)) (if (> (@ this collection length) 0) (! this collection (each (@ this render-one) this)) (! this $el (append (who-ps-html (:li :class "list-group-item" "No data"))))) this))))) ;; ** Paginator (setf (@ *timeliner *views *paginator) (! *backbone *view (extend (create :events (create selected-date-changed "changed") :initialize (lambda (opts) (! this $el (datepaginator)) (when (@ opts date) (! this $el (datepaginator "setSelectedDate" (list (@ opts date) "YYYY-MM-DD"))))) :changed (lambda (e date) (! *timeliner router (navigate (+ "day/" (! date (format "YYYY-MM-DD"))) (create :trigger t)))))))) ;; ** Map (setf (@ *timeliner *views *map) (! *backbone *view (extend (create initialize (lambda () (var tile-layer (! *L (tile-layer "http://{s}.tiles.mapbox.com/v3/{id}/{z}/{x}/{y}.png" (create :id "enikesha.icd0bj4k" max-Zoom 18)))) (setf (@ this events-layer) (! *L (feature-group))) (setf (@ this path-layer) (! *L (polyline (list) (create :weight 4 :color "#f30")))) (setf (@ this map) (! *L (map (@ this el) (create :center '(59.94 30.33) :zoom 10 :layers (list tile-layer (@ this path-layer) (@ this events-layer)))))) (! this (listen-to (@ this collection) "reset" (@ this render))) (! this (listen-to (@ this collection) "change" (@ this render))) (! this (listen-to (@ this collection) "add" (@ this render))) (! this (listen-to (@ this collection) "remove" (@ this render))) (! this (listen-to (@ *timeliner dispatcher) "event:selected" (@ this highlight)))) render (lambda () (! this events-layer (clear-layers)) (! this path-layer (splice-lat-lngs 0)) (! this collection (each (lambda (e) (var loc (! e (get "loc"))) (when loc (var marker (! *L (circle-marker (list (@ loc coordinates 1) (@ loc coordinates 0)) (create :radius 4 :weight 1 :color "#000" fill-color "#F00" fill-opacity 1)))) (setf (@ e "_layer") marker) (! this path-layer (add-lat-lng (! marker (get-lat-lng)))) (! this events-layer (add-layer marker)))) this)) (when (@ this collection length) (set-timeout (! _ (bind (lambda () (! this map (fit-bounds (! this events-layer (get-bounds)) (create :padding '(50 50))))) this)) 200)) this) highlight (lambda (event) (var layer (@ event "_layer")) (! this events-layer (set-style (create fill-color "#F00"))) (if layer (progn (! layer (set-style (create fill-color "#03F"))) (when (and (not (@ *L *browser ie)) (not (@ *L *browser opera))) (! layer (bring-to-front))) (! this map (set-view (! layer (get-lat-lng)) 16))) (! this map (fit-bounds (! this events-layer (get-bounds)) (create :padding '(50 50)))))))))))) (restas:define-route static/js ("js/:file" :content-type "application/x-javascript") (cond ((equal file "timeliner.js") +timeliner.js+) (t (merge-pathnames (format nil "js/~A" file) *resources*)))) (restas:define-route static/fonts ("fonts/:file") (merge-pathnames (format nil "fonts/~A" file) *resources*))