diff options
Diffstat (limited to 'src/tg-types')
| -rw-r--r-- | src/tg-types/bot-name.lisp | 14 | ||||
| -rw-r--r-- | src/tg-types/callback-query.lisp | 24 | ||||
| -rw-r--r-- | src/tg-types/chat.lisp | 31 | ||||
| -rw-r--r-- | src/tg-types/force-reply.lisp | 21 | ||||
| -rw-r--r-- | src/tg-types/inline-keyboard-button.lisp | 32 | ||||
| -rw-r--r-- | src/tg-types/inline-keyboard-markup.lisp | 17 | ||||
| -rw-r--r-- | src/tg-types/link-preview-options.lisp | 25 | ||||
| -rw-r--r-- | src/tg-types/macros.lisp | 134 | ||||
| -rw-r--r-- | src/tg-types/message-entity.lisp | 61 | ||||
| -rw-r--r-- | src/tg-types/message.lisp | 168 | ||||
| -rw-r--r-- | src/tg-types/parsers.lisp | 9 | ||||
| -rw-r--r-- | src/tg-types/reply-parameters.lisp | 32 | ||||
| -rw-r--r-- | src/tg-types/update.lisp | 47 | ||||
| -rw-r--r-- | src/tg-types/user.lisp | 48 |
14 files changed, 663 insertions, 0 deletions
diff --git a/src/tg-types/bot-name.lisp b/src/tg-types/bot-name.lisp new file mode 100644 index 0000000..385b91c --- /dev/null +++ b/src/tg-types/bot-name.lisp | |||
| @@ -0,0 +1,14 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/bot-name | ||
| 4 | (:use :c2cl :ukkoclot/tg-types/macros) | ||
| 5 | (:export | ||
| 6 | bot-name bot-name-p | ||
| 7 | |||
| 8 | hash->bot-name make-bot-name parse-bot-name-array | ||
| 9 | |||
| 10 | bot-name-name)) | ||
| 11 | (in-package :ukkoclot/tg-types/bot-name) | ||
| 12 | |||
| 13 | (define-tg-type bot-name | ||
| 14 | (name string)) | ||
diff --git a/src/tg-types/callback-query.lisp b/src/tg-types/callback-query.lisp new file mode 100644 index 0000000..bb1b4e7 --- /dev/null +++ b/src/tg-types/callback-query.lisp | |||
| @@ -0,0 +1,24 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/callback-query | ||
| 4 | (:use :c2cl :ukkoclot/tg-types/macros) | ||
| 5 | (:use | ||
| 6 | :ukkoclot/tg-types/message | ||
| 7 | :ukkoclot/tg-types/user) | ||
| 8 | (:export | ||
| 9 | callback-query callback-query-p | ||
| 10 | |||
| 11 | hash->callback-query make-callback-query parse-callback-query-array | ||
| 12 | |||
| 13 | callback-query-id callback-query-from callback-query-message callback-query-inline-message-id | ||
| 14 | callback-query-chat-instance callback-query-data callback-query-game-short-name)) | ||
| 15 | (in-package :ukkoclot/tg-types/callback-query) | ||
| 16 | |||
| 17 | (define-tg-type callback-query | ||
| 18 | (id string) | ||
| 19 | (from user) | ||
| 20 | (message (or message null) nil) | ||
| 21 | (inline-message-id (or string null) nil) | ||
| 22 | (chat-instance string) | ||
| 23 | (data (or string null) nil) | ||
| 24 | (game-short-name (or string null) nil)) | ||
diff --git a/src/tg-types/chat.lisp b/src/tg-types/chat.lisp new file mode 100644 index 0000000..4010f7b --- /dev/null +++ b/src/tg-types/chat.lisp | |||
| @@ -0,0 +1,31 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/chat | ||
| 4 | (:use :c2cl :ukkoclot/tg-types/macros :ukkoclot/tg-types/parsers) | ||
| 5 | (:export | ||
| 6 | chat | ||
| 7 | make-chat | ||
| 8 | chat-p | ||
| 9 | copy-chat | ||
| 10 | chat-id | ||
| 11 | chat-type | ||
| 12 | chat-title | ||
| 13 | chat-username | ||
| 14 | chat-first-name | ||
| 15 | chat-last-name | ||
| 16 | chat-is-forum | ||
| 17 | chat-is-direct-messages | ||
| 18 | |||
| 19 | hash->chat | ||
| 20 | parse-chat-array)) | ||
| 21 | (in-package :ukkoclot/tg-types/chat) | ||
| 22 | |||
| 23 | (define-tg-type chat | ||
| 24 | (id integer) | ||
| 25 | (type keyword nil :parser tg-string->keyword) | ||
| 26 | (title (or string null) nil) | ||
| 27 | (username (or string null) nil) | ||
| 28 | (first-name (or string null) nil) | ||
| 29 | (last-name (or string null) nil) | ||
| 30 | (is-forum boolean nil) | ||
| 31 | (is-direct-messages boolean nil)) | ||
diff --git a/src/tg-types/force-reply.lisp b/src/tg-types/force-reply.lisp new file mode 100644 index 0000000..ad9d2a0 --- /dev/null +++ b/src/tg-types/force-reply.lisp | |||
| @@ -0,0 +1,21 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/force-reply | ||
| 4 | (:use :c2cl :ukkoclot/tg-types/macros) | ||
| 5 | (:export | ||
| 6 | force-reply | ||
| 7 | make-force-reply | ||
| 8 | force-reply-p | ||
| 9 | copy-force-reply | ||
| 10 | force-reply-force-reply | ||
| 11 | force-reply-input-field-placeholder | ||
| 12 | force-reply-selective | ||
| 13 | |||
| 14 | hash->force-reply | ||
| 15 | parse-force-reply-array)) | ||
| 16 | (in-package :ukkoclot/tg-types/force-reply) | ||
| 17 | |||
| 18 | (define-tg-type force-reply | ||
| 19 | (force-reply boolean t :skip-if-default nil) | ||
| 20 | (input-field-placeholder (or string null) nil) | ||
| 21 | (selective boolean nil)) | ||
diff --git a/src/tg-types/inline-keyboard-button.lisp b/src/tg-types/inline-keyboard-button.lisp new file mode 100644 index 0000000..3b76ade --- /dev/null +++ b/src/tg-types/inline-keyboard-button.lisp | |||
| @@ -0,0 +1,32 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/inline-keyboard-button | ||
| 4 | (:use :c2cl :ukkoclot/tg-types/macros) | ||
| 5 | (:export | ||
| 6 | inline-keyboard-button | ||
| 7 | make-inline-keyboard-button | ||
| 8 | inline-keyboard-button-p | ||
| 9 | copy-inline-keyboard-button | ||
| 10 | inline-keyboard-button-text | ||
| 11 | inline-keyboard-button-url | ||
| 12 | inline-keyboard-button-callback-data | ||
| 13 | inline-keyboard-button-switch-inline-query | ||
| 14 | inline-keyboard-button-switch-inline-query-current-chat | ||
| 15 | inline-keyboard-button-pay | ||
| 16 | |||
| 17 | hash->inline-keyboard-button | ||
| 18 | parse-inline-keyboard-button-array)) | ||
| 19 | (in-package :ukkoclot/tg-types/inline-keyboard-button) | ||
| 20 | |||
| 21 | (define-tg-type inline-keyboard-button | ||
| 22 | (text string) | ||
| 23 | (url (or string null) nil) | ||
| 24 | (callback-data string) | ||
| 25 | ;; TODO: (web-app (or web-app-info null) nil) | ||
| 26 | ;; TODO: (login-url (or login-url null) nil) | ||
| 27 | (switch-inline-query (or string null) nil) | ||
| 28 | (switch-inline-query-current-chat (or string null) nil) | ||
| 29 | ;; TODO: (switch-inline-query-chosen-chat (or switch-inline-query-chosen-chat null) nil) | ||
| 30 | ;; TODO: (copy-text (or copy-text-button null) nil) | ||
| 31 | ;; TODO: (callback-game (or callback-game null) nil) | ||
| 32 | (pay boolean nil)) | ||
diff --git a/src/tg-types/inline-keyboard-markup.lisp b/src/tg-types/inline-keyboard-markup.lisp new file mode 100644 index 0000000..1f17f6c --- /dev/null +++ b/src/tg-types/inline-keyboard-markup.lisp | |||
| @@ -0,0 +1,17 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/inline-keyboard-markup | ||
| 4 | (:use :c2cl :ukkoclot/tg-types/inline-keyboard-button :ukkoclot/tg-types/macros) | ||
| 5 | (:export | ||
| 6 | inline-keyboard-markup | ||
| 7 | make-inline-keyboard-markup | ||
| 8 | inline-keyboard-markup-p | ||
| 9 | copy-inline-keyboard-markup | ||
| 10 | inline-keyboard-markup-inline-keyboard | ||
| 11 | |||
| 12 | hash->inline-keyboard-markup | ||
| 13 | parse-inline-keyboard-markup-array)) | ||
| 14 | (in-package :ukkoclot/tg-types/inline-keyboard-markup) | ||
| 15 | |||
| 16 | (define-tg-type inline-keyboard-markup | ||
| 17 | (inline-keyboard (array (array inline-keyboard-button)))) | ||
diff --git a/src/tg-types/link-preview-options.lisp b/src/tg-types/link-preview-options.lisp new file mode 100644 index 0000000..66b7d83 --- /dev/null +++ b/src/tg-types/link-preview-options.lisp | |||
| @@ -0,0 +1,25 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/link-preview-options | ||
| 4 | (:use :c2cl :ukkoclot/tg-types/macros) | ||
| 5 | (:export | ||
| 6 | link-preview-options | ||
| 7 | make-link-preview-options | ||
| 8 | link-preview-options-p | ||
| 9 | copy-link-preview-options | ||
| 10 | link-preview-options-is-disabled | ||
| 11 | link-preview-options-url | ||
| 12 | link-preview-options-prefer-small-media | ||
| 13 | link-preview-options-prefer-large-media | ||
| 14 | link-preview-options-show-above-text | ||
| 15 | |||
| 16 | hash->link-preview-options | ||
| 17 | parse-link-preview-options-array)) | ||
| 18 | (in-package :ukkoclot/tg-types/link-preview-options) | ||
| 19 | |||
| 20 | (define-tg-type link-preview-options | ||
| 21 | (is-disabled boolean nil) | ||
| 22 | (url (or string null) nil) | ||
| 23 | (prefer-small-media boolean nil) | ||
| 24 | (prefer-large-media boolean nil) | ||
| 25 | (show-above-text boolean nil)) | ||
diff --git a/src/tg-types/macros.lisp b/src/tg-types/macros.lisp new file mode 100644 index 0000000..668df17 --- /dev/null +++ b/src/tg-types/macros.lisp | |||
| @@ -0,0 +1,134 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/macros | ||
| 4 | (:use :c2cl) | ||
| 5 | (:import-from :ukkoclot/bot/impl :arg-encode :bot :do-call :will-arg-encode) | ||
| 6 | (:import-from :ukkoclot/hash-tables :gethash-lazy) | ||
| 7 | (:import-from :ukkoclot/strings :lisp->snake-case) | ||
| 8 | (:export :define-tg-method :define-tg-type)) | ||
| 9 | (in-package :ukkoclot/tg-types/macros) | ||
| 10 | |||
| 11 | (eval-when (:compile-toplevel :load-toplevel :execute) | ||
| 12 | (defstruct (field (:constructor make-field%)) name type default skip-if-default (parser 'identity)) | ||
| 13 | |||
| 14 | (defparameter +unique+ (gensym)) | ||
| 15 | |||
| 16 | (defun make-field (name type &optional (default +unique+) &key (parser 'identity) (skip-if-default (not (eq default +unique+)))) | ||
| 17 | (let ((default (if (eq default +unique+) | ||
| 18 | (list 'error (format nil "No value given for ~A" name)) | ||
| 19 | default))) | ||
| 20 | (make-field% :name name | ||
| 21 | :type type | ||
| 22 | :default default | ||
| 23 | :skip-if-default skip-if-default | ||
| 24 | :parser parser))) | ||
| 25 | |||
| 26 | (defun parse-field-specs (field-specs) | ||
| 27 | (loop for field-spec in field-specs | ||
| 28 | collect (apply #'make-field field-spec))) | ||
| 29 | |||
| 30 | (defun field-hash-key (field) | ||
| 31 | (string-downcase (lisp->snake-case (symbol-name (field-name field))))) | ||
| 32 | |||
| 33 | (defun field-accessor (struc-name field) | ||
| 34 | (intern (concatenate 'string (symbol-name struc-name) "-" (symbol-name (field-name field))))) | ||
| 35 | |||
| 36 | (defun field->defun-spec (field) | ||
| 37 | (list (field-name field) (field-default field))) | ||
| 38 | |||
| 39 | (defun field->format-arg (field name struc) | ||
| 40 | `(',(field-name field) (,(field-accessor name field) ,struc))) | ||
| 41 | |||
| 42 | (defun field->ftype-spec (field) | ||
| 43 | (list (intern (symbol-name (field-name field)) :keyword) (field-type field))) | ||
| 44 | |||
| 45 | (defun field->gethash-spec (field hash-table-sym) | ||
| 46 | (let ((hash-key (field-hash-key field))) | ||
| 47 | (list 'gethash-lazy hash-key hash-table-sym (field-default field)))) | ||
| 48 | |||
| 49 | (defun field->sethash-spec (field name struc hash-table-sym) | ||
| 50 | (let ((hash-key (field-hash-key field)) | ||
| 51 | (skip-if-default (field-skip-if-default field)) | ||
| 52 | (default (field-default field))) | ||
| 53 | (if skip-if-default | ||
| 54 | (let ((tmpsym (gensym "TMP"))) | ||
| 55 | `(let ((,tmpsym (,(field-accessor name field) ,struc))) | ||
| 56 | (unless (equal ,tmpsym ,default) | ||
| 57 | (setf (gethash ,hash-key ,hash-table-sym) ,tmpsym)))) | ||
| 58 | `(setf (gethash ,hash-key ,hash-table-sym) (,(field-accessor name field) ,struc))))) | ||
| 59 | |||
| 60 | (defun field->let-gethash-spec (field hash-table-sym) | ||
| 61 | (list (field-name field) | ||
| 62 | (list 'funcall | ||
| 63 | (list 'function (field-parser field)) | ||
| 64 | (field->gethash-spec field hash-table-sym)))) | ||
| 65 | |||
| 66 | (defun field->make-spec (field) | ||
| 67 | (list (intern (symbol-name (field-name field)) :keyword) | ||
| 68 | (field-name field))) | ||
| 69 | |||
| 70 | (defun field->struct-spec (field) | ||
| 71 | (list (field-name field) (field-default field) :type (field-type field)))) | ||
| 72 | |||
| 73 | ;; TODO: Automatically derive path from name | ||
| 74 | ;; TODO: Automatically derive mapfn from type | ||
| 75 | ;; TODO: Skip values that are already their defaults | ||
| 76 | (defmacro define-tg-method ( | ||
| 77 | (name type path mapfn &optional (method :POST)) | ||
| 78 | &body field-specs) | ||
| 79 | (let ((fields (parse-field-specs field-specs)) | ||
| 80 | (args-plist (gensym "ARGS-PLIST-")) | ||
| 81 | (bot (gensym "BOT-"))) | ||
| 82 | `(progn | ||
| 83 | (declaim (ftype (function (bot &key ,@(loop for field in fields | ||
| 84 | collect (field->ftype-spec field))) | ||
| 85 | ,type) | ||
| 86 | ,name)) | ||
| 87 | (defun ,name (,bot &rest ,args-plist &key ,@(loop for field in fields collect (field->defun-spec field))) | ||
| 88 | (declare ,@(loop for field in fields collect (list 'ignore (field-name field)))) | ||
| 89 | (do-call ,bot ,method ,path ,mapfn ,args-plist))))) | ||
| 90 | |||
| 91 | (defmacro define-tg-type (name &body field-specs) | ||
| 92 | (let* ((fields (parse-field-specs field-specs)) | ||
| 93 | (revfields (reverse fields)) | ||
| 94 | (make-name (intern (concatenate 'string "MAKE-" (symbol-name name)))) | ||
| 95 | (hash->name (intern (concatenate 'string "HASH->" (symbol-name name)))) | ||
| 96 | (parse-name-array (intern (concatenate 'string "PARSE-" (symbol-name name) "-ARRAY"))) | ||
| 97 | (printer (gensym (concatenate 'string "PRINT-" (symbol-name name)))) | ||
| 98 | (hash (gensym "HASH-")) | ||
| 99 | (array (gensym "ARRAY-")) | ||
| 100 | (struc (gensym (symbol-name name))) | ||
| 101 | (stream (gensym "STREAM")) | ||
| 102 | (depth (gensym "DEPTH")) | ||
| 103 | (pprint-args (gensym "PPRINT-ARGS"))) | ||
| 104 | `(progn | ||
| 105 | (defstruct (,name (:print-function ,printer)) | ||
| 106 | ,@(loop for field in fields | ||
| 107 | collect (field->struct-spec field))) | ||
| 108 | (defun ,printer (,struc ,stream ,depth) | ||
| 109 | (declare (ignore ,depth)) | ||
| 110 | (let (,pprint-args) | ||
| 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 ,pprint-args (list* ',(field-name field) value ,pprint-args)))) | ||
| 117 | `(setf ,pprint-args (list* ',(field-name field) (,(field-accessor name field) ,struc) ,pprint-args)))) | ||
| 118 | (format ,stream "~A~<[~;~@{~_~1I~W = ~W~^, ~}~;]~:>" ',name ,pprint-args))) | ||
| 119 | (defun ,hash->name (,hash) | ||
| 120 | (when ,hash | ||
| 121 | (let ,(loop for field in fields | ||
| 122 | collect (field->let-gethash-spec field hash)) | ||
| 123 | (,make-name ,@(loop for field in fields | ||
| 124 | append (field->make-spec field)))))) | ||
| 125 | (defmethod arg-encode ((,struc ,name)) | ||
| 126 | (let ((,hash (make-hash-table))) | ||
| 127 | ,@(loop for field in fields | ||
| 128 | collect (field->sethash-spec field name struc hash)) | ||
| 129 | ,hash)) | ||
| 130 | (defmethod will-arg-encode ((,struc ,name)) | ||
| 131 | t) | ||
| 132 | (defun ,parse-name-array (,array) | ||
| 133 | (when ,array | ||
| 134 | (map 'vector #',hash->name ,array)))))) | ||
diff --git a/src/tg-types/message-entity.lisp b/src/tg-types/message-entity.lisp new file mode 100644 index 0000000..fcabcce --- /dev/null +++ b/src/tg-types/message-entity.lisp | |||
| @@ -0,0 +1,61 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/message-entity | ||
| 4 | (:use :c2cl :iterate :ukkoclot/tg-types/macros :ukkoclot/tg-types/parsers :ukkoclot/tg-types/user) | ||
| 5 | (:export | ||
| 6 | message-entity | ||
| 7 | make-message-entity | ||
| 8 | message-entity-p | ||
| 9 | copy-message-entity | ||
| 10 | message-entity-type | ||
| 11 | message-entity-offset | ||
| 12 | message-entity-length | ||
| 13 | message-entity-url | ||
| 14 | message-entity-user | ||
| 15 | message-entity-language | ||
| 16 | message-entity-custom-emoji-id | ||
| 17 | |||
| 18 | hash->message-entity | ||
| 19 | message-entity-extract | ||
| 20 | parse-message-entity-array)) | ||
| 21 | (in-package :ukkoclot/tg-types/message-entity) | ||
| 22 | |||
| 23 | (define-tg-type message-entity | ||
| 24 | (type keyword nil :parser tg-string->keyword) | ||
| 25 | (offset integer) | ||
| 26 | (length integer) | ||
| 27 | (url (or string null) nil) | ||
| 28 | (user (or user null) nil) | ||
| 29 | (language (or string null) nil) | ||
| 30 | (custom-emoji-id (or string null) nil)) | ||
| 31 | |||
| 32 | (unless (= char-code-limit #x110000) | ||
| 33 | (error "Some UTF-16 fuckery assumes that system chars are UTF-32")) | ||
| 34 | |||
| 35 | (defun utf16-width (ch) | ||
| 36 | (if (< (char-code ch) #x10000) | ||
| 37 | 1 | ||
| 38 | 2)) | ||
| 39 | |||
| 40 | (defun message-entity-extract (entity text) | ||
| 41 | (with-slots (length offset) entity | ||
| 42 | (if (= length 0) | ||
| 43 | "" | ||
| 44 | (let* ((start (iterate | ||
| 45 | (with curr-idx16 = 0) | ||
| 46 | (for ch in-string text with-index curr-idx32) | ||
| 47 | (for curr-width = (utf16-width ch)) | ||
| 48 | (when (or (= curr-idx16 offset) | ||
| 49 | (> (+ curr-idx16 curr-width) offset)) | ||
| 50 | (return curr-idx32)) | ||
| 51 | (setq curr-idx16 (+ curr-idx16 curr-width)) | ||
| 52 | (finally (return (length text))))) | ||
| 53 | (end (iterate | ||
| 54 | (with curr-len16 = 0) | ||
| 55 | (for ch in-string text from start with-index curr-idx32) | ||
| 56 | (for curr-width = (utf16-width ch)) | ||
| 57 | (when (>= curr-len16 length) | ||
| 58 | (return curr-idx32)) | ||
| 59 | (setq curr-len16 (+ curr-len16 curr-width)) | ||
| 60 | (finally (return (length text)))))) | ||
| 61 | (subseq text start end))))) | ||
diff --git a/src/tg-types/message.lisp b/src/tg-types/message.lisp new file mode 100644 index 0000000..fee0734 --- /dev/null +++ b/src/tg-types/message.lisp | |||
| @@ -0,0 +1,168 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/message | ||
| 4 | (:use :c2cl :ukkoclot/tg-types/macros | ||
| 5 | |||
| 6 | :ukkoclot/tg-types/chat | ||
| 7 | :ukkoclot/tg-types/message-entity | ||
| 8 | :ukkoclot/tg-types/user) | ||
| 9 | (:export | ||
| 10 | message | ||
| 11 | make-message | ||
| 12 | message-p | ||
| 13 | copy-message | ||
| 14 | message-message-id | ||
| 15 | message-message-thread-id | ||
| 16 | message-from | ||
| 17 | message-sender-boost-count | ||
| 18 | message-sender-business-bot | ||
| 19 | message-date | ||
| 20 | message-business-connection-id | ||
| 21 | message-chat | ||
| 22 | message-is-topic-message | ||
| 23 | message-is-automatic-forward | ||
| 24 | message-reply-to-message | ||
| 25 | message-reply-to-checklist-task-id | ||
| 26 | message-via-bot | ||
| 27 | message-edit-date | ||
| 28 | message-has-protected-content | ||
| 29 | message-is-from-offline | ||
| 30 | message-is-paid-post | ||
| 31 | message-media-group-id | ||
| 32 | message-author-signature | ||
| 33 | message-paid-star-count | ||
| 34 | message-text | ||
| 35 | message-entities | ||
| 36 | message-effect-id | ||
| 37 | message-caption | ||
| 38 | message-show-caption-above-media | ||
| 39 | message-has-media-spoiler | ||
| 40 | message-new-chat-members | ||
| 41 | message-new-chat-title | ||
| 42 | message-delete-chat-photo | ||
| 43 | message-group-chat-created | ||
| 44 | message-supergroup-chat-created | ||
| 45 | message-channel-chat-created | ||
| 46 | message-migrate-to-chat-id | ||
| 47 | message-migrate-from-chat-id | ||
| 48 | message-pinned-message | ||
| 49 | message-connected-website | ||
| 50 | |||
| 51 | hash->message | ||
| 52 | message-id | ||
| 53 | message-chat-id | ||
| 54 | message-thread-id | ||
| 55 | parse-message-array)) | ||
| 56 | (in-package :ukkoclot/tg-types/message) | ||
| 57 | |||
| 58 | ;; If this is a MaybeInaccessibleMessage date will be 0 if this is inaccessible | ||
| 59 | (define-tg-type message | ||
| 60 | (message-id integer) | ||
| 61 | (message-thread-id (or integer null) nil) | ||
| 62 | ;; (direct-messages-topic (or direct-messages-topic null) nil) | ||
| 63 | (from (or user null) nil :parser hash->user) | ||
| 64 | ;; (sender-chat (or chat null) nil) | ||
| 65 | (sender-boost-count (or integer null) nil) | ||
| 66 | (sender-business-bot (or user null) nil :parser hash->user) | ||
| 67 | (date integer) | ||
| 68 | (business-connection-id (or string null) nil) | ||
| 69 | (chat chat nil :parser hash->chat) | ||
| 70 | ;; (forward-origin (or message-origin null) nil) | ||
| 71 | (is-topic-message boolean nil) | ||
| 72 | (is-automatic-forward boolean nil) | ||
| 73 | (reply-to-message (or message null) nil :parser hash->message) | ||
| 74 | ;; (external-reply (or external-reply-info null) nil) | ||
| 75 | ;; (quote (or text-quote null) nil) | ||
| 76 | ;; (reply-to-story (or story null) nil) | ||
| 77 | (reply-to-checklist-task-id (or integer null) nil) | ||
| 78 | (via-bot (or user null) nil :parser hash->user) | ||
| 79 | (edit-date (or integer null) nil) | ||
| 80 | (has-protected-content boolean nil) | ||
| 81 | (is-from-offline boolean nil) | ||
| 82 | (is-paid-post boolean nil) | ||
| 83 | (media-group-id (or string null) nil) | ||
| 84 | (author-signature (or string null) nil) | ||
| 85 | (paid-star-count (or string null) nil) | ||
| 86 | (text (or string null) nil) | ||
| 87 | (entities (or (array message-entity) null) nil :parser parse-message-entity-array) | ||
| 88 | ;; (link-preview-options (or link-preview-options null) nil) | ||
| 89 | ;; (suggested-post-info (or suggested-post-info null) nil) | ||
| 90 | (effect-id (or string null) nil) | ||
| 91 | ;; (animation (or animation null) nil) | ||
| 92 | ;; (audio (or audio null) nil) | ||
| 93 | ;; (document (or document null) nil) | ||
| 94 | ;; (paid-media (or paid-media-info null) nil) | ||
| 95 | ;; (photo (or (array photo-size) null) nil) | ||
| 96 | ;; (sticker (or sticker null) nil) | ||
| 97 | ;; (story (or story null) nil) | ||
| 98 | ;; (video (or video null) nil) | ||
| 99 | ;; (video-note (or video-note null) nil) | ||
| 100 | ;; (voice (or voice null) nil) | ||
| 101 | (caption (or string null) nil) | ||
| 102 | ;; (caption-entities (or (array message-entity) null) nil) | ||
| 103 | (show-caption-above-media boolean nil) | ||
| 104 | (has-media-spoiler boolean nil) | ||
| 105 | ;; (contact (or contact null) nil) | ||
| 106 | ;; (dice (or dice null) nil) | ||
| 107 | ;; (game (or game null) nil) | ||
| 108 | ;; (poll (or poll null) nil) | ||
| 109 | ;; (venue (or venue null) nil) | ||
| 110 | ;; (location (or location null) nil) | ||
| 111 | (new-chat-members (or (array user) null) nil :parser parse-user-array) | ||
| 112 | ;; (left-chat-member (or user null) nil) | ||
| 113 | (new-chat-title (or string null) nil) | ||
| 114 | ;; (new-chat-photo (or (array photo-size) null) nil) | ||
| 115 | (delete-chat-photo boolean nil) | ||
| 116 | (group-chat-created boolean nil) | ||
| 117 | (supergroup-chat-created boolean nil) | ||
| 118 | (channel-chat-created boolean nil) | ||
| 119 | ;; (message-auto-delete-timer-changed (orp message-auto-delete-timer-changed null) nil) | ||
| 120 | (migrate-to-chat-id (or integer null) nil) | ||
| 121 | (migrate-from-chat-id (or integer null) nil) | ||
| 122 | (pinned-message (or message null) nil :parser hash->message) | ||
| 123 | ;; (invoice (or invoice null) nil) | ||
| 124 | ;; (successful-payment (or successful-payment null) nil) | ||
| 125 | ;; (refunded-payment (or refunded-payment null) nil) | ||
| 126 | ;; (users-shared (or users-shared null) nil) | ||
| 127 | ;; (chat-shared (or chat-shared null) nil) | ||
| 128 | ;; (gift (or gift-info null) nil) | ||
| 129 | ;; (unique-gift (or unique-gift-info null) nil) | ||
| 130 | (connected-website (or string null) nil) | ||
| 131 | ;; (write-access-allowed (or write-access-allowed null) nil) | ||
| 132 | ;; (passport-data (or passport-data null) nil) | ||
| 133 | ;; (proximity-alert-triggered (or proximity-alert-triggered null) nil) | ||
| 134 | ;; (boost-added (or chat-boost-added null) nil) | ||
| 135 | ;; (chat-background-set (or chat-background null) nil) | ||
| 136 | ;; (checklist-tasks-added (or checklist-tasks-added null) nil) | ||
| 137 | ;; (direct-message-price-changed (or direct-message-price-changed null) nil) | ||
| 138 | ;; (forum-topic-created (or forum-topic-created null) nil) | ||
| 139 | ;; (forum-topic-edited (or forum-topic-edited null) nil) | ||
| 140 | ;; (forum-topic-closed (or forum-topic-closed null) nil) | ||
| 141 | ;; (forum-topic-reopened (or forum-topic-reopened null) nil) | ||
| 142 | ;; (general-forum-topic-hidden (or general-forum-topic-hidden null) nil) | ||
| 143 | ;; (general-forum-topic-unhidden (or general-forum-topic-unhidden null) nil) | ||
| 144 | ;; (giveaway-created (or giveaway-created null) nil) | ||
| 145 | ;; (giveaway-winners (or giveaway-winners null) nil) | ||
| 146 | ;; (giveaway-completed (or giveaway-completed null) nil) | ||
| 147 | ;; (paid-message-price-changed (or paid-message-price-changed null) nil) | ||
| 148 | ;; (suggested-post-approved (or suggested-post-approved null) nil) | ||
| 149 | ;; (suggested-post-approval-failed (or suggested-post-approval-failed null) nil) | ||
| 150 | ;; (suggested-post-declined (or suggested-post-declined null) nil) | ||
| 151 | ;; (suggested-post-paid (or suggested-post-paid null) nil) | ||
| 152 | ;; (suggested-post-refunded (or suggested-post-refunded null) nil) | ||
| 153 | ;; (video-chat-scheduled (or video-chat-scheduled null) nil) | ||
| 154 | ;; (video-chat-started (or video-chat-started null) nil) | ||
| 155 | ;; (video-chat-ended (or video-chat-ended null) nil) | ||
| 156 | ;; (video-chat-participants-invited (or video-chat-participants-invited null) nil) | ||
| 157 | ;; (web-app-data (or web-app-data null) nil) | ||
| 158 | ;; (reply-markup (or inline-keyboard-markup null) nil) | ||
| 159 | ) | ||
| 160 | |||
| 161 | (defun message-id (msg) | ||
| 162 | (message-message-id msg)) | ||
| 163 | |||
| 164 | (defun message-chat-id (msg) | ||
| 165 | (chat-id (message-chat msg))) | ||
| 166 | |||
| 167 | (defun message-thread-id (msg) | ||
| 168 | (message-message-thread-id msg)) | ||
diff --git a/src/tg-types/parsers.lisp b/src/tg-types/parsers.lisp new file mode 100644 index 0000000..0b6c4ae --- /dev/null +++ b/src/tg-types/parsers.lisp | |||
| @@ -0,0 +1,9 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/parsers | ||
| 4 | (:use :c2cl :ukkoclot/strings) | ||
| 5 | (:export tg-string->keyword)) | ||
| 6 | (in-package :ukkoclot/tg-types/parsers) | ||
| 7 | |||
| 8 | (defun tg-string->keyword (str) | ||
| 9 | (intern (string-upcase (snake->lisp-case str)) :keyword)) | ||
diff --git a/src/tg-types/reply-parameters.lisp b/src/tg-types/reply-parameters.lisp new file mode 100644 index 0000000..5f0595d --- /dev/null +++ b/src/tg-types/reply-parameters.lisp | |||
| @@ -0,0 +1,32 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/reply-parameters | ||
| 4 | (:use :c2cl :ukkoclot/tg-types/macros :ukkoclot/tg-types/message-entity) | ||
| 5 | (:export | ||
| 6 | reply-parameters | ||
| 7 | make-reply-parameters | ||
| 8 | reply-parameters-p | ||
| 9 | copy-reply-parameters | ||
| 10 | reply-parameters-message-id | ||
| 11 | reply-parameters-chat-id | ||
| 12 | reply-parameters-allow-sending-without-reply | ||
| 13 | reply-parameters-quote | ||
| 14 | reply-parameters-quote-parse-mode | ||
| 15 | reply-parameters-quote-entities | ||
| 16 | reply-parameters-quote-position | ||
| 17 | reply-parameters-checklist-task-id | ||
| 18 | |||
| 19 | hash->reply-parameters | ||
| 20 | parse-reply-parameters-array)) | ||
| 21 | (in-package :ukkoclot/tg-types/reply-parameters) | ||
| 22 | |||
| 23 | (define-tg-type reply-parameters | ||
| 24 | (message-id integer) | ||
| 25 | (chat-id (or integer string null) nil) | ||
| 26 | ;; Technically true if on a business account but yeah right lmao | ||
| 27 | (allow-sending-without-reply boolean nil) | ||
| 28 | (quote (or string null) nil) | ||
| 29 | (quote-parse-mode (or string null) nil) | ||
| 30 | (quote-entities (or (array message-entity) null) nil) | ||
| 31 | (quote-position (or integer null) nil) | ||
| 32 | (checklist-task-id (or integer null) nil)) | ||
diff --git a/src/tg-types/update.lisp b/src/tg-types/update.lisp new file mode 100644 index 0000000..9043d54 --- /dev/null +++ b/src/tg-types/update.lisp | |||
| @@ -0,0 +1,47 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/update | ||
| 4 | (:use :c2cl :ukkoclot/tg-types/macros | ||
| 5 | :ukkoclot/tg-types/callback-query | ||
| 6 | :ukkoclot/tg-types/message) | ||
| 7 | (:export | ||
| 8 | update update-p | ||
| 9 | |||
| 10 | hash->update make-update parse-update-array | ||
| 11 | |||
| 12 | update-update-id update-message update-edited-message update-channel-post update-edited-channel-post | ||
| 13 | ;; update-business-connection | ||
| 14 | update-business-message update-edited-business-message | ||
| 15 | ;; update-deleted-business-messages update-message-reaction update-message-reaction-count update-inline-query | ||
| 16 | ;; update-chosen-inline-result | ||
| 17 | update-callback-query | ||
| 18 | ;; update-shipping-query update-pre-checkout-query update-poll update-poll-answer update-my-chat-member | ||
| 19 | ;; update-chat-member update-chat-join-request update-chat-boost update-removed-chat-boost | ||
| 20 | )) | ||
| 21 | (in-package :ukkoclot/tg-types/update) | ||
| 22 | |||
| 23 | (define-tg-type update | ||
| 24 | (update-id integer) | ||
| 25 | (message (or message null) nil :parser hash->message) | ||
| 26 | (edited-message (or message null) nil :parser hash->message) | ||
| 27 | (channel-post (or message null) nil :parser hash->message) | ||
| 28 | (edited-channel-post (or message null) nil :parser hash->message) | ||
| 29 | ;; (business-connection (or business-connection null) nil) | ||
| 30 | (business-message (or message null) nil :parser hash->message) | ||
| 31 | (edited-business-message (or message null) nil :parser hash->message) | ||
| 32 | ;; (deleted-business-messages (or business-messages-deleted null) nil) | ||
| 33 | ;; (message-reaction (or message-reaction-updated null) nil) | ||
| 34 | ;; (message-reaction-count (or message-reaction-count-updated null) nil) | ||
| 35 | ;; (inline-query (or inline-query null) nil) | ||
| 36 | ;; (chosen-inline-result (or chosen-inline-result null) nil) | ||
| 37 | (callback-query (or callback-query null) nil :parser hash->callback-query) | ||
| 38 | ;; (shipping-query (or shipping-query null) nil) | ||
| 39 | ;; (pre-checkout-query (or pre-checkout-query null) nil) | ||
| 40 | ;; (poll (or poll null) nil) | ||
| 41 | ;; (poll-answer (or poll-answer null) nil) | ||
| 42 | ;; (my-chat-member (or chat-member-updated null) nil) | ||
| 43 | ;; (chat-member (or chat-member-updated null) nil) | ||
| 44 | ;; (chat-join-request (or chat-join-request null) nil) | ||
| 45 | ;; (chat-boost (or chat-boost-updated null) nil) | ||
| 46 | ;; (removed-chat-boost (or chat-boost-removed) nil) | ||
| 47 | ) | ||
diff --git a/src/tg-types/user.lisp b/src/tg-types/user.lisp new file mode 100644 index 0000000..c5ed499 --- /dev/null +++ b/src/tg-types/user.lisp | |||
| @@ -0,0 +1,48 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/user | ||
| 4 | (:use :c2cl :ukkoclot/tg-types/macros) | ||
| 5 | (:import-from :ukkoclot/strings :escape-xml) | ||
| 6 | (:export | ||
| 7 | user user-p | ||
| 8 | |||
| 9 | hash->user make-user parse-user-array user-format-name | ||
| 10 | |||
| 11 | user-id user-is-bot user-first-name user-last-name user-username user-language-code user-is-premium | ||
| 12 | user-added-to-attachment-menu user-can-join-groups user-can-read-all-group-messages user-supports-inline-queries | ||
| 13 | user-can-connect-to-business)) | ||
| 14 | (in-package :ukkoclot/tg-types/user) | ||
| 15 | |||
| 16 | (define-tg-type user | ||
| 17 | (id integer) | ||
| 18 | (is-bot boolean) | ||
| 19 | (first-name string) | ||
| 20 | (last-name (or string null) nil) | ||
| 21 | (username (or string null) nil) | ||
| 22 | (language-code (or string null) nil) | ||
| 23 | (is-premium boolean nil) | ||
| 24 | (added-to-attachment-menu boolean nil) | ||
| 25 | (can-join-groups boolean nil) | ||
| 26 | (can-read-all-group-messages boolean nil) | ||
| 27 | (supports-inline-queries boolean nil) | ||
| 28 | (can-connect-to-business boolean nil)) | ||
| 29 | |||
| 30 | (defun user-format-name% (user out) | ||
| 31 | (format out "<a href=\"tg://user?id=~A\"><i>" (user-id user)) | ||
| 32 | (escape-xml (user-first-name user) out) | ||
| 33 | (when (user-last-name user) | ||
| 34 | (write-char #\Space out) | ||
| 35 | (escape-xml (user-last-name user) out)) | ||
| 36 | (write-string "</i>" out) | ||
| 37 | |||
| 38 | (when (user-username user) | ||
| 39 | (write-string " @" out) | ||
| 40 | (escape-xml (user-username user) out)) | ||
| 41 | |||
| 42 | (format out "</a> [<code>~A</code>]" (user-id user))) | ||
| 43 | |||
| 44 | (defun user-format-name (user &optional out) | ||
| 45 | (if out | ||
| 46 | (user-format-name% user out) | ||
| 47 | (with-output-to-string (stream) | ||
| 48 | (user-format-name% user stream)))) | ||