git.fiddlerwoaroof.com
main.lisp
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)))))))