diff --git a/config.lisp b/config.lisp index d54c919..4cb651f 100644 --- a/config.lisp +++ b/config.lisp @@ -4,30 +4,10 @@ (defpackage :scopes/config (:use :common-lisp) - (:export #:base #:make-system-path #:override-keys - #:config-path #:file-path - #:relative-path #:runtime-path #:system-path #:test-path)) + (:export #:base #:make-system-path #:override-keys)) (in-package :scopes/config) -(defun relative-path (name &rest dirs) - (let* ((parts (str:rsplit "." name :limit 2)) - (n (pop parts)) - (type (car parts))) - (when (string= n "") - (setf n name) - (setf type nil)) - (make-pathname :name n :type type :directory (cons :relative dirs)))) - -(defun system-path (sys name &rest dirs) - (asdf:system-relative-pathname sys (apply #'relative-path name dirs))) - -(defun test-path (sys name &rest more-dirs) - (apply #'system-path sys name "test" more-dirs)) - -(defun runtime-path (name &rest dirs) - (merge-pathnames (apply #'relative-path name dirs))) - (defclass base () ((override-keys :reader override-keys :initform nil diff --git a/scopes-core.asd b/scopes-core.asd index 44dc066..f168d81 100644 --- a/scopes-core.asd +++ b/scopes-core.asd @@ -7,9 +7,10 @@ :homepage "https://www.cyberconcepts.org" :description "Core packages of the scopes project." :depends-on (:alexandria :com.inuoe.jzon :local-time :log4cl :str) - :components ((:file "config") + :components ((:file "config" :depends-on ("util")) (:file "forge/forge") - (:file "testing") + (:file "util") + (:file "testing" :depends-on ("util")) (:file "test/test-config" :depends-on ("testing" "config")) (:file "test/test-forge" :depends-on ("testing" "forge/forge"))) :long-description "scopes/core: The core packages of the scopes project." diff --git a/scopes.asd b/scopes.asd index fa79568..af98815 100644 --- a/scopes.asd +++ b/scopes.asd @@ -8,11 +8,12 @@ :description "Generic data processing." :depends-on (:alexandria :chanl :cl-dotenv :com.inuoe.jzon :dbi :local-time :log4cl :str :sxql) - :components ((:file "config") + :components ((:file "config" :depends-on ("util")) (:file "forge/forge") (:file "storage/storage") (:file "storage/tracking" :depends-on ("storage/storage")) - (:file "testing") + (:file "util") + (:file "testing" :depends-on ("util")) (:file "test/test-config" :depends-on ("testing" "config")) (:file "test/test-forge" :depends-on ("testing" "forge/forge")) (:file "test/test-storage" diff --git a/test/test-config.lisp b/test/test-config.lisp index 61ba6be..4fd5c22 100644 --- a/test/test-config.lisp +++ b/test/test-config.lisp @@ -4,7 +4,8 @@ (defpackage :scopes/test-config (:use :common-lisp) - (:local-nicknames (:config :scopes/config) + (:local-nicknames (:config :scopes/config) + (:util :scopes/util) (:t :scopes/testing)) (:export #:run) (:import-from :scopes/testing #:deftest #:==)) @@ -24,12 +25,12 @@ (t:show-result))) (t:deftest test-make-path () - (format t "~&relative-path: ~s" (config:relative-path "config" "app" "etc")) - (format t "~%system-path: ~s" (config:system-path :scopes "config" "test")) - (format t "~%test-path (config): ~s" (config:test-path :scopes "config")) - (format t "~%test-path (data): ~s" (config:test-path :scopes "test.db" "data")) - (format t "~%runtime-path: ~s" (config:runtime-path "config" "app" "etc")) - (format t "~%runtime-path (.env): ~s" (config:runtime-path ".env" "app"))) + (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 "~&runtime-path: ~s" (util:runtime-path "config" "app" "etc")) + (format t "~&runtime-path (.env): ~s" (util:runtime-path ".env" "app"))) (t:deftest test-env-override () - (format t "~%override-keys: ~s" (config:override-keys *config*))) + (format t "~&override-keys: ~s~%" (config:override-keys *config*))) diff --git a/testing.lisp b/testing.lisp index c2ac9dd..a946c97 100644 --- a/testing.lisp +++ b/testing.lisp @@ -6,7 +6,8 @@ (:use :common-lisp) (:export #:*test-suite* #:test-suite #:deftest #:show-result - #:test #:==)) + #:test #:== + #:test-path)) (in-package :scopes/testing) @@ -41,3 +42,10 @@ `(defun ,name ,args (push '(,name) (result *test-suite*)) ,@body)) + +;;;; utilities + +(defun test-path (sys name &rest dirs) + (apply #'scopes/util:system-path sys name "test" dirs)) + + diff --git a/util.lisp b/util.lisp new file mode 100644 index 0000000..ed88370 --- /dev/null +++ b/util.lisp @@ -0,0 +1,24 @@ +;;;; clscopes/util + +;;;; Common utilities for the scopes project. + +(defpackage :scopes/util + (:use :common-lisp) + (:export #:relative-path #:runtime-path #:system-path)) + +(in-package :scopes/util) + +(defun relative-path (name &rest dirs) + (let* ((parts (str:rsplit "." name :limit 2)) + (n (pop parts)) + (type (car parts))) + (when (string= n "") + (setf n name) + (setf type nil)) + (make-pathname :name n :type type :directory (cons :relative dirs)))) + +(defun runtime-path (name &rest dirs) + (merge-pathnames (apply #'relative-path name dirs))) + +(defun system-path (sys name &rest dirs) + (asdf:system-relative-pathname sys (apply #'relative-path name dirs)))