;;;; utilities.lisp

(in-package #:vampire)

(let ((host (uiop:hostname))
      (count 0))
  (defun nuid ()
    "Generates a Nearly Universal ID"
    (format nil "~36r"
            (sxhash
             (list
              (incf count)
              host
              (get-universal-time))))))

(defun hash-string (plaintext salt)
  "Hash plaintext using SALT"
  (flexi-streams:octets-to-string 
   (ironclad:digest-sequence
    :sha3
    (flexi-streams:string-to-octets (concatenate 'string salt plaintext)
                                    :external-format :utf-8))
   :external-format :latin1))


(defun default-name (kind)
  (format nil "~a" (gensym kind)))

(defun take (n list &optional share-tail)
  "Returns two values. The first value returned is a list of the first
   N members of LIST. The second value is a list of the remaining
   values of list. 

   If N is negative, NIL is returned for both values.  If N is greater
   than the length of LIST then the entire list is returned.
   
   If SHARE-TAIL is non-nil, the second value will
   share memory with LIST, otherwise a copy is returned."
  (if (zerop n) 
      (values nil (if share-tail list (copy-seq list)))
      (loop repeat n
            for (h . tail) on list
            collect h into front
            finally
               (return (values front
                               (if share-tail
                                   tail
                                   (copy-seq tail)))))))

(defun insert-nth (x n list &optional share-tail)
  "Creates a new list, the result of inserting X into the Nth position
   of LIST, displacing the rest of the elements by one position. If N
   is greater than the length of LIST, X becomes the last element of
   LIST.  

    If N is negative, the element is inserted from the back of
   the list. If the abslute value of -N is greater than the lenght of
   the list, a list just containing X is returned."
  (when (minusp n)
    (setf n (+ 1 n (length list))))
  (multiple-value-bind (front back) (take n list share-tail)
    (nconc front (cons x back))))

(defun remove-nth (n list &optional share-tail)
  "Removes Nth member of list. Returns two values. 

   The first value is the new list with the Nth member removed. The
   second value is the removed item.

   See insert-nth for a description of the behavior of negative values
   of N, and for documentation on SHARE-TAIL."
  (when (minusp n)
    (setf n (+ n (length list))))
  (multiple-value-bind (front back) (take n list share-tail)
    (values 
     (nconc front (cdr back))
     (car back))))

(defun nswap (list n m)
  "Swap Nth and Mth members of LIST. Mutates LIST. Assumes both N and
   M are less than the length of LIST."
  (let ((tmp (nth n list)))
    (setf (nth n list) (nth m list)
          (nth m list) tmp)
    list))

(defmacro thunk* (&body body)
  "Returns a lambda of any number of arguments where those arguments
   are ignored."
  (let ((args (gensym)) )
    `(lambda (&rest ,args)
       (declare (ignorable ,args))
       ,@body)))

(defun tmp-dir-name ()
  (merge-pathnames
   (format nil "~a/" (gensym "tmpdir"))
   (uiop:temporary-directory)))

(defmacro with-temp-dir ((dir) &body body)
  "Create  temporary directory and bind its full path name to the variable DIR"
  `(let ((,dir (tmp-dir-name)))
     (ensure-directories-exist ,dir)
     (unwind-protect
          (progn ,@body)
       (uiop:delete-directory-tree ,dir :validate t))))

(defun read-from-file (path)
  (read-from-string
   (alexandria:read-file-into-string path)))


(defun secs-to-hms (secs)
  (setf secs (round secs))
  (let ((hours (floor (/ secs (* 60 60))))
        (mins (floor (/ (mod secs (* 60 60))
                        60)))
        (secs (mod secs 60)))
    (if (plusp hours)
        (format nil "~a:~2,'0d:~2,'0d"
                hours mins secs)
        (format nil "~a:~2,'0d"
                mins secs))))

(defun <?> (pred then else)
  (lambda (&rest args)
    (if (apply pred args)
        (apply then args)
        (apply else args))))

(defun clean-filename (str)
  (let ((non-safe-chars (cl-ppcre:create-scanner "[^a-zA-Z0-9_\\-.]")))
    (cl-ppcre:regex-replace-all non-safe-chars str "-")))