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/tg/method-macros.lisp | 72 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 72 insertions(+) create mode 100644 src/tg/method-macros.lisp (limited to 'src/tg/method-macros.lisp') 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)))) -- cgit v1.2.3