more config simplifications with config:*root* and config:*current*

This commit is contained in:
Helmut Merz 2024-06-27 10:09:04 +02:00
parent 5278b2551c
commit df9ee430af
6 changed files with 16 additions and 19 deletions

View file

@ -24,6 +24,7 @@
;;;; config root (top-level) class with no parent
(defvar *root* nil)
(defvar *current* nil)
(defclass root (common)
((env-keys :reader env-keys
@ -79,9 +80,9 @@
(defun add (name &rest params
&key (class 'base) (parent *root*)
&allow-other-keys)
(apply #'make-instance class :parent parent :name name params))
(setf *current* (apply #'make-instance class :parent parent :name name params)))
(defun add-action (cfg pattern handler &rest params)
(defun add-action (pattern handler &rest params &key (cfg *current*))
(if params
(setf handler #'(lambda (ctx msg) (apply handler ctx msg params))))
(push (list pattern handler) (actions cfg)))

View file

@ -56,7 +56,7 @@
(when services
(gethash name services))))
(defun setup-services (cfg)
(defun setup-services (&optional (cfg config:*root*))
(setf *root* (make-instance 'context :config cfg))
(dolist (c (config:children cfg))
(add-service *root* c)))

View file

@ -4,5 +4,5 @@
(config:root)
(let ((cfg (config:add :test-receiver :setup #'setup)))
(config:add-action cfg '(:test) #'check-message))
(config:add :test-receiver :setup #'setup)
(config:add-action '(:test) #'check-message)

View file

@ -6,5 +6,3 @@
(config:root :class 'test-config)
(config:add :child :class 'child-config)
;(make-instance 'child-config :parent config:*root*)

View file

@ -4,15 +4,13 @@
(config:root :env-keys '(:address :port))
(let ((cfg (config:add :server
:class 'server:config
:port "8899"
:routes
`((("api") server:message-handler)
(() server:fileserver
:doc-root ,(t:test-path "" "docs")))))))
(config:add :server :class 'server:config
:port "8899"
:routes
`((("api") server:message-handler)
(() server:fileserver
:doc-root ,(t:test-path "" "docs"))))
(let ((cfg (config:add :client
:class 'client:config
:base-url "http://localhost:8899"
:doc-path "/" :api-path "/api/"))))
(config:add :client :class 'client:config
:base-url "http://localhost:8899"
:doc-path "/" :api-path "/api/")

View file

@ -52,7 +52,7 @@
(load (t:test-path "config-core" "etc"))
(unwind-protect
(progn
(core:setup-services config:*root*)
(core:setup-services)
(setf (receiver t:*test-suite*) (core:find-service :test-receiver))
(test-send))
(core:shutdown)