Browse code

Don't even remember.

Jaidyn Lev authored on 2018-12-02 08:26:38
Showing 9 changed files
1 1
new file mode 100644
... ...
@@ -0,0 +1,51 @@
1
+(in-package :nih)
2
+
3
+;; UNIVERSAL-TIME --> STRING
4
+(defun iso-time (universal-time)
5
+  "Return `universal-time` in ISO 8601 format. :)"
6
+
7
+  (multiple-value-bind
8
+    (second minute hour date month year)
9
+    (decode-universal-time universal-time)
10
+
11
+    (format nil "~A-~A-~A"
12
+	    year
13
+	    (min-string-length month 2 :prefix "0")
14
+	    (min-string-length date 2 :prefix "0"))))
15
+
16
+
17
+;; NIL --> STRING
18
+(defun get-iso-time ()
19
+  "Return the ISO 8601 time of immediately, right here, right now."
20
+
21
+  (iso-time (get-universal-time)))
22
+
23
+
24
+;; STRING STRING --> INTEGER
25
+(defun iso-date-distance (iso-date-a iso-date-b)
26
+  "Return the number of days between date-a and date-b."
27
+
28
+  (let* ((a (mapcar #'read-from-string (nih:char-split "-" iso-date-a)))
29
+	 (year-a (car a)) (month-a (cadr a)) (day-a (caddr a))
30
+
31
+	 (b (mapcar #'read-from-string (nih:char-split "-" iso-date-b)))
32
+	 (year-b (car b)) (month-b (cadr b)) (day-b (caddr b)))
33
+
34
+    (+
35
+      (* 365 (- year-b year-a))
36
+      (- (day-number month-b day-b) (day-number month-a day-a)))))
37
+
38
+
39
+(defvar month-length
40
+  '(31 28 31 30 31 30 31 31 30 31 30 30))
41
+
42
+
43
+;; INTEGER [INTEGER] --> INTEGER
44
+(defun day-number (month &optional (date 1))
45
+  "Return the day-number (of a year) of a month/day combo."
46
+
47
+  (let ((month-days (reduce #'+ (nih:up-to (- month 2) month-length)))
48
+	(date-days date))
49
+
50
+    (+ month-days date-days)))
51
+
0 52
new file mode 100644
... ...
@@ -0,0 +1,35 @@
1
+(in-package :nih)
2
+
3
+;; PATH --> STRING
4
+(defun read-file-string (path)
5
+  "Read all lines from a file into a string."
6
+
7
+  (if (file-exists path)
8
+    (let ((encoding (asdf-encodings:detect-file-encoding path)))
9
+      
10
+      (with-open-file (fstream path
11
+			       :direction :input
12
+			       :external-format encoding)
13
+	(line-string
14
+	  (loop
15
+	    :for line = (read-line fstream nil)
16
+	    :while line
17
+	    :collect line))))))
18
+
19
+
20
+(defun write-file-string (path string &key
21
+			       (if-exists :append)
22
+			       (if-does-not-exist :create))
23
+  "Write a string to a file."
24
+
25
+  (let ((encoding :utf-8))
26
+
27
+    (if (file-exists path)
28
+      (setq encoding (asdf-encodings:detect-file-encoding path)))
29
+
30
+    (with-open-file (fstream path
31
+			     :direction :output
32
+			     :external-format encoding
33
+			     :if-exists if-exists
34
+			     :if-does-not-exist if-does-not-exist)
35
+      (format fstream "~A" string))))
... ...
@@ -1,19 +1,19 @@
1 1
 (in-package :nih)
2 2
 
3 3
 ;; ITEM LIST --> DATA_AFTER_ITEM
4
-(defun following (item list)
4
+(defun following (item list &key (test #'eq))
5 5
   "Return all items following the first instance of ITEM"
6 6
 
7
-  (cdr (up-from (position item list :test #'equal) list)))
7
+  (cdr (up-from (position item list :test test) list)))
8 8
 
9 9
 
10 10
 ;; ITEM LIST --> DATA_UP_TO_ITEM
11
-(defun preceding (item list)
11
+(defun preceding (item list &key (test #'eq))
12 12
   "Return all items preceding the first instance of ITEM"
13 13
 
14 14
   (reverse
15 15
     (cdr (reverse
16
-	   (up-to (position item list :test #'equal) list)))))
16
+	   (up-to (position item list :test test) list)))))
17 17
 
18 18
 
19 19
 ;; ----------------------------------------
... ...
@@ -93,3 +93,71 @@
93 93
       (setq i (+ 1 i)))
94 94
 
95 95
     stack))
96
+
97
+
98
+;; ----------------------------------------
99
+
100
+
101
+;; LIST --> LIST_OF_ODD-NUMBERED_ITEMS
102
+(defun odds (list)
103
+  "Return a list only containing the odd-numbered items of a list."
104
+
105
+  (let ((stack '())
106
+	(i 0))
107
+
108
+    (loop
109
+      :while (< i (length list))
110
+      :do
111
+      (if (oddp i)
112
+	(setq stack (concatenate 'list stack (list (nth i list)))))
113
+
114
+      (setq i (+ 1 i)))
115
+
116
+    stack))
117
+
118
+
119
+;; LIST --> LIST_OF_ODD-NUMBERED_ITEMS
120
+(defun evens (list)
121
+  "Return a list only containing the even-numbered items of a list."
122
+
123
+  (let ((stack '())
124
+	(i 0))
125
+
126
+    (loop
127
+      :while (< i (length list))
128
+      :do
129
+      (if (evenp i)
130
+	(setq stack (concatenate 'list stack (list (nth i list)))))
131
+
132
+      (setq i (+ 1 i)))
133
+
134
+    stack))
135
+
136
+
137
+;; ----------------------------------------
138
+
139
+
140
+
141
+;; PLIST PLIST --> PLIST
142
+(defun property-list-merge (plist-a plist-b)
143
+  "Merge two property-lists, with plist-a being the canonical one.
144
+  Useful for when you have defaults (in plist-a) and modifications to
145
+  them (in plist-b), especially for configs."
146
+
147
+  (let* ((keys (evens plist-a))
148
+	 (pairs (length keys))
149
+	 (stack '())
150
+	 (i 0))
151
+
152
+    (loop
153
+      :while (< i pairs)
154
+      :do
155
+      (let* ((key (nth i keys))
156
+	     (a-value (getf plist-a key))
157
+	     (b-value (getf plist-b key)))
158
+
159
+	(setq stack
160
+	      (append stack
161
+		      (list key (value-or b-value a-value))))
162
+	(setq i (+ i 1))))
163
+      stack))
... ...
@@ -49,18 +49,38 @@
49 49
 (defun random-item (list)
50 50
   "Return a random item from a list."
51 51
 
52
-  (nth (random (length list)) list))
53
-
54
-
55
-;; UNIVERSAL-TIME --> ISO8601-FORMAT_TIME
56
-(defun iso-time (universal-time)
57
-  "Return `universal-time` in ISO 8601 format. :)"
58
-
59
-  (multiple-value-bind
60
-    (second minute hour date month year)
61
-    (decode-universal-time universal-time)
62
-
63
-    (format nil "~A-~A-~A"
64
-	    year
65
-	    (min-string-length month 2 "0")
66
-	    (min-string-length date 2 "0"))))
52
+  (if (not list)
53
+    nil
54
+    (nth (random (length list)) list)))
55
+
56
+;; INTEGER LIST --> LIST
57
+(defun random-items (number list)
58
+  "Return an amount of random items from a list."
59
+
60
+  (if (not list)
61
+    nil
62
+    (let ((item (random-item list)))
63
+      (concatenate 'list
64
+		   (list item)
65
+		   (if (not (eq number 1))
66
+		     (random-items (- number 1) (remove item list)))))))
67
+
68
+;; FILE_PATH --> BOOLEAN
69
+(defun file-exists (path)
70
+  "Return whether or not a file exists."
71
+
72
+  (if (ignore-errors (file-author path))
73
+    'T
74
+    nil))
75
+
76
+
77
+;; STREAM --> STRING_OF_ENTIRE_STREAM
78
+(defun read-line-entire (stream)
79
+  (let* ((cur-line (ignore-errors (read-line stream))))
80
+
81
+    (cond
82
+      (cur-line
83
+	(string-combine cur-line
84
+			(read-line-entire stream)
85
+			:seperator (format nil "~%")) )
86
+      ('T ""))))
... ...
@@ -16,17 +16,20 @@
16 16
     :regex-get-all
17 17
     :regex-remove
18 18
     :regex-remove-all
19
+    :regex-split
19 20
 
20 21
     :nil-string
21 22
 
22 23
     :pad-string
23 24
     :min-string-length
25
+    :max-string-length
24 26
 
25 27
     :getf-string
26 28
     :getf-strings
27 29
 
28 30
     :get-colon-values
29 31
     :remove-colon-values
32
+    :replace-colon-value
30 33
 
31 34
 
32 35
     ;; STRING/WORD
... ...
@@ -41,6 +44,8 @@
41 44
     :word-remove-all
42 45
     :word-position
43 46
     :word-positions
47
+    :word-split
48
+    :word-length
44 49
 
45 50
     :word-car
46 51
     :word-caar :word-cadddrr :word-cadaar :word-cadr :word-caadr
... ...
@@ -63,6 +68,8 @@
63 68
     :line-remove-all
64 69
     :line-position
65 70
     :line-positions
71
+    :line-split
72
+    :line-length
66 73
 
67 74
     :line-car
68 75
     :line-caar :line-cadddrr :line-cadaar :line-cadr :line-caadr
... ...
@@ -83,6 +90,8 @@
83 90
     :char-remove-all
84 91
     :char-position
85 92
     :char-positions
93
+    :char-split
94
+    :char-length
86 95
 
87 96
     :char-car
88 97
     :char-caar :char-cadddrr :char-cadaar :char-cadr :char-caadr
... ...
@@ -108,13 +117,37 @@
108 117
     
109 118
     :replace-at
110 119
 
120
+    :odds
121
+    :evens
122
+
123
+    :property-list-merge
124
+
125
+
126
+    ;; DATE
127
+    ;; =======================
128
+    :iso-time  ;; see (local-time:format-timestring nil timestamp)
129
+    :get-iso-time
130
+    ;; see (local-time:format-timestring nil (local-time:universal-to-timestamp)
131
+    :iso-date-distance ;; see #'local-time:timestamp-difference
132
+    :day-number ;; see #'local-time:format-timestring
133
+    :week-number ;; see #'local-time:format-timestring
134
+
135
+
136
+    ;; FILE
137
+    ;; =======================
138
+    :read-file-string ;; see #'alexandria:read-file-into-string
139
+    :write-file-string ;; see #'alexandria:write-string-into-file
140
+
111 141
 
112 142
     ;; MISC
113 143
     ;; =======================
114 144
     :random-item
145
+    :random-items
115 146
     :iso-time
116 147
     :list-or-real
117 148
     :value-or
149
+    :file-exists
150
+    :read-line-entire
118 151
     :parse-keys))
119 152
 
120 153
 
... ...
@@ -37,6 +37,14 @@
37 37
   (nth n (char-list string)))
38 38
 
39 39
 
40
+;; STRING --> INTEGER
41
+(defun char-length (string)
42
+  "Return the length of a string by character."
43
+
44
+  (length (char-list string)))
45
+
46
+
47
+
40 48
 ;; ----------------------------------------
41 49
 
42 50
 
... ...
@@ -75,6 +83,14 @@
75 83
   (positions character (char-list string)))
76 84
 
77 85
 
86
+;; CHARACTER STRING --> LIST_OF_STRINGS
87
+(defun char-split (character string)
88
+  "Split a string into a list of strings, at a set character."
89
+
90
+  (regex-split (string character)
91
+	       (mapcar #'string (char-list string))))
92
+
93
+
78 94
 ;; ----------------------------------------
79 95
 
80 96
 
... ...
@@ -30,6 +30,14 @@
30 30
   (nth n (line-list string)))
31 31
 
32 32
 
33
+;; STRING --> INTEGER
34
+(defun line-length (string)
35
+  "Return the length of a string in lines."
36
+
37
+  (length (line-list string)))
38
+
39
+
40
+
33 41
 ;; ----------------------------------------
34 42
 
35 43
 
... ...
@@ -72,6 +80,13 @@
72 80
   (positions line (line-list string) :test #'equal))
73 81
 
74 82
 
83
+;; QUERY STRING --> LIST_OF_LINES_SANS_MATCHES
84
+(defun line-split (query string)
85
+    "Split a string into a list, seperated by a set line matching a regex query."
86
+
87
+      (regex-split query (line-list string) (string #\Newline)))
88
+
89
+
75 90
 ;; ----------------------------------------
76 91
 
77 92
 
... ...
@@ -87,6 +87,26 @@
87 87
 	(padding "" string suffix)))))
88 88
 
89 89
 
90
+;; STRING INTEGER --> STRING
91
+(defun max-string-length (string length)
92
+  "Return a string by splitting it into lines, each line being length long."
93
+
94
+  (let ((stack "")
95
+	(i 0))
96
+    (loop
97
+      :for char
98
+      :across string
99
+      :do
100
+      (if (eq length i)
101
+	(progn
102
+	  (setq i 0)
103
+	  (setq stack
104
+		(nih:string-combine stack (format nil "~%~A" char))))
105
+	(setq stack
106
+	      (nih:string-combine stack (format nil "~A" char))))
107
+      (setq i (+ 1 i)))
108
+    stack))
109
+
90 110
 
91 111
 ;; STRING DESIRED_LENGTH [PREFIX] [SUFFIX] --> STRING_OF_DESIRED_LENGTH
92 112
 (defun min-string-length (string target-length
... ...
@@ -188,6 +208,35 @@ Example:
188 208
     stack))
189 209
 
190 210
 
211
+;; QUERY LIST_OF_STRINGS --> LIST_SANS_QUERY_MATCHES
212
+(defun regex-split (query list &optional (combiner ""))
213
+  "Split a string into a list, seperated by a set item matching a regex query."
214
+
215
+  (let ((stack '(""))
216
+	(i 0))
217
+
218
+    (loop
219
+      :while (< i (length list))
220
+      :do
221
+      (let ((string (nth i list))
222
+	    (last-string (car (reverse stack)))
223
+	    (stack-sans (reverse (cdr (reverse stack)))))
224
+
225
+	(cond
226
+	  ((ppcre:scan-to-strings query string)
227
+	   (setq stack (concatenate 'list stack (list ""))))
228
+	  ('T
229
+	   (setq stack (concatenate 'list stack-sans
230
+				    (list (string-trim combiner
231
+						       (string-combine
232
+							 last-string string
233
+							 :seperator combiner))))))))
234
+
235
+      (setq i (+ 1 i)))
236
+
237
+    (remove "" stack :test #'equal)))
238
+
239
+
191 240
 ;; ---------------------------------------- 
192 241
 
193 242
 
... ...
@@ -263,8 +312,46 @@ Example:
263 312
 
264 313
 
265 314
 
266
-  ;; STRING COLON_VARIABLE_NAME --> STRING_WITHOUT_COLON_VARIABLE
267
-  (defun remove-colon-values (string)
268
-    "Remove the colon-variable declaration from a string."
315
+;; STRING COLON_VARIABLE_NAME --> STRING_WITHOUT_COLON_VARIABLE
316
+(defun remove-colon-values (string)
317
+  "Remove the colon-variable declaration from a string."
318
+
319
+  (line-remove-all "^:.*" string))
320
+
321
+
322
+
323
+;; STRING SYMBOL STRING --> STRING
324
+(defun replace-colon-value (string key-string value)
325
+  "Replace a colon variable's value."
326
+
327
+  (let ((existent
328
+	  (getf (get-colon-values string) (read-from-string key-string))))
329
+    (if existent
330
+      (line-replace
331
+	(line-position
332
+	  (line-get (string-combine "^" key-string " ") string)
333
+	  string)
334
+	(string-combine key-string value :seperator " ")
335
+	string)
336
+      (string-combine :seperator (string #\Newline)
337
+		      string (string-combine key-string " " value)))))
338
+
339
+
340
+
341
+
342
+;; -------------------------------------
343
+;; PRIVATE HELPER FUNCTIONS
344
+
345
+
346
+;; INTEGER STRING STRING --> STRING
347
+(defun line-replace (position new-line string)
348
+  "Replace nth line with a new one in a string."
349
+
350
+  (let* ((line-list (nih:line-split (nih:line-nth position string) string))
351
+	 (modified-list
352
+	   (list (car line-list)
353
+		 new-line
354
+		 (nih:value-or (cadr line-list) ""))))
269 355
 
270
-    (line-remove-all "^:.*" string))
356
+    (reduce (lambda (a b) (nih:string-combine a b :seperator (format nil "~%")))
357
+	    modified-list)))
... ...
@@ -30,6 +30,14 @@
30 30
   (word-string (nth n (word-list string))))
31 31
 
32 32
 
33
+;; STRING --> INTEGER
34
+(defun word-length (string)
35
+    "Return the length of a string by word."
36
+
37
+      (length (word-list string)))
38
+
39
+
40
+
33 41
 ;; ----------------------------------------
34 42
 
35 43
 
... ...
@@ -37,7 +45,7 @@
37 45
 (defun word-get (query string)
38 46
   "Return a word in a string that matches a regex query."
39 47
 
40
-  (word-car (word-get-all query string)))
48
+  (ignore-errors (word-car (word-get-all query string))))
41 49
 
42 50
 ;; REGEX STRING --> LIST_OF_MATCHING_WORDS
43 51
 (defun word-get-all (query string)
... ...
@@ -48,15 +56,15 @@
48 56
 
49 57
 ;; REGEX STRING --> LINES_SANS_MATCHES
50 58
 (defun word-remove (query string)
51
-    "Remove a word from a string that matches a regex query."
59
+  "Remove a word from a string that matches a regex query."
52 60
 
53
-      (word-string (regex-remove query (word-list string))))
61
+  (word-string (regex-remove query (word-list string))))
54 62
 
55 63
 ;; REGEX STRING --> LINES_SANS_MATCHES
56 64
 (defun word-remove-all (query string)
57
-    "Remove all words from a string that match a regex query."
65
+  "Remove all words from a string that match a regex query."
58 66
 
59
-      (word-string (regex-remove-all query (word-list string))))
67
+  (word-string (regex-remove-all query (word-list string))))
60 68
 
61 69
 
62 70
 ;; WORD STRING --> WORD_POS_IN_STRING
... ...
@@ -72,6 +80,12 @@
72 80
   (positions word (word-list string) :test #'equal))
73 81
 
74 82
 
83
+(defun word-split (query string)
84
+  "Split a string into a list, seperated by a set word matching a regex query."
85
+
86
+  (regex-split query (word-list string) " "))
87
+
88
+
75 89
 ;; ----------------------------------------
76 90
 
77 91