get rid of env-slots and env-override 'magic'
This commit is contained in:
parent
8555d1740b
commit
a671982cc5
7 changed files with 31 additions and 34 deletions
|
@ -9,11 +9,11 @@
|
||||||
:console nil)
|
:console nil)
|
||||||
|
|
||||||
(config:add :server :class 'server:config
|
(config:add :server :class 'server:config
|
||||||
:port "8800"
|
:port (config:from-env :port "8800")
|
||||||
:address "0.0.0.0"
|
:address (config:from-env :address "0.0.0.0")
|
||||||
:routes
|
:routes
|
||||||
`((("hx") server:message-handler :html-responder cs-hx:response)
|
`((("hx") server:message-handler :html-responder cs-hx:response)
|
||||||
(() server:fileserver :doc-root
|
(() server:fileserver :doc-root
|
||||||
,(config:path "/var/www/html/" :env-key :docroot))))
|
,(util:path-from-string (config:from-env :docroot "/var/www/html/")))))
|
||||||
(config:add-action '(:test :data) #'core:echo)
|
(config:add-action '(:test :data) #'core:echo)
|
||||||
(config:add-action '(:auth :login) #'core:echo)
|
(config:add-action '(:auth :login) #'core:echo)
|
||||||
|
|
31
config.lisp
31
config.lisp
|
@ -6,8 +6,8 @@
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:local-nicknames (:util :scopes/util))
|
(:local-nicknames (:util :scopes/util))
|
||||||
(:export #:base #:root #:*root* #:*current*
|
(:export #:base #:root #:*root* #:*current*
|
||||||
#:env-data #:env-keys #:env-prefix #:env-path #:from-env #:path
|
#:env-data #:env-keys #:env-prefix #:env-path #:from-env
|
||||||
#:actions #:add #:add-action #:add-actions #:children #:env-slots
|
#:actions #:add #:add-action #:add-actions #:children
|
||||||
#:name #:setup #:parent #:shutdown))
|
#:name #:setup #:parent #:shutdown))
|
||||||
|
|
||||||
(in-package :scopes/config)
|
(in-package :scopes/config)
|
||||||
|
@ -28,17 +28,10 @@
|
||||||
(defvar *current* nil)
|
(defvar *current* nil)
|
||||||
|
|
||||||
(defclass root (common)
|
(defclass root (common)
|
||||||
((env-keys :reader env-keys
|
((env-keys :reader env-keys :initarg :env-keys :initform nil)
|
||||||
:initarg :env-keys
|
(env-prefix :reader env-prefix :initarg :env-prefix :initform "SCOPES_")
|
||||||
:initform nil)
|
(env-path :reader env-path :initarg :env-path :initform nil)
|
||||||
(env-prefix :reader env-prefix
|
(env-data :accessor env-data :initform (make-hash-table))))
|
||||||
:initarg :env-prefix
|
|
||||||
:initform "SCOPES_")
|
|
||||||
(env-path :reader env-path
|
|
||||||
:initarg :env-path
|
|
||||||
:initform nil)
|
|
||||||
(env-data :accessor env-data
|
|
||||||
:initform (make-hash-table))))
|
|
||||||
|
|
||||||
(defmethod initialize-instance :after ((cfg root) &key &allow-other-keys)
|
(defmethod initialize-instance :after ((cfg root) &key &allow-other-keys)
|
||||||
(let* ((data (env-data cfg))
|
(let* ((data (env-data cfg))
|
||||||
|
@ -61,8 +54,7 @@
|
||||||
;;;; config base class
|
;;;; config base class
|
||||||
|
|
||||||
(defclass base (common)
|
(defclass base (common)
|
||||||
((env-slots :reader env-slots :initform nil :allocation :class)
|
((name :reader name :initarg :name)
|
||||||
(name :reader name :initarg :name)
|
|
||||||
(parent :accessor parent :initarg :parent)
|
(parent :accessor parent :initarg :parent)
|
||||||
(setup :reader setup :initarg :setup :initform #'(lambda (cfg)))
|
(setup :reader setup :initarg :setup :initform #'(lambda (cfg)))
|
||||||
(shutdown :reader shutdown :initarg :shutdown :initform #'(lambda (ctx)))
|
(shutdown :reader shutdown :initarg :shutdown :initform #'(lambda (ctx)))
|
||||||
|
@ -70,8 +62,7 @@
|
||||||
|
|
||||||
(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))))
|
||||||
(env-override cfg))
|
|
||||||
|
|
||||||
(defmethod (setf parent) ((cfg base) (parent common))
|
(defmethod (setf parent) ((cfg base) (parent common))
|
||||||
(setf (parent cfg) parent)
|
(setf (parent cfg) parent)
|
||||||
|
@ -96,9 +87,6 @@
|
||||||
(defun from-env (key &optional (default ""))
|
(defun from-env (key &optional (default ""))
|
||||||
(or (gethash key (env-data *root*)) default))
|
(or (gethash key (env-data *root*)) default))
|
||||||
|
|
||||||
(defun path (s &key env-key)
|
|
||||||
(util:path-from-string (from-env env-key s)))
|
|
||||||
|
|
||||||
(defun hash-to-slots (ht obj slots)
|
(defun hash-to-slots (ht obj slots)
|
||||||
(if ht
|
(if ht
|
||||||
(dolist (sl slots)
|
(dolist (sl slots)
|
||||||
|
@ -106,6 +94,3 @@
|
||||||
(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 *root*) cfg (env-slots cfg)))
|
|
||||||
|
|
|
@ -1,4 +1,6 @@
|
||||||
# test/.test.env - environment file for overriding config settings
|
# test/.test.env - environment file for overriding config settings
|
||||||
|
|
||||||
SCOPES_USER=user-from-env-file
|
SCOPES_USER=user-from-env-file
|
||||||
SCOPES_PASSWORD=secret-file
|
SCOPES_PASSWORD=secret-from-env-file
|
||||||
|
|
||||||
|
SCOPES_DOCROOT=/var/www/html
|
||||||
|
|
|
@ -5,9 +5,12 @@
|
||||||
(in-package :scopes/test-config)
|
(in-package :scopes/test-config)
|
||||||
|
|
||||||
(config:root
|
(config:root
|
||||||
:env-keys '(:user :password)
|
:env-keys '(:user :password :address :port)
|
||||||
:env-path (t:test-path ".test.env"))
|
:env-path (t:test-path ".test.env"))
|
||||||
|
|
||||||
(config:add :child :class 'child-config
|
(config:add :child :class 'child-config
|
||||||
:user (config:from-env :user)
|
:user (config:from-env :user)
|
||||||
:password (config:from-env :password))
|
:password (config:from-env :password)
|
||||||
|
:address (config:from-env :address)
|
||||||
|
:port (config:from-env :port "8199")
|
||||||
|
:docroot (config:from-env :docroot))
|
||||||
|
|
|
@ -12,7 +12,7 @@
|
||||||
|
|
||||||
(config:add :server
|
(config:add :server
|
||||||
:class 'server:config
|
:class 'server:config
|
||||||
:port "8899"
|
:port (config:from-env :port "8899")
|
||||||
:routes
|
:routes
|
||||||
`((("hx") server:message-handler :html-responder cs-hx:response)
|
`((("hx") server:message-handler :html-responder cs-hx:response)
|
||||||
(() server:fileserver
|
(() server:fileserver
|
||||||
|
|
|
@ -14,7 +14,10 @@
|
||||||
|
|
||||||
(defclass child-config (config:base)
|
(defclass child-config (config:base)
|
||||||
((user :accessor user :initarg :user)
|
((user :accessor user :initarg :user)
|
||||||
(password :accessor password :initarg :password)))
|
(password :accessor password :initarg :password)
|
||||||
|
(address :accessor address :initarg :address)
|
||||||
|
(port :accessor port :initarg :port)
|
||||||
|
(docroot :accessor docroot :initarg :docroot)))
|
||||||
|
|
||||||
(defun run ()
|
(defun run ()
|
||||||
(let ((t:*test-suite* (t:test-suite "config")))
|
(let ((t:*test-suite* (t:test-suite "config")))
|
||||||
|
@ -34,5 +37,10 @@
|
||||||
(child (car (config:children config:*root*))))
|
(child (car (config:children config:*root*))))
|
||||||
(== (gethash :user data) "user-from-env-file")
|
(== (gethash :user data) "user-from-env-file")
|
||||||
(== (gethash :password data) "very_secret")
|
(== (gethash :password data) "very_secret")
|
||||||
|
(== (gethash :address data) nil)
|
||||||
|
(== (gethash :docroot data) nil)
|
||||||
(== (user child) "user-from-env-file")
|
(== (user child) "user-from-env-file")
|
||||||
(== (password child) "very_secret")))
|
(== (password child) "very_secret")
|
||||||
|
(== (address child) "")
|
||||||
|
(== (port child) "8199")
|
||||||
|
(== (docroot child) "")))
|
||||||
|
|
|
@ -17,8 +17,7 @@
|
||||||
(in-package :scopes/web/server)
|
(in-package :scopes/web/server)
|
||||||
|
|
||||||
(defclass config (config:base)
|
(defclass config (config:base)
|
||||||
((config:env-slots :initform '(address port))
|
((config:setup :initform #'setup)
|
||||||
(config:setup :initform #'setup)
|
|
||||||
(config:shutdown :initform #'stop)
|
(config:shutdown :initform #'stop)
|
||||||
(address :reader address :initarg :address :initform "localhost")
|
(address :reader address :initarg :address :initform "localhost")
|
||||||
(port :reader port :initarg :port :initform "8888")
|
(port :reader port :initarg :port :initform "8888")
|
||||||
|
|
Loading…
Add table
Reference in a new issue