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

(defpackage :scopes/util
  (:use :common-lisp)
  (:local-nicknames (:b64 :qbase64))
  #+sbcl (:import-from :sb-ext #:add-package-local-nickname)
  (:export #:make-vars-format #:lg #:lgd #:lgi #:lgw
           #:from-unix-time #:to-unix-time
           #:rfill #:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal
           #:flatten-str #:from-keyword #:to-keyword #:to-integer #:to-string
           #:from-bytes #:to-bytes #:b64-decode #:b64-encode #:from-b64 #:to-b64
           #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
           #:relative-path #:runtime-path #:system-path
           #:add-package-local-nickname))

(in-package :scopes/util)

;;;; formatting and logging shortcuts

(defun make-vars-format (vars &optional info)
  (let ((prefix (if info (format nil "~a: " info) "")))
    (format nil "~a~{~(~a~): ~~S ~}" prefix vars)))

(defmacro lg (level info &rest vars)
  (let ((lm (find-symbol (string level) :log))
        (fm (make-vars-format vars info)))
    `(,lm ,fm ,@vars)))

(defmacro lgd (&rest vars) `(lg :debug nil ,@vars))
(defmacro lgi (&rest vars) `(lg :info nil ,@vars))
(defmacro lgw (info &rest vars) `(lg :warn ,info ,@vars))

;;;; date and time manipulations

(defconstant +unix-time-base+ (encode-universal-time 0 0 0 1 1 1970 0))

(defun from-unix-time (time)
  (when time (+ time +unix-time-base+)))

(defun to-unix-time (time)
  (when time (- time +unix-time-base+)))

;;;; lists and loops

(defun rfill (ll ls)
  (mapcar #'(lambda (x) (pop ls)) ll))

(defun rtrim (lst)
  (nreverse (member-if #'identity (reverse lst))))

(defmacro loop-plist (plist kvar vvar &body body)
  `(loop for (,kvar ,vvar . nil) on ,plist by #'cddr ,@body))

(defun filter-plist (pl keys)
  (loop-plist pl k v when (find k keys) append (list k v)))

(defun plist-pairs (pl)
  (loop-plist pl k v collect (list k v)))

(defun plist-equal (l1 l2)
  (unless (= (length l1) (length l2))
    (return-from plist-equal nil))
  (loop-plist l1 k v do
    (unless (equal (getf l2 k) v)
      (return-from plist-equal nil)))
  t)
;;;; 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-integer (k)
  (parse-integer (string k)))

(defun from-keyword (k)
  (if k (string-downcase k) ""))

(defun to-keyword (s)
  (if (string= s "")
    nil
    (intern (string-upcase s) :keyword)))

(defun from-bytes (b)
  (flexi-streams:octets-to-string b :external-format :utf8))

(defun to-bytes (s)
  (flexi-streams:string-to-octets s :external-format :utf8))

(defun b64-decode (s &key (scheme :uri))
  (let ((padding
          (case (mod (length s) 4)
            (3 "=")
            (2 "==")
            (t ""))))
    (b64:decode-string (str:concat s padding) :scheme scheme)))

(defun b64-encode (b &key (scheme :uri))
  (str:trim-right (b64:encode-bytes b :scheme scheme) :char-bag "="))

(defun from-b64 (s &key (scheme :uri))
  (from-bytes (b64-decode s :scheme scheme)))

(defun to-b64 (s &key (scheme :uri))
  (b64-encode (to-bytes s) :scheme scheme))

;;;; 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)))