git.fiddlerwoaroof.com
Raw Blame History
(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))

(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)))))))