summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/tg/animation.lisp2
-rw-r--r--src/tg/bot-name.lisp2
-rw-r--r--src/tg/business-bot-rights.lisp2
-rw-r--r--src/tg/business-connection.lisp2
-rw-r--r--src/tg/callback-query.lisp2
-rw-r--r--src/tg/chat-administrator-rights.lisp2
-rw-r--r--src/tg/chat.lisp2
-rw-r--r--src/tg/force-reply.lisp2
-rw-r--r--src/tg/inline-keyboard-button.lisp2
-rw-r--r--src/tg/inline-keyboard-markup.lisp2
-rw-r--r--src/tg/keyboard-button-poll-type.lisp2
-rw-r--r--src/tg/keyboard-button-request-chat.lisp2
-rw-r--r--src/tg/keyboard-button-request-users.lisp2
-rw-r--r--src/tg/keyboard-button.lisp2
-rw-r--r--src/tg/link-preview-options.lisp2
-rw-r--r--src/tg/macros.lisp118
-rw-r--r--src/tg/message-entity.lisp2
-rw-r--r--src/tg/message-reaction-updated.lisp2
-rw-r--r--src/tg/message.lisp2
-rw-r--r--src/tg/photo-size.lisp2
-rw-r--r--src/tg/reaction-type-custom-emoji.lisp2
-rw-r--r--src/tg/reaction-type-emoji.lisp2
-rw-r--r--src/tg/reaction-type-paid.lisp2
-rw-r--r--src/tg/reaction-type.lisp2
-rw-r--r--src/tg/reply-keyboard-markup.lisp2
-rw-r--r--src/tg/reply-keyboard-remove.lisp2
-rw-r--r--src/tg/reply-parameters.lisp2
-rw-r--r--src/tg/suggested-post-parameters.lisp2
-rw-r--r--src/tg/suggested-post-price.lisp2
-rw-r--r--src/tg/type-macros.lisp125
-rw-r--r--src/tg/update.lisp2
-rw-r--r--src/tg/user.lisp2
-rw-r--r--src/tg/web-app-info.lisp2
33 files changed, 156 insertions, 149 deletions
diff --git a/src/tg/animation.lisp b/src/tg/animation.lisp
index d17db94..cae4933 100644
--- a/src/tg/animation.lisp
+++ b/src/tg/animation.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/animation 3(defpackage :ukkoclot/tg/animation
4 (:use :c2cl :ukkoclot/tg/macros :ukkoclot/tg/photo-size) 4 (:use :c2cl :ukkoclot/tg/type-macros :ukkoclot/tg/photo-size)
5 (:export 5 (:export
6 #:animation 6 #:animation
7 #:make-animation 7 #:make-animation
diff --git a/src/tg/bot-name.lisp b/src/tg/bot-name.lisp
index 933ce8c..10e873c 100644
--- a/src/tg/bot-name.lisp
+++ b/src/tg/bot-name.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/bot-name 3(defpackage :ukkoclot/tg/bot-name
4 (:use :c2cl :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:bot-name 6 #:bot-name
7 #:make-bot-name 7 #:make-bot-name
diff --git a/src/tg/business-bot-rights.lisp b/src/tg/business-bot-rights.lisp
index f5a44c0..8d852d2 100644
--- a/src/tg/business-bot-rights.lisp
+++ b/src/tg/business-bot-rights.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/business-bot-rights 3(defpackage :ukkoclot/tg/business-bot-rights
4 (:use :c2cl :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:business-bot-rights 6 #:business-bot-rights
7 #:make-business-bot-rights 7 #:make-business-bot-rights
diff --git a/src/tg/business-connection.lisp b/src/tg/business-connection.lisp
index 74f6c9e..726cdd4 100644
--- a/src/tg/business-connection.lisp
+++ b/src/tg/business-connection.lisp
@@ -3,7 +3,7 @@
3(defpackage :ukkoclot/tg/business-connection 3(defpackage :ukkoclot/tg/business-connection
4 (:use 4 (:use
5 :c2cl 5 :c2cl
6 :ukkoclot/tg/macros 6 :ukkoclot/tg/type-macros
7 :ukkoclot/tg/business-bot-rights 7 :ukkoclot/tg/business-bot-rights
8 :ukkoclot/tg/user) 8 :ukkoclot/tg/user)
9 (:export 9 (:export
diff --git a/src/tg/callback-query.lisp b/src/tg/callback-query.lisp
index 6b89755..3f8cf2d 100644
--- a/src/tg/callback-query.lisp
+++ b/src/tg/callback-query.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/callback-query 3(defpackage :ukkoclot/tg/callback-query
4 (:use :c2cl :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/type-macros)
5 (:use 5 (:use
6 :ukkoclot/tg/message 6 :ukkoclot/tg/message
7 :ukkoclot/tg/user) 7 :ukkoclot/tg/user)
diff --git a/src/tg/chat-administrator-rights.lisp b/src/tg/chat-administrator-rights.lisp
index 2c37757..4cbe47f 100644
--- a/src/tg/chat-administrator-rights.lisp
+++ b/src/tg/chat-administrator-rights.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/chat-administrator-rights 3(defpackage :ukkoclot/tg/chat-administrator-rights
4 (:use :c2cl :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:chat-administrator-rights 6 #:chat-administrator-rights
7 #:make-chat-administrator-rights 7 #:make-chat-administrator-rights
diff --git a/src/tg/chat.lisp b/src/tg/chat.lisp
index 1fa3f7e..bdb698a 100644
--- a/src/tg/chat.lisp
+++ b/src/tg/chat.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/chat 3(defpackage :ukkoclot/tg/chat
4 (:use :c2cl :ukkoclot/tg/chat-type :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/chat-type :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:chat 6 #:chat
7 #:make-chat 7 #:make-chat
diff --git a/src/tg/force-reply.lisp b/src/tg/force-reply.lisp
index 816eb75..21a4ac6 100644
--- a/src/tg/force-reply.lisp
+++ b/src/tg/force-reply.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/force-reply 3(defpackage :ukkoclot/tg/force-reply
4 (:use :c2cl :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:force-reply 6 #:force-reply
7 #:make-force-reply 7 #:make-force-reply
diff --git a/src/tg/inline-keyboard-button.lisp b/src/tg/inline-keyboard-button.lisp
index e403f2a..7b49be6 100644
--- a/src/tg/inline-keyboard-button.lisp
+++ b/src/tg/inline-keyboard-button.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/inline-keyboard-button 3(defpackage :ukkoclot/tg/inline-keyboard-button
4 (:use :c2cl :ukkoclot/tg/macros :ukkoclot/tg/web-app-info) 4 (:use :c2cl :ukkoclot/tg/type-macros :ukkoclot/tg/web-app-info)
5 (:export 5 (:export
6 #:inline-keyboard-button 6 #:inline-keyboard-button
7 #:make-inline-keyboard-button 7 #:make-inline-keyboard-button
diff --git a/src/tg/inline-keyboard-markup.lisp b/src/tg/inline-keyboard-markup.lisp
index 023b87f..a242557 100644
--- a/src/tg/inline-keyboard-markup.lisp
+++ b/src/tg/inline-keyboard-markup.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/inline-keyboard-markup 3(defpackage :ukkoclot/tg/inline-keyboard-markup
4 (:use :c2cl :ukkoclot/tg/inline-keyboard-button :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/inline-keyboard-button :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:inline-keyboard-markup 6 #:inline-keyboard-markup
7 #:make-inline-keyboard-markup 7 #:make-inline-keyboard-markup
diff --git a/src/tg/keyboard-button-poll-type.lisp b/src/tg/keyboard-button-poll-type.lisp
index 7b5b063..7aecc48 100644
--- a/src/tg/keyboard-button-poll-type.lisp
+++ b/src/tg/keyboard-button-poll-type.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/keyboard-button-poll-type 3(defpackage :ukkoclot/tg/keyboard-button-poll-type
4 (:use :c2cl :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:keyboard-button-poll-type 6 #:keyboard-button-poll-type
7 #:make-keyboard-button-poll-type 7 #:make-keyboard-button-poll-type
diff --git a/src/tg/keyboard-button-request-chat.lisp b/src/tg/keyboard-button-request-chat.lisp
index 07f0d27..4128571 100644
--- a/src/tg/keyboard-button-request-chat.lisp
+++ b/src/tg/keyboard-button-request-chat.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/keyboard-button-request-chat 3(defpackage :ukkoclot/tg/keyboard-button-request-chat
4 (:use :c2cl :ukkoclot/tg/chat-administrator-rights :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/chat-administrator-rights :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:keyboard-button-request-chat 6 #:keyboard-button-request-chat
7 #:make-keyboard-button-request-chat 7 #:make-keyboard-button-request-chat
diff --git a/src/tg/keyboard-button-request-users.lisp b/src/tg/keyboard-button-request-users.lisp
index 82b9151..2782870 100644
--- a/src/tg/keyboard-button-request-users.lisp
+++ b/src/tg/keyboard-button-request-users.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/keyboard-button-request-users 3(defpackage :ukkoclot/tg/keyboard-button-request-users
4 (:use :c2cl :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:keyboard-button-request-users 6 #:keyboard-button-request-users
7 #:make-keyboard-button-request-users 7 #:make-keyboard-button-request-users
diff --git a/src/tg/keyboard-button.lisp b/src/tg/keyboard-button.lisp
index 79c87d6..7e0791f 100644
--- a/src/tg/keyboard-button.lisp
+++ b/src/tg/keyboard-button.lisp
@@ -6,7 +6,7 @@
6 :ukkoclot/tg/keyboard-button-poll-type 6 :ukkoclot/tg/keyboard-button-poll-type
7 :ukkoclot/tg/keyboard-button-request-chat 7 :ukkoclot/tg/keyboard-button-request-chat
8 :ukkoclot/tg/keyboard-button-request-users 8 :ukkoclot/tg/keyboard-button-request-users
9 :ukkoclot/tg/macros 9 :ukkoclot/tg/type-macros
10 :ukkoclot/tg/web-app-info) 10 :ukkoclot/tg/web-app-info)
11 (:export 11 (:export
12 #:keyboard-button 12 #:keyboard-button
diff --git a/src/tg/link-preview-options.lisp b/src/tg/link-preview-options.lisp
index 7ed4859..a6fe618 100644
--- a/src/tg/link-preview-options.lisp
+++ b/src/tg/link-preview-options.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/link-preview-options 3(defpackage :ukkoclot/tg/link-preview-options
4 (:use :c2cl :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:link-preview-options 6 #:link-preview-options
7 #:make-link-preview-options 7 #:make-link-preview-options
diff --git a/src/tg/macros.lisp b/src/tg/macros.lisp
deleted file mode 100644
index 9577d94..0000000
--- a/src/tg/macros.lisp
+++ /dev/null
@@ -1,118 +0,0 @@
1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/macros
4 (:use :c2cl)
5 (:import-from :ukkoclot/bot/impl :bot :do-call :parse-value)
6 (:import-from :ukkoclot/hash-tables :gethash-lazy)
7 (:import-from :ukkoclot/strings :lisp->snake-case)
8 (:local-nicknames
9 (:jzon :com.inuoe.jzon))
10 (:export :define-tg-type))
11(in-package :ukkoclot/tg/macros)
12
13(eval-when (:compile-toplevel :load-toplevel :execute)
14 (defstruct (field (:constructor make-field%)) name type default skip-if-default)
15
16 (defparameter +unique+ (gensym))
17
18 (defun make-field (name type &optional (default +unique+) &key (skip-if-default (not (eq default +unique+))))
19 (let ((default (if (eq default +unique+)
20 (list 'error (format nil "No value given for ~A" name))
21 default)))
22 (make-field% :name name
23 :type type
24 :default default
25 :skip-if-default skip-if-default)))
26
27 (defun parse-field-specs (field-specs)
28 (loop for field-spec in field-specs
29 collect (apply #'make-field field-spec)))
30
31 (defun field-hash-key (field)
32 (string-downcase (lisp->snake-case (symbol-name (field-name field)))))
33
34 (defun field-accessor (struc-name field)
35 (intern (concatenate 'string (symbol-name struc-name) "-" (symbol-name (field-name field)))))
36
37 (defun field->coerced-field-spec (field struc-name obj-name)
38 `(list ,(string-downcase (lisp->snake-case (symbol-name (field-name field))))
39 (,(field-accessor struc-name field) ,obj-name)
40 ',(field-type field)))
41
42 (defun field->defun-spec (field)
43 (list (field-name field) (field-default field)))
44
45 (defun field->format-arg (field name struc)
46 `(',(field-name field) (,(field-accessor name field) ,struc)))
47
48 (defun field->ftype-spec (field)
49 (list (intern (symbol-name (field-name field)) :keyword) (field-type field)))
50
51 (defun field->gethash-spec (field hash-table-sym)
52 (let ((hash-key (field-hash-key field)))
53 (list 'gethash-lazy hash-key hash-table-sym (field-default field))))
54
55 (defun field->sethash-spec (field name struc hash-table-sym)
56 (let ((hash-key (field-hash-key field))
57 (skip-if-default (field-skip-if-default field))
58 (default (field-default field)))
59 (if skip-if-default
60 (let ((tmpsym (gensym "TMP")))
61 `(let ((,tmpsym (,(field-accessor name field) ,struc)))
62 (unless (equal ,tmpsym ,default)
63 (setf (gethash ,hash-key ,hash-table-sym) ,tmpsym))))
64 `(setf (gethash ,hash-key ,hash-table-sym) (,(field-accessor name field) ,struc)))))
65
66 (defun field->let-gethash-spec (field hash-table-sym)
67 `(,(field-name field)
68 (parse-value ',(field-type field) ,(field->gethash-spec field hash-table-sym))))
69
70 (defun field->make-spec (field)
71 (list (intern (symbol-name (field-name field)) :keyword)
72 (field-name field)))
73
74 (defun field->struct-spec (field)
75 (list (field-name field) (field-default field) :type (field-type field))))
76
77(defmacro define-tg-type (name &body field-specs)
78 (let* ((fields (parse-field-specs field-specs))
79 (revfields (reverse fields))
80 (make-name (intern (concatenate 'string "MAKE-" (symbol-name name))))
81 (printer (gensym (concatenate 'string "PRINT-" (symbol-name name))))
82 (hash (gensym "HASH-"))
83 (struc (gensym (symbol-name name)))
84 (stream (gensym "STREAM"))
85 (depth (gensym "DEPTH"))
86 (pprint-args (gensym "PPRINT-ARGS"))
87 (res (gensym "RES"))
88 (type (gensym "TYPE")))
89 `(progn
90 (defstruct (,name (:print-function ,printer))
91 ,@(loop for field in fields
92 collect (field->struct-spec field)))
93 (defun ,printer (,struc ,stream ,depth)
94 (declare (ignore ,depth))
95 (let (,pprint-args)
96 ,@(loop for field in revfields
97 collecting
98 (if (field-skip-if-default field)
99 `(let ((value (,(field-accessor name field) ,struc)))
100 (unless (equal value ,(field-default field))
101 (setf ,pprint-args (list* ',(field-name field) value ,pprint-args))))
102 `(setf ,pprint-args (list* ',(field-name field) (,(field-accessor name field) ,struc) ,pprint-args))))
103 (format ,stream "~A~<[~;~@{~_~1I~W = ~W~^, ~}~;]~:>" ',name ,pprint-args)))
104 (defmethod parse-value ((,type (eql ',name)) ,hash)
105 (let ,(loop for field in fields
106 collect (field->let-gethash-spec field hash))
107 (,make-name ,@(loop for field in fields
108 append (field->make-spec field)))))
109 (defmethod jzon:coerced-fields ((,struc ,name))
110 (let (,res)
111 ,@(loop for field in revfields
112 collecting
113 (if (field-skip-if-default field)
114 `(let ((value (,(field-accessor name field) ,struc)))
115 (unless (equal value ,(field-default field))
116 (setf ,res (cons ,(field->coerced-field-spec field name struc) ,res))))
117 `(setf ,res (cons ,(field->coerced-field-spec field name struc) ,res))))
118 ,res)))))
diff --git a/src/tg/message-entity.lisp b/src/tg/message-entity.lisp
index c5be269..3413763 100644
--- a/src/tg/message-entity.lisp
+++ b/src/tg/message-entity.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/message-entity 3(defpackage :ukkoclot/tg/message-entity
4 (:use :c2cl :iterate :ukkoclot/tg/macros :ukkoclot/tg/message-entity-type :ukkoclot/tg/user) 4 (:use :c2cl :iterate :ukkoclot/tg/type-macros :ukkoclot/tg/message-entity-type :ukkoclot/tg/user)
5 (:export 5 (:export
6 #:message-entity 6 #:message-entity
7 #:make-message-entity 7 #:make-message-entity
diff --git a/src/tg/message-reaction-updated.lisp b/src/tg/message-reaction-updated.lisp
index f91a8f1..3792246 100644
--- a/src/tg/message-reaction-updated.lisp
+++ b/src/tg/message-reaction-updated.lisp
@@ -4,7 +4,7 @@
4 (:use 4 (:use
5 :c2cl 5 :c2cl
6 :ukkoclot/tg/chat 6 :ukkoclot/tg/chat
7 :ukkoclot/tg/macros 7 :ukkoclot/tg/type-macros
8 :ukkoclot/tg/reaction-type 8 :ukkoclot/tg/reaction-type
9 :ukkoclot/tg/user) 9 :ukkoclot/tg/user)
10 (:export 10 (:export
diff --git a/src/tg/message.lisp b/src/tg/message.lisp
index 18eb5c4..4707c57 100644
--- a/src/tg/message.lisp
+++ b/src/tg/message.lisp
@@ -5,9 +5,9 @@
5 :c2cl 5 :c2cl
6 :ukkoclot/tg/animation 6 :ukkoclot/tg/animation
7 :ukkoclot/tg/chat 7 :ukkoclot/tg/chat
8 :ukkoclot/tg/macros
9 :ukkoclot/tg/message-entity 8 :ukkoclot/tg/message-entity
10 :ukkoclot/tg/photo-size 9 :ukkoclot/tg/photo-size
10 :ukkoclot/tg/type-macros
11 :ukkoclot/tg/user) 11 :ukkoclot/tg/user)
12 (:export 12 (:export
13 #:message-chat-id 13 #:message-chat-id
diff --git a/src/tg/photo-size.lisp b/src/tg/photo-size.lisp
index 32b586c..f55c0df 100644
--- a/src/tg/photo-size.lisp
+++ b/src/tg/photo-size.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/photo-size 3(defpackage :ukkoclot/tg/photo-size
4 (:use :c2cl :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:photo-size 6 #:photo-size
7 #:make-photo-size 7 #:make-photo-size
diff --git a/src/tg/reaction-type-custom-emoji.lisp b/src/tg/reaction-type-custom-emoji.lisp
index 9191f1e..21cb966 100644
--- a/src/tg/reaction-type-custom-emoji.lisp
+++ b/src/tg/reaction-type-custom-emoji.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/reaction-type-custom-emoji 3(defpackage :ukkoclot/tg/reaction-type-custom-emoji
4 (:use :c2cl :ukkoclot/enum :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/enum :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:custom-emoji-type 6 #:custom-emoji-type
7 #:reaction-type-custom-emoji-type 7 #:reaction-type-custom-emoji-type
diff --git a/src/tg/reaction-type-emoji.lisp b/src/tg/reaction-type-emoji.lisp
index bf4920a..6939e41 100644
--- a/src/tg/reaction-type-emoji.lisp
+++ b/src/tg/reaction-type-emoji.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/reaction-type-emoji 3(defpackage :ukkoclot/tg/reaction-type-emoji
4 (:use :c2cl :ukkoclot/enum :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/enum :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:reaction-type-emoji-type 6 #:reaction-type-emoji-type
7 #:emoji-type 7 #:emoji-type
diff --git a/src/tg/reaction-type-paid.lisp b/src/tg/reaction-type-paid.lisp
index f5b1bfd..8d53610 100644
--- a/src/tg/reaction-type-paid.lisp
+++ b/src/tg/reaction-type-paid.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/reaction-type-paid 3(defpackage :ukkoclot/tg/reaction-type-paid
4 (:use :c2cl :ukkoclot/enum :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/enum :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:reaction-type-paid-type 6 #:reaction-type-paid-type
7 #:paid-type 7 #:paid-type
diff --git a/src/tg/reaction-type.lisp b/src/tg/reaction-type.lisp
index 35bf4cd..1fd07f5 100644
--- a/src/tg/reaction-type.lisp
+++ b/src/tg/reaction-type.lisp
@@ -3,7 +3,7 @@
3(defpackage :ukkoclot/tg/reaction-type 3(defpackage :ukkoclot/tg/reaction-type
4 (:use 4 (:use
5 :c2cl 5 :c2cl
6 :ukkoclot/tg/macros 6 :ukkoclot/tg/type-macros
7 :ukkoclot/tg/reaction-type-custom-emoji 7 :ukkoclot/tg/reaction-type-custom-emoji
8 :ukkoclot/tg/reaction-type-emoji 8 :ukkoclot/tg/reaction-type-emoji
9 :ukkoclot/tg/reaction-type-paid) 9 :ukkoclot/tg/reaction-type-paid)
diff --git a/src/tg/reply-keyboard-markup.lisp b/src/tg/reply-keyboard-markup.lisp
index 2674c10..a0c16ca 100644
--- a/src/tg/reply-keyboard-markup.lisp
+++ b/src/tg/reply-keyboard-markup.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/reply-keyboard-markup 3(defpackage :ukkoclot/tg/reply-keyboard-markup
4 (:use :c2cl :ukkoclot/tg/keyboard-button :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/keyboard-button :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:reply-keyboard-markup 6 #:reply-keyboard-markup
7 #:make-reply-keyboard-markup 7 #:make-reply-keyboard-markup
diff --git a/src/tg/reply-keyboard-remove.lisp b/src/tg/reply-keyboard-remove.lisp
index 908e46d..595ff31 100644
--- a/src/tg/reply-keyboard-remove.lisp
+++ b/src/tg/reply-keyboard-remove.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/reply-keyboard-remove 3(defpackage :ukkoclot/tg/reply-keyboard-remove
4 (:use :c2cl :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:reply-keyboard-remove 6 #:reply-keyboard-remove
7 #:make-reply-keyboard-remove 7 #:make-reply-keyboard-remove
diff --git a/src/tg/reply-parameters.lisp b/src/tg/reply-parameters.lisp
index e41d837..9527c40 100644
--- a/src/tg/reply-parameters.lisp
+++ b/src/tg/reply-parameters.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/reply-parameters 3(defpackage :ukkoclot/tg/reply-parameters
4 (:use :c2cl :ukkoclot/tg/macros :ukkoclot/tg/message-entity) 4 (:use :c2cl :ukkoclot/tg/type-macros :ukkoclot/tg/message-entity)
5 (:export 5 (:export
6 #:reply-parameters 6 #:reply-parameters
7 #:make-reply-parameters 7 #:make-reply-parameters
diff --git a/src/tg/suggested-post-parameters.lisp b/src/tg/suggested-post-parameters.lisp
index 525272a..2bf3753 100644
--- a/src/tg/suggested-post-parameters.lisp
+++ b/src/tg/suggested-post-parameters.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/suggested-post-parameters 3(defpackage :ukkoclot/tg/suggested-post-parameters
4 (:use :c2cl :ukkoclot/tg/macros :ukkoclot/tg/suggested-post-price) 4 (:use :c2cl :ukkoclot/tg/type-macros :ukkoclot/tg/suggested-post-price)
5 (:export 5 (:export
6 #:suggested-post-parameters 6 #:suggested-post-parameters
7 #:make-suggested-post-parameters 7 #:make-suggested-post-parameters
diff --git a/src/tg/suggested-post-price.lisp b/src/tg/suggested-post-price.lisp
index 9012e75..1369b89 100644
--- a/src/tg/suggested-post-price.lisp
+++ b/src/tg/suggested-post-price.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/suggested-post-price 3(defpackage :ukkoclot/tg/suggested-post-price
4 (:use :c2cl :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:suggested-post-price 6 #:suggested-post-price
7 #:make-suggested-post-price 7 #:make-suggested-post-price
diff --git a/src/tg/type-macros.lisp b/src/tg/type-macros.lisp
new file mode 100644
index 0000000..06de32d
--- /dev/null
+++ b/src/tg/type-macros.lisp
@@ -0,0 +1,125 @@
1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/type-macros
4 (:use :c2cl :iterate)
5 (:import-from :ukkoclot/hash-tables :gethash-lazy)
6 (:import-from :ukkoclot/strings :lisp->snake-case)
7 (:local-nicknames
8 (:jzon :com.inuoe.jzon))
9 (:export :define-tg-type))
10(in-package :ukkoclot/tg/type-macros)
11
12(eval-when (:compile-toplevel :load-toplevel :execute)
13 (defstruct (field (:constructor make-field%)) name type default skip-if-default)
14
15 (defparameter +unique+ (gensym))
16
17 (defun make-field (name type &optional (default +unique+) &key (skip-if-default (not (eq default +unique+))))
18 (let ((default (if (eq default +unique+)
19 `(error ,(format nil "No value given for ~A" name))
20 default)))
21 (make-field% :name name
22 :type type
23 :default default
24 :skip-if-default skip-if-default)))
25
26 (defun type-constructor (name)
27 (intern (concatenate 'string "MAKE-" (symbol-name name))))
28
29 (defun field-accessor (name field)
30 (intern (concatenate 'string (symbol-name name) "-" (symbol-name (field-name field)))))
31
32 (defun field-hash-key (field)
33 (string-downcase (lisp->snake-case (symbol-name (field-name field)))))
34
35 (defun field-keyword (field)
36 (intern (symbol-name (field-name field)) :keyword))
37
38 (defun parse-field-specs (field-specs)
39 (iter (for field-spec in field-specs)
40 (collect (apply #'make-field field-spec))))
41
42 (defun emit-append-to-pprint-args (field value pprint-args)
43 `(setf ,pprint-args (list* ',(field-name field) ,value ,pprint-args)))
44
45 (defun emit-coerced-field (field value)
46 `(list ,(field-hash-key field) ,value ',(field-type field)))
47
48 (defun emit-collect-nondefault-fields (name fields obj collector)
49 (let ((value (gensym "VALUE")))
50 (iter (for field in (reverse fields))
51 (collect
52 (if (field-skip-if-default field)
53 `(let ((,value (,(field-accessor name field) ,obj)))
54 (unless (equal ,value ,(field-default field))
55 ,(funcall collector field value)))
56 (funcall collector field (list (field-accessor name field) obj)))))))
57
58 (defun emit-constructor-args (field)
59 `(,(field-keyword field) ,(field-name field)))
60
61 (defun emit-gethash (field source)
62 `(gethash-lazy ,(field-hash-key field) ,source ,(field-default field)))
63
64 (defun emit-jzon-coerced-fields (name fields)
65 (let ((obj (gensym "OBJ"))
66 (result (gensym "RESULT")))
67 `(defmethod jzon:coerced-fields ((,obj ,name))
68 (let (,result)
69 ,@(emit-collect-nondefault-fields
70 name fields obj
71 (lambda (field value)
72 `(setf ,result (cons ,(emit-coerced-field field value) ,result))))
73 ,result))))
74
75 (defun emit-let-gethash (field source)
76 `(,(field-name field)
77 (parse-value ',(field-type field) ,(emit-gethash field source))))
78
79 (defun emit-parse-value (name fields)
80 (let ((type-sym (gensym "TYPE-SYM"))
81 (source (gensym "SOURCE")))
82 `(defmethod parse-value ((,type-sym (eql ',name)) ,source)
83 (let ,(iter (for field in fields)
84 (collect (emit-let-gethash field source)))
85 (,(type-constructor name)
86 ,@(print (iter (for field in fields)
87 (appending (print (emit-constructor-args field))))))))))
88
89 (defun emit-printer (name printer-name fields)
90 (let ((obj (gensym "OBJ"))
91 (stream (gensym "STREAM"))
92 (depth (gensym "DEPTH"))
93 (pprint-args (gensym "PPRINT-ARGS")))
94 `(defun ,printer-name (,obj ,stream ,depth)
95 (declare (ignore ,depth))
96 (let (,pprint-args)
97 ,@(emit-collect-nondefault-fields
98 name fields obj
99 (lambda (field value)
100 `(setf ,pprint-args (list* ',(field-name field) ,value ,pprint-args))))
101 ;; ,@(iter (for field in (reverse fields))
102 ;; (collect
103 ;; (if (field-skip-if-default field)
104 ;; `(let ((,value (,(field-accessor name field) ,obj)))
105 ;; (unless (equal ,value ,(field-default field))
106 ;; ,(emit-append-to-pprint-args field value pprint-args)))
107 ;; (emit-append-to-pprint-args field `(,(field-accessor name field) ,obj) pprint-args))))
108 (format ,stream "~A~<[~;~@{~_~1I~W = ~W~^, ~}~;]~:>" ',name ,pprint-args)))))
109
110 (defun emit-struct (name printer-name fields)
111 `(defstruct (,name (:print-function ,printer-name))
112 ,@(iter (for field in fields)
113 (collect (emit-struct-field field)))))
114
115 (defun emit-struct-field (field)
116 `(,(field-name field) ,(field-default field) :type ,(field-type field))))
117
118(defmacro define-tg-type (name &body field-specs)
119 (let ((fields (parse-field-specs field-specs))
120 (printer-name (gensym "PRINTER")))
121 `(progn
122 ,(emit-struct name printer-name fields)
123 ,(emit-printer name printer-name fields)
124 ,(emit-parse-value name fields)
125 ,(emit-jzon-coerced-fields name fields))))
diff --git a/src/tg/update.lisp b/src/tg/update.lisp
index 1f0a463..1c4ae46 100644
--- a/src/tg/update.lisp
+++ b/src/tg/update.lisp
@@ -3,7 +3,7 @@
3(defpackage :ukkoclot/tg/update 3(defpackage :ukkoclot/tg/update
4 (:use 4 (:use
5 :c2cl 5 :c2cl
6 :ukkoclot/tg/macros 6 :ukkoclot/tg/type-macros
7 :ukkoclot/tg/business-connection 7 :ukkoclot/tg/business-connection
8 :ukkoclot/tg/callback-query 8 :ukkoclot/tg/callback-query
9 :ukkoclot/tg/message 9 :ukkoclot/tg/message
diff --git a/src/tg/user.lisp b/src/tg/user.lisp
index c5b5b4d..b16ee15 100644
--- a/src/tg/user.lisp
+++ b/src/tg/user.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/user 3(defpackage :ukkoclot/tg/user
4 (:use :c2cl :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/type-macros)
5 (:import-from :ukkoclot/strings :escape-xml) 5 (:import-from :ukkoclot/strings :escape-xml)
6 (:export 6 (:export
7 #:user 7 #:user
diff --git a/src/tg/web-app-info.lisp b/src/tg/web-app-info.lisp
index 8e96df2..3f8dc42 100644
--- a/src/tg/web-app-info.lisp
+++ b/src/tg/web-app-info.lisp
@@ -1,7 +1,7 @@
1;; SPDX-License-Identifier: EUPL-1.2 1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/web-app-info 3(defpackage :ukkoclot/tg/web-app-info
4 (:use :c2cl :ukkoclot/tg/macros) 4 (:use :c2cl :ukkoclot/tg/type-macros)
5 (:export 5 (:export
6 #:web-app-info 6 #:web-app-info
7 #:make-web-app-info 7 #:make-web-app-info