;;;; cl-scopes/util - common utilities for the scopes project

(defpackage :scopes/util
  (:use :common-lisp)
  (:export #:flatten-str #:to-keyword #:keyword-to-string #: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 keyword-to-string (k)
  (if k (string-downcase k) ""))

(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 . nil) 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)))