1  (in-package #:ami)
 2  
 3  (defmacro input (type classes)
 4    `(:input :type ,type)) 
 5  
 6  (define-error unknown-field-type (field-type))
 7  
 8  ;; Start the application
 9  
10  (defun mito-connect-db ()
11    (mito:connect-toplevel :postgres :host "127.0.0.1" :database-name "ami_test"))
12  
13  (defun is-development ()
14    (let ((env (or (uiop:getenv "AMI_ENV") "DEV")))
15      (string= env "DEV")))
16  
17  (defparameter *ws-updates-conns* (make-hash-table :test 'equal))
18  
19  (defun trigger-update ()
20    (dolist (key (alexandria:hash-table-keys *ws-updates-conns*))
21      (let ((conn (gethash key *ws-updates-conns*)))
22        (websocket-driver:send conn "."))))
23  
24  (defun server-acceptor (env)
25    (let* ((server-name (if (is-development)
26  			  (cadr (split-sequence:split-sequence #\/ (getf env :path-info)))
27  			  (getf env :server-name)))
28  	 (original-path-info (getf env :path-info))
29  	 (path-info (if (is-development)
30  			(format nil "/~{~a/~}" (cddr (split-sequence:split-sequence #\/ (getf env :path-info))))
31  			(getf env :path-info)))
32  	 (method (getf env :request-method))
33  	 (body-params (getf env :body-parameters))
34  	 (app (gethash server-name *apps*)))
35      (if (string= original-path-info "/updates")
36  	(let ((ws (websocket-driver:make-server env))
37  	      (id (fuuid:to-string (fuuid:make-v4))))
38  	  (setf (gethash id *ws-updates-conns*) ws)
39  	  (websocket-driver:on :message ws
40  	      (lambda (message)
41  		(websocket-driver:send ws message)))
42  	  (lambda (responder)
43  	    (declare (ignore responder))
44  	    (websocket-driver:start-connection ws)))
45  	(if app
46  	    (request app method path-info body-params)
47  	    '(404 (:content-type "text/plain") ("Site doesn't exist"))))))
48  
49  (defparameter *handle* nil)
50    
51  (defun stop-app ()
52    (when *handle*
53      (clack:stop *handle*)
54      (setf *handle* nil)))
55  
56  (defun start-app ()
57    (if *handle*
58        (stop-app))
59    ;; (slynk-api:add-hook slynk-api:*pre-reply-hook* #'trigger-update)
60    (mito-connect-db)
61    (setf *handle*
62  	(clack:clackup
63  	 (lack:builder
64  	  :session
65  	  (:static :path "/static/"
66  		   :root #P"./static/")
67  	  (lambda (env)
68  	    (let ((*package* (find-package :ami)))
69  	      (server-acceptor env))))
70  	 :server :hunchentoot :port 1235)))
71