allow flexible context / service setup with make-setup; + web/response improvements
This commit is contained in:
parent
2d59317980
commit
b9fa6efc68
4 changed files with 12 additions and 11 deletions
|
@ -39,10 +39,6 @@
|
|||
(defgeneric start (ac)
|
||||
(:method ((ac actor)))
|
||||
(:method ((ac bg-actor))
|
||||
;(setf (task ac) (make-task ac))
|
||||
(async:start (task ac)))
|
||||
(:method ((ac fg-actor))
|
||||
;(setf (task ac) (make-task ac 'async:fg-task))
|
||||
(async:start (task ac))))
|
||||
|
||||
(defgeneric stop (ac)
|
||||
|
|
|
@ -12,9 +12,9 @@
|
|||
(:lp :lparallel)
|
||||
(:lpq :lparallel.queue))
|
||||
(:export #:action-spec #:define-actions
|
||||
#:*root* #:default-setup #:actions
|
||||
#:*root* #:default-setup #:make-setup #:actions
|
||||
#:find-service #:run-services #:setup-services #:shutdown
|
||||
#:base-context #:context #:add-action #:config #:name
|
||||
#:base-context #:context #:service #:add-action #:config #:name
|
||||
#:handle-message
|
||||
#:do-print #:echo))
|
||||
|
||||
|
@ -73,8 +73,13 @@
|
|||
|
||||
(defclass root-service (service actor:fg-actor) ())
|
||||
|
||||
(defun default-setup (cfg &optional (cls 'context) &rest args &key &allow-other-keys)
|
||||
(apply #'actor:create #'handle-message cls :config cfg :name (config:name cfg) args))
|
||||
(defun default-setup (cfg &optional (cls 'context) &rest args &key &allow-other-keys)
|
||||
(apply #'actor:create #'handle-message cls :config cfg :name (config:name cfg) args))
|
||||
|
||||
(defun make-setup (&rest args &key (class 'context) (behavior #'handle-message)
|
||||
&allow-other-keys)
|
||||
#'(lambda (cfg)
|
||||
(apply #'actor:create behavior class :config cfg :name (config:name cfg) args)))
|
||||
|
||||
(defun find-service (name &optional (parent *root*))
|
||||
(with-slots (services) parent
|
||||
|
|
|
@ -15,7 +15,7 @@
|
|||
(defvar *cookie-jar* (cl-cookie:make-cookie-jar))
|
||||
|
||||
(defclass config (config:base)
|
||||
((config:setup :initform #'core:default-setup)
|
||||
((config:setup :initform (core:make-setup :class 'core:service))
|
||||
(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/")
|
||||
|
|
|
@ -35,7 +35,7 @@
|
|||
(let ((cookie (apply #'cookie:create-from-keys cdata)))
|
||||
(cookie:make-header cookie)))
|
||||
|
||||
;;;; response definitions
|
||||
;;;; response definitions - classes and methods
|
||||
|
||||
(defvar *html-response-class* nil)
|
||||
|
||||
|
@ -46,7 +46,7 @@
|
|||
(headers :accessor headers :initform nil)
|
||||
(ctype :reader ctype :allocation :class)
|
||||
(responder :accessor responder)
|
||||
(writer :accessor writer)))
|
||||
(writer :accessor writer :initform nil)))
|
||||
|
||||
(defmethod print-object ((resp response) s)
|
||||
(shape:print-fields resp s))
|
||||
|
|
Loading…
Add table
Reference in a new issue