work in progress: config processing

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)))

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

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)

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"))

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"))

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)))

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))
 
 

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)))