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)
|
(defgeneric start (ac)
|
||||||
(:method ((ac actor)))
|
(:method ((ac actor)))
|
||||||
(:method ((ac bg-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))))
|
(async:start (task ac))))
|
||||||
|
|
||||||
(defgeneric stop (ac)
|
(defgeneric stop (ac)
|
||||||
|
|
|
@ -12,9 +12,9 @@
|
||||||
(:lp :lparallel)
|
(:lp :lparallel)
|
||||||
(:lpq :lparallel.queue))
|
(:lpq :lparallel.queue))
|
||||||
(:export #:action-spec #:define-actions
|
(:export #:action-spec #:define-actions
|
||||||
#:*root* #:default-setup #:actions
|
#:*root* #:default-setup #:make-setup #:actions
|
||||||
#:find-service #:run-services #:setup-services #:shutdown
|
#:find-service #:run-services #:setup-services #:shutdown
|
||||||
#:base-context #:context #:add-action #:config #:name
|
#:base-context #:context #:service #:add-action #:config #:name
|
||||||
#:handle-message
|
#:handle-message
|
||||||
#:do-print #:echo))
|
#:do-print #:echo))
|
||||||
|
|
||||||
|
@ -73,9 +73,14 @@
|
||||||
|
|
||||||
(defclass root-service (service actor:fg-actor) ())
|
(defclass root-service (service actor:fg-actor) ())
|
||||||
|
|
||||||
(defun default-setup (cfg &optional (cls 'context) &rest args &key &allow-other-keys)
|
(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))
|
(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*))
|
(defun find-service (name &optional (parent *root*))
|
||||||
(with-slots (services) parent
|
(with-slots (services) parent
|
||||||
(when services
|
(when services
|
||||||
|
|
|
@ -15,7 +15,7 @@
|
||||||
(defvar *cookie-jar* (cl-cookie:make-cookie-jar))
|
(defvar *cookie-jar* (cl-cookie:make-cookie-jar))
|
||||||
|
|
||||||
(defclass config (config:base)
|
(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")
|
(base-url :reader base-url :initarg :base-url :initform "http://localhost:8135")
|
||||||
(doc-path :reader doc-path :initarg :doc-path :initform "/")
|
(doc-path :reader doc-path :initarg :doc-path :initform "/")
|
||||||
(api-path :reader api-path :initarg :api-path :initform "/api/")
|
(api-path :reader api-path :initarg :api-path :initform "/api/")
|
||||||
|
|
|
@ -35,7 +35,7 @@
|
||||||
(let ((cookie (apply #'cookie:create-from-keys cdata)))
|
(let ((cookie (apply #'cookie:create-from-keys cdata)))
|
||||||
(cookie:make-header cookie)))
|
(cookie:make-header cookie)))
|
||||||
|
|
||||||
;;;; response definitions
|
;;;; response definitions - classes and methods
|
||||||
|
|
||||||
(defvar *html-response-class* nil)
|
(defvar *html-response-class* nil)
|
||||||
|
|
||||||
|
@ -46,7 +46,7 @@
|
||||||
(headers :accessor headers :initform nil)
|
(headers :accessor headers :initform nil)
|
||||||
(ctype :reader ctype :allocation :class)
|
(ctype :reader ctype :allocation :class)
|
||||||
(responder :accessor responder)
|
(responder :accessor responder)
|
||||||
(writer :accessor writer)))
|
(writer :accessor writer :initform nil)))
|
||||||
|
|
||||||
(defmethod print-object ((resp response) s)
|
(defmethod print-object ((resp response) s)
|
||||||
(shape:print-fields resp s))
|
(shape:print-fields resp s))
|
||||||
|
|
Loading…
Add table
Reference in a new issue