;;;; cl-scopes/config ;;;; Utilities for configuration of scopes services. (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)) (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 :allocation :class)))