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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
;;; 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."
(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" 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))
(condition-case err
(while (w/db-parse-response))
(error
(w/write-chat-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))))
(defun w/db-send-raw (msg)
"Send MSG to Redis."
(w/write-log (format "sending to redis: %s" msg))
(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)
(queue-clear w/db-callback-queue)
(with-current-buffer (get-buffer-create w/db-buffer)
(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))
(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")))
(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)
(error "Redis key must be string")))
(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)))
(defun w/db-hget (key hkey k)
"Get HKEY in hash KEY from Redis and pass the corresponding value to K."
(w/db-cmd `("HGET" ,key ,hkey) k))
(provide 'wasp-db)
;;; wasp-db.el ends here
|
