diff options
Diffstat (limited to 'src/main.lisp')
| -rw-r--r-- | src/main.lisp | 33 |
1 files changed, 18 insertions, 15 deletions
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>>:3</b>" :parse-mode html)) | 162 | (reply-message bot msg "<b>>: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) |