work in progess: use new actor implementation in web

core/core.lisp

@@ -83,8 +83,7 @@
 
 (defun setup-services (&optional (cfg config:*root*))
   (async:init)
-  (let* ((ctx (make-instance 'context :config cfg))
-         (bhv (lambda (msg) (funcall #'handle-message ctx msg)))) 
+  (let* ((ctx (make-instance 'context :config cfg))) 
     (setf (mailbox ctx) (lpq:make-queue))
     (setf *root* ctx))
   (dolist (c (reverse (config:children cfg)))
@@ -94,7 +93,9 @@
   (unwind-protect
     (progn
       (setup-services cfg)
-      (actor:start (mailbox *root*) :foreground t))
+      (actor:start (mailbox *root*) 
+                   (lambda (msg) (funcall #'handle-message *root* msg)) 
+                   :foreground t))
     (shutdown)))
  
 (defun shutdown ()

web/client.lisp

@@ -15,7 +15,7 @@
 (defvar *cookie-jar* (cl-cookie:make-cookie-jar))
 
 (defclass config (config:base)
-  ((config:setup :initform (core:make-setup :class 'core:service))
+  ((config:setup :initform (core:make-setup :class 'core:context))
    (base-url :reader base-url :initarg :base-url :initform "http://localhost:8135")
    (doc-path :reader doc-path :initarg :doc-path :initform "/")
    (api-path :reader api-path :initarg :api-path :initform "/api/")

web/response.lisp

@@ -6,6 +6,7 @@
                     (:cookie :scopes/web/cookie)
                     (:core :scopes/core)
                     (:dom :scopes/web/dom)
+                    (:lpq :lparallel.queue)
                     (:message :scopes/core/message)
                     (:shape :scopes/shape)
                     (:util :scopes/util))
@@ -71,8 +72,11 @@
 
 (defun setup (ctx env &key html-responder)
   (let* ((headers (getf env :headers))
-         (resp-class (select-response-class (gethash "accept" headers) html-responder)))
-    (actor:make-actor #'core:handle-message resp-class :context ctx :env env)))
+         (resp-class (select-response-class (gethash "accept" headers) html-responder))
+         (resp (make-instance resp-class :context ctx :env env)))
+    (setf (core:mailbox resp) (lpq:make-queue))
+    resp))
+    ;(actor:make-actor #'core:handle-message resp-class :context ctx :env env)))
 
 (defun select-response-class (accept html-responder)
   (let ((accept (string-downcase accept)))
@@ -100,7 +104,9 @@
 (defun render (resp)
   #'(lambda (responder)
       (setf (responder resp) responder)
-      (actor:start resp)))
+      (actor:start (core:mailbox resp) 
+                   (lambda (msg) (funcall #'core:handle-message resp msg))
+                   :foreground t)))
 
 (defun render-not-found(resp)
   (list 404 '(:content-type "text/plain") '("Not found")))

web/server.lisp

@@ -29,7 +29,7 @@
   ((listener :accessor listener)))
 
 (defun setup (cfg)
-  (let ((ctx (core:default-setup cfg 'context)))
+  (let ((ctx (funcall (core:make-setup :class 'context) cfg)))
     (start ctx)))
 
 ;;;; listener = server process
@@ -89,8 +89,9 @@
 
 (defun message-handler (ctx env &key html-responder)
   (let* ((resp (response:setup ctx env :html-responder html-responder))
-         (msg (message:create 
-                (head env) :data (plist (post-data env)) :customer resp)))
+         (msg (message:create (head env) 
+                              :data (plist (post-data env)) 
+                              :customer (core:mailbox resp))))
     (util:lgd msg)
     ; (check-auth ctx msg env) => (response:render-unauthorized resp)
     (if (core:handle-message ctx msg)