/ src / server / app.lisp
app.lisp
 1  (in-package :ami.server)
 2  
 3  (defparameter *current-app* nil)
 4  (defparameter *apps* (make-hash-table :test 'equal))
 5  (defparameter *apps-by-name* (make-hash-table))
 6  
 7  (defun find-app-by-name (name)
 8    (gethash name *apps-by-name*))
 9  
10  (defmacro in-app (app-name)
11    `(eval-when (:compile-toplevel :load-toplevel :execute)
12       (setq ami.server::*current-app* (ami.server::find-app-by-name ',app-name))))
13  
14  (defclass app ()
15    ((name :initarg :name :accessor name)
16     (domains :initarg :domains :accessor domains)
17     (package :initarg :package :accessor app-package)
18     (route-tree :initform '(:root "ROOT") :accessor route-tree)))
19  
20  (defmethod reset-routes ((app app))
21    (setf (route-tree app) '(:root "ROOT")))
22  
23  (defmethod print-routes ((app app))
24    (print-route-table (route-tree app)))
25  
26  (defmethod print-object ((obj app) out)
27    (print-unreadable-object (obj out :type t)
28      (format out "~a" (name obj))))
29  
30  (defmethod handle ((obj app) env)
31    `(200 (:content-type "text/plain")
32  	(,(format nil "Welcome to ~a (~a)" (name obj) (getf env :server-name)))))
33  
34  (defmacro define-app (name &key domains)
35    `(let ((instance (make-instance 'app :domains ',domains :name ',name :package *package*)))
36       (dolist (domain ',domains)
37         (setf (gethash domain ami.server::*apps*) instance)
38         (setf (gethash ',name ami.server::*apps-by-name*) instance))))
39  
40  (defun print-loaded-apps ()
41    (format t "~%Loaded apps:~%")
42    (dolist (name (alexandria:hash-table-keys *apps*))
43      (let ((app (gethash name *apps*)))
44        (format t "  + ~a ~a~%" (name app) (domains app))))
45    (format t "~%"))
46  
47  (define-app local
48    :domains ("localhost"))