67 lines
2 KiB
Common Lisp
67 lines
2 KiB
Common Lisp
;;;; cl-scopes/util - common utilities for the scopes project
|
|
|
|
(defpackage :scopes/util
|
|
(:use :common-lisp)
|
|
(:export #:flatten-str #:to-keyword #:to-string
|
|
#:loop-plist
|
|
#: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 (sep " "))
|
|
(str:join sep
|
|
(mapcar (lambda (x) (str:trim x))
|
|
(str:lines s))))
|
|
|
|
(defun to-string (k &key (sep " ") lower-case)
|
|
(let ((pattern (if lower-case "~(~a~)" "~a")))
|
|
(if (atom k)
|
|
(format nil pattern k)
|
|
(str:join sep (mapcar #'(lambda (s) (format nil pattern s)) k)))))
|
|
|
|
(defun to-keyword (s)
|
|
(if (string= s "")
|
|
nil
|
|
(intern (string-upcase s) :keyword)))
|
|
|
|
(defmacro loop-plist (plist kvar vvar &body body)
|
|
`(loop for (,kvar ,vvar . _) on ,plist by #'cddr ,@body))
|
|
|
|
;;;; 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)))
|