blob: 46999b5e2dc50b3d0462a825c6cb41bf1067a2f8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
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
|
