(cl:in-package :fwoar.web-lisp) (defclass web-lisp-app (ningle:) ()) (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)) (defun jb (it) (if it 'yason:true 'yason:false)) (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) (let ((package-name (substitute #\/ #\: (serapeum:assocdr :package-name params :test 'equal)))) (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) "value-bound" (jb (boundp sym)) "function-bound" (jb (fboundp sym)) "macro-bound" (jb (macro-function sym)))))))))))) (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)))))))