From a802a63364721a2da95b75bc8ab19abfa4888373 Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Sat, 18 Oct 2025 08:19:45 +0300 Subject: Bunch more tiny improvements --- src/db.lisp | 6 +++--- src/main.lisp | 33 ++++++++++++++++++--------------- src/serializing.lisp | 6 +++--- src/strings.lisp | 6 +++--- 4 files changed, 27 insertions(+), 24 deletions(-) (limited to 'src') 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 @@ (case type (:blacklisted 0) (:whitelisted 1) - (t (error "Unknown inline bot type ~S" type)))) + (otherwise (error "Unknown inline bot type ~S" type)))) (defun integer->inline-bot-type (num) (case num (0 :blacklisted) (1 :whitelisted) - (t (error "Unknown inline bot type value ~S" num)))) + (otherwise (error "Unknown inline bot type value ~S" num)))) (defun upgrade (db) (execute-non-query db "CREATE TABLE IF NOT EXISTS version(id INTEGER PRIMARY KEY, version INTEGER)") @@ -81,4 +81,4 @@ VALUES (?, 'blacklisted'), (?, 'whitelisted')" CREATE TABLE inline_bots ( id INTEGER PRIMARY KEY, type INTEGER REFERENCES inline_bots_enum(id))")) - (t (error "Unreachable upgrade step reached ~A" new-version)))) + (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 @@ (:import-from :alexandria :when-let) (:import-from :com.dieggsy.f-string :enable-f-strings) (:import-from :log) + (:import-from :serapeum :drop) (:import-from :ukkoclot/db :with-db) (:import-from :ukkoclot/serializing :fixup-value) (:import-from :ukkoclot/state :make-bot :bot-config :bot-power-on) @@ -21,10 +22,11 @@ (defvar *in-prod* t) (defmacro reporty ((evt) &body body) - `(if *in-prod* - (handler-case (progn ,@body) - (error (err) (report-error bot ,evt err))) - (progn ,@body))) + `(cond + (*in-prod* + (handler-case (progn ,@body) ; lint:suppress redundant-progn + (error (err) (report-error bot ,evt err)))) + (t ,@body))) (defun main () (log:config :debug) @@ -38,11 +40,10 @@ (defun main-with-config (config) (unwind-protect - (progn - (with-db (db (config-db-path config)) - (let ((bot (make-bot config db))) - ;; TODO: Catch fatal errors & report them - (wrapped-main bot config)))) + (with-db (db (config-db-path config)) + (let ((bot (make-bot config db))) + ;; TODO: Catch fatal errors & report them + (wrapped-main bot config))) (log:info "We're done!"))) (defun wrapped-main (bot config) @@ -161,7 +162,7 @@ (reply-message bot msg ">:3" :parse-mode html)) ((starts-with-ignore-case text "big ") - (let ((the-text (subseq text 4))) + (let ((the-text (drop 4 text))) (unless (is-tg-whitespace-str the-text) (reply-message bot msg (concatenate 'string @@ -190,12 +191,12 @@ "dio cane")) ((starts-with-ignore-case text "say ") - (let ((the-text (subseq text 4))) + (let ((the-text (drop 4 text))) (unless (is-tg-whitespace-str the-text) (reply-message bot msg the-text)))) ((starts-with-ignore-case text "tiny ") - (let ((the-text (subseq text 5))) + (let ((the-text (drop 5 text))) (unless (is-tg-whitespace-str the-text) (reply-message bot msg (map 'string #'(lambda (ch) @@ -227,13 +228,15 @@ (write-string "GIR" s)) (if (char= (elt text 3) #\t) (write-char #\l s) - (write-char #\L s)))))))) + (write-char #\L s))))) + + (t nil)))) (defun simplify-cmd (bot cmd) (let ((at-idx (position #\@ cmd))) (if (null at-idx) - (subseq cmd 1) - (let ((username (subseq cmd (1+ at-idx))) + (drop 1 cmd) + (let ((username (drop (1+ at-idx) cmd)) (my-username (bot-username bot))) (if (equal username my-username) (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 @@ json)) (defmethod parse-value ((type cons) json) - (cond ((and (eq (car type) 'array) + (cond ((and (eq (first type) 'array) (null (cddr type))) (when json (let ((element-type (cadr type))) (iter (for element in-vector json) (collect (parse-value element-type element) result-type vector))))) - ((eq (car type) 'or) - (iter (for el-type in (cdr type)) + ((eq (first type) 'or) + (iter (for el-type in (rest type)) (multiple-value-bind (success res) (try-parse-value el-type json) (when success (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 @@ (#\> (write-string ">" out)) (#\& (write-string "&" out)) (#\" (write-string """ out)) - (t (write-char ch out))))) + (otherwise (write-char ch out))))) (defun is-tg-whitespace (ch) (let ((gc (general-category ch))) @@ -65,14 +65,14 @@ (loop for ch across str do (case ch (#\- (write-char #\_ out)) - (t (write-char ch out)))))) + (otherwise (write-char ch out)))))) (defun snake->lisp-case (str) (with-output-to-string (out) (loop for ch across str do (case ch (#\_ (write-char #\- out)) - (t (write-char ch out)))))) + (otherwise (write-char ch out)))))) (defun starts-with (str prefix) (and (> (length str) (length prefix)) -- cgit v1.2.3