From cec817b03a32fab7f7282ca4822f8093f8b6d4d6 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Fri, 21 Jun 2024 11:20:35 +0200
Subject: [PATCH] use add-config for web server and client; +env-override; +
 fixes

---
 config.lisp               | 16 ++++++++++------
 core/core.lisp            |  7 ++++---
 test/etc/config-core.lisp |  2 +-
 test/etc/config-web.lisp  |  9 ++++++---
 4 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/config.lisp b/config.lisp
index 0b365b3..fb765c4 100644
--- a/config.lisp
+++ b/config.lisp
@@ -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)))
diff --git a/core/core.lisp b/core/core.lisp
index 7992ae2..5805680 100644
--- a/core/core.lisp
+++ b/core/core.lisp
@@ -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)
diff --git a/test/etc/config-core.lisp b/test/etc/config-core.lisp
index 47dcba5..2de4288 100644
--- a/test/etc/config-core.lisp
+++ b/test/etc/config-core.lisp
@@ -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))
diff --git a/test/etc/config-web.lisp b/test/etc/config-web.lisp
index 781a3f3..6d59bf4 100644
--- a/test/etc/config-web.lisp
+++ b/test/etc/config-web.lisp
@@ -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))))