From 5253c83ed5d4d1f8e43cc289da3901738039c8f5 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Tue, 4 Jun 2024 11:16:24 +0200 Subject: [PATCH] work in progress: config processing --- config.lisp | 8 +++++++- test/.test.env | 4 ++++ test/config-sqlite.lisp | 2 +- test/etc/config-dummy.lisp | 10 ++++++++++ test/test-config.lisp | 18 ++++++++++-------- test/test-storage.lisp | 4 ++-- testing.lisp | 5 +++-- util.lisp | 17 ++++++++++++----- 8 files changed, 49 insertions(+), 19 deletions(-) create mode 100644 test/.test.env create mode 100644 test/etc/config-dummy.lisp diff --git a/config.lisp b/config.lisp index 4cb651f..3140fc5 100644 --- a/config.lisp +++ b/config.lisp @@ -11,4 +11,10 @@ (defclass base () ((override-keys :reader override-keys :initform nil - :allocation :class))) + :allocation :class) + (env-prefix :reader env-prefix + :initarg :env-prefix + :initform "SCOPES_") + (env-file :reader env-file + :initarg :env-file + :initform nil))) diff --git a/test/.test.env b/test/.test.env new file mode 100644 index 0000000..1bd864f --- /dev/null +++ b/test/.test.env @@ -0,0 +1,4 @@ +# test/.test.env - environment file for overriding config settings + +SCOPES_USER=user-from-env-file +SCOPES_PASSWORD=secret-file diff --git a/test/config-sqlite.lisp b/test/config-sqlite.lisp index 1919ae8..e0f2170 100644 --- a/test/config-sqlite.lisp +++ b/test/config-sqlite.lisp @@ -6,7 +6,7 @@ :db-type :sqlite3 :connect-args (:database-name - ,(str:concat (namestring (asdf:system-source-directory :scopes)) "test/test.db")) + ,(namestring (scopes/testing:test-path "test.db"))) :options nil)) (setf scopes/test-storage:*db-config-test* db-config-sqlite) diff --git a/test/etc/config-dummy.lisp b/test/etc/config-dummy.lisp new file mode 100644 index 0000000..546509d --- /dev/null +++ b/test/etc/config-dummy.lisp @@ -0,0 +1,10 @@ +;;;; cl-scopes/test/etc/config-dummy + +;;;; dummy configuration for config tests + +(in-package :scopes/test-config) + +(setf *config* + (make-instance 'test-config + :user "default-user" + :password "public")) diff --git a/test/test-config.lisp b/test/test-config.lisp index 4fd5c22..9692c01 100644 --- a/test/test-config.lisp +++ b/test/test-config.lisp @@ -15,22 +15,24 @@ (defvar *config* nil) (defclass test-config (config:base) - ((config:override-keys :initform '(user password)))) + ((config:override-keys :initform '(user password)) + (user :initarg :user :accessor user) + (password :initarg :password :accessor password))) (defun run () (let ((t:*test-suite* (t:test-suite "config"))) - (setf *config* (make-instance 'test-config)) + (load (t:test-path "config-dummy" "etc")) (test-make-path) (test-env-override) (t:show-result))) (t:deftest test-make-path () - (format t "~&relative-path: ~s" (util:relative-path "config" "app" "etc")) - (format t "~&system-path: ~s" (util:system-path :scopes "config" "test")) - (format t "~&test-path (config): ~s" (t:test-path :scopes "config")) - (format t "~&test-path (data): ~s" (t:test-path :scopes "test.db" "data")) + (format t "~&test-path (config): ~s" (t:test-path "config")) + (format t "~&test-path (data): ~s" (t:test-path "test.db" "data")) (format t "~&runtime-path: ~s" (util:runtime-path "config" "app" "etc")) - (format t "~&runtime-path (.env): ~s" (util:runtime-path ".env" "app"))) + (format t "~&runtime-path (.env): ~s" (util:runtime-path ".env" "app")) + (format t "~&home-path: ~s" (util:home-path ".env.txt" "development" "cco"))) (t:deftest test-env-override () - (format t "~&override-keys: ~s~%" (config:override-keys *config*))) + (format t "~&override-keys: ~s~%" (config:override-keys *config*)) + (== (user *config*) "default-user")) diff --git a/test/test-storage.lisp b/test/test-storage.lisp index 56aec6c..2aad7fa 100644 --- a/test/test-storage.lisp +++ b/test/test-storage.lisp @@ -20,13 +20,13 @@ (run-postgres)) (defun run-sqlite () - (load (t:test-path :scopes "config-sqlite")) + (load (t:test-path "config-sqlite")) (let ((storage:*db-config* *db-config-test*) (t:*test-suite* (t:test-suite "sqlite"))) (run))) (defun run-postgres () - (load (t:test-path :scopes "config-postgres")) + (load (t:test-path "config-postgres")) (let ((storage:*db-config* *db-config-test*) (t:*test-suite* (t:test-suite "postgres"))) (run))) diff --git a/testing.lisp b/testing.lisp index a946c97..b382f73 100644 --- a/testing.lisp +++ b/testing.lisp @@ -12,6 +12,7 @@ (in-package :scopes/testing) (defvar *test-suite* nil) +(defparameter *current-system* :scopes) (defclass test-suite () ((name :reader name :initform "test" :initarg :name) @@ -45,7 +46,7 @@ ;;;; utilities -(defun test-path (sys name &rest dirs) - (apply #'scopes/util:system-path sys name "test" dirs)) +(defun test-path (name &rest dirs) + (apply #'scopes/util:system-path *current-system* name "test" dirs)) diff --git a/util.lisp b/util.lisp index ed88370..6efdfa5 100644 --- a/util.lisp +++ b/util.lisp @@ -4,21 +4,28 @@ (defpackage :scopes/util (:use :common-lisp) - (:export #:relative-path #:runtime-path #:system-path)) + (:export #:home-path #:relative-path #:runtime-path #:system-path)) (in-package :scopes/util) -(defun relative-path (name &rest dirs) +(defun split-filename (name) (let* ((parts (str:rsplit "." name :limit 2)) - (n (pop parts)) - (type (car parts))) - (when (string= n "") + (n (car parts)) + (type (cadr parts))) + (when (string= n "") ; leading dot, e.g. ".env" (setf n name) (setf type nil)) + (values n type))) + +(defun relative-path (name &rest dirs) + (multiple-value-bind (n type) (split-filename name) (make-pathname :name n :type type :directory (cons :relative dirs)))) (defun runtime-path (name &rest dirs) (merge-pathnames (apply #'relative-path name dirs))) +(defun home-path (name &rest dirs) + (merge-pathnames (apply #'relative-path name dirs) (user-homedir-pathname))) + (defun system-path (sys name &rest dirs) (asdf:system-relative-pathname sys (apply #'relative-path name dirs)))