more config simplifications with config:*root* and config:*current*
This commit is contained in:
parent
5278b2551c
commit
df9ee430af
6 changed files with 16 additions and 19 deletions
|
@ -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)))
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -6,5 +6,3 @@
|
|||
|
||||
(config:root :class 'test-config)
|
||||
(config:add :child :class 'child-config)
|
||||
|
||||
;(make-instance 'child-config :parent config:*root*)
|
||||
|
|
|
@ -4,15 +4,13 @@
|
|||
|
||||
(config:root :env-keys '(:address :port))
|
||||
|
||||
(let ((cfg (config:add :server
|
||||
:class 'server:config
|
||||
(config:add :server :class 'server:config
|
||||
:port "8899"
|
||||
:routes
|
||||
`((("api") server:message-handler)
|
||||
(() server:fileserver
|
||||
:doc-root ,(t:test-path "" "docs")))))))
|
||||
:doc-root ,(t:test-path "" "docs"))))
|
||||
|
||||
(let ((cfg (config:add :client
|
||||
:class 'client:config
|
||||
(config:add :client :class 'client:config
|
||||
:base-url "http://localhost:8899"
|
||||
:doc-path "/" :api-path "/api/"))))
|
||||
:doc-path "/" :api-path "/api/")
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Add table
Reference in a new issue