From 722e2f8782e92c47cb6257ab56a215ee4b023d7d Mon Sep 17 00:00:00 2001 From: Jaidyn Lev Date: Sun, 2 Dec 2018 02:26:38 -0600 Subject: [PATCH] Don't even remember. --- src/date.lisp | 51 +++++++++++++++++++++++ src/file.lisp | 35 ++++++++++++++++ src/list.lisp | 76 +++++++++++++++++++++++++++++++-- src/misc.lisp | 44 +++++++++++++------ src/package.lisp | 33 +++++++++++++++ src/string/char.lisp | 16 +++++++ src/string/line.lisp | 15 +++++++ src/string/string.lisp | 95 ++++++++++++++++++++++++++++++++++++++++-- src/string/word.lisp | 24 ++++++++--- 9 files changed, 364 insertions(+), 25 deletions(-) create mode 100644 src/date.lisp create mode 100644 src/file.lisp diff --git a/src/date.lisp b/src/date.lisp new file mode 100644 index 0000000..6392b6f --- /dev/null +++ b/src/date.lisp @@ -0,0 +1,51 @@ +(in-package :nih) + +;; UNIVERSAL-TIME --> STRING +(defun iso-time (universal-time) + "Return `universal-time` in ISO 8601 format. :)" + + (multiple-value-bind + (second minute hour date month year) + (decode-universal-time universal-time) + + (format nil "~A-~A-~A" + year + (min-string-length month 2 :prefix "0") + (min-string-length date 2 :prefix "0")))) + + +;; NIL --> STRING +(defun get-iso-time () + "Return the ISO 8601 time of immediately, right here, right now." + + (iso-time (get-universal-time))) + + +;; STRING STRING --> INTEGER +(defun iso-date-distance (iso-date-a iso-date-b) + "Return the number of days between date-a and date-b." + + (let* ((a (mapcar #'read-from-string (nih:char-split "-" iso-date-a))) + (year-a (car a)) (month-a (cadr a)) (day-a (caddr a)) + + (b (mapcar #'read-from-string (nih:char-split "-" iso-date-b))) + (year-b (car b)) (month-b (cadr b)) (day-b (caddr b))) + + (+ + (* 365 (- year-b year-a)) + (- (day-number month-b day-b) (day-number month-a day-a))))) + + +(defvar month-length + '(31 28 31 30 31 30 31 31 30 31 30 30)) + + +;; INTEGER [INTEGER] --> INTEGER +(defun day-number (month &optional (date 1)) + "Return the day-number (of a year) of a month/day combo." + + (let ((month-days (reduce #'+ (nih:up-to (- month 2) month-length))) + (date-days date)) + + (+ month-days date-days))) + diff --git a/src/file.lisp b/src/file.lisp new file mode 100644 index 0000000..e486fd7 --- /dev/null +++ b/src/file.lisp @@ -0,0 +1,35 @@ +(in-package :nih) + +;; PATH --> STRING +(defun read-file-string (path) + "Read all lines from a file into a string." + + (if (file-exists path) + (let ((encoding (asdf-encodings:detect-file-encoding path))) + + (with-open-file (fstream path + :direction :input + :external-format encoding) + (line-string + (loop + :for line = (read-line fstream nil) + :while line + :collect line)))))) + + +(defun write-file-string (path string &key + (if-exists :append) + (if-does-not-exist :create)) + "Write a string to a file." + + (let ((encoding :utf-8)) + + (if (file-exists path) + (setq encoding (asdf-encodings:detect-file-encoding path))) + + (with-open-file (fstream path + :direction :output + :external-format encoding + :if-exists if-exists + :if-does-not-exist if-does-not-exist) + (format fstream "~A" string)))) diff --git a/src/list.lisp b/src/list.lisp index e6c6d43..6cec8ad 100644 --- a/src/list.lisp +++ b/src/list.lisp @@ -1,19 +1,19 @@ (in-package :nih) ;; ITEM LIST --> DATA_AFTER_ITEM -(defun following (item list) +(defun following (item list &key (test #'eq)) "Return all items following the first instance of ITEM" - (cdr (up-from (position item list :test #'equal) list))) + (cdr (up-from (position item list :test test) list))) ;; ITEM LIST --> DATA_UP_TO_ITEM -(defun preceding (item list) +(defun preceding (item list &key (test #'eq)) "Return all items preceding the first instance of ITEM" (reverse (cdr (reverse - (up-to (position item list :test #'equal) list))))) + (up-to (position item list :test test) list))))) ;; ---------------------------------------- @@ -93,3 +93,71 @@ (setq i (+ 1 i))) stack)) + + +;; ---------------------------------------- + + +;; LIST --> LIST_OF_ODD-NUMBERED_ITEMS +(defun odds (list) + "Return a list only containing the odd-numbered items of a list." + + (let ((stack '()) + (i 0)) + + (loop + :while (< i (length list)) + :do + (if (oddp i) + (setq stack (concatenate 'list stack (list (nth i list))))) + + (setq i (+ 1 i))) + + stack)) + + +;; LIST --> LIST_OF_ODD-NUMBERED_ITEMS +(defun evens (list) + "Return a list only containing the even-numbered items of a list." + + (let ((stack '()) + (i 0)) + + (loop + :while (< i (length list)) + :do + (if (evenp i) + (setq stack (concatenate 'list stack (list (nth i list))))) + + (setq i (+ 1 i))) + + stack)) + + +;; ---------------------------------------- + + + +;; PLIST PLIST --> PLIST +(defun property-list-merge (plist-a plist-b) + "Merge two property-lists, with plist-a being the canonical one. + Useful for when you have defaults (in plist-a) and modifications to + them (in plist-b), especially for configs." + + (let* ((keys (evens plist-a)) + (pairs (length keys)) + (stack '()) + (i 0)) + + (loop + :while (< i pairs) + :do + (let* ((key (nth i keys)) + (a-value (getf plist-a key)) + (b-value (getf plist-b key))) + + (setq stack + (append stack + (list key (value-or b-value a-value)))) + (setq i (+ i 1)))) + stack)) diff --git a/src/misc.lisp b/src/misc.lisp index 1b38b37..f9cf62e 100644 --- a/src/misc.lisp +++ b/src/misc.lisp @@ -49,18 +49,38 @@ (defun random-item (list) "Return a random item from a list." - (nth (random (length list)) list)) + (if (not list) + nil + (nth (random (length list)) list))) + +;; INTEGER LIST --> LIST +(defun random-items (number list) + "Return an amount of random items from a list." + + (if (not list) + nil + (let ((item (random-item list))) + (concatenate 'list + (list item) + (if (not (eq number 1)) + (random-items (- number 1) (remove item list))))))) + +;; FILE_PATH --> BOOLEAN +(defun file-exists (path) + "Return whether or not a file exists." + + (if (ignore-errors (file-author path)) + 'T + nil)) -;; UNIVERSAL-TIME --> ISO8601-FORMAT_TIME -(defun iso-time (universal-time) - "Return `universal-time` in ISO 8601 format. :)" +;; STREAM --> STRING_OF_ENTIRE_STREAM +(defun read-line-entire (stream) + (let* ((cur-line (ignore-errors (read-line stream)))) - (multiple-value-bind - (second minute hour date month year) - (decode-universal-time universal-time) - - (format nil "~A-~A-~A" - year - (min-string-length month 2 "0") - (min-string-length date 2 "0")))) + (cond + (cur-line + (string-combine cur-line + (read-line-entire stream) + :seperator (format nil "~%")) ) + ('T "")))) diff --git a/src/package.lisp b/src/package.lisp index d009559..c9df757 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -16,17 +16,20 @@ :regex-get-all :regex-remove :regex-remove-all + :regex-split :nil-string :pad-string :min-string-length + :max-string-length :getf-string :getf-strings :get-colon-values :remove-colon-values + :replace-colon-value ;; STRING/WORD @@ -41,6 +44,8 @@ :word-remove-all :word-position :word-positions + :word-split + :word-length :word-car :word-caar :word-cadddrr :word-cadaar :word-cadr :word-caadr @@ -63,6 +68,8 @@ :line-remove-all :line-position :line-positions + :line-split + :line-length :line-car :line-caar :line-cadddrr :line-cadaar :line-cadr :line-caadr @@ -83,6 +90,8 @@ :char-remove-all :char-position :char-positions + :char-split + :char-length :char-car :char-caar :char-cadddrr :char-cadaar :char-cadr :char-caadr @@ -108,13 +117,37 @@ :replace-at + :odds + :evens + + :property-list-merge + + + ;; DATE + ;; ======================= + :iso-time ;; see (local-time:format-timestring nil timestamp) + :get-iso-time + ;; see (local-time:format-timestring nil (local-time:universal-to-timestamp) + :iso-date-distance ;; see #'local-time:timestamp-difference + :day-number ;; see #'local-time:format-timestring + :week-number ;; see #'local-time:format-timestring + + + ;; FILE + ;; ======================= + :read-file-string ;; see #'alexandria:read-file-into-string + :write-file-string ;; see #'alexandria:write-string-into-file + ;; MISC ;; ======================= :random-item + :random-items :iso-time :list-or-real :value-or + :file-exists + :read-line-entire :parse-keys)) diff --git a/src/string/char.lisp b/src/string/char.lisp index 0f24a40..1712d98 100644 --- a/src/string/char.lisp +++ b/src/string/char.lisp @@ -37,6 +37,14 @@ (nth n (char-list string))) +;; STRING --> INTEGER +(defun char-length (string) + "Return the length of a string by character." + + (length (char-list string))) + + + ;; ---------------------------------------- @@ -75,6 +83,14 @@ (positions character (char-list string))) +;; CHARACTER STRING --> LIST_OF_STRINGS +(defun char-split (character string) + "Split a string into a list of strings, at a set character." + + (regex-split (string character) + (mapcar #'string (char-list string)))) + + ;; ---------------------------------------- diff --git a/src/string/line.lisp b/src/string/line.lisp index 82e046a..4bb5fe1 100644 --- a/src/string/line.lisp +++ b/src/string/line.lisp @@ -30,6 +30,14 @@ (nth n (line-list string))) +;; STRING --> INTEGER +(defun line-length (string) + "Return the length of a string in lines." + + (length (line-list string))) + + + ;; ---------------------------------------- @@ -72,6 +80,13 @@ (positions line (line-list string) :test #'equal)) +;; QUERY STRING --> LIST_OF_LINES_SANS_MATCHES +(defun line-split (query string) + "Split a string into a list, seperated by a set line matching a regex query." + + (regex-split query (line-list string) (string #\Newline))) + + ;; ---------------------------------------- diff --git a/src/string/string.lisp b/src/string/string.lisp index e6ff73a..44e3e2d 100644 --- a/src/string/string.lisp +++ b/src/string/string.lisp @@ -87,6 +87,26 @@ (padding "" string suffix))))) +;; STRING INTEGER --> STRING +(defun max-string-length (string length) + "Return a string by splitting it into lines, each line being length long." + + (let ((stack "") + (i 0)) + (loop + :for char + :across string + :do + (if (eq length i) + (progn + (setq i 0) + (setq stack + (nih:string-combine stack (format nil "~%~A" char)))) + (setq stack + (nih:string-combine stack (format nil "~A" char)))) + (setq i (+ 1 i))) + stack)) + ;; STRING DESIRED_LENGTH [PREFIX] [SUFFIX] --> STRING_OF_DESIRED_LENGTH (defun min-string-length (string target-length @@ -188,6 +208,35 @@ Example: stack)) +;; QUERY LIST_OF_STRINGS --> LIST_SANS_QUERY_MATCHES +(defun regex-split (query list &optional (combiner "")) + "Split a string into a list, seperated by a set item matching a regex query." + + (let ((stack '("")) + (i 0)) + + (loop + :while (< i (length list)) + :do + (let ((string (nth i list)) + (last-string (car (reverse stack))) + (stack-sans (reverse (cdr (reverse stack))))) + + (cond + ((ppcre:scan-to-strings query string) + (setq stack (concatenate 'list stack (list "")))) + ('T + (setq stack (concatenate 'list stack-sans + (list (string-trim combiner + (string-combine + last-string string + :seperator combiner)))))))) + + (setq i (+ 1 i))) + + (remove "" stack :test #'equal))) + + ;; ---------------------------------------- @@ -263,8 +312,46 @@ Example: - ;; STRING COLON_VARIABLE_NAME --> STRING_WITHOUT_COLON_VARIABLE - (defun remove-colon-values (string) - "Remove the colon-variable declaration from a string." +;; STRING COLON_VARIABLE_NAME --> STRING_WITHOUT_COLON_VARIABLE +(defun remove-colon-values (string) + "Remove the colon-variable declaration from a string." - (line-remove-all "^:.*" string)) + (line-remove-all "^:.*" string)) + + + +;; STRING SYMBOL STRING --> STRING +(defun replace-colon-value (string key-string value) + "Replace a colon variable's value." + + (let ((existent + (getf (get-colon-values string) (read-from-string key-string)))) + (if existent + (line-replace + (line-position + (line-get (string-combine "^" key-string " ") string) + string) + (string-combine key-string value :seperator " ") + string) + (string-combine :seperator (string #\Newline) + string (string-combine key-string " " value))))) + + + + +;; ------------------------------------- +;; PRIVATE HELPER FUNCTIONS + + +;; INTEGER STRING STRING --> STRING +(defun line-replace (position new-line string) + "Replace nth line with a new one in a string." + + (let* ((line-list (nih:line-split (nih:line-nth position string) string)) + (modified-list + (list (car line-list) + new-line + (nih:value-or (cadr line-list) "")))) + + (reduce (lambda (a b) (nih:string-combine a b :seperator (format nil "~%"))) + modified-list))) diff --git a/src/string/word.lisp b/src/string/word.lisp index 490b3dd..3d54d88 100644 --- a/src/string/word.lisp +++ b/src/string/word.lisp @@ -30,6 +30,14 @@ (word-string (nth n (word-list string)))) +;; STRING --> INTEGER +(defun word-length (string) + "Return the length of a string by word." + + (length (word-list string))) + + + ;; ---------------------------------------- @@ -37,7 +45,7 @@ (defun word-get (query string) "Return a word in a string that matches a regex query." - (word-car (word-get-all query string))) + (ignore-errors (word-car (word-get-all query string)))) ;; REGEX STRING --> LIST_OF_MATCHING_WORDS (defun word-get-all (query string) @@ -48,15 +56,15 @@ ;; REGEX STRING --> LINES_SANS_MATCHES (defun word-remove (query string) - "Remove a word from a string that matches a regex query." + "Remove a word from a string that matches a regex query." - (word-string (regex-remove query (word-list string)))) + (word-string (regex-remove query (word-list string)))) ;; REGEX STRING --> LINES_SANS_MATCHES (defun word-remove-all (query string) - "Remove all words from a string that match a regex query." + "Remove all words from a string that match a regex query." - (word-string (regex-remove-all query (word-list string)))) + (word-string (regex-remove-all query (word-list string)))) ;; WORD STRING --> WORD_POS_IN_STRING @@ -72,6 +80,12 @@ (positions word (word-list string) :test #'equal)) +(defun word-split (query string) + "Split a string into a list, seperated by a set word matching a regex query." + + (regex-split query (word-list string) " ")) + + ;; ----------------------------------------