|
|
@@ -1,11 +1,15 @@
|
|
|
(in-package :travels)
|
|
|
|
|
|
(defun update-indexes (storage old new)
|
|
|
+ (declare (optimize (speed 3) (safety 0))
|
|
|
+ (type hash-table storage)
|
|
|
+ (type (or null list) old)
|
|
|
+ (type (or null list) 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|)))
|
|
|
+ (old-user (the (or null fixnum) (getf old :|user|)))
|
|
|
+ (new-user (the (or null fixnum) (getf new :|user|)))
|
|
|
+ (old-loc (the (or null fixnum) (getf old :|location|)))
|
|
|
+ (new-loc (the (or null fixnum) (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)))))
|
|
|
@@ -21,20 +25,30 @@
|
|
|
(setf (gethash :location-visits storage) (make-hash-table)))
|
|
|
old-loc new-loc)))))
|
|
|
|
|
|
+(defun loads (bytes)
|
|
|
+ (declare (optimize (speed 3) (safety 0))
|
|
|
+ (type (simple-array (unsigned-byte 8) (*)) bytes))
|
|
|
+ (jojo:parse (trivial-utf-8:utf-8-bytes-to-string bytes)))
|
|
|
+
|
|
|
+(defun dumps (data)
|
|
|
+ (declare (optimize (speed 3) (safety 0))
|
|
|
+ (type (or null list) data))
|
|
|
+ (trivial-utf-8:string-to-utf-8-bytes (jojo:to-json data)))
|
|
|
+
|
|
|
(defun load-data (pathname)
|
|
|
+ (declare (optimize (speed 3) (safety 0)))
|
|
|
(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)))
|
|
|
+ (let ((data (loads (zip:zipfile-entry-contents entry))))
|
|
|
(destructuring-bind (entity elements) data
|
|
|
(let ((entity-storage
|
|
|
(or (gethash entity storage)
|
|
|
(setf (gethash entity storage)
|
|
|
- (make-hash-table :size (length elements))))))
|
|
|
+ (make-hash-table :size (length (the list elements)))))))
|
|
|
(loop for item in elements
|
|
|
- do (setf (gethash (getf item :|id|) entity-storage) item)
|
|
|
+ do (setf (gethash (getf item :|id|) entity-storage)
|
|
|
+ (dumps item))
|
|
|
when (eq entity :|visits|)
|
|
|
do (update-indexes storage nil item)))))))
|
|
|
storage))
|
|
|
@@ -52,16 +66,13 @@
|
|
|
(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" :content-length 2) ("{}")))
|
|
|
-(defun 200-json (data)
|
|
|
- (declare (optimize (speed 3) (safety 0))
|
|
|
- (type list data))
|
|
|
- (let ((content (jojo:to-json data)))
|
|
|
- `(200 (:content-type "application/json"
|
|
|
- :content-length ,(trivial-utf-8:utf-8-byte-length content))
|
|
|
- (,content))))
|
|
|
+(defparameter +400+ '(400 nil #.(trivial-utf-8:string-to-utf-8-bytes "400")))
|
|
|
+(defparameter +404+ '(404 nil #.(trivial-utf-8:string-to-utf-8-bytes "404")))
|
|
|
+(defparameter +200-empty+ '(200 (:content-type "application/json")
|
|
|
+ #.(trivial-utf-8:string-to-utf-8-bytes "{}")))
|
|
|
+
|
|
|
+(defvar *200* '(200 (:content-type "application/json") content))
|
|
|
+(defun 200-json (data) (setf (caddr *200*) (dumps data)) *200*)
|
|
|
|
|
|
(defun get-entity (params)
|
|
|
(let ((id (parse-integer (getf params :id) :junk-allowed t))
|
|
|
@@ -71,62 +82,66 @@
|
|
|
((:|users| :|visits| :|locations|)
|
|
|
(let ((entity (gethash id (gethash entity *storage*))))
|
|
|
(if entity
|
|
|
- (200-json entity)
|
|
|
+ `(200 (:content-type "application/json") ,entity)
|
|
|
+404+)))
|
|
|
(otherwise +404+))
|
|
|
+404+)))
|
|
|
|
|
|
(defun validate-item (item)
|
|
|
- (declare (type list item)
|
|
|
+ (declare (type (or null list) item)
|
|
|
(optimize (speed 3) (safety 0)))
|
|
|
- (loop for (k v) on item by #'cddr
|
|
|
- unless v return nil
|
|
|
- when (and (eq k :|id|) (not (integerp v))) return nil
|
|
|
- when (and (eq k :|distance|) (not (integerp v))) return nil
|
|
|
- when (and (eq k :|visited_at|) (not (integerp v))) return nil
|
|
|
- when (and (eq k :|country|) (> (length v) 50)) return nil
|
|
|
- when (and (eq k :|city|) (> (length v) 50)) return nil
|
|
|
- when (and (eq k :|mark|) (or (not (integerp v)) (not (<= 0 (the fixnum v) 5)))) return nil
|
|
|
- when (and (eq k :|user|) (or (not (integerp v)) (not (gethash v *storage-users*)))) return nil
|
|
|
- when (and (eq k :|location|) (or (not (integerp v)) (not (gethash v *storage-locations*)))) return nil
|
|
|
- finally (return t)))
|
|
|
+ (when item
|
|
|
+ (loop for (k v) on item by #'cddr
|
|
|
+ unless v return nil
|
|
|
+ ; when (and (eq k :|id|) (not (integerp v))) return nil
|
|
|
+ ; when (and (eq k :|distance|) (not (integerp v))) return nil
|
|
|
+ ; when (and (eq k :|visited_at|) (not (integerp v))) return nil
|
|
|
+ ; when (and (eq k :|country|) (or (not (stringp v)) (> (length v) 50))) return nil
|
|
|
+ ; when (and (eq k :|city|) (or (not (stringp v)) (> (length v) 50))) return nil
|
|
|
+ ; when (and (eq k :|mark|) (or (not (integerp v)) (not (<= 0 (the fixnum v) 5)))) return nil
|
|
|
+ ; when (and (eq k :|user|) (or (not (integerp v)) (not (gethash v *storage-users*)))) return nil
|
|
|
+ ; when (and (eq k :|location|) (or (not (integerp v)) (not (gethash v *storage-locations*)))) return nil
|
|
|
+ finally (return t))))
|
|
|
|
|
|
(defun post-entity (params)
|
|
|
+ (declare (optimize (speed 3) (safety 0)))
|
|
|
(let ((id (parse-integer (getf params :id) :junk-allowed t))
|
|
|
(entity (getkey params :entity)))
|
|
|
- (if (or id (string= (getf params :id) "new"))
|
|
|
+ (if (or id (string= (the simple-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 (validate-item item)
|
|
|
- (let ((item-id (getf item :|id|)))
|
|
|
- (if id
|
|
|
- (if item-id +400+
|
|
|
- (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
|
|
|
- do (setf (getf existing k) v))
|
|
|
- +200-EMPTY+)
|
|
|
- +404+)))
|
|
|
- (let ((e (gethash item-id entity-storage)))
|
|
|
- (if e +400+
|
|
|
- (progn
|
|
|
- (when (eq entity :|visits|)
|
|
|
- (update-indexes *storage* nil item))
|
|
|
- (setf (gethash item-id entity-storage) item)
|
|
|
- +200-EMPTY+)))))
|
|
|
- +400+)))
|
|
|
- (error () +400+)))
|
|
|
- (otherwise +404+))
|
|
|
+ (let* ((body (trivial-utf-8:read-utf-8-string
|
|
|
+ (getf myway:*env* :raw-body)
|
|
|
+ :stop-at-eof t))
|
|
|
+ (item (jojo:parse (coerce body 'simple-string)))
|
|
|
+ (entity-storage (gethash entity *storage*)))
|
|
|
+ (if (validate-item item)
|
|
|
+ (let ((item-id (getf item :|id|)))
|
|
|
+ (if id
|
|
|
+ (if item-id +400+
|
|
|
+ (let ((existing-raw (gethash id entity-storage)))
|
|
|
+ (if existing-raw
|
|
|
+ (let ((existing (loads existing-raw)))
|
|
|
+ (when (eq entity :|visits|)
|
|
|
+ (update-indexes *storage* existing item))
|
|
|
+ (loop for (k v) on item by #'cddr
|
|
|
+ do (setf (getf existing k) v))
|
|
|
+ (setf (gethash id entity-storage)
|
|
|
+ (dumps existing))
|
|
|
+ +200-EMPTY+)
|
|
|
+ +404+)))
|
|
|
+ (let ((e (gethash item-id entity-storage)))
|
|
|
+ (if e +400+
|
|
|
+ (progn
|
|
|
+ (when (eq entity :|visits|)
|
|
|
+ (update-indexes *storage* nil item))
|
|
|
+ (setf (gethash item-id entity-storage)
|
|
|
+ (dumps item))
|
|
|
+ +200-EMPTY+)))))
|
|
|
+ +400+))
|
|
|
+))
|
|
|
+ (othewise +404+))
|
|
|
+400+)))
|
|
|
|
|
|
(defun aget (place indicator &key (test #'equal))
|
|
|
@@ -150,6 +165,8 @@
|
|
|
(or (not to-date) (< (getf visit :|visited_at|) to-date))))
|
|
|
|
|
|
(defun user-visits (params)
|
|
|
+ (declare (optimize (speed 3) (safety 0))
|
|
|
+ (type list params))
|
|
|
(let ((id (parse-integer (getf params :id) :junk-allowed t)))
|
|
|
(if id
|
|
|
(let ((user (gethash id *storage-users*)))
|
|
|
@@ -161,19 +178,20 @@
|
|
|
(let ((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")))
|
|
|
- (assert (or (null country) (<= (length country) 50)))
|
|
|
+ (country (the (or null string) (aget query-params "country"))))
|
|
|
+ ;; (assert (or (null country) (<= (length country) 50)))
|
|
|
;; TODO: Smarter indexes
|
|
|
(let ((user-visits (loop for v-id in user-visit-ids
|
|
|
- for visit = (gethash v-id *storage-visits*)
|
|
|
- for loc = (gethash (getf visit :|location|) *storage-locations*)
|
|
|
+ for visit = (loads (gethash v-id *storage-visits*))
|
|
|
+ for loc = (loads (gethash (getf visit :|location|) *storage-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|)))))
|
|
|
(200-json (list :|visits|
|
|
|
- (sort user-visits #'< :key (lambda (v) (getf v :|visited_at|))))))))
|
|
|
+ (sort (the list user-visits)
|
|
|
+ #'< :key (lambda (v) (getf v :|visited_at|))))))))
|
|
|
(error () +400+))
|
|
|
+404+))
|
|
|
+404+)))
|
|
|
@@ -211,6 +229,8 @@
|
|
|
(or (not to-age) (< age to-age)))))
|
|
|
|
|
|
(defun location-avg-mark (params)
|
|
|
+ (declare (optimize (speed 3) (safety 0))
|
|
|
+ (type list params))
|
|
|
(let ((id (parse-integer (getf params :id) :junk-allowed t)))
|
|
|
(if id
|
|
|
(let ((location (gethash id (gethash :|locations| *storage*))))
|
|
|
@@ -224,18 +244,21 @@
|
|
|
(now (get-unix-time))
|
|
|
(from-age (may-integer (aget query-params "fromAge")))
|
|
|
(to-age (may-integer (aget query-params "toAge")))
|
|
|
- (gender (aget query-params "gender")))
|
|
|
+ (gender (the (or null string) (aget query-params "gender"))))
|
|
|
(assert (or (null gender) (string= gender "m") (string= gender "f")))
|
|
|
- (let ((marks (loop for v-id in location-visit-ids
|
|
|
- for visit = (gethash v-id *storage-visits*)
|
|
|
- for user = (gethash (getf visit :|user|) *storage-users*)
|
|
|
- when (and visit (matching-visit visit from-date to-date))
|
|
|
- when (and user (matching-user user from-age to-age gender now))
|
|
|
- collect (getf visit :|mark|))))
|
|
|
- (200-json (list :|avg|
|
|
|
- (if marks
|
|
|
- (/ (apply #'+ marks) (length marks))
|
|
|
- 0.0))))))
|
|
|
+ (multiple-value-bind (s c)
|
|
|
+ (loop
|
|
|
+ with sum-marks of-type fixnum = 0
|
|
|
+ with count-marks of-type fixnum = 0
|
|
|
+ for v-id in location-visit-ids
|
|
|
+ for visit = (loads (gethash v-id *storage-visits*))
|
|
|
+ for user = (loads (gethash (getf visit :|user|) *storage-users*))
|
|
|
+ when (and visit (matching-visit visit from-date to-date))
|
|
|
+ when (and user (matching-user user from-age to-age gender now))
|
|
|
+ do (setf sum-marks (+ sum-marks (the fixnum (getf visit :|mark|)))
|
|
|
+ count-marks (1+ count-marks))
|
|
|
+ finally (return (values sum-marks count-marks)))
|
|
|
+ (200-json (list :|avg| (if (zerop c) 0.0 (/ s c)))))))
|
|
|
(error () +400+))
|
|
|
+404+))
|
|
|
+404+)))
|
|
|
@@ -258,6 +281,8 @@
|
|
|
(setf *storage-users* (gethash :|users| *storage*)
|
|
|
*storage-locations* (gethash :|locations| *storage*)
|
|
|
*storage-visits* (gethash :|visits| *storage*))
|
|
|
+ #+sbcl (sb-ext:gc)
|
|
|
+ (room)
|
|
|
(format t "Loaded ~A~%" data)
|
|
|
(apply #'clack:clackup
|
|
|
(myway:to-app *mapper*)
|
