From 0749b67b29db8773e840345cc67963a1c1545cba Mon Sep 17 00:00:00 2001
From: Uko Kokņevičs
Date: Mon, 13 Oct 2025 00:26:15 +0300
Subject: Move define-tg-method to a new file

---
 src/bot/method-macros.lisp | 64 ++++++++++++++++++++++++++++++++++++++++++++++
 src/bot/methods.lisp       |  2 +-
 src/tg/macros.lisp         | 26 +------------------
 3 files changed, 66 insertions(+), 26 deletions(-)
 create mode 100644 src/bot/method-macros.lisp

(limited to 'src')

diff --git a/src/bot/method-macros.lisp b/src/bot/method-macros.lisp
new file mode 100644
index 0000000..7b54dc9
--- /dev/null
+++ b/src/bot/method-macros.lisp
@@ -0,0 +1,64 @@
+;; SPDX-License-Identifier: EUPL-1.2
+;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
+(defpackage :ukkoclot/bot/method-macros
+  (:use :c2cl :iterate :ukkoclot/bot/impl)
+  (: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 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 path)
+    (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 ',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))))
+
+;; TODO: Automatically derive path from name
+(defmacro define-tg-method (
+                            (name type path &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))))
diff --git a/src/bot/methods.lisp b/src/bot/methods.lisp
index 6ef507c..bddb9ff 100644
--- a/src/bot/methods.lisp
+++ b/src/bot/methods.lisp
@@ -1,7 +1,7 @@
 ;; SPDX-License-Identifier: EUPL-1.2
 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
 (defpackage :ukkoclot/bot/methods
-  (:use :c2cl :ukkoclot/bot/impl :ukkoclot/tg :ukkoclot/tg/macros)
+  (:use :c2cl :ukkoclot/bot/method-macros :ukkoclot/bot/impl :ukkoclot/tg)
   (: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)
 
diff --git a/src/tg/macros.lisp b/src/tg/macros.lisp
index 92afd6e..9577d94 100644
--- a/src/tg/macros.lisp
+++ b/src/tg/macros.lisp
@@ -7,7 +7,7 @@
   (:import-from :ukkoclot/strings :lisp->snake-case)
   (:local-nicknames
    (:jzon :com.inuoe.jzon))
-  (:export :define-tg-method :define-tg-type))
+  (:export :define-tg-type))
 (in-package :ukkoclot/tg/macros)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -74,30 +74,6 @@
   (defun field->struct-spec (field)
     (list (field-name field) (field-default field) :type (field-type field))))
 
-;; TODO: Automatically derive path from name
-;; TODO: Automatically derive mapfn from type
-(defmacro define-tg-method (
-                            (name type path &optional (method :POST))
-                            &body field-specs)
-  (let* ((fields (parse-field-specs field-specs))
-         (revfields (reverse fields))
-         (args (gensym "ARGS"))
-         (bot (gensym "BOT-")))
-    `(progn
-       (declaim (ftype (function (bot &key ,@(loop for field in fields
-                                                 collect (field->ftype-spec field)))
-                                 ,type)
-                       ,name))
-       (defun ,name (,bot &key ,@(loop for field in fields collect (field->defun-spec field)))
-         (let (,args)
-           ,@(loop for field in revfields
-                   collecting
-                   (if (field-skip-if-default field)
-                       `(unless (equal ,(field-name field) ,(field-default field))
-                          (setf ,args (acons ',(field-name field) ,(field-name field) ,args)))
-                       `(setf ,args (acons ',(field-name field) ,(field-name field) ,args))))
-           (do-call ,bot ,method ,path ',type ,args))))))
-
 (defmacro define-tg-type (name &body field-specs)
   (let* ((fields (parse-field-specs field-specs))
          (revfields (reverse fields))
-- 
cgit v1.2.3