|
@@ -0,0 +1,164 @@
|
|
|
|
|
+(in-package :travels)
|
|
|
|
|
+
|
|
|
|
|
+(defun update-indexes (storage old new)
|
|
|
|
|
+ (let ((id (or (getf old :|id|) (getf new :|id|)))
|
|
|
|
|
+ (old-user (getf old :|user|))
|
|
|
|
|
+ (new-user (getf new :|user|))
|
|
|
|
|
+ (old-loc (getf old :|location|))
|
|
|
|
|
+ (new-loc (getf new :|location|)))
|
|
|
|
|
+ (labels ((update (s o n)
|
|
|
|
|
+ (when o (setf (gethash o s) (remove id (gethash o s))))
|
|
|
|
|
+ (when n (push id (gethash n s)))))
|
|
|
|
|
+ (when (or (null new)
|
|
|
|
|
+ (null old)
|
|
|
|
|
+ (and new-user (not (= old-user new-user))))
|
|
|
|
|
+ (update (or (gethash :user-visits storage)
|
|
|
|
|
+ (setf (gethash :user-visits storage) (make-hash-table)))
|
|
|
|
|
+ old-user new-user))
|
|
|
|
|
+ (when (or (null new) (null old)
|
|
|
|
|
+ (and new-loc (not (= old-loc new-loc))))
|
|
|
|
|
+ (update (or (gethash :location-visits storage)
|
|
|
|
|
+ (setf (gethash :location-visits storage) (make-hash-table)))
|
|
|
|
|
+ old-loc new-loc)))))
|
|
|
|
|
+
|
|
|
|
|
+(defun load-data (pathname)
|
|
|
|
|
+ (let ((storage (make-hash-table)))
|
|
|
|
|
+ (zip:with-zipfile (zip pathname)
|
|
|
|
|
+ (zip:do-zipfile-entries (name entry zip)
|
|
|
|
|
+ (let ((data (jojo:parse
|
|
|
|
|
+ (flex:octets-to-string (zip:zipfile-entry-contents entry) :external-format :utf-8)
|
|
|
|
|
+ :as :plist)))
|
|
|
|
|
+ (destructuring-bind (entity elements) data
|
|
|
|
|
+ (let ((entity-storage
|
|
|
|
|
+ (or (gethash entity storage)
|
|
|
|
|
+ (setf (gethash entity storage)
|
|
|
|
|
+ (make-hash-table :size (length elements))))))
|
|
|
|
|
+ (loop for item in elements
|
|
|
|
|
+ do (setf (gethash (getf item :|id|) entity-storage) item)
|
|
|
|
|
+ when (eq entity :|visits|)
|
|
|
|
|
+ do (update-indexes storage nil item)))))))
|
|
|
|
|
+ storage))
|
|
|
|
|
+
|
|
|
|
|
+(defvar *storage* nil "data store")
|
|
|
|
|
+
|
|
|
|
|
+(let ((keyword-package (find-package :keyword)))
|
|
|
|
|
+ (defun getkey (place indicator)
|
|
|
|
|
+ (declare
|
|
|
|
|
+ (optimize (speed 3) (safety 0))
|
|
|
|
|
+ (type list place)
|
|
|
|
|
+ (type symbol indicator))
|
|
|
|
|
+ (intern (getf place indicator) keyword-package)))
|
|
|
|
|
+
|
|
|
|
|
+(defparameter +400+ '(400 nil nil))
|
|
|
|
|
+(defparameter +404+ '(404 nil nil))
|
|
|
|
|
+(defparameter +200-empty+ '(200 (:content-type "application/json") ("{}")))
|
|
|
|
|
+
|
|
|
|
|
+(defun get-entity (params)
|
|
|
|
|
+ (let ((id (parse-integer (getf params :id) :junk-allowed t))
|
|
|
|
|
+ (entity (getkey params :entity)))
|
|
|
|
|
+ (if id
|
|
|
|
|
+ (case entity
|
|
|
|
|
+ ((:|users| :|visits| :|locations|)
|
|
|
|
|
+ (let ((entity (gethash id (gethash entity *storage*))))
|
|
|
|
|
+ (if entity
|
|
|
|
|
+ `(200 (:content-type "application/json") (,(jojo:to-json entity)))
|
|
|
|
|
+ +404+)))
|
|
|
|
|
+ (otherwise +404+))
|
|
|
|
|
+ +400+)))
|
|
|
|
|
+
|
|
|
|
|
+(defun post-entity (params)
|
|
|
|
|
+ (let ((id (parse-integer (getf params :id) :junk-allowed t))
|
|
|
|
|
+ (entity (getkey params :entity)))
|
|
|
|
|
+ (if (or id (string= (getf params :id) "new"))
|
|
|
|
|
+ (case entity
|
|
|
|
|
+ ((:|users| :|visits| :|locations|)
|
|
|
|
|
+ (handler-case
|
|
|
|
|
+ (let ((body (make-string (getf myway:*env* :content-length))))
|
|
|
|
|
+ (read-sequence body (flex:make-flexi-stream
|
|
|
|
|
+ (getf myway:*env* :raw-body)
|
|
|
|
|
+ :external-format :utf8))
|
|
|
|
|
+ (let ((item (jojo:parse body))
|
|
|
|
|
+ (entity-storage (gethash entity *storage*)))
|
|
|
|
|
+ (if id
|
|
|
|
|
+ (let ((existing (gethash id entity-storage)))
|
|
|
|
|
+ (if existing
|
|
|
|
|
+ (progn
|
|
|
|
|
+ (when (eq entity :|visits|)
|
|
|
|
|
+ (update-indexes *storage* existing item))
|
|
|
|
|
+ (loop for (k v) on item by #'cddr
|
|
|
|
|
+ unless (eq k :|id|)
|
|
|
|
|
+ do (setf (getf existing k) v))
|
|
|
|
|
+ +200-EMPTY+)
|
|
|
|
|
+ +404+))
|
|
|
|
|
+ (progn
|
|
|
|
|
+ (when (eq entity :|visits|)
|
|
|
|
|
+ (update-indexes *storage* nil item))
|
|
|
|
|
+ (setf (gethash (getf item :|id|) entity-storage) item)
|
|
|
|
|
+ +200-EMPTY+))))
|
|
|
|
|
+ (error () +400+)))
|
|
|
|
|
+ (otherwise +404+))
|
|
|
|
|
+ +400+)))
|
|
|
|
|
+
|
|
|
|
|
+(defun aget (place indicator &key (test #'equal))
|
|
|
|
|
+ (declare (type list place)
|
|
|
|
|
+ (type (or string symbol) indicator)
|
|
|
|
|
+ (type function test)
|
|
|
|
|
+ (optimize (speed 3) (safety 0)))
|
|
|
|
|
+ (cdr (assoc indicator place :test test)))
|
|
|
|
|
+
|
|
|
|
|
+(defun may-integer (string)
|
|
|
|
|
+ (declare (type (or null string) string))
|
|
|
|
|
+ (when string
|
|
|
|
|
+ (parse-integer string)))
|
|
|
|
|
+
|
|
|
|
|
+(defun matching-location (location country to-distance)
|
|
|
|
|
+ (and (or (not country) (equal (getf location :|country|) country))
|
|
|
|
|
+ (or (not to-distance) (< (getf location :|distance|) to-distance))))
|
|
|
|
|
+
|
|
|
|
|
+(defun matching-visit (visit from-date to-date)
|
|
|
|
|
+ (and (or (not from-date) (> (getf visit :|visited_at|) from-date))
|
|
|
|
|
+ (or (not to-date) (< (getf visit :|visited_at|) to-date))))
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+(defun user-visits (params)
|
|
|
|
|
+ (let ((id (parse-integer (getf params :id) :junk-allowed t)))
|
|
|
|
|
+ (if id
|
|
|
|
|
+ (let ((user (gethash id (gethash :|users| *storage*))))
|
|
|
|
|
+ (if user
|
|
|
|
|
+ (handler-case
|
|
|
|
|
+ (let* ((user-visit-ids (gethash id (gethash :user-visits *storage*)))
|
|
|
|
|
+ (locations (gethash :|locations| *storage*))
|
|
|
|
|
+ (visits (gethash :|visits| *storage*))
|
|
|
|
|
+ (query-string (getf myway:*env* :query-string))
|
|
|
|
|
+ (query-params (and query-string (quri:url-decode-params query-string)))
|
|
|
|
|
+ (from-date (may-integer (aget query-params "fromDate")))
|
|
|
|
|
+ (to-date (may-integer (aget query-params "toDate")))
|
|
|
|
|
+ (to-distance (may-integer (aget query-params "toDistance")))
|
|
|
|
|
+ (country (aget query-params "country"))
|
|
|
|
|
+ (user-visits (loop for v-id in user-visit-ids
|
|
|
|
|
+ for visit = (gethash v-id visits)
|
|
|
|
|
+ for loc = (gethash (getf visit :|location|) locations)
|
|
|
|
|
+ when (and visit (matching-visit visit from-date to-date))
|
|
|
|
|
+ when (and loc (matching-location loc country to-distance))
|
|
|
|
|
+ collect (list :|mark| (getf visit :|mark|)
|
|
|
|
|
+ :|visited_at| (getf visit :|visited_at|)
|
|
|
|
|
+ :|place| (getf loc :|place|)
|
|
|
|
|
+ :|loc| loc))))
|
|
|
|
|
+ (sort user-visits #'< :key (lambda (v) (getf v :|visited_at|)))
|
|
|
|
|
+ `(200 (:content-type "application/json") (,(jojo:to-json (list :|visits| user-visits)))))
|
|
|
|
|
+ (error () +400+))
|
|
|
|
|
+ +404+))
|
|
|
|
|
+ +400+)))
|
|
|
|
|
+
|
|
|
|
|
+(defvar *mapper* (myway:make-mapper))
|
|
|
|
|
+(myway:connect *mapper* "/:entity/:id" 'post-entity :method :post)
|
|
|
|
|
+(myway:connect *mapper* "/:entity/:id" 'get-entity)
|
|
|
|
|
+(myway:connect *mapper* "/users/:id/visits" 'user-visits)
|
|
|
|
|
+
|
|
|
|
|
+(defun main ()
|
|
|
|
|
+ (setf *storage* (load-data "data.zip"))
|
|
|
|
|
+ (clack:clackup (myway:to-app *mapper*)
|
|
|
|
|
+ :server :woo
|
|
|
|
|
+ :debug t
|
|
|
|
|
+ :use-default-middlewares nil
|
|
|
|
|
+ :use-thread nil))
|
