From cf7a89781d32365026df402338d4f462666ad3a3 Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Mon, 13 Oct 2025 06:51:46 +0300 Subject: Move bot/method-macros to tg/method-macros --- src/bot/method-macros.lisp | 72 --------------------------------------- src/tg/answer-callback-query.lisp | 2 +- src/tg/delete-message.lisp | 2 +- src/tg/edit-message-text.lisp | 2 +- src/tg/get-me.lisp | 2 +- src/tg/get-my-name.lisp | 2 +- src/tg/get-updates.lisp | 2 +- src/tg/method-macros.lisp | 72 +++++++++++++++++++++++++++++++++++++++ src/tg/send-animation.lisp | 2 +- src/tg/send-message.lisp | 2 +- src/tg/set-my-name.lisp | 2 +- 11 files changed, 81 insertions(+), 81 deletions(-) delete mode 100644 src/bot/method-macros.lisp create mode 100644 src/tg/method-macros.lisp diff --git a/src/bot/method-macros.lisp b/src/bot/method-macros.lisp deleted file mode 100644 index d4f04ad..0000000 --- a/src/bot/method-macros.lisp +++ /dev/null @@ -1,72 +0,0 @@ -;; SPDX-License-Identifier: EUPL-1.2 -;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs -(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) - -(eval-when (:compile-toplevel :load-toplevel :execute) - (defstruct (param (:constructor make-param%)) name type default skip-if-default) - - (defparameter +unique+ (gensym)) - - (defun make-param (name type &optional (default +unique+) &key (skip-if-default (not (eq default +unique+)))) - (let ((default (if (eq default +unique+) - `(error ,(format nil "No value given for ~A" name)) - default))) - (make-param% :name name - :type type - :default default - :skip-if-default skip-if-default))) - - (defun parse-param-specs (param-specs) - (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))) - - (defun emit-arg-type (param) - `(,(intern (symbol-name (param-name param)) :keyword) - ,(param-type param))) - - (defun emit-defun-arg (param) - `(,(param-name param) ,(param-default param))) - - (defun emit-defun (name return-type params method) - (let ((revparams (reverse params)) - (args (gensym "ARGS")) - (bot (gensym "BOT"))) - `(defun ,name (,bot &key ,@(iter (for param in params) - (collect (emit-defun-arg param)))) - (let (,args) - ,@(iter (for param in revparams) - (collect (if (param-skip-if-default param) - `(unless (equal ,(param-name param) - ,(param-default param)) - ,(emit-append-to-args param args)) - (emit-append-to-args param 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) - (collect (emit-arg-type param)))) - ,return-type) - ,name)))) - -(defmacro define-tg-method ( - (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)))) diff --git a/src/tg/answer-callback-query.lisp b/src/tg/answer-callback-query.lisp index badd8a4..c7ecb5f 100644 --- a/src/tg/answer-callback-query.lisp +++ b/src/tg/answer-callback-query.lisp @@ -1,7 +1,7 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/tg/answer-callback-query - (:use :c2cl :ukkoclot/bot/method-macros) + (:use :c2cl :ukkoclot/tg/method-macros) (:export :answer-callback-query)) (in-package :ukkoclot/tg/answer-callback-query) diff --git a/src/tg/delete-message.lisp b/src/tg/delete-message.lisp index fd6f323..54cfc8b 100644 --- a/src/tg/delete-message.lisp +++ b/src/tg/delete-message.lisp @@ -1,7 +1,7 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/tg/delete-message - (:use :c2cl :ukkoclot/tg/message :ukkoclot/bot/method-macros :ukkoclot/tg/send-animation) + (:use :c2cl :ukkoclot/tg/message :ukkoclot/tg/method-macros :ukkoclot/tg/send-animation) (:export :delete-message :try-delete-message)) (in-package :ukkoclot/tg/delete-message) diff --git a/src/tg/edit-message-text.lisp b/src/tg/edit-message-text.lisp index a7db3a8..65e2cc7 100644 --- a/src/tg/edit-message-text.lisp +++ b/src/tg/edit-message-text.lisp @@ -7,7 +7,7 @@ :ukkoclot/tg/link-preview-options :ukkoclot/tg/message :ukkoclot/tg/message-entity - :ukkoclot/bot/method-macros + :ukkoclot/tg/method-macros :ukkoclot/tg/parse-mode) (:export :edit-message-text)) (in-package :ukkoclot/tg/edit-message-text) diff --git a/src/tg/get-me.lisp b/src/tg/get-me.lisp index cfb1304..e4a6de5 100644 --- a/src/tg/get-me.lisp +++ b/src/tg/get-me.lisp @@ -1,7 +1,7 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/tg/get-me - (:use :c2cl :ukkoclot/bot/method-macros :ukkoclot/tg/user) + (:use :c2cl :ukkoclot/tg/method-macros :ukkoclot/tg/user) (:import-from :ukkoclot/state :bot-id% :bot-username%) (:export :bot-id :bot-username :get-me)) (in-package :ukkoclot/tg/get-me) diff --git a/src/tg/get-my-name.lisp b/src/tg/get-my-name.lisp index 59bb753..a597fe0 100644 --- a/src/tg/get-my-name.lisp +++ b/src/tg/get-my-name.lisp @@ -1,7 +1,7 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/tg/get-my-name - (:use :c2cl :ukkoclot/tg/bot-name :ukkoclot/bot/method-macros) + (:use :c2cl :ukkoclot/tg/bot-name :ukkoclot/tg/method-macros) (:export :get-my-name)) (in-package :ukkoclot/tg/get-my-name) diff --git a/src/tg/get-updates.lisp b/src/tg/get-updates.lisp index 15f5e3f..5192e3c 100644 --- a/src/tg/get-updates.lisp +++ b/src/tg/get-updates.lisp @@ -1,7 +1,7 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/tg/get-updates - (:use :c2cl :ukkoclot/bot/method-macros :ukkoclot/tg/update) + (:use :c2cl :ukkoclot/tg/method-macros :ukkoclot/tg/update) (:export :get-updates)) (in-package :ukkoclot/tg/get-updates) diff --git a/src/tg/method-macros.lisp b/src/tg/method-macros.lisp new file mode 100644 index 0000000..3599328 --- /dev/null +++ b/src/tg/method-macros.lisp @@ -0,0 +1,72 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg/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/tg/method-macros) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defstruct (param (:constructor make-param%)) name type default skip-if-default) + + (defparameter +unique+ (gensym)) + + (defun make-param (name type &optional (default +unique+) &key (skip-if-default (not (eq default +unique+)))) + (let ((default (if (eq default +unique+) + `(error ,(format nil "No value given for ~A" name)) + default))) + (make-param% :name name + :type type + :default default + :skip-if-default skip-if-default))) + + (defun parse-param-specs (param-specs) + (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))) + + (defun emit-arg-type (param) + `(,(intern (symbol-name (param-name param)) :keyword) + ,(param-type param))) + + (defun emit-defun-arg (param) + `(,(param-name param) ,(param-default param))) + + (defun emit-defun (name return-type params method) + (let ((revparams (reverse params)) + (args (gensym "ARGS")) + (bot (gensym "BOT"))) + `(defun ,name (,bot &key ,@(iter (for param in params) + (collect (emit-defun-arg param)))) + (let (,args) + ,@(iter (for param in revparams) + (collect (if (param-skip-if-default param) + `(unless (equal ,(param-name param) + ,(param-default param)) + ,(emit-append-to-args param args)) + (emit-append-to-args param 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) + (collect (emit-arg-type param)))) + ,return-type) + ,name)))) + +(defmacro define-tg-method ( + (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)))) diff --git a/src/tg/send-animation.lisp b/src/tg/send-animation.lisp index 97dd9f0..1fd7a89 100644 --- a/src/tg/send-animation.lisp +++ b/src/tg/send-animation.lisp @@ -7,7 +7,7 @@ :ukkoclot/tg/inline-keyboard-markup :ukkoclot/tg/message :ukkoclot/tg/message-entity - :ukkoclot/bot/method-macros + :ukkoclot/tg/method-macros :ukkoclot/tg/parse-mode :ukkoclot/tg/reply-keyboard-markup :ukkoclot/tg/reply-keyboard-remove diff --git a/src/tg/send-message.lisp b/src/tg/send-message.lisp index 7cd91d9..164dd83 100644 --- a/src/tg/send-message.lisp +++ b/src/tg/send-message.lisp @@ -8,7 +8,7 @@ :ukkoclot/tg/link-preview-options :ukkoclot/tg/message :ukkoclot/tg/message-entity - :ukkoclot/bot/method-macros + :ukkoclot/tg/method-macros :ukkoclot/tg/parse-mode :ukkoclot/tg/reply-keyboard-markup :ukkoclot/tg/reply-keyboard-remove diff --git a/src/tg/set-my-name.lisp b/src/tg/set-my-name.lisp index 5638a92..1c6b634 100644 --- a/src/tg/set-my-name.lisp +++ b/src/tg/set-my-name.lisp @@ -1,7 +1,7 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/tg/set-my-name - (:use :c2cl :ukkoclot/tg/bot-name :ukkoclot/tg/get-my-name :ukkoclot/bot/method-macros) + (:use :c2cl :ukkoclot/tg/bot-name :ukkoclot/tg/get-my-name :ukkoclot/tg/method-macros) (:export :set-my-name)) (in-package :ukkoclot/tg/set-my-name) -- cgit v1.2.3