Initial commit

3 files changed, 383 insertions, 0 deletions

diff --git a/src/wasp-bus.el b/src/wasp-bus.el
new file mode 100644
index 00000000..73952078
--- /dev/null
+++ b/src/wasp-bus.el
@@ -0,0 +1,111 @@
+;;; wasp-bus --- Pub/sub bus client -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'dash)
+(require 's)
+(require 'wasp-utils)
+
+(defgroup wasp nil
+  "Pub/sub bus client."
+  :group 'applications)
+
+(defcustom w/bus-process "wasp-bus"
+  "Name of process connected to network bus."
+  :type '(string)
+  :group 'wasp)
+
+(defcustom w/bus-buffer " *wasp-bus*"
+  "Name of buffer used to store intermediate network data."
+  :type '(string)
+  :group 'wasp)
+
+(defcustom w/bus-host "shiro"
+  "Hostname of the bus server."
+  :type '(string)
+  :group 'wasp)
+
+(defcustom w/bus-port 32050
+  "Port of the bus server."
+  :type '(integer)
+  :group 'wasp)
+
+(defvar w/bus-event-handlers nil
+  "List of pairs of events and handler functions.")
+
+(defun w/handle-message (msg)
+  "Handle the message MSG."
+  (let* ((ev (car msg))
+         (body (cdr msg))
+         (handler (alist-get ev w/bus-event-handlers nil nil #'equal)))
+    (if handler
+        (funcall handler body)
+      (w/write-log (format "Unknown incoming event: %S" ev)))))
+
+(defun w/get-complete-line ()
+  "Kill a line followed by a newline if it exists, and nil otherwise."
+  (let ((l (thing-at-point 'line t)))
+    (if (and l (s-contains? "\n" l))
+        (progn
+          (delete-region (line-beginning-position) (line-beginning-position 2))
+          l)
+      nil)))
+(defun w/handle-lines ()
+  "Call `w/handle-message' on every complete line of the current buffer."
+  (let ((l (w/get-complete-line)))
+    (when (and l (not (s-blank? l)))
+      (w/handle-message (read (w/clean-string l)))
+      (w/handle-lines))))
+(defun w/process-filter (proc data)
+  "Process filter for pub/sub bus connection on PROC and DATA."
+  (with-current-buffer (get-buffer-create w/bus-buffer)
+    (when (not (marker-position (process-mark proc)))
+      (set-marker (process-mark proc) (point-max)))
+    (goto-char (process-mark proc))
+    (insert data)
+    (set-marker (process-mark proc) (point))
+    (goto-char (point-min))
+    (w/handle-lines)))
+
+(defun w/sub (ev)
+  "Subscribe to the event EV."
+  (process-send-string
+   w/bus-process
+   (s-concat
+    (format "%S" `(sub ,ev))
+    "\n")))
+
+(defun w/pub (ev &optional d)
+  "Publish the data D to the event EV."
+  (process-send-string
+   w/bus-process
+   (s-concat
+    (format "%S" `(pub ,ev ,@d))
+    "\n")))
+
+(defun w/sub-all ()
+  "Subscribe to all events in `w/bus-event-handlers'."
+  (--each w/bus-event-handlers
+    (w/write-log (format "Subscribing to: %S" (car it)))
+    (w/sub (car it))))
+
+(defun w/disconnect ()
+  "Disconnect from the pub/sub bus."
+  (interactive)
+  (when (process-live-p (get-process w/bus-process))
+    (delete-process w/bus-process)))
+
+(defun w/connect ()
+  "Connect to the pub/sub bus."
+  (interactive)
+  (w/disconnect)
+  (make-network-process
+   :name w/bus-process
+   :buffer nil
+   :host w/bus-host
+   :service w/bus-port
+   :filter #'w/process-filter)
+  (w/sub-all))
+
+(provide 'wasp-network)
+;;; wasp-bus.el ends here
diff --git a/src/wasp-db.el b/src/wasp-db.el
new file mode 100644
index 00000000..46999b5e
--- /dev/null
+++ b/src/wasp-db.el
@@ -0,0 +1,119 @@
+;;; wasp-db --- Redis protocol -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 'cl-lib)
+(require 'queue)
+(require 'dash)
+(require 'wasp-utils)
+
+(defcustom w/db-process "wasp-db"
+  "Name of process connected to Redis."
+  :type '(string)
+  :group 'wasp)
+
+(defcustom w/db-buffer " *wasp-db*"
+  "Name of buffer used to store intermediate Redis connection data."
+  :type '(string)
+  :group 'wasp)
+
+(defcustom w/db-host "shiro"
+  "Hostname of the Redis server."
+  :type '(string)
+  :group 'wasp)
+
+(defcustom w/db-port 6379
+  "Port of the Redis server."
+  :type '(integer)
+  :group 'wasp)
+
+(defvar w/db-callback-queue (make-queue)
+  "Queue of callbacks to handle incoming responses.")
+
+(defun w/db-parse-rest ()
+  "Parse everything before the \r\n terminator (and consume the terminator)."
+  (let ((res (w/eat (lambda (c) (/= c ?\r)))))
+    (w/munch ?\r)
+    (w/munch ?\n)
+    res))
+
+(defun w/db-parse-value ()
+  "Parse a single RESP value from the current buffer."
+  (when-let ((c (char-after)))
+    (delete-char 1)
+    (cl-case c
+      (?+ (w/db-parse-rest))
+      (?: (string-to-number (w/db-parse-rest)))
+      (?$
+       (let* ((len (string-to-number (w/db-parse-rest)))
+              (ret (w/devour (point) (+ (point) len))))
+         (w/munch ?\r)
+         (w/munch ?\n)
+         ret))
+      (?*
+       (let ((len (string-to-number (w/db-parse-rest))))
+         (--map (w/db-parse-value) (-iota len))))
+      (otherwise (error (format "Unknown Redis sigil: %s" c))))))
+
+(defun w/db-parse-response ()
+  "Try to parse a single RESP value from the current process buffer.
+If successful, pass the value to the queued callback and return non-nil.
+If not, return nil."
+  (when-let ((v (w/db-parse-value)))
+    (when-let ((cb (queue-dequeue w/db-callback-queue)))
+      (funcall cb v))
+    t))
+
+(defun w/db-process-filter (proc data)
+  "Process filter for Redis connection on PROC and DATA."
+  (with-current-buffer (get-buffer-create w/db-buffer)
+    (when (not (marker-position (process-mark proc)))
+      (set-marker (process-mark proc) (point-max)))
+    (goto-char (process-mark proc))
+    (insert data)
+    (set-marker (process-mark proc) (point))
+    (goto-char (point-min))
+    (while (w/db-parse-response))))
+
+(defun w/db-encode (x)
+  "Encode X for Redis."
+  (cond
+   ((listp x) (format "*%d\r\n%s\r\n" (length x) (apply #'s-concat (-map #'w/db-encode x))))
+   ((stringp x) (format "$%d\r\n%s\r\n" (string-bytes x) x))))
+
+
+(defun w/db-send-raw (msg)
+  "Send MSG to Redis."
+  (process-send-string w/db-process msg))
+
+(defun w/db-cmd (cmd k)
+  "Run CMD in Redis and pass the result to K."
+  (let ((enc (w/db-encode cmd)))
+    (queue-enqueue w/db-callback-queue k)
+    (w/db-send-raw enc)))
+
+(defun w/db-disconnect ()
+  "Disconnect from Redis."
+  (when (process-live-p (get-process w/db-process))
+    (delete-process w/db-process)))
+
+(defun w/db-connect ()
+  "Connect to Redis."
+  (w/db-disconnect)
+  (make-network-process
+   :name w/db-process
+   :buffer nil
+   :host w/db-host
+   :service w/db-port
+   :filter #'w/db-process-filter))
+
+(defun w/db-set (key val)
+  "Set KEY to VAL in Redis."
+  (w/db-cmd `("SET" ,key ,val) (lambda (_) (message "ok"))))
+
+(defun w/db-get (key k)
+  "Get KEY from Redis and pass the corresponding value to K."
+  (w/db-cmd `("GET" ,key) k))
+
+(provide 'wasp-db)
+;;; wasp-db.el ends here
diff --git a/src/wasp-utils.el b/src/wasp-utils.el
new file mode 100644
index 00000000..15148f74
--- /dev/null
+++ b/src/wasp-utils.el
@@ -0,0 +1,153 @@
+;;; wasp-utils --- Miscellaneous utilities -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+
+(require 's)
+(require 'cl-lib)
+(require 'eieio)
+(require 'request)
+
+(defcustom w/log-buffer "*wasp-log*"
+  "Name of buffer used to store the log."
+  :type '(string)
+  :group 'wasp)
+
+(defun w/write (text &optional face)
+  "Write TEXT to the current buffer and apply FACE."
+  (let ((text-final (if face (propertize text 'face face) text)))
+    (insert text-final)))
+
+(defun w/write-line (line &optional face)
+  "Write LINE and a newline to the current buffer and apply FACE."
+  (w/write (concat line "\n") face))
+
+(defun w/clean-string (s)
+  "Remove special characters from S."
+  (replace-regexp-in-string "[^[:print:]]" "" s))
+
+(defun w/write-log (line &optional face)
+  "Write LINE to the log buffer and apply FACE."
+  (with-current-buffer (get-buffer-create w/log-buffer)
+    (goto-char (point-max))
+    (w/write-line (w/clean-string (format "%s" line)) face)
+    (goto-char (point-max))))
+
+(defmacro w/defstruct (name &rest body)
+  "Define a structure with NAME (with the constructor under the w/ namespace).
+BODY is passed directly to `cl-defstruct'."
+  `(cl-defstruct
+       (,name (:constructor ,(intern (s-concat "w/make-" (s-chop-prefix "w/" (symbol-name name)))))
+              (:copier nil))
+     ,@body))
+
+(defmacro w/. (slot s)
+  "Lookup SLOT in the struct S."
+  `(eieio-oref ,s (quote ,slot)))
+
+(defun w/pick-random (xs)
+  "Pick a random element of XS."
+  (nth (random (length xs)) xs))
+
+(defun w/shuffle (s)
+  "Shuffle S."
+  (if (seq-empty-p s)
+      nil
+    (let ((elt (seq-elt s (random (seq-length s)))))
+      (cons elt (w/shuffle (remove elt s))))))
+
+(defun w/list-to-pair (xs)
+  "Turn the first two elements of XS into a pair."
+  (cons (car xs) (cadr xs)))
+
+(defun w/tempfile (prefix str &optional ext)
+  "Write STR to a temporary file with PREFIX and return the path.
+Optionally append EXT to the path."
+  (let ((path (s-concat (make-temp-file prefix) (or ext ""))))
+    (with-temp-file path (insert str))
+    path))
+
+(defun w/decode-string (s)
+  "Decode the base64 UTF-8 string S."
+  (decode-coding-string (base64-decode-string s) 'utf-8))
+
+(defun w/encode-string (s)
+  "Decode the base64 UTF-8 string S."
+  (base64-encode-string (encode-coding-string s 'utf-8) t))
+
+(defun w/slurp (path)
+  "Read PATH and return a string."
+  (with-temp-buffer
+    (insert-file-contents-literally path)
+    (buffer-string)))
+
+(defun w/spit (path data)
+  "Write DATA to PATH."
+  (write-region data nil path))
+
+(defvar w/fetch-last-response nil)
+(defun w/fetch (url &optional k)
+  "Get URL, passing the returned data to K."
+  (request
+    url
+    :type "GET"
+    :success
+    (cl-function
+     (lambda (&key data &allow-other-keys)
+       (setq w/fetch-last-response data)
+       (when k
+         (funcall k data)))))
+  t)
+(defun w/fetch-html (url &optional k)
+  "Get URL, passing the returned HTML to K."
+  (w/fetch
+   url
+   (lambda (data)
+     (funcall
+      k
+      (with-temp-buffer
+        (insert data)
+        (libxml-parse-html-region (point-min) (point-max)))))))
+(defun w/fetch-json (url &optional k)
+  "Get URL, passing the returned JSON to K."
+  (w/fetch
+   url
+   (lambda (data)
+     (funcall k (json-parse-string data)))))
+
+(defun w/devour (start end)
+  "Delete and return the region from START to END."
+  (let ((ret (buffer-substring start end)))
+    (delete-region start end)
+    ret))
+
+(defun w/eat (p)
+  "Consume characters from the current buffer while P yields true.
+Return the consumed string."
+  (let ((start (point)))
+    (while-let ((char (char-after))
+                (cont (funcall p char)))
+      (forward-char 1))
+    (w/devour start (point))))
+
+(defun w/peek (c)
+  "Look at the character at point in the current buffer.
+If it is C, consume it and return non-nil."
+  (when-let ((char (char-after))
+             (cont (= char c)))
+    (delete-char 1)
+    t))
+
+(defun w/munch (c)
+  "Look at the character at point in the current buffer.
+If it is C, consume it.
+Otherwise, throw an error."
+  (if-let ((char (char-after))
+           (cont (= char c)))
+      (progn
+        (delete-char 1)
+        t)
+    (error (format "While parsing, expected %c but found %c" c char))))
+    
+
+(provide 'wasp-utils)
+;;; wasp-utils.el ends here