|
|
@@ -1,3 +1,7 @@
|
|
|
+(defun ts->ms (ts)
|
|
|
+ (+ (* 1000 (local-time:timestamp-to-unix ts))
|
|
|
+ (floor (local-time:nsec-of ts) 1000000)))
|
|
|
+
|
|
|
(defun doc->point (doc)
|
|
|
(geo:point-deg
|
|
|
(/ (get-element "latitudeE7" doc) 1d7)
|
|
|
@@ -8,12 +12,37 @@
|
|
|
(floor (get-element "timestampMs" doc) 1000)))
|
|
|
|
|
|
(defun day-kv (date)
|
|
|
- (let* ((ts (local-time:parse-timestring date))
|
|
|
- (nd (local-time:timestamp+ ts 1 :day)))
|
|
|
+ (ts->kv (local-time:parse-timestring date))
|
|
|
+
|
|
|
+(defun ts->kv (ts)
|
|
|
+ (let ((nd (local-time:timestamp+ ts 1 :day)))
|
|
|
($between "timestampMs"
|
|
|
(* 1000 (local-time:timestamp-to-unix ts))
|
|
|
(* 1000 (local-time:timestamp-to-unix nd)))))
|
|
|
|
|
|
+(defun reverse-geocode (lat lon)
|
|
|
+ (let* ((data (yason:parse
|
|
|
+ (drakma:http-request
|
|
|
+ (format nil
|
|
|
+ "http://open.mapquestapi.com/nominatim/v1/reverse.php?format=json&lat=~A&lon=~A"
|
|
|
+ lat lon)
|
|
|
+ :want-stream t)))
|
|
|
+ (address (gethash "address" data)))
|
|
|
+ (values (gethash "display_name" data)
|
|
|
+ address)))
|
|
|
+
|
|
|
+(defun make-place-doc (ts point)
|
|
|
+ (let ((lat (geo:latitude-deg point))
|
|
|
+ (lon (geo:longitude-deg point)))
|
|
|
+ (multiple-value-bind (text address) (reverse-geocode lat lon)
|
|
|
+ (kv
|
|
|
+ (kv :ts (ts->ms ts))
|
|
|
+ (kv :type "place")
|
|
|
+ (kv :title text)
|
|
|
+ (kv :language (gethash "country_code" address))
|
|
|
+ (kv :loc (kv (kv :type "Point") ; GeoJSON Point
|
|
|
+ (kv :coordinates (list lon lat))))))))
|
|
|
+
|
|
|
(defun extract-places (docs)
|
|
|
(loop
|
|
|
for doc in docs
|
|
|
@@ -34,5 +63,18 @@
|
|
|
400))
|
|
|
collect (cons (doc->ts last-place) (doc->point last-place))
|
|
|
and do (setf need-add nil)
|
|
|
- when (not last-place) do (setf last-place doc)
|
|
|
- ))
|
|
|
+ when (not last-place) do (setf last-place doc)))
|
|
|
+
|
|
|
+(defun takedown-import (from-date)
|
|
|
+ (let ((now (local-time:now)))
|
|
|
+ (loop
|
|
|
+ for ts = (local-time:parse-timestring from-date) then (local-time:timestamp+ ts 1 :day)
|
|
|
+ for locs = (docs (db.sort "locations" (ts->kv ts) :field "timestampMs" :limit 1440))
|
|
|
+ for places = (extract-places locs)
|
|
|
+ when places do
|
|
|
+ (format t "Inserting ~A places for ~A~%" (length places) ts)
|
|
|
+ (loop
|
|
|
+ for place in places
|
|
|
+ do (db.insert "events" (make-place-doc (car place) (cdr place))))
|
|
|
+ until (local-time:timestamp> ts now)
|
|
|
+ finally (return ts))))
|