cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

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

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

16
config.lisp
View file

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

7
core/core.lisp
View file

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

2
test/etc/config-core.lisp
View file

@ -4,5 +4,5 @@
(setf *config* (core:root-config)) (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)) (core:add-action cfg '(:test) #'check-message))

9
test/etc/config-web.lisp
View file

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