From 6c4a545b30c601047091ac9439741ba52a3334d2 Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Sun, 19 Oct 2025 08:50:52 +0300 Subject: Make state be a global special variable --- src/main.lisp | 126 +++++++++++++++++++++++++++------------------------------- 1 file changed, 58 insertions(+), 68 deletions(-) (limited to 'src/main.lisp') diff --git a/src/main.lisp b/src/main.lisp index caef651..fa7fab0 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -8,10 +8,10 @@ (:import-from :conf) (:import-from :log) (:import-from :serapeum :drop) + (:import-from :state :*state* :make-state) (:import-from :str) (:import-from :ukkoclot/src/db :with-db) (:import-from :ukkoclot/src/serializing :fixup-value) - (:import-from :ukkoclot/src/state :make-bot :bot-power-on) (:import-from :ukkoclot/src/strings :escape-xml :is-tg-whitespace :is-tg-whitespace-str) (:local-nicknames (:jzon :com.inuoe.jzon)) @@ -26,7 +26,7 @@ `(cond (*in-prod* (handler-case (progn ,@body) ; lint:suppress redundant-progn - (error (err) (report-error bot ,evt err)))) + (error (err) (report-error ,evt err)))) (t ,@body))) (defun main () @@ -43,87 +43,82 @@ (defun main-with-config () (unwind-protect (with-db (db (conf:db-path)) - (let ((bot (make-bot db))) - ;; TODO: Catch fatal errors & report them - (wrapped-main bot))) + (setf *state* (make-state db)) + ;; TODO: Catch fatal errors & report them + (wrapped-main)) (log:info "We're done!"))) -(defun wrapped-main (bot) +(defun wrapped-main () (when *in-prod* - (send-message bot :chat-id (conf:dev-group) :text "Initializing...")) - (set-my-name bot :name (conf:bot-name)) + (send-message :chat-id (conf:dev-group) :text "Initializing...")) + (set-my-name :name (conf:bot-name)) (let ((gup-offset 0)) - (loop while (bot-power-on bot) do - (let ((updates (get-updates bot :timeout 60 :offset gup-offset))) + (loop while (state:power-on) do + (let ((updates (get-updates :timeout 60 :offset gup-offset))) (loop for update across updates do (unwind-protect (progn (when-let (msg (update-message update)) (reporty (msg) - (on-message bot msg))) + (on-message msg))) (when-let (cbq (update-callback-query update)) (reporty (cbq) - (on-callback-query bot cbq)))) + (on-callback-query cbq)))) (setf gup-offset (1+ (update-update-id update))))))) ;; One last getUpdates to make sure offset is stored on server - (get-updates bot :timeout 0 :limit 1 :offset gup-offset)) - (send-message bot :chat-id (conf:dev-group) :text "Shutting down...")) + (get-updates :timeout 0 :limit 1 :offset gup-offset)) + (send-message :chat-id (conf:dev-group) :text "Shutting down...")) -(defun on-callback-query (bot cb) +(defun on-callback-query (cb) (let ((data (callback-query-data cb))) (cond ((and data (str:starts-with-p "bbl:" data :ignore-case nil) (= (user-id (callback-query-from cb)) (conf:owner))) (let ((bot-id (read-from-string data t nil :start 4))) - (blacklist-inline-bot bot bot-id)) + (blacklist-inline-bot bot-id)) (when-let (msg (callback-query-message cb)) - (delete-message bot - :chat-id (message-chat-id msg) + (delete-message :chat-id (message-chat-id msg) :message-id (message-id msg))) - (answer-callback-query bot - :callback-query-id (callback-query-id cb) + (answer-callback-query :callback-query-id (callback-query-id cb) :text "OK")) ((and data (str:starts-with-p "bwl:" data :ignore-case nil) (= (user-id (callback-query-from cb)) (conf:owner))) (let ((bot-id (read-from-string data t nil :start 4))) - (whitelist-inline-bot bot bot-id)) + (whitelist-inline-bot bot-id)) (when-let (msg (callback-query-message cb)) - (delete-message bot - :chat-id (message-chat-id msg) + (delete-message :chat-id (message-chat-id msg) :message-id (message-id msg))) - (answer-callback-query bot - :callback-query-id (callback-query-id cb) + (answer-callback-query :callback-query-id (callback-query-id cb) :text "OK")) (t (log:info "Unrecognised callback query data: ~A" data) - (answer-callback-query bot - :callback-query-id (callback-query-id cb) + (answer-callback-query :callback-query-id (callback-query-id cb) :text "Unallowed callback query, don't press the button again" :show-alert t))))) -(defun on-message (bot msg) +(defun on-message (msg) (block nil (when-let (inline-bot (message-via-bot msg)) - (unless (on-inline-bot bot msg inline-bot) + (unless (on-inline-bot msg inline-bot) (return))) (when-let (text (message-text msg)) - (on-text-message bot msg text)) + (on-text-message msg text)) (when-let (new-chat-members (message-new-chat-members msg)) (iter (for new-chat-member in-vector new-chat-members) - (on-new-member bot msg new-chat-member))))) + (on-new-member msg new-chat-member))))) -(defun on-new-member (bot msg new-member) - (if (= (user-id new-member) (bot-id bot)) - (reply-animation bot msg #P"blob/rule-11.mp4" +(defun on-new-member (msg new-member) + (if (= (user-id new-member) (bot-id)) + (reply-animation msg #P"blob/rule-11.mp4" :allow-sending-without-reply t) - (reply-animation bot msg #P"blob/rule-10.mp4" + (reply-animation msg #P"blob/rule-10.mp4" :text (concatenate 'string "Hello there, " (user-format-name new-member) "! Be on your bestest behaviour now!!") @@ -136,7 +131,7 @@ ;; TODO: nil) -(defun on-text-message (bot msg text) +(defun on-text-message (msg text) (block nil (when (is-bad-text text) ;; TODO: Delete message, mute & warn user @@ -155,19 +150,19 @@ (for entity in-vector entities) (when (and (eql (message-entity-type entity) bot-command) (zerop (message-entity-offset entity))) - (on-text-command bot msg text (message-entity-extract entity text))))) + (on-text-command msg text (message-entity-extract entity text))))) ;; TODO: Replace this cond with a nicer dispatch. Something like string-case? (cond ((equal text ":3") - (reply-message bot msg ">:3")) + (reply-message msg ">:3")) ((equal text ">:3") - (reply-message bot msg ">:3" :parse-mode html)) + (reply-message msg ">:3" :parse-mode html)) ((str:starts-with-p "big " text) (let ((the-text (drop 4 text))) (unless (is-tg-whitespace-str the-text) - (reply-message bot msg + (reply-message msg (concatenate 'string "" (escape-xml (string-upcase the-text)) @@ -175,33 +170,31 @@ :parse-mode html)))) ((string-equal text "dio cane") - (reply-message bot - (or (message-reply-to-message msg) msg) + (reply-message (or (message-reply-to-message msg) msg) "porco dio")) ((string-equal text "forgor") - (reply-message bot msg "💀")) + (reply-message msg "💀")) ((string-equal text "huh") - (reply-message bot msg "idgi")) + (reply-message msg "idgi")) ((string= text "H") - (reply-message bot msg "Randomly selected reminder that h > H." :parse-mode html)) + (reply-message msg "Randomly selected reminder that h > H." :parse-mode html)) ((string-equal text "porco dio") - (reply-message bot - (or (message-reply-to-message msg) msg) + (reply-message (or (message-reply-to-message msg) msg) "dio cane")) ((str:starts-with-p "say " text) (let ((the-text (drop 4 text))) (unless (is-tg-whitespace-str the-text) - (reply-message bot msg the-text)))) + (reply-message msg the-text)))) ((str:starts-with-p "tiny " text) (let ((the-text (drop 5 text))) (unless (is-tg-whitespace-str the-text) - (reply-message bot msg + (reply-message msg (map 'string #'(lambda (ch) (if (is-tg-whitespace ch) ch @@ -209,16 +202,15 @@ the-text))))) ((string-equal text "uwu") - (reply-message bot msg "OwO")) + (reply-message msg "OwO")) ((string-equal text "waow") (reply-message - bot (or (message-reply-to-message msg) msg) "BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED")) ((string-equal text "what") - (reply-message bot msg + (reply-message msg (with-output-to-string (s) (if (char= (elt text 0) #\w) (write-char #\g s) @@ -235,55 +227,53 @@ (t nil)))) -(defun simplify-cmd (bot cmd) +(defun simplify-cmd (cmd) (let ((at-idx (position #\@ cmd))) (if (null at-idx) (drop 1 cmd) (let ((username (drop (1+ at-idx) cmd)) - (my-username (bot-username bot))) + (my-username (bot-username))) (if (equal username my-username) (subseq cmd 1 at-idx) nil))))) -(defun on-text-command (bot msg text cmd) +(defun on-text-command (msg text cmd) (declare (ignore text)) - (let ((simple-cmd (simplify-cmd bot cmd))) + (let ((simple-cmd (simplify-cmd cmd))) (log:debug "text-command: ~A AKA ~A" cmd simple-cmd) ;; TODO: Replace this cond with a nicer dispatch. Something like string-case? (cond ((equal simple-cmd "chatid") - (reply-message bot msg + (reply-message msg #f"{(message-chat-id msg)}" :parse-mode html)) ((equal simple-cmd "msginfo") (when-let (replied (message-reply-to-message msg)) - (reply-message bot replied (let ((*print-pretty* t)) (fixup-value replied))))) + (reply-message replied (let ((*print-pretty* t)) (fixup-value replied))))) ((equal simple-cmd "ping") (let* ((start-time (get-internal-real-time)) - (reply (reply-message bot msg #f"Pong!{;~2%}Send time: ...")) + (reply (reply-message msg #f"Pong!{;~2%}Send time: ...")) (end-time (get-internal-real-time)) (time-elapsed (* (/ (- end-time start-time) internal-time-units-per-second) 1000))) - (edit-message-text bot - :chat-id (message-chat-id reply) + (edit-message-text :chat-id (message-chat-id reply) :message-id (message-id reply) :text #f"Pong!{;~2%}Send time: {time-elapsed;~G}ms"))) ((and (equal simple-cmd "shutdown") (message-from msg) (= (user-id (message-from msg)) (conf:owner))) - (setf (bot-power-on bot) nil) - (reply-message bot msg "Initialising shutdown..." :allow-sending-without-reply t))))) + (setf (state:power-on) nil) + (reply-message msg "Initialising shutdown..." :allow-sending-without-reply t))))) (defun escape-xml-obj (obj) (escape-xml #f"{obj}")) -(defun report-error (bot evt err) +(defun report-error (evt err) (log:error "While handling ~A: ~A" evt err) (let ((msg #f"{(escape-xml-obj err)} while handling{;~%}
{(escape-xml-obj evt)}
")) - (send-message bot - :chat-id (conf:dev-group) - :text msg - :parse-mode html))) + (send-message :chat-id (conf:dev-group) + :text msg + :parse-mode html))) -- cgit v1.2.3