aboutsummaryrefslogtreecommitdiffhomepage
path: root/utilities.lisp
blob: a7e90e438e2597561f8c8b0789e3e2d60f0595ff (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
;;;; 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 "-")))