diff --git a/backend.lisp b/backend.lisp index 6b629ed..c5f7cdb 100644 --- a/backend.lisp +++ b/backend.lisp @@ -25,7 +25,10 @@ (defgeneric add-vote (backend id user value)) (defgeneric execute-search (backend term &key search-field rdf-type lex-file word-count-pt word-count-en - frame start limit sf so fl num-pages)) + frame start limit)) + +(defgeneric search-activities (backend term &key sum_votes num_votes type tags action status + doc_type provenance user start limit so sf)) ;; ES aux @@ -87,6 +90,12 @@ returns the first entry in word_en." :|votes| (:|positive| ,positive :|negative| ,negative :|total| ,total :|positive_votes| ,positive-votes :|negative_votes| ,negative-votes)))))) +(defun get-tags (str) + (mappend #'(lambda (x) + (cond ((starts-with #\# x) (list (concatenate 'string "HASH" (subseq x 1)))) + ((starts-with #\@ x) (list (concatenate 'string "AT" (subseq x 1)))))) + (cl-ppcre:split "[\\s\.\,\"\'\:\;]+" str))) + ;;; ES backend (defmethod get-synset ((backend (eql 'es)) id) @@ -129,7 +138,7 @@ returns the first entry in word_en." ("params" . ,text) ("status" . "new") ("provenance" . "web") - ;; ("tags" . (localGetTags params)) TODO + ("tags" . (get-tags params)) ("id" . ,id))))) (clesc:es/add "suggestion" "suggestion" comment :id id))) @@ -204,14 +213,15 @@ returns the first entry in word_en." ;; search (defmethod execute-search ((backend (eql 'es)) term &key search-field rdf-type lex-file word-count-pt word-count-en - frame start limit sf so fl num-pages) ;; TODO: use sf, so, fl + frame start limit) (let* ((yason:*parse-object-as* :plist) (yason:*parse-object-key-fn* #'make-keyword) - (filters (append (when rdf-type (mapcar (lambda (x) `("rdf_type" ,x)) rdf-type)) - (when lex-file (mapcar (lambda (x) `("wn30_lexicographerFile" ,x)) lex-file)) - (when word-count-pt (mapcar (lambda (x) `("word_count_pt" ,x)) word-count-pt)) - (when word-count-en (mapcar (lambda (x) `("word_count_en" ,x)) word-count-en)) - (when frame (mapcar (lambda (x) `("wn30_frame" ,x)) frame)))) + (filters (append + (when rdf-type (mapcar (lambda (x) `("rdf_type" ,x)) rdf-type)) + (when lex-file (mapcar (lambda (x) `("wn30_lexicographerFile" ,x)) lex-file)) + (when word-count-pt (mapcar (lambda (x) `("word_count_pt" ,x)) word-count-pt)) + (when word-count-en (mapcar (lambda (x) `("word_count_en" ,x)) word-count-en)) + (when frame (mapcar (lambda (x) `("wn30_frame" ,x)) frame)))) (result (clesc:es/search "wn" :text (unless (equal "all" search-field) term) :search-field (unless (equal "all" search-field) search-field) @@ -233,3 +243,41 @@ returns the first entry in word_en." buckets)) aggregations))) (values docs total facets nil))) + +(defmethod search-activities ((backend (eql 'es)) term + &key sum_votes num_votes type tags action status + doc_type provenance user start limit so sf) + (let* ((yason:*parse-object-as* :plist) + (yason:*parse-object-key-fn* #'make-keyword) + (filters (append + (when sum_votes (mapcar (lambda (x) `("sum_votes" ,x)) sum_votes)) + (when num_votes (mapcar (lambda (x) `("vote_score" ,x)) num_votes)) + (when type (mapcar (lambda (x) `("type" ,x)) type)) + (when tags (mapcar (lambda (x) `("tags" ,x)) tags)) + (when action (mapcar (lambda (x) `("action" ,x)) action)) + (when status (mapcar (lambda (x) `("status" ,x)) status)) + (when doc_type (mapcar (lambda (x) `("doc_type" ,x)) doc_type)) + (when provenance (mapcar (lambda (x) `("provenance" ,x)) provenance)) + (when user (mapcar (lambda (x) `("user" ,x)) user)))) + (sort (if (not (emptyp sf)) `((,sf ,(if (equal so "") "desc" so))) '(("date" "desc")))) + (result (clesc:es/search "suggestion" + :text term ; (unless (equal "all" search-field) term) + ; :search-field (unless (equal "all" search-field) search-field) + ; :string (if (equal "all" search-field) term) + :size limit :terms filters :from start :fields-order sort + :facets '("type" "action" "status" "doc_type" "user" + "provenance" "tags" "sum_votes" "vote_score"))) + (hits-1 (getf result :|hits|)) + (hits-2 (getf hits-1 :|hits|)) + (docs (mapcar (lambda (hit) (getf hit :|_source|)) hits-2)) + (total (getf hits-1 :|total|)) + (aggregations (getf result :|aggregations|)) + (facets (mapcar #'(lambda (buckets) + (if (listp buckets) + (mapcar (lambda (bucket) + (list :|name| (format nil "~a" (getf bucket :|key|)) + :|count| (getf bucket :|doc_count|))) + (getf buckets :|buckets|)) + buckets)) + aggregations))) + (values docs total facets nil))) diff --git a/ownpt-api.lisp b/ownpt-api.lisp index 6120156..d0f0ee6 100644 --- a/ownpt-api.lisp +++ b/ownpt-api.lisp @@ -9,6 +9,11 @@ ;; own-api aux +(defun preprocess-term (term) + (cond ((= 0 (length term)) "*:*") + ((string-equal term "*") "*:*") + (t term))) + (defun get-search-query-plist (q drilldown limit start sort-field sort-order fl) (remove nil @@ -23,7 +28,7 @@ (cons "limit" limit))) (when drilldown drilldown)))) -(defun execute-search-query (term &key drilldown limit sort-field sort-order (start 0) fl num-pages (api "search-documents")) +(defun execute-search-query (term &key drilldown limit sort-field sort-order (start 0) fl (api "search-documents")) (call-rest-method api :parameters (get-search-query-plist term drilldown limit start sort-field sort-order fl))) @@ -258,8 +263,8 @@ long to parse the stream and the stream may be cut due to timeout." (cons "key" *ownpt-api-key*)))) -(defmethod execute-search ((backend (eql 'own-api)) term &key search-field rdf-type lex-file word-count-pt word-count-en - frame start limit sf so fl num-pages) +(defmethod execute-search ((backend (eql 'own-api)) term &key search-field rdf-type lex-file word-count-pt word-count-en + frame start limit) (let* ((drilldown (make-drilldown :rdf-type rdf-type :lex-file lex-file :frame frame @@ -267,13 +272,39 @@ long to parse the stream and the stream may be cut due to timeout." :word-count-en word-count-en)) (api "search-documents") (result (execute-search-query term + :drilldown drilldown + :api api + :start start + :limit limit)) + (success (request-successful? result))) + (if success + (values + (get-docs result) + (get-num-found result) + (get-facet-fields result) + nil) + (values nil nil nil (get-error-reason result))))) + +(defmethod search-activities ((backend (eql 'own-api)) term + &key sum_votes num_votes type tags action status + doc_type provenance user start limit so sf) + (let* ((drilldown (make-drilldown-activity + :sum_votes sum_votes + :num_votes num_votes + :type type + :tag tags + :action action + :status status + :doc_type doc_type + :provenance provenance + :user user)) + (api "search-activities") + (result (execute-search-query (preprocess-term term) :drilldown drilldown :api api :start start :limit limit - :num-pages num-pages :sort-field sf - :fl fl :sort-order so)) (success (request-successful? result))) (if success @@ -283,3 +314,6 @@ long to parse the stream and the stream may be cut due to timeout." (get-facet-fields result) nil) (values nil nil nil (get-error-reason result))))) + + + diff --git a/web-service.lisp b/web-service.lisp index 191ca81..4dfeda2 100644 --- a/web-service.lisp +++ b/web-service.lisp @@ -58,11 +58,6 @@ (defun disable-caching () (hunchentoot:no-cache)) - -(defun preprocess-term (term) - (cond ((= 0 (length term)) "*:*") - ((string-equal term "*") "*:*") - (t term))) ;; (hunchentoot:define-easy-handler (get-stats-handler :uri "/wn/stats") () ;; (disable-caching) @@ -127,72 +122,72 @@ (hunchentoot:delete-session-value :ids) (process-results result))))))))) -;; (hunchentoot:define-easy-handler (search-activity-handler :uri "/wn/search-activities") -;; (term start debug sf so -;; (fq_sum_votes :parameter-type 'list) -;; (fq_num_votes :parameter-type 'list) -;; (fq_type :parameter-type 'list) -;; (fq_tag :parameter-type 'list) -;; (fq_action :parameter-type 'list) -;; (fq_status :parameter-type 'list) -;; (fq_doc_type :parameter-type 'list) -;; (fq_provenance :parameter-type 'list) -;; (fq_user :parameter-type 'list) sexp) -;; (disable-caching) -;; (multiple-value-bind -;; (documents num-found facets error) -;; (execute-search -;; (preprocess-term term) -;; :drilldown (make-drilldown-activity -;; :sum_votes fq_sum_votes -;; :num_votes fq_num_votes -;; :type fq_type -;; :tag fq_tag -;; :action fq_action -;; :status fq_status -;; :doc_type fq_doc_type -;; :provenance fq_provenance -;; :user fq_user) -;; :api "search-activities" :start start -;; :limit "25" :sf sf :so so) - -;; (let* ((start/i (if start (parse-integer start) 0)) -;; (request-uri (hunchentoot:request-uri*)) -;; (result (if error (list :error error :term term) -;; (append (get-login) -;; (list :debug debug -;; :info (get-root) -;; :term term -;; :githubid *github-client-id* -;; :login (hunchentoot:session-value :login) -;; :callbackuri (make-callback-uri request-uri) -;; :returnuri request-uri -;; :fq_type fq_type -;; :fq_num_votes fq_num_votes -;; :fq_sum_votes fq_sum_votes -;; :fq_tag fq_tag -;; :fq_action fq_action -;; :fq_status fq_status -;; :fq_doc_type fq_doc_type -;; :fq_user fq_user -;; :fq_provenance fq_provenance -;; :previous (get-previous start/i) -;; :next (get-next start/i 25) -;; :so so -;; :sf sf -;; :start start/i :numfound num-found -;; :facets facets -;; :documents documents))))) -;; (if (string-equal "yes" sexp) -;; (progn -;; (setf (hunchentoot:content-type*) "application/sexp") -;; (with-output-to-string (s) -;; (print result s))) -;; (progn -;; (setf (hunchentoot:session-value :term) term) -;; (setf (hunchentoot:content-type*) "text/html") -;; (if error (process-error (list :error error :term term)) -;; (cl-wnbrowser.templates:activities result))))))) +(hunchentoot:define-easy-handler (search-activity-handler :uri "/wn/search-activities") + (term start debug sf so + (fq_sum_votes :parameter-type 'list) + (fq_num_votes :parameter-type 'list) + (fq_type :parameter-type 'list) + (fq_tag :parameter-type 'list) + (fq_action :parameter-type 'list) + (fq_status :parameter-type 'list) + (fq_doc_type :parameter-type 'list) + (fq_provenance :parameter-type 'list) + (fq_user :parameter-type 'list) sexp) + (disable-caching) + (multiple-value-bind + (documents num-found facets error) + (search-activities + *backend* + term + :sum_votes fq_sum_votes + :num_votes fq_num_votes + :type fq_type + :tags fq_tag + :action fq_action + :status fq_status + :doc_type fq_doc_type + :provenance fq_provenance + :user fq_user + :start start + :limit "25" :sf sf :so so) + + (let* ((start/i (if start (parse-integer start) 0)) + (request-uri (hunchentoot:request-uri*)) + (result (if error (list :error error :term term) + (append (get-login) + (list :debug debug + :info (get-root) + :term term + :githubid *github-client-id* + :login (hunchentoot:session-value :login) + :callbackuri (make-callback-uri request-uri) + :returnuri request-uri + :fq_type fq_type + :fq_num_votes fq_num_votes + :fq_sum_votes fq_sum_votes + :fq_tag fq_tag + :fq_action fq_action + :fq_status fq_status + :fq_doc_type fq_doc_type + :fq_user fq_user + :fq_provenance fq_provenance + :previous (get-previous start/i) + :next (get-next start/i 25) + :so so + :sf sf + :start start/i :numfound num-found + :facets facets + :documents documents))))) + (if (string-equal "yes" sexp) + (progn + (setf (hunchentoot:content-type*) "application/sexp") + (with-output-to-string (s) + (print result s))) + (progn + (setf (hunchentoot:session-value :term) term) + (setf (hunchentoot:content-type*) "text/html") + (if error (process-error (list :error error :term term)) + (cl-wnbrowser.templates:activities result))))))) (hunchentoot:define-easy-handler (get-synset-handler :uri "/wn/synset") (id debug sexp)