UpdateHEADmaster

1 files changed, 84 insertions, 40 deletions

diff --git a/src/wasp-db.el b/src/wasp-db.el
index 420bdf84..2242d907 100644
--- a/src/wasp-db.el
+++ b/src/wasp-db.el
@@ -39,33 +39,35 @@
 
 (defun w/db-parse-value ()
   "Parse a single RESP value from the current buffer."
-  ;; (w/write-log (format "parsing: %S" (buffer-string)))
-  (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))))
-         (if (= len -1)
-             ""
-           (let ((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 (contents: %S)" c (buffer-string)))))))
+  (if-let* ((c (char-after)))
+    (progn
+      (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))))
+            (if (= len -1)
+              ""
+              (let ((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 (contents: %S)" c (buffer-string))))))
+    'eof))
 
 (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))
+  (let ((v (w/db-parse-value)))
+    (when (not (eq v 'eof))
+      (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."
@@ -78,18 +80,18 @@ If not, return nil."
     (goto-char (point-min))
     (when (s-suffix? "\r\n" (buffer-string))
       (condition-case err
-          (while (w/db-parse-response))
+        (while (w/db-parse-response))
         (error
-         (w/chat-write-event (format "Database crashed, error: %s" err))
-         (w/db-disconnect))))))
+          (w/chat-write-event (format "Database crashed, error: %s" err))
+          (w/db-disconnect))))))
 
 (defun w/db-encode (x)
   "Encode X for Redis."
   (cond
-   ((listp x) ;; encode lists as arrays
-    (format "*%d\r\n%s\r\n" (length x) (apply #'s-concat (-map #'w/db-encode x))))
-   ((stringp x) ;; encode strings as bulk strings
-    (format "$%d\r\n%s\r\n" (string-bytes x) x))))
+    ((listp x) ;; encode lists as arrays
+      (format "*%d\r\n%s\r\n" (length x) (apply #'s-concat (-map #'w/db-encode x))))
+    ((stringp x) ;; encode strings as bulk strings
+      (format "$%d\r\n%s\r\n" (string-bytes x) x))))
 
 (defun w/db-send-raw (msg)
   "Send MSG to Redis."
@@ -115,29 +117,29 @@ If not, return nil."
     (set-buffer-multibyte nil)
     (erase-buffer))
   (make-network-process
-   :coding 'no-conversion
-   :name w/db-process
-   :buffer nil
-   :host w/db-host
-   :service w/db-port
-   :filter #'w/db-process-filter))
+    :coding 'no-conversion
+    :name w/db-process
+    :buffer nil
+    :host w/db-host
+    :service w/db-port
+    :filter #'w/db-process-filter))
 
 (defun w/db-keys (pat k)
   "Retrieve the list of keys matching PAT and pass them to K."
   (if (stringp pat)
-      (w/db-cmd `("KEYS" ,pat) k)
+    (w/db-cmd `("KEYS" ,pat) k)
     (error "Redis pattern must be string")))
 
 (defun w/db-set (key val)
   "Set KEY to VAL in Redis."
   (if (and (stringp key) (stringp val))
-      (w/db-cmd `("SET" ,key ,val) (lambda (_) nil))
-    (error "Redis key and value must be strings")))
+    (w/db-cmd `("SET" ,key ,val) (lambda (_) nil))
+    (error "Redis key and value must be strings: %s %s" key val)))
 
 (defun w/db-get (key k)
   "Get KEY from Redis and pass the corresponding value to K."
   (if (stringp key)
-      (w/db-cmd `("GET" ,key) k)
+    (w/db-cmd `("GET" ,key) k)
     (error "Redis key must be string")))
 
 (defun w/db-mget (keys k)
@@ -152,7 +154,7 @@ Afterward call K."
 (defun w/db-hset (key hkey val &rest vals)
   "Set HKEY in hash KEY to VAL in Redis."
   (w/db-cmd `("HSET" ,key ,hkey ,val ,@vals) (lambda (_) nil)))
-  ;; (w/db-hset-then key hkey val (lambda (_) nil) vals))
+;; (w/db-hset-then key hkey val (lambda (_) nil) vals))
 
 (defun w/db-hmset (key &rest vals)
   "Set many keys in hash KEY to VALS in Redis."
@@ -162,5 +164,47 @@ Afterward call K."
   "Get HKEY in hash KEY from Redis and pass the corresponding value to K."
   (w/db-cmd `("HGET" ,key ,hkey) k))
 
+(defun w/db-hgetall (key k)
+  "Get all key/value pairs in hash KEY from Redis and pass to K."
+  (w/db-cmd `("HGETALL" ,key)
+    (lambda (res)
+      (funcall k
+        (if (listp res)
+          (ht<-plist res)
+          (ht-create))))))
+
+(defun w/db-lpush (key &rest vals)
+  "Push VALS to the list at KEY in Redis."
+  (if (stringp key)
+    (w/db-cmd `("LPUSH" ,key ,@vals) (lambda (_) nil))
+    (error "Redis key must be a string")))
+
+(defun w/db-sadd (key &rest vals)
+  "Add VALS to the set at KEY in Redis."
+  (if (stringp key)
+    (w/db-cmd `("SADD" ,key ,@vals) (lambda (_) nil))
+    (error "Redis key must be a string")))
+
+(defun w/db-smembers (key k)
+  "Pass the members of the set at KEY to K."
+  (if (stringp key)
+    (w/db-cmd `("SMEMBERS" ,key) k)
+    (error "Redis key must be a string")))
+
+(defun w/db-exists (key k)
+  "Query whether KEY exists in Redis and pass the result to K."
+  (if (stringp key)
+    (w/db-cmd `("EXISTS" ,key) (lambda (res) (funcall k (= res 1))))
+    (error "Redis key must be a string")))
+
+(defun w/db-test ()
+  "Test the database."
+  (with-temp-buffer
+    ;; (insert "*2\r\n$5\r\nhello\r\n$5\r\nworld\r\n")
+    (insert "*0\r\n")
+    (goto-char (point-min))
+    (cons (w/db-parse-value) (buffer-string))
+    ))
+
 (provide 'wasp-db)
 ;;; wasp-db.el ends here