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