|
|
@@ -11,6 +11,9 @@
|
|
|
(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")
|
|
|
+
|
|
|
(defun import-events ()
|
|
|
(timeliner.locations:import-location-events (local-time:timestamp- (today) 1 :day)))
|
|
|
(defun import-finance ()
|
|
|
@@ -20,20 +23,21 @@
|
|
|
(restas:with-context context
|
|
|
(cl-mongo:mongo :host "10.8.0.6")
|
|
|
(cl-mongo:db.use "timeline")
|
|
|
- (restas:context-add-variable context
|
|
|
- '*import-events-timer*
|
|
|
- (clon:schedule-function #'import-events
|
|
|
- (clon:make-scheduler (clon:make-typed-cron-schedule
|
|
|
- :minute 10 :hour 0))
|
|
|
- :name "import-events"
|
|
|
- :thread t))
|
|
|
- (restas:context-add-variable context
|
|
|
- '*import-finance-timer*
|
|
|
- (clon:schedule-function #'import-finance
|
|
|
- (clon:make-scheduler (clon:make-typed-cron-schedule
|
|
|
- :minute 0 :hour 7))
|
|
|
- :name "import-finance"
|
|
|
- :thread t))))
|
|
|
+ (when *run-cron*
|
|
|
+ (restas:context-add-variable
|
|
|
+ context '*import-events-timer*
|
|
|
+ (clon:schedule-function #'import-events
|
|
|
+ (clon:make-scheduler (clon:make-typed-cron-schedule
|
|
|
+ :minute 10 :hour 0))
|
|
|
+ :name "import-events"
|
|
|
+ :thread t))
|
|
|
+ (restas:context-add-variable
|
|
|
+ context '*import-finance-timer*
|
|
|
+ (clon:schedule-function #'import-finance
|
|
|
+ (clon:make-scheduler (clon:make-typed-cron-schedule
|
|
|
+ :minute 0 :hour 7))
|
|
|
+ :name "import-finance"
|
|
|
+ :thread t)))))
|
|
|
|
|
|
(defmethod restas:finalize-module-instance :after ((module (eql #.*package*)) context)
|
|
|
(let ((events-timer (restas:context-symbol-value context '*import-events-timer*))
|
|
|
@@ -198,6 +202,9 @@
|
|
|
((equal file "timeliner.css") +timeliner.css+)
|
|
|
(t (merge-pathnames (format nil "css/~A" file) *resources*))))
|
|
|
|
|
|
+(defpsmacro ! (&rest method-calls)
|
|
|
+ `(chain ,@method-calls))
|
|
|
+
|
|
|
(defparameter +timeliner.js+
|
|
|
(ps
|
|
|
;; Base app structure
|
|
|
@@ -210,6 +217,7 @@
|
|
|
: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"
|
|
|
@@ -222,192 +230,193 @@
|
|
|
(create :el "#map"
|
|
|
:collection events)))
|
|
|
|
|
|
- (chain router (on "route:home"
|
|
|
- (lambda ()
|
|
|
- (var today (chain (moment)
|
|
|
- (format "YYYY-MM-DD")))
|
|
|
- (chain router (navigate
|
|
|
- (concatenate 'string "day/" today)
|
|
|
- (create :trigger t :replace t))))))
|
|
|
- (chain router (on "route:day"
|
|
|
- (lambda (day)
|
|
|
- (chain events (fetch
|
|
|
- (create
|
|
|
- :reset t
|
|
|
- :data (create
|
|
|
- :start (chain
|
|
|
- (moment day "YYYY-MM-DD")
|
|
|
- (value-of)))))))))
|
|
|
- (chain *backbone history (start (create push-state t)))
|
|
|
+ (! router (on "route:home"
|
|
|
+ (lambda ()
|
|
|
+ (var today (! (moment)
|
|
|
+ (format "YYYY-MM-DD")))
|
|
|
+ (! router (navigate
|
|
|
+ (concatenate 'string "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)
|
|
|
- (chain *backbone *router
|
|
|
- (extend (create :routes (create
|
|
|
- "" "home"
|
|
|
- "day/:day" "day")))))
|
|
|
+ (! *backbone *router
|
|
|
+ (extend (create :routes (create
|
|
|
+ "" "home"
|
|
|
+ "day/:day" "day")))))
|
|
|
;; * Models
|
|
|
(setf (@ *timeliner *models *state)
|
|
|
- (chain *backbone *model (extend (create
|
|
|
- :defaults (create
|
|
|
- :day nil)))))
|
|
|
+ (! *backbone *model (extend (create
|
|
|
+ :defaults (create
|
|
|
+ :day nil)))))
|
|
|
(setf (@ *timeliner *models *event)
|
|
|
- (chain *backbone *model (extend (create
|
|
|
- :defaults (create
|
|
|
- :ts nil
|
|
|
- :type nil
|
|
|
- :title nil
|
|
|
- :loc nil)))))
|
|
|
+ (! *backbone *model (extend (create
|
|
|
+ id-attribute "_id"
|
|
|
+ :defaults (create
|
|
|
+ :ts nil
|
|
|
+ :type nil
|
|
|
+ :title nil
|
|
|
+ :loc nil)))))
|
|
|
;; * Collections
|
|
|
(setf (@ *timeliner *collections *events)
|
|
|
- (chain *backbone *collection (extend (create
|
|
|
- :model (@ *timeliner *models *event)))))
|
|
|
+ (! *backbone *collection (extend (create
|
|
|
+ :model (@ *timeliner *models *event)))))
|
|
|
;; * Views
|
|
|
;; ** Event
|
|
|
(setf (@ *timeliner *views *event)
|
|
|
- (chain *backbone *view
|
|
|
- (extend
|
|
|
- (create
|
|
|
- tag-name "a"
|
|
|
- class-name "list-group-item"
|
|
|
- :events (create
|
|
|
- "click" "select")
|
|
|
- icon-class (lambda ()
|
|
|
- (case (chain this model (get :type))
|
|
|
- (:place "glyphicon glyphicon-map-marker")
|
|
|
- (:finance "glyphicon glyphicon-usd")))
|
|
|
- render (lambda ()
|
|
|
- (chain this $el (attr (create
|
|
|
- :href "#"
|
|
|
- :data-type (chain this model (get :type)))))
|
|
|
- (chain this $el (html
|
|
|
- (who-ps-html
|
|
|
- (:span :class "label label-info pull-right"
|
|
|
- (:span :class "glyphicon glyphicon-time")
|
|
|
- " "
|
|
|
- (chain (moment
|
|
|
- (chain this model (get :ts)))
|
|
|
- (format "HH:mm")))
|
|
|
- (:span :class (chain this (icon-class)))
|
|
|
- " "
|
|
|
- (chain this model (get :title)))))
|
|
|
- this)
|
|
|
- select (lambda (e)
|
|
|
- (chain e (prevent-default))
|
|
|
- (chain this $el
|
|
|
- (siblings) (remove-class "active") (end)
|
|
|
- (add-class "active"))
|
|
|
- (chain *timeliner dispatcher
|
|
|
- (trigger "event:selected" (@ this model))))))))
|
|
|
+ (! *backbone *view
|
|
|
+ (extend
|
|
|
+ (create
|
|
|
+ tag-name "a"
|
|
|
+ class-name "list-group-item"
|
|
|
+ :events (create
|
|
|
+ "click" "select")
|
|
|
+ icon-class (lambda ()
|
|
|
+ (case (! this model (get :type))
|
|
|
+ (:place "glyphicon glyphicon-map-marker")
|
|
|
+ (:finance "glyphicon glyphicon-usd")))
|
|
|
+ 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))))))))
|
|
|
;; ** Events
|
|
|
(setf
|
|
|
(@ *timeliner *views *events)
|
|
|
- (chain *backbone *view
|
|
|
- (extend
|
|
|
- (create
|
|
|
- initialize (lambda ()
|
|
|
- (chain this (listen-to (@ this collection) "reset" (@ this render))))
|
|
|
- render-one (lambda (event)
|
|
|
- (var item-view (new ((@ *timeliner *views *event)
|
|
|
- (create :model event))))
|
|
|
- (chain this $el (append (@ (chain item-view (render)) $el))))
|
|
|
- render (lambda ()
|
|
|
- (chain this $el (empty))
|
|
|
- (if (> (@ this collection length) 0)
|
|
|
- (chain this collection (each (@ this render-one) this))
|
|
|
- (chain this $el (append (who-ps-html (:li :class "list-group-item"
|
|
|
- "No data")))))
|
|
|
- this)))))
|
|
|
+ (! *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)
|
|
|
- (chain *backbone *view
|
|
|
- (extend
|
|
|
- (create
|
|
|
- :events (create selected-date-changed "changed")
|
|
|
- :initialize (lambda (opts)
|
|
|
- (chain this $el (datepaginator))
|
|
|
- (when (@ opts date)
|
|
|
- (chain this $el (datepaginator "setSelectedDate"
|
|
|
- (list (@ opts date)
|
|
|
- "YYYY-MM-DD")))))
|
|
|
- :changed (lambda (e date)
|
|
|
- (chain *timeliner router
|
|
|
- (navigate
|
|
|
- (concatenate 'string "day/"
|
|
|
- (chain date (format "YYYY-MM-DD")))
|
|
|
- (create :trigger t))))))))
|
|
|
+ (! *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
|
|
|
+ (concatenate 'string "day/"
|
|
|
+ (! date (format "YYYY-MM-DD")))
|
|
|
+ (create :trigger t))))))))
|
|
|
;; ** Map
|
|
|
(setf (@ *timeliner *views *map)
|
|
|
- (chain
|
|
|
+ (!
|
|
|
*backbone *view
|
|
|
(extend
|
|
|
(create
|
|
|
initialize (lambda ()
|
|
|
(var tile-layer
|
|
|
- (chain *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) (chain *L (feature-group)))
|
|
|
- (setf (@ this path-layer) (chain *L (polyline (list)
|
|
|
- (create
|
|
|
- :weight 4
|
|
|
- :color "#f30"))))
|
|
|
+ (! *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)
|
|
|
- (chain *L (map (@ this el)
|
|
|
- (create
|
|
|
- :center '(59.94 30.33)
|
|
|
- :zoom 10
|
|
|
- :layers (list tile-layer
|
|
|
- (@ this path-layer)
|
|
|
- (@ this events-layer))))))
|
|
|
- (chain this (listen-to (@ this collection) "reset"
|
|
|
- (@ this render)))
|
|
|
- (chain this (listen-to (@ *timeliner dispatcher) "event:selected"
|
|
|
- (@ this highlight))))
|
|
|
+ (! *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 (@ *timeliner dispatcher) "event:selected"
|
|
|
+ (@ this highlight))))
|
|
|
render (lambda ()
|
|
|
- (chain this events-layer (clear-layers))
|
|
|
- (chain this path-layer (splice-lat-lngs 0))
|
|
|
- (chain this collection
|
|
|
- (each (lambda (e)
|
|
|
- (var loc (chain e (get "loc")))
|
|
|
- (when loc
|
|
|
- (var marker (chain *L (circle-marker
|
|
|
- (list (@ loc coordinates 1)
|
|
|
- (@ loc coordinates 0))
|
|
|
- (create
|
|
|
- :radius 4
|
|
|
- :weight 1
|
|
|
- :color "#000"
|
|
|
- fill-color "#F00"
|
|
|
- fill-opacity 1))))
|
|
|
- (chain e (set "_layer" marker))
|
|
|
- (chain this path-layer (add-lat-lng
|
|
|
- (chain marker (get-lat-lng))))
|
|
|
- (chain this events-layer (add-layer marker))))
|
|
|
- this))
|
|
|
+ (! 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))))
|
|
|
+ (! e (set "_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
|
|
|
- (chain _ (bind (lambda ()
|
|
|
- (chain this map (fit-bounds
|
|
|
- (chain this events-layer (get-bounds))
|
|
|
- (create :padding '(50 50)))))
|
|
|
- this))
|
|
|
+ (! _ (bind (lambda ()
|
|
|
+ (! this map (fit-bounds
|
|
|
+ (! this events-layer (get-bounds))
|
|
|
+ (create :padding '(50 50)))))
|
|
|
+ this))
|
|
|
200))
|
|
|
this)
|
|
|
highlight (lambda (event)
|
|
|
- (var layer (chain event (get "_layer")))
|
|
|
- (chain this events-layer
|
|
|
- (set-style (create fill-color "#F00")))
|
|
|
+ (var layer (! event (get "_layer")))
|
|
|
+ (! this events-layer
|
|
|
+ (set-style (create fill-color "#F00")))
|
|
|
(if layer
|
|
|
(progn
|
|
|
- (chain layer (set-style (create fill-color "#03F")))
|
|
|
+ (! layer (set-style (create fill-color "#03F")))
|
|
|
(when (and (not (@ *L *browser ie))
|
|
|
(not (@ *L *browser opera)))
|
|
|
- (chain layer (bring-to-front)))
|
|
|
- (chain this map (set-view (chain layer (get-lat-lng))
|
|
|
- 16)))
|
|
|
- (chain this map (fit-bounds
|
|
|
- (chain this events-layer (get-bounds))
|
|
|
- (create :padding '(50 50))))))))))))
|
|
|
+ (! 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
|
