allow flexible context / service setup with make-setup; + web/response improvements

This commit is contained in:
Helmut Merz 2025-05-21 10:02:44 +02:00
parent 2d59317980
commit b9fa6efc68
4 changed files with 12 additions and 11 deletions

View file

@ -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)

View file

@ -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

View file

@ -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/")

View file

@ -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))