From 0e6ad43b6ccdf3c67d1e2f6fe2dcfab3e4cc3552 Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Mon, 13 Oct 2025 06:06:51 +0300 Subject: Improve define-tg-method --- src/bot/method-macros.lisp | 16 +++++++++++----- src/bot/methods.lisp | 18 +++++++++--------- 2 files changed, 20 insertions(+), 14 deletions(-) (limited to 'src/bot') diff --git a/src/bot/method-macros.lisp b/src/bot/method-macros.lisp index 0500de9..d4f04ad 100644 --- a/src/bot/method-macros.lisp +++ b/src/bot/method-macros.lisp @@ -3,6 +3,7 @@ (defpackage :ukkoclot/bot/method-macros (:use :c2cl :iterate) (:import-from :ukkoclot/state :bot) + (:import-from :ukkoclot/strings :ends-with :lisp->camel-case) (:import-from :ukkoclot/transport :do-call) (:export :define-tg-method)) (in-package :ukkoclot/bot/method-macros) @@ -25,6 +26,12 @@ (iter (for param-spec in param-specs) (collect (apply #'make-param param-spec)))) + (defun path-from-name (name) + (let ((str (lisp->camel-case (symbol-name name)))) + (if (ends-with str "%") + (subseq str 0 (- (length str) 1)) + str))) + (defun emit-append-to-args (param args) `(setf ,args (acons ',(param-name param) ,(param-name param) ,args))) @@ -35,7 +42,7 @@ (defun emit-defun-arg (param) `(,(param-name param) ,(param-default param))) - (defun emit-defun (name return-type params method path) + (defun emit-defun (name return-type params method) (let ((revparams (reverse params)) (args (gensym "ARGS")) (bot (gensym "BOT"))) @@ -48,7 +55,7 @@ ,(param-default param)) ,(emit-append-to-args param args)) (emit-append-to-args param args)))) - (do-call ,bot ,method ,path ',return-type ,args))))) + (do-call ,bot ,method ,(path-from-name name) ',return-type ,args))))) (defun emit-ftype (name return-type params) `(declaim (ftype (function (bot &key ,@(iter (for param in params) @@ -56,11 +63,10 @@ ,return-type) ,name)))) -;; TODO: Automatically derive path from name (defmacro define-tg-method ( - (name type path &optional (method :POST)) + (name type &optional (method :POST)) &body param-specs) (let ((params (parse-param-specs param-specs))) `(progn ,(emit-ftype name type params) - ,(emit-defun name type params method path)))) + ,(emit-defun name type params method)))) diff --git a/src/bot/methods.lisp b/src/bot/methods.lisp index 2daea6f..6f01cae 100644 --- a/src/bot/methods.lisp +++ b/src/bot/methods.lisp @@ -6,19 +6,19 @@ (:export :answer-callback-query :delete-message :send-animation :edit-message-text :get-me :get-updates :send-message :set-my-name)) (in-package :ukkoclot/bot/methods) -(define-tg-method (answer-callback-query boolean "answerCallbackQuery") +(define-tg-method (answer-callback-query boolean) (callback-query-id string) (text (or string null) nil) (show-alert boolean nil) (url (or string null) nil) (cache-time (or integer null) nil)) -(define-tg-method (delete-message boolean "deleteMessage") +(define-tg-method (delete-message boolean) (chat-id (or integer string)) (message-id integer)) ;; TODO: Add a way to simply specify :message msg :) -(define-tg-method (edit-message-text message "editMessageText") +(define-tg-method (edit-message-text message) (business-connection-id (or string null) nil) (chat-id (or integer string null) nil) (message-id (or integer null) nil) @@ -29,7 +29,7 @@ (link-preview-options (or link-preview-options null) nil) (reply-markup (or inline-keyboard-markup null) nil)) -(define-tg-method (get-me% user "getMe" :GET)) +(define-tg-method (get-me% user :GET)) (defun get-me (bot) (let ((res (get-me% bot))) @@ -37,16 +37,16 @@ (setf (bot-username% bot) (user-username res)) res)) -(define-tg-method (get-my-name bot-name "getMyName" :GET) +(define-tg-method (get-my-name bot-name :GET) (language-code (or string null) nil)) -(define-tg-method (get-updates (array update) "getUpdates") +(define-tg-method (get-updates (array update)) (offset (or integer null) nil) (limit (or integer null) nil) (timeout (or integer null) nil) (allowed-updates (or string null) nil)) -(define-tg-method (send-animation message "sendAnimation") +(define-tg-method (send-animation message) (business-connection-id (or string null) nil) (chat-id (or integer string)) (message-thread-id (or integer null) nil) @@ -69,7 +69,7 @@ (reply-parameters (or reply-parameters null) nil) (reply-markup (or inline-keyboard-markup reply-keyboard-markup reply-keyboard-remove force-reply null) nil)) -(define-tg-method (send-message message "sendMessage") +(define-tg-method (send-message message) (business-connection-id (or string null) nil) (chat-id (or integer string)) (message-thread-id (or integer null) nil) @@ -83,7 +83,7 @@ (reply-parameters (or reply-parameters null) nil) (reply-markup (or inline-keyboard-markup reply-keyboard-markup reply-keyboard-remove force-reply null) nil)) -(define-tg-method (set-my-name% boolean "setMyName") +(define-tg-method (set-my-name% boolean) (name (or string null) nil) (language-code (or string null) nil)) -- cgit v1.2.3