hierarchical config, fetch env data from root config when updating slots of child
This commit is contained in:
parent
81043d0e35
commit
27542c5c40
3 changed files with 20 additions and 9 deletions
10
config.lisp
10
config.lisp
|
@ -49,13 +49,19 @@
|
|||
((parent :reader parent
|
||||
:initarg :parent)))
|
||||
|
||||
(defmethod initialize-instance :after ((cfg base) &key parent &allow-other-keys)
|
||||
(push cfg (children parent)))
|
||||
|
||||
(defmethod (setf parent) ((cfg base) (parent common))
|
||||
(push cfg (children parent)))
|
||||
|
||||
(defgeneric add (cfg child)
|
||||
(:method ((cfg common) (child base))
|
||||
(push (children cfg) child)
|
||||
(push child (children cfg))
|
||||
(setf (parent child) cfg)))
|
||||
|
||||
(defmethod env-data ((cfg base))
|
||||
(env-data (parent (cfg))))
|
||||
(env-data (parent cfg)))
|
||||
|
||||
;;;; utility functions
|
||||
|
||||
|
|
|
@ -6,3 +6,5 @@
|
|||
|
||||
(setf *config*
|
||||
(make-instance 'test-config))
|
||||
|
||||
(make-instance 'child-config :parent *config*)
|
||||
|
|
|
@ -16,11 +16,13 @@
|
|||
|
||||
(defclass test-config (config:root)
|
||||
((config:env-keys :initform '(:user :password))
|
||||
(config:env-path :initform (t:test-path ".test.env"))
|
||||
(user :accessor user :initarg :user)
|
||||
(config:env-path :initform (t:test-path ".test.env"))))
|
||||
|
||||
(defclass child-config (config:base)
|
||||
((user :accessor user :initarg :user)
|
||||
(password :accessor password :initarg :password)))
|
||||
|
||||
(defmethod initialize-instance :after ((cfg test-config) &key &allow-other-keys)
|
||||
(defmethod initialize-instance :after ((cfg child-config) &key &allow-other-keys)
|
||||
(config:hash-to-slots (config:env-data cfg) cfg '(user password)))
|
||||
|
||||
(defun run ()
|
||||
|
@ -38,8 +40,9 @@
|
|||
(== (pathname-name (util:home-path ".env.txt" "lisp" "cl-scopes")) ".env"))
|
||||
|
||||
(t:deftest test-env-override ()
|
||||
(let ((data (config:env-data *config*)))
|
||||
(let ((data (config:env-data *config*))
|
||||
(child (car (config:children *config*))))
|
||||
(== (gethash :user data) "user-from-env-file")
|
||||
(== (gethash :password data) "very_secret")
|
||||
(== (user *config*) "user-from-env-file")
|
||||
(== (password *config*) "very_secret")))
|
||||
(== (user child) "user-from-env-file")
|
||||
(== (password child) "very_secret")))
|
||||
|
|
Loading…
Add table
Reference in a new issue