a5523e32 |
(cl:in-package :fwoar.web-lisp)
(defclass web-lisp-app (ningle:<app>)
())
(defun string-return (s)
`(200 () (,s)))
(defmacro with-json-string ((s &rest args &key indent) &body body)
"Set up a JSON streaming encoder context, then evaluate BODY.
Return a string with the generated JSON output."
(declare (ignore indent))
`(with-output-to-string (,s)
(with-open-stream (,s (yason:make-json-output-stream s ,@args))
,@body)))
(deftype simple-json-type ()
'(or
(member yason:true yason:false t)
real string null))
(deftype compound-json-type ()
'(or
(array *)
list
hash-table))
(deftype json-type ()
'(or simple-json-type compound-json-type))
(defun encodable (it)
(typep it
'json-type))
|
d83dc2bd |
(defun jb (it)
(if it
'yason:true
'yason:false))
|
a5523e32 |
(defmethod araneus:routes progn ((app web-lisp-app))
(setf (ningle:route app "/systems" :method :get)
(lambda (params)
(declare (ignore params))
(string-return
(with-json-string (s :indent t)
(yason:encode (asdf:registered-systems)
s))))
(ningle:route app "/packages" :method :get)
(lambda (params)
(declare (ignore params))
(string-return
(with-json-string (s :indent t)
(yason:encode (mapcar 'package-name
(list-all-packages))
s))))
(ningle:route app "/packages/:package-name" :method :get)
(lambda (params)
|
d83dc2bd |
(let ((package-name (substitute #\/ #\:
(serapeum:assocdr :package-name params
:test 'equal))))
|
a5523e32 |
(string-return
(yason:with-output-to-string* (:indent t)
(yason:with-object ()
(yason:encode-object-element "package" package-name)
(yason:with-object-element ("symbols")
(yason:with-array ()
(do-external-symbols (sym package-name)
(yason:with-object ()
(yason:encode-object-elements
"name" (symbol-name sym)
|
d83dc2bd |
"value-bound" (jb (boundp sym))
"function-bound" (jb (fboundp sym))
"macro-bound" (jb (macro-function sym))))))))))))
|
a5523e32 |
(ningle:route app "/packages/:package-name/describe/:symbol-name" :method :get)
(lambda (params)
(let ((package-name (serapeum:assocdr :package-name params
:test 'equal))
(symbol-name (serapeum:assocdr :symbol-name params
:test 'equal)))
(string-return
(with-output-to-string (s)
(describe (find-symbol symbol-name package-name)
s)))))))
|