diff options
Diffstat (limited to 'src/wasp-db.el')
| -rw-r--r-- | src/wasp-db.el | 124 |
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 |