provide env-slots on child config to control overriding settings from env

This commit is contained in:
Helmut Merz 2024-06-21 09:53:15 +02:00
parent 978c3ee8bc
commit d3187747ef
7 changed files with 14 additions and 16 deletions

View file

@ -6,7 +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 #:parent #:add #:children #:env-slots #:parent
#:hash-to-slots)) #:hash-to-slots))
(in-package :scopes/config) (in-package :scopes/config)
@ -52,12 +52,14 @@
;;;; config base class ;;;; config base class
(defclass base (common) (defclass base (common)
((parent :reader parent ((env-slots :reader env-slots :initform nil :allocation :class)
(parent :reader parent
: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 (if parent
(push cfg (children parent)))) (push cfg (children parent))
(hash-to-slots (env-data cfg) cfg (env-slots cfg))))
(defmethod (setf parent) ((cfg base) (parent common)) (defmethod (setf parent) ((cfg base) (parent common))
(push cfg (children parent))) (push cfg (children parent)))

View file

@ -15,8 +15,8 @@
(defclass config (config:root) ()) (defclass config (config:root) ())
(defun root-config () (defun root-config (&rest params)
(make-instance 'config)) (apply #'make-instance 'config params))
(defclass service-config (config:base) (defclass service-config (config:base)
((name :reader name :initarg :name) ((name :reader name :initarg :name)

View file

@ -2,8 +2,7 @@
(in-package :scopes/test-web) (in-package :scopes/test-web)
(setf *config* (setf *config* (core:root-config :env-keys '(:address :port)))
(make-instance 'config:root :env-keys '(:address :port)))
(make-instance 'server:config :parent *config* (make-instance 'server:config :parent *config*
:port "8899") :port "8899")

View file

@ -19,12 +19,10 @@
(config:env-path :initform (t:test-path ".test.env")))) (config:env-path :initform (t:test-path ".test.env"))))
(defclass child-config (config:base) (defclass child-config (config:base)
((user :accessor user :initarg :user) ((config:env-slots :initform '(user password))
(user :accessor user :initarg :user)
(password :accessor password :initarg :password))) (password :accessor password :initarg :password)))
(defmethod initialize-instance :after ((cfg child-config) &key &allow-other-keys)
(config:hash-to-slots (config:env-data cfg) cfg '(user password)))
(defun run () (defun run ()
(let ((*config* nil) (let ((*config* nil)
(t:*test-suite* (t:test-suite "config"))) (t:*test-suite* (t:test-suite "config")))

View file

@ -64,6 +64,6 @@
(msg (message:simple-message '(:test :dummy) "dummy payload")) (msg (message:simple-message '(:test :dummy) "dummy payload"))
(msg-exp (message:simple-message '(:test :dummy) "dummy payload"))) (msg-exp (message:simple-message '(:test :dummy) "dummy payload")))
(expect rcvr msg-exp) (expect rcvr msg-exp)
(== (core:name (core:config rcvr)) :test-receiver) (== (core:name rcvr) :test-receiver)
(core:send rcvr msg) (core:send rcvr msg)
)) ))

View file

@ -3,6 +3,7 @@
(defpackage :scopes/test-web (defpackage :scopes/test-web
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:config :scopes/config) (:local-nicknames (:config :scopes/config)
(:core :scopes/core)
(:client :scopes/web/client) (:client :scopes/web/client)
(:server :scopes/web/server) (:server :scopes/web/server)
(:t :scopes/testing)) (:t :scopes/testing))

View file

@ -9,12 +9,10 @@
(in-package :scopes/web/server) (in-package :scopes/web/server)
(defclass config (config:base) (defclass config (config:base)
((address :reader address :initarg :address :initform "localhost") ((config:env-slots :initform '(address port))
(address :reader address :initarg :address :initform "localhost")
(port :reader port :initarg :port :initform "8888"))) (port :reader port :initarg :port :initform "8888")))
(defmethod initialize-instance :after ((cfg config) &key &allow-other-keys)
(config:hash-to-slots (config:env-data cfg) cfg '(address port)))
;;;; listener = server process ;;;; listener = server process
(defvar *listener* nil) (defvar *listener* nil)