summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Uko Kokņevičs2025-10-18 08:19:45 +0300
committerGravatar Uko Kokņevičs2025-10-18 08:19:45 +0300
commita802a63364721a2da95b75bc8ab19abfa4888373 (patch)
treec4a197592df54ea722be9592238914be86f8e266 /src
parentGet rid of anaphora (diff)
downloadukkoclot-a802a63364721a2da95b75bc8ab19abfa4888373.tar.gz
ukkoclot-a802a63364721a2da95b75bc8ab19abfa4888373.tar.xz
ukkoclot-a802a63364721a2da95b75bc8ab19abfa4888373.zip
Bunch more tiny improvements
Diffstat (limited to 'src')
-rw-r--r--src/db.lisp6
-rw-r--r--src/main.lisp33
-rw-r--r--src/serializing.lisp6
-rw-r--r--src/strings.lisp6
4 files changed, 27 insertions, 24 deletions
diff --git a/src/db.lisp b/src/db.lisp
index 8fab0db..b0159c0 100644
--- a/src/db.lisp
+++ b/src/db.lisp
@@ -29,13 +29,13 @@
29 (case type 29 (case type
30 (:blacklisted 0) 30 (:blacklisted 0)
31 (:whitelisted 1) 31 (:whitelisted 1)
32 (t (error "Unknown inline bot type ~S" type)))) 32 (otherwise (error "Unknown inline bot type ~S" type))))
33 33
34(defun integer->inline-bot-type (num) 34(defun integer->inline-bot-type (num)
35 (case num 35 (case num
36 (0 :blacklisted) 36 (0 :blacklisted)
37 (1 :whitelisted) 37 (1 :whitelisted)
38 (t (error "Unknown inline bot type value ~S" num)))) 38 (otherwise (error "Unknown inline bot type value ~S" num))))
39 39
40(defun upgrade (db) 40(defun upgrade (db)
41 (execute-non-query db "CREATE TABLE IF NOT EXISTS version(id INTEGER PRIMARY KEY, version INTEGER)") 41 (execute-non-query db "CREATE TABLE IF NOT EXISTS version(id INTEGER PRIMARY KEY, version INTEGER)")
@@ -81,4 +81,4 @@ VALUES (?, 'blacklisted'), (?, 'whitelisted')"
81CREATE TABLE inline_bots ( 81CREATE TABLE inline_bots (
82 id INTEGER PRIMARY KEY, 82 id INTEGER PRIMARY KEY,
83 type INTEGER REFERENCES inline_bots_enum(id))")) 83 type INTEGER REFERENCES inline_bots_enum(id))"))
84 (t (error "Unreachable upgrade step reached ~A" new-version)))) 84 (otherwise (error "Unreachable upgrade step reached ~A" new-version))))
diff --git a/src/main.lisp b/src/main.lisp
index 94148a7..28c3801 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -6,6 +6,7 @@
6 (:import-from :alexandria :when-let) 6 (:import-from :alexandria :when-let)
7 (:import-from :com.dieggsy.f-string :enable-f-strings) 7 (:import-from :com.dieggsy.f-string :enable-f-strings)
8 (:import-from :log) 8 (:import-from :log)
9 (:import-from :serapeum :drop)
9 (:import-from :ukkoclot/db :with-db) 10 (:import-from :ukkoclot/db :with-db)
10 (:import-from :ukkoclot/serializing :fixup-value) 11 (:import-from :ukkoclot/serializing :fixup-value)
11 (:import-from :ukkoclot/state :make-bot :bot-config :bot-power-on) 12 (:import-from :ukkoclot/state :make-bot :bot-config :bot-power-on)
@@ -21,10 +22,11 @@
21(defvar *in-prod* t) 22(defvar *in-prod* t)
22 23
23(defmacro reporty ((evt) &body body) 24(defmacro reporty ((evt) &body body)
24 `(if *in-prod* 25 `(cond
25 (handler-case (progn ,@body) 26 (*in-prod*
26 (error (err) (report-error bot ,evt err))) 27 (handler-case (progn ,@body) ; lint:suppress redundant-progn
27 (progn ,@body))) 28 (error (err) (report-error bot ,evt err))))
29 (t ,@body)))
28 30
29(defun main () 31(defun main ()
30 (log:config :debug) 32 (log:config :debug)
@@ -38,11 +40,10 @@
38 40
39(defun main-with-config (config) 41(defun main-with-config (config)
40 (unwind-protect 42 (unwind-protect
41 (progn 43 (with-db (db (config-db-path config))
42 (with-db (db (config-db-path config)) 44 (let ((bot (make-bot config db)))
43 (let ((bot (make-bot config db))) 45 ;; TODO: Catch fatal errors & report them
44 ;; TODO: Catch fatal errors & report them 46 (wrapped-main bot config)))
45 (wrapped-main bot config))))
46 (log:info "We're done!"))) 47 (log:info "We're done!")))
47 48
48(defun wrapped-main (bot config) 49(defun wrapped-main (bot config)
@@ -161,7 +162,7 @@
161 (reply-message bot msg "<b>&gt;:3</b>" :parse-mode html)) 162 (reply-message bot msg "<b>&gt;:3</b>" :parse-mode html))
162 163
163 ((starts-with-ignore-case text "big ") 164 ((starts-with-ignore-case text "big ")
164 (let ((the-text (subseq text 4))) 165 (let ((the-text (drop 4 text)))
165 (unless (is-tg-whitespace-str the-text) 166 (unless (is-tg-whitespace-str the-text)
166 (reply-message bot msg 167 (reply-message bot msg
167 (concatenate 'string 168 (concatenate 'string
@@ -190,12 +191,12 @@
190 "dio cane")) 191 "dio cane"))
191 192
192 ((starts-with-ignore-case text "say ") 193 ((starts-with-ignore-case text "say ")
193 (let ((the-text (subseq text 4))) 194 (let ((the-text (drop 4 text)))
194 (unless (is-tg-whitespace-str the-text) 195 (unless (is-tg-whitespace-str the-text)
195 (reply-message bot msg the-text)))) 196 (reply-message bot msg the-text))))
196 197
197 ((starts-with-ignore-case text "tiny ") 198 ((starts-with-ignore-case text "tiny ")
198 (let ((the-text (subseq text 5))) 199 (let ((the-text (drop 5 text)))
199 (unless (is-tg-whitespace-str the-text) 200 (unless (is-tg-whitespace-str the-text)
200 (reply-message bot msg 201 (reply-message bot msg
201 (map 'string #'(lambda (ch) 202 (map 'string #'(lambda (ch)
@@ -227,13 +228,15 @@
227 (write-string "GIR" s)) 228 (write-string "GIR" s))
228 (if (char= (elt text 3) #\t) 229 (if (char= (elt text 3) #\t)
229 (write-char #\l s) 230 (write-char #\l s)
230 (write-char #\L s)))))))) 231 (write-char #\L s)))))
232
233 (t nil))))
231 234
232(defun simplify-cmd (bot cmd) 235(defun simplify-cmd (bot cmd)
233 (let ((at-idx (position #\@ cmd))) 236 (let ((at-idx (position #\@ cmd)))
234 (if (null at-idx) 237 (if (null at-idx)
235 (subseq cmd 1) 238 (drop 1 cmd)
236 (let ((username (subseq cmd (1+ at-idx))) 239 (let ((username (drop (1+ at-idx) cmd))
237 (my-username (bot-username bot))) 240 (my-username (bot-username bot)))
238 (if (equal username my-username) 241 (if (equal username my-username)
239 (subseq cmd 1 at-idx) 242 (subseq cmd 1 at-idx)
diff --git a/src/serializing.lisp b/src/serializing.lisp
index 7fafb3a..205190f 100644
--- a/src/serializing.lisp
+++ b/src/serializing.lisp
@@ -47,14 +47,14 @@
47 json)) 47 json))
48 48
49(defmethod parse-value ((type cons) json) 49(defmethod parse-value ((type cons) json)
50 (cond ((and (eq (car type) 'array) 50 (cond ((and (eq (first type) 'array)
51 (null (cddr type))) 51 (null (cddr type)))
52 (when json 52 (when json
53 (let ((element-type (cadr type))) 53 (let ((element-type (cadr type)))
54 (iter (for element in-vector json) 54 (iter (for element in-vector json)
55 (collect (parse-value element-type element) result-type vector))))) 55 (collect (parse-value element-type element) result-type vector)))))
56 ((eq (car type) 'or) 56 ((eq (first type) 'or)
57 (iter (for el-type in (cdr type)) 57 (iter (for el-type in (rest type))
58 (multiple-value-bind (success res) (try-parse-value el-type json) 58 (multiple-value-bind (success res) (try-parse-value el-type json)
59 (when success 59 (when success
60 (return res))) 60 (return res)))
diff --git a/src/strings.lisp b/src/strings.lisp
index f08010e..b1b4f00 100644
--- a/src/strings.lisp
+++ b/src/strings.lisp
@@ -34,7 +34,7 @@
34 (#\> (write-string "&gt;" out)) 34 (#\> (write-string "&gt;" out))
35 (#\& (write-string "&amp;" out)) 35 (#\& (write-string "&amp;" out))
36 (#\" (write-string "&quot;" out)) 36 (#\" (write-string "&quot;" out))
37 (t (write-char ch out))))) 37 (otherwise (write-char ch out)))))
38 38
39(defun is-tg-whitespace (ch) 39(defun is-tg-whitespace (ch)
40 (let ((gc (general-category ch))) 40 (let ((gc (general-category ch)))
@@ -65,14 +65,14 @@
65 (loop for ch across str do 65 (loop for ch across str do
66 (case ch 66 (case ch
67 (#\- (write-char #\_ out)) 67 (#\- (write-char #\_ out))
68 (t (write-char ch out)))))) 68 (otherwise (write-char ch out))))))
69 69
70(defun snake->lisp-case (str) 70(defun snake->lisp-case (str)
71 (with-output-to-string (out) 71 (with-output-to-string (out)
72 (loop for ch across str do 72 (loop for ch across str do
73 (case ch 73 (case ch
74 (#\_ (write-char #\- out)) 74 (#\_ (write-char #\- out))
75 (t (write-char ch out)))))) 75 (otherwise (write-char ch out))))))
76 76
77(defun starts-with (str prefix) 77(defun starts-with (str prefix)
78 (and (> (length str) (length prefix)) 78 (and (> (length str) (length prefix))