PageRenderTime 167ms CodeModel.GetById 151ms app.highlight 11ms RepoModel.GetById 2ms app.codeStats 0ms

/examples/autocomplete-freebase.lisp

http://github.com/mtravers/wuwei
Lisp | 138 lines | 114 code | 20 blank | 4 comment | 0 complexity | 7f959f8753ad2378506aff05c318e1ec MD5 | raw file
  1(in-package :wu)
  2
  3;;; +++ this is having json version trouble, should replace all keywords with strings in MQL.
  4
  5(publish :path "/mql-autocomplete-simple-demo"
  6	 :content-type "text/html"
  7	 :function 'mql-autocomplete-simple-demo)
  8
  9(publish-code)
 10
 11(defun mql-autocomplete-simple-demo (req ent)
 12  (with-http-response-and-body (req ent)
 13    (html
 14     (:head
 15      (:title "Auocomplete simple demo")
 16      (javascript-includes "prototype.js" "effects.js" "controls.js" "wuwei.js")
 17      (css-includes "wuwei.css"))
 18     (:html 
 19      ((:body :id "body")
 20       (example-header #.(this-pathname))
 21       (:h3 "Autocomplete Demo")
 22       (:princ "This example shows the use of an autocomplete field, using Freebase as the backend.") :p
 23       :newline
 24       "Enter an author (eg \"Minsky\"): " :br
 25       (autocomplete-mql-field :type "/book/author"
 26			       :anchor-start? nil
 27			       :show-ids? nil
 28			       :input-options '(:size 60)
 29			       :on-selected
 30			       #'(lambda (value string id)
 31				   (declare (ignore id))
 32				   (render-update 
 33				     (:update "result" 
 34					      (html
 35					       ((:a :href (freebase-url value) :target "freebase")
 36						(:princ-safe string))
 37					       "  " (:princ-safe value)
 38					       :p
 39					       ((:table :border 1)
 40						(:tr
 41						 (:th "Book")
 42						 (:th "Pub Date")
 43						 (:th "Subjects"))
 44						(dolist (book-mql 
 45							  (cdr (assoc :works_written 
 46								      (car
 47								       (mql-read
 48									`(((:id . ,value)
 49									  (:type . "/book/author")
 50									  ("works_written" . (((:id . nil) 
 51											       ("a:name" . nil)
 52											       ("/book/written_work/date_of_first_publication" . nil)
 53											       ("/book/written_work/subjects" .
 54															      (((:id . nil) 
 55																("a:name" . nil)
 56																("optional" . t))))
 57											       )))
 58									  
 59									  )))))))
 60						  (html
 61						   (:tr
 62						    (:td ((:a href (freebase-url (cdr (assoc :id book-mql)))  :target "freebase")
 63							  (:princ-safe (cdr (assoc :|A:NAME| book-mql)))))
 64						    (:td (awhen (cdr (assoc :/BOOK/WRITTEN_WORK/DATE_OF_FIRST_PUBLICATION book-mql))
 65							   (html (:princ it))))
 66						    (:td (dolist (subject-mql (cdr (assoc :/BOOK/WRITTEN_WORK/SUBJECTS book-mql)))
 67							   (html
 68							    ((:a href (freebase-url (cdr (assoc :id subject-mql)))  :target "freebase")
 69							     (:princ-safe (cdr (assoc :|A:NAME| subject-mql)))) 
 70							    :br)))
 71						    ))))
 72					       
 73					       
 74					       ))
 75				     )))
 76       ((:div :id "result") (:i "result goes here"))
 77       (tracker)
 78       )))))
 79
 80(defun freebase-url (id)
 81  (string+ "http://www.freebase.com/view" id))
 82
 83(defun autocomplete-mql-field (&rest other &key anchor-start? type show-ids? &allow-other-keys)
 84  (apply 'auto-complete-field 
 85	 :completions-generator
 86	 #'(lambda (prefix)
 87	     (mapcar #'(lambda (item)
 88			 (cons (cdr (assoc :id item))
 89			       (if show-ids?
 90				   (string+ 
 91				    (cdr (assoc :|A:NAME| item))
 92				    (format nil " (~A)" (cdr (assoc :id item))))
 93				   (cdr (assoc :|A:NAME| item)))))
 94		     (mql-autocomplete prefix type :anchor-start? anchor-start?)))
 95	 (delete-keyword-args '(:anchor-start? :type :show-ids?) other)))
 96	 
 97
 98;;; MQL machinery
 99
100(defparameter *freebase-readservice* "https://www.googleapis.com/freebase/v1/mqlread")   ; Path to mqlread service
101
102(defvar *mql-debug* nil)
103
104(defun mql-read (q)
105  (let ((json (json:encode-json-to-string q))
106	 response)
107    (when *mql-debug*
108      (terpri)
109      (princ json))
110    (setq response
111	  ;; Behavior changed in cl-json 0.4.0, this changes it back.
112	  (let ((json:*json-identifier-name-to-lisp* #'json:simplified-camel-case-to-lisp)) 
113	    (json:decode-json-from-string 
114	     (coerce-drakma-to-string
115	      (drakma:http-request *freebase-readservice* :parameters `(("query" . ,json)))
116	     ))))
117    (aif (assocdr :error response)
118	 (error "MQL error ~A" it))
119    (when *mql-debug*
120      (terpri)
121      (print response))
122    (assocdr :result response)))
123
124;;; eg: (mql-autocomplete "Marv" "/people/person")
125(defun mql-autocomplete (prefix type &key (property "name") (anchor-start? nil) (limit 10))
126  (mql-read
127   `(((,(string+ (string property) "~=") . ,(string+ (if anchor-start? "^" "") prefix "*"))
128     ("type" . ,type)
129     ("id" . nil)
130     ("a:name" . nil)
131     ("limit" . ,limit)
132     ("sort" . "a:name")
133     ))))
134
135
136
137
138