From 7f3817548078926715a0edd4da4ed8eb68818024 Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Sat, 18 Oct 2025 08:06:22 +0300 Subject: Get rid of anaphora --- src/main.lisp | 60 ++++++++++++++++++++++++++++-------------------------- src/transport.lisp | 38 ++++++++++++++++++++-------------- 2 files changed, 54 insertions(+), 44 deletions(-) (limited to 'src') diff --git a/src/main.lisp b/src/main.lisp index cd9e755..94148a7 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -2,8 +2,8 @@ ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/main (:nicknames :ukkoclot) - (:use :c2cl :ukkoclot/config :ukkoclot/inline-bots :ukkoclot/tg) - (:import-from :anaphora :acond :awhen :it) + (:use :c2cl :iterate :ukkoclot/config :ukkoclot/inline-bots :ukkoclot/tg) + (:import-from :alexandria :when-let) (:import-from :com.dieggsy.f-string :enable-f-strings) (:import-from :log) (:import-from :ukkoclot/db :with-db) @@ -55,12 +55,12 @@ (loop for update across updates do (unwind-protect (progn - (awhen (update-message update) - (reporty (it) - (on-message bot it))) - (awhen (update-callback-query update) - (reporty (it) - (on-callback-query bot it)))) + (when-let (msg (update-message update)) + (reporty (msg) + (on-message bot msg))) + (when-let (cbq (update-callback-query update)) + (reporty (cbq) + (on-callback-query bot 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)) @@ -74,10 +74,10 @@ (config-owner (bot-config bot)))) (let ((bot-id (read-from-string data t nil :start 4))) (blacklist-inline-bot bot bot-id)) - (awhen (callback-query-message cb) + (when-let (msg (callback-query-message cb)) (delete-message bot - :chat-id (message-chat-id it) - :message-id (message-id it))) + :chat-id (message-chat-id msg) + :message-id (message-id msg))) (answer-callback-query bot :callback-query-id (callback-query-id cb) :text "OK")) @@ -87,10 +87,10 @@ (config-owner (bot-config bot)))) (let ((bot-id (read-from-string data t nil :start 4))) (whitelist-inline-bot bot bot-id)) - (awhen (callback-query-message cb) + (when-let (msg (callback-query-message cb)) (delete-message bot - :chat-id (message-chat-id it) - :message-id (message-id it))) + :chat-id (message-chat-id msg) + :message-id (message-id msg))) (answer-callback-query bot :callback-query-id (callback-query-id cb) :text "OK")) @@ -104,15 +104,16 @@ (defun on-message (bot msg) (block nil - (awhen (message-via-bot msg) - (unless (on-inline-bot bot msg it) + (when-let (inline-bot (message-via-bot msg)) + (unless (on-inline-bot bot msg inline-bot) (return))) - (awhen (message-text msg) - (on-text-message bot msg it)) + (when-let (text (message-text msg)) + (on-text-message bot msg text)) - (awhen (message-new-chat-members msg) - (loop for new-chat-member across it do + (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))))) (defun on-new-member (bot msg new-member) @@ -145,11 +146,12 @@ ;; warn gets removed after a month of no warns (return)) - (awhen (message-entities msg) - (loop for entity across it - when (and (equal (message-entity-type entity) bot-command) - (= (message-entity-offset entity) 0)) - do (on-text-command bot msg text (message-entity-extract entity text)))) + (when-let (entities (message-entities msg)) + (iter + (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))))) ;; TODO: Replace this cond with a nicer dispatch. Something like string-case? (cond ((equal text ":3") @@ -241,15 +243,15 @@ (let ((simple-cmd (simplify-cmd bot cmd))) (log:debug "text-command: ~A AKA ~A" cmd simple-cmd) ;; TODO: Replace this cond with a nicer dispatch. Something like string-case? - (acond + (cond ((equal simple-cmd "chatid") (reply-message bot msg #f"{(message-chat-id msg)}" :parse-mode html)) - ((and (equal simple-cmd "msginfo") - (message-reply-to-message msg)) - (reply-message bot it (let ((*print-pretty* t)) (fixup-value it)))) + ((equal simple-cmd "msginfo") + (when-let (replied (message-reply-to-message msg)) + (reply-message bot replied (let ((*print-pretty* t)) (fixup-value replied))))) ((equal simple-cmd "ping") (let* ((start-time (get-internal-real-time)) diff --git a/src/transport.lisp b/src/transport.lisp index 941341a..d47db4d 100644 --- a/src/transport.lisp +++ b/src/transport.lisp @@ -1,8 +1,8 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/transport + (:documentation "Package dealing with HTTP calls.") (:use :c2cl) - (:import-from :anaphora :aand :acond :it) (:import-from :cl+ssl) (:import-from :dex) (:import-from :log) @@ -14,6 +14,7 @@ (in-package :ukkoclot/transport) (defun req (uri method content) + "Wrapper function for making a request." (let ((retrier (dex:retry-request 5 :interval 1)) ;; This is needed to avoid hangs, ;; see https://github.com/fukamachi/dexador/issues/91#issuecomment-1093472364 @@ -25,22 +26,29 @@ (cl+ssl::ssl-error (e) (funcall retrier e))))) (defun do-call% (method uri out-type args-encoded) - (let ((body (req uri method args-encoded))) - (let ((hash (jzon:parse body))) - (acond - ((gethash "ok" hash) (parse-value out-type (gethash "result" hash))) - ((aand (gethash "parameters" hash) - (gethash "retry_after" it)) - (log:info "Should sleep for ~A seconds" it) - (sleep it) - (log:info "Good morning!") - (do-call% method uri out-type args-encoded)) - (t (error "TG error ~A: ~A ~:A" - (gethash "error_code" hash) - (gethash "description" hash) - (gethash "parameters" hash))))))) + "Internal function with the arguments already encoded. + +See `do-call'." + (let* ((body (req uri method args-encoded)) + (hash (jzon:parse body))) + (if (gethash "ok" hash) + (parse-value out-type (gethash "result" hash)) + (let* ((error-code (gethash "error_code" hash)) + (description (gethash "description" hash)) + (parameters (gethash "parameters" hash)) + (retry-after (when parameters (gethash "retry_after" parameters)))) + (cond + (retry-after + (log:info "Should sleep for ~A seconds" retry-after) + (sleep retry-after) + (log:info "Good morning!") + (do-call% method uri out-type args-encoded)) + (t + (error "TG error ~A: ~A ~:A" + error-code description parameters))))))) (defun do-call (bot method path out-type args) + "Perform a HTTP call." (let ((uri (concatenate 'string (bot-base-uri bot) path)) (args-encoded (fixup-args args))) (log:debug "~A .../~A ~S" method path args-encoded) -- cgit v1.2.3