use add-config for web server and client; +env-override; + fixes

This commit is contained in:
Helmut Merz 2024-06-21 11:20:35 +02:00
parent d3187747ef
commit cec817b03a
4 changed files with 21 additions and 13 deletions

View file

@ -6,8 +6,7 @@
(:use :common-lisp)
(:export #:base #:root
#:env-data #:env-keys #:env-prefix #:env-path
#:add #:children #:env-slots #:parent
#:hash-to-slots))
#:add #:children #:env-slots #:parent))
(in-package :scopes/config)
@ -57,17 +56,19 @@
:initarg :parent)))
(defmethod initialize-instance :after ((cfg base) &key parent &allow-other-keys)
(if parent
(when parent
(push cfg (children parent))
(hash-to-slots (env-data cfg) cfg (env-slots cfg))))
(env-override cfg)))
(defmethod (setf parent) ((cfg base) (parent common))
(push cfg (children parent)))
(push cfg (children parent))
(env-override cfg))
(defgeneric add (cfg child)
(:method ((cfg common) (child base))
(push child (children cfg))
(setf (parent child) cfg)))
(setf (parent child) cfg)
(env-override child)))
(defmethod env-data ((cfg base))
(env-data (parent cfg)))
@ -81,3 +82,6 @@
(val (gethash key ht)))
(if val
(setf (slot-value obj sl) val))))))
(defun env-override (cfg)
(hash-to-slots (env-data cfg) cfg (env-slots cfg)))

View file

@ -23,9 +23,10 @@
(setup :reader setup :initarg :setup :initform #'default-setup)
(actions :accessor actions :initarg :actions :initform nil)))
(defun add-config (parent name setup &rest actions)
(make-instance 'service-config :parent parent :name name :setup setup
:actions actions))
(defun add-config (parent name &rest params
&key (setup #'default-setup) (class 'service-config)
&allow-other-keys)
(apply #'make-instance class :parent parent :name name :setup setup params))
(defgeneric add-action (container pattern handler)
(:method ((cfg service-config) pattern handler)

View file

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

View file

@ -4,7 +4,10 @@
(setf *config* (core:root-config :env-keys '(:address :port)))
(make-instance 'server:config :parent *config*
:port "8899")
(let ((cfg (core:add-config *config* :server
:class 'server:config
:setup #'server:start
:port "8899"))))
(make-instance 'client:config :parent *config*)
(let ((cfg (core:add-config *config* :client
:class 'client:config))))