/examples/autocomplete-freebase.lisp
http://github.com/mtravers/wuwei · Lisp · 138 lines · 114 code · 20 blank · 4 comment · 0 complexity · 7f959f8753ad2378506aff05c318e1ec MD5 · raw file
- (in-package :wu)
- ;;; +++ this is having json version trouble, should replace all keywords with strings in MQL.
- (publish :path "/mql-autocomplete-simple-demo"
- :content-type "text/html"
- :function 'mql-autocomplete-simple-demo)
- (publish-code)
- (defun mql-autocomplete-simple-demo (req ent)
- (with-http-response-and-body (req ent)
- (html
- (:head
- (:title "Auocomplete simple demo")
- (javascript-includes "prototype.js" "effects.js" "controls.js" "wuwei.js")
- (css-includes "wuwei.css"))
- (:html
- ((:body :id "body")
- (example-header #.(this-pathname))
- (:h3 "Autocomplete Demo")
- (:princ "This example shows the use of an autocomplete field, using Freebase as the backend.") :p
- :newline
- "Enter an author (eg \"Minsky\"): " :br
- (autocomplete-mql-field :type "/book/author"
- :anchor-start? nil
- :show-ids? nil
- :input-options '(:size 60)
- :on-selected
- #'(lambda (value string id)
- (declare (ignore id))
- (render-update
- (:update "result"
- (html
- ((:a :href (freebase-url value) :target "freebase")
- (:princ-safe string))
- " " (:princ-safe value)
- :p
- ((:table :border 1)
- (:tr
- (:th "Book")
- (:th "Pub Date")
- (:th "Subjects"))
- (dolist (book-mql
- (cdr (assoc :works_written
- (car
- (mql-read
- `(((:id . ,value)
- (:type . "/book/author")
- ("works_written" . (((:id . nil)
- ("a:name" . nil)
- ("/book/written_work/date_of_first_publication" . nil)
- ("/book/written_work/subjects" .
- (((:id . nil)
- ("a:name" . nil)
- ("optional" . t))))
- )))
-
- )))))))
- (html
- (:tr
- (:td ((:a href (freebase-url (cdr (assoc :id book-mql))) :target "freebase")
- (:princ-safe (cdr (assoc :|A:NAME| book-mql)))))
- (:td (awhen (cdr (assoc :/BOOK/WRITTEN_WORK/DATE_OF_FIRST_PUBLICATION book-mql))
- (html (:princ it))))
- (:td (dolist (subject-mql (cdr (assoc :/BOOK/WRITTEN_WORK/SUBJECTS book-mql)))
- (html
- ((:a href (freebase-url (cdr (assoc :id subject-mql))) :target "freebase")
- (:princ-safe (cdr (assoc :|A:NAME| subject-mql))))
- :br)))
- ))))
-
-
- ))
- )))
- ((:div :id "result") (:i "result goes here"))
- (tracker)
- )))))
- (defun freebase-url (id)
- (string+ "http://www.freebase.com/view" id))
- (defun autocomplete-mql-field (&rest other &key anchor-start? type show-ids? &allow-other-keys)
- (apply 'auto-complete-field
- :completions-generator
- #'(lambda (prefix)
- (mapcar #'(lambda (item)
- (cons (cdr (assoc :id item))
- (if show-ids?
- (string+
- (cdr (assoc :|A:NAME| item))
- (format nil " (~A)" (cdr (assoc :id item))))
- (cdr (assoc :|A:NAME| item)))))
- (mql-autocomplete prefix type :anchor-start? anchor-start?)))
- (delete-keyword-args '(:anchor-start? :type :show-ids?) other)))
-
- ;;; MQL machinery
- (defparameter *freebase-readservice* "https://www.googleapis.com/freebase/v1/mqlread") ; Path to mqlread service
- (defvar *mql-debug* nil)
- (defun mql-read (q)
- (let ((json (json:encode-json-to-string q))
- response)
- (when *mql-debug*
- (terpri)
- (princ json))
- (setq response
- ;; Behavior changed in cl-json 0.4.0, this changes it back.
- (let ((json:*json-identifier-name-to-lisp* #'json:simplified-camel-case-to-lisp))
- (json:decode-json-from-string
- (coerce-drakma-to-string
- (drakma:http-request *freebase-readservice* :parameters `(("query" . ,json)))
- ))))
- (aif (assocdr :error response)
- (error "MQL error ~A" it))
- (when *mql-debug*
- (terpri)
- (print response))
- (assocdr :result response)))
- ;;; eg: (mql-autocomplete "Marv" "/people/person")
- (defun mql-autocomplete (prefix type &key (property "name") (anchor-start? nil) (limit 10))
- (mql-read
- `(((,(string+ (string property) "~=") . ,(string+ (if anchor-start? "^" "") prefix "*"))
- ("type" . ,type)
- ("id" . nil)
- ("a:name" . nil)
- ("limit" . ,limit)
- ("sort" . "a:name")
- ))))