;;;; cl-scopes/util - common utilities for the scopes project (defpackage :scopes/util (:use :common-lisp) (:export #:flatten-str #:to-keyword #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string #:relative-path #:runtime-path #:system-path)) (in-package :scopes/util) ;;;; strings, symbols, keywords, ... (defun flatten-str (s &key (with " ")) (str:join with (str:lines s))) (defun to-keyword (s) (intern (string-upcase s) :keyword)) ;;;; directory and pathname utilities (defun split-filename (name) (let* ((parts (str:rsplit "." name :limit 2)) (n (car parts)) (type (cadr parts))) (when (string= n "") ; leading dot, e.g. ".env" (setf n name) (setf type nil)) (values n type))) (defun absolute-dir (path) (make-pathname :directory (list :absolute path))) (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))) (defun path-from-string (s) (uiop:parse-native-namestring (uiop:native-namestring s))) (defun check-dir (p) (probe-file (directory-namestring p))) (defun ensure-dir (p) (ensure-directories-exist (directory-namestring p)))