From 4da3ad1f569832845b58c3ce35149633a2bb665c Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Thu, 9 Oct 2025 21:58:43 +0300 Subject: Initial commit --- src/tg-types/bot-name.lisp | 14 +++ src/tg-types/callback-query.lisp | 24 +++++ src/tg-types/chat.lisp | 31 ++++++ src/tg-types/force-reply.lisp | 21 ++++ src/tg-types/inline-keyboard-button.lisp | 32 ++++++ src/tg-types/inline-keyboard-markup.lisp | 17 ++++ src/tg-types/link-preview-options.lisp | 25 +++++ src/tg-types/macros.lisp | 134 ++++++++++++++++++++++++ src/tg-types/message-entity.lisp | 61 +++++++++++ src/tg-types/message.lisp | 168 +++++++++++++++++++++++++++++++ src/tg-types/parsers.lisp | 9 ++ src/tg-types/reply-parameters.lisp | 32 ++++++ src/tg-types/update.lisp | 47 +++++++++ src/tg-types/user.lisp | 48 +++++++++ 14 files changed, 663 insertions(+) create mode 100644 src/tg-types/bot-name.lisp create mode 100644 src/tg-types/callback-query.lisp create mode 100644 src/tg-types/chat.lisp create mode 100644 src/tg-types/force-reply.lisp create mode 100644 src/tg-types/inline-keyboard-button.lisp create mode 100644 src/tg-types/inline-keyboard-markup.lisp create mode 100644 src/tg-types/link-preview-options.lisp create mode 100644 src/tg-types/macros.lisp create mode 100644 src/tg-types/message-entity.lisp create mode 100644 src/tg-types/message.lisp create mode 100644 src/tg-types/parsers.lisp create mode 100644 src/tg-types/reply-parameters.lisp create mode 100644 src/tg-types/update.lisp create mode 100644 src/tg-types/user.lisp (limited to 'src/tg-types') 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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/bot-name + (:use :c2cl :ukkoclot/tg-types/macros) + (:export + bot-name bot-name-p + + hash->bot-name make-bot-name parse-bot-name-array + + bot-name-name)) +(in-package :ukkoclot/tg-types/bot-name) + +(define-tg-type bot-name + (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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/callback-query + (:use :c2cl :ukkoclot/tg-types/macros) + (:use + :ukkoclot/tg-types/message + :ukkoclot/tg-types/user) + (:export + callback-query callback-query-p + + hash->callback-query make-callback-query parse-callback-query-array + + callback-query-id callback-query-from callback-query-message callback-query-inline-message-id + callback-query-chat-instance callback-query-data callback-query-game-short-name)) +(in-package :ukkoclot/tg-types/callback-query) + +(define-tg-type callback-query + (id string) + (from user) + (message (or message null) nil) + (inline-message-id (or string null) nil) + (chat-instance string) + (data (or string null) nil) + (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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/chat + (:use :c2cl :ukkoclot/tg-types/macros :ukkoclot/tg-types/parsers) + (:export + chat + make-chat + chat-p + copy-chat + chat-id + chat-type + chat-title + chat-username + chat-first-name + chat-last-name + chat-is-forum + chat-is-direct-messages + + hash->chat + parse-chat-array)) +(in-package :ukkoclot/tg-types/chat) + +(define-tg-type chat + (id integer) + (type keyword nil :parser tg-string->keyword) + (title (or string null) nil) + (username (or string null) nil) + (first-name (or string null) nil) + (last-name (or string null) nil) + (is-forum boolean nil) + (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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/force-reply + (:use :c2cl :ukkoclot/tg-types/macros) + (:export + force-reply + make-force-reply + force-reply-p + copy-force-reply + force-reply-force-reply + force-reply-input-field-placeholder + force-reply-selective + + hash->force-reply + parse-force-reply-array)) +(in-package :ukkoclot/tg-types/force-reply) + +(define-tg-type force-reply + (force-reply boolean t :skip-if-default nil) + (input-field-placeholder (or string null) nil) + (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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/inline-keyboard-button + (:use :c2cl :ukkoclot/tg-types/macros) + (:export + inline-keyboard-button + make-inline-keyboard-button + inline-keyboard-button-p + copy-inline-keyboard-button + inline-keyboard-button-text + inline-keyboard-button-url + inline-keyboard-button-callback-data + inline-keyboard-button-switch-inline-query + inline-keyboard-button-switch-inline-query-current-chat + inline-keyboard-button-pay + + hash->inline-keyboard-button + parse-inline-keyboard-button-array)) +(in-package :ukkoclot/tg-types/inline-keyboard-button) + +(define-tg-type inline-keyboard-button + (text string) + (url (or string null) nil) + (callback-data string) + ;; TODO: (web-app (or web-app-info null) nil) + ;; TODO: (login-url (or login-url null) nil) + (switch-inline-query (or string null) nil) + (switch-inline-query-current-chat (or string null) nil) + ;; TODO: (switch-inline-query-chosen-chat (or switch-inline-query-chosen-chat null) nil) + ;; TODO: (copy-text (or copy-text-button null) nil) + ;; TODO: (callback-game (or callback-game null) nil) + (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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/inline-keyboard-markup + (:use :c2cl :ukkoclot/tg-types/inline-keyboard-button :ukkoclot/tg-types/macros) + (:export + inline-keyboard-markup + make-inline-keyboard-markup + inline-keyboard-markup-p + copy-inline-keyboard-markup + inline-keyboard-markup-inline-keyboard + + hash->inline-keyboard-markup + parse-inline-keyboard-markup-array)) +(in-package :ukkoclot/tg-types/inline-keyboard-markup) + +(define-tg-type inline-keyboard-markup + (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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/link-preview-options + (:use :c2cl :ukkoclot/tg-types/macros) + (:export + link-preview-options + make-link-preview-options + link-preview-options-p + copy-link-preview-options + link-preview-options-is-disabled + link-preview-options-url + link-preview-options-prefer-small-media + link-preview-options-prefer-large-media + link-preview-options-show-above-text + + hash->link-preview-options + parse-link-preview-options-array)) +(in-package :ukkoclot/tg-types/link-preview-options) + +(define-tg-type link-preview-options + (is-disabled boolean nil) + (url (or string null) nil) + (prefer-small-media boolean nil) + (prefer-large-media boolean nil) + (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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/macros + (:use :c2cl) + (:import-from :ukkoclot/bot/impl :arg-encode :bot :do-call :will-arg-encode) + (:import-from :ukkoclot/hash-tables :gethash-lazy) + (:import-from :ukkoclot/strings :lisp->snake-case) + (:export :define-tg-method :define-tg-type)) +(in-package :ukkoclot/tg-types/macros) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defstruct (field (:constructor make-field%)) name type default skip-if-default (parser 'identity)) + + (defparameter +unique+ (gensym)) + + (defun make-field (name type &optional (default +unique+) &key (parser 'identity) (skip-if-default (not (eq default +unique+)))) + (let ((default (if (eq default +unique+) + (list 'error (format nil "No value given for ~A" name)) + default))) + (make-field% :name name + :type type + :default default + :skip-if-default skip-if-default + :parser parser))) + + (defun parse-field-specs (field-specs) + (loop for field-spec in field-specs + collect (apply #'make-field field-spec))) + + (defun field-hash-key (field) + (string-downcase (lisp->snake-case (symbol-name (field-name field))))) + + (defun field-accessor (struc-name field) + (intern (concatenate 'string (symbol-name struc-name) "-" (symbol-name (field-name field))))) + + (defun field->defun-spec (field) + (list (field-name field) (field-default field))) + + (defun field->format-arg (field name struc) + `(',(field-name field) (,(field-accessor name field) ,struc))) + + (defun field->ftype-spec (field) + (list (intern (symbol-name (field-name field)) :keyword) (field-type field))) + + (defun field->gethash-spec (field hash-table-sym) + (let ((hash-key (field-hash-key field))) + (list 'gethash-lazy hash-key hash-table-sym (field-default field)))) + + (defun field->sethash-spec (field name struc hash-table-sym) + (let ((hash-key (field-hash-key field)) + (skip-if-default (field-skip-if-default field)) + (default (field-default field))) + (if skip-if-default + (let ((tmpsym (gensym "TMP"))) + `(let ((,tmpsym (,(field-accessor name field) ,struc))) + (unless (equal ,tmpsym ,default) + (setf (gethash ,hash-key ,hash-table-sym) ,tmpsym)))) + `(setf (gethash ,hash-key ,hash-table-sym) (,(field-accessor name field) ,struc))))) + + (defun field->let-gethash-spec (field hash-table-sym) + (list (field-name field) + (list 'funcall + (list 'function (field-parser field)) + (field->gethash-spec field hash-table-sym)))) + + (defun field->make-spec (field) + (list (intern (symbol-name (field-name field)) :keyword) + (field-name field))) + + (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 +;; TODO: Skip values that are already their defaults +(defmacro define-tg-method ( + (name type path mapfn &optional (method :POST)) + &body field-specs) + (let ((fields (parse-field-specs field-specs)) + (args-plist (gensym "ARGS-PLIST-")) + (bot (gensym "BOT-"))) + `(progn + (declaim (ftype (function (bot &key ,@(loop for field in fields + collect (field->ftype-spec field))) + ,type) + ,name)) + (defun ,name (,bot &rest ,args-plist &key ,@(loop for field in fields collect (field->defun-spec field))) + (declare ,@(loop for field in fields collect (list 'ignore (field-name field)))) + (do-call ,bot ,method ,path ,mapfn ,args-plist))))) + +(defmacro define-tg-type (name &body field-specs) + (let* ((fields (parse-field-specs field-specs)) + (revfields (reverse fields)) + (make-name (intern (concatenate 'string "MAKE-" (symbol-name name)))) + (hash->name (intern (concatenate 'string "HASH->" (symbol-name name)))) + (parse-name-array (intern (concatenate 'string "PARSE-" (symbol-name name) "-ARRAY"))) + (printer (gensym (concatenate 'string "PRINT-" (symbol-name name)))) + (hash (gensym "HASH-")) + (array (gensym "ARRAY-")) + (struc (gensym (symbol-name name))) + (stream (gensym "STREAM")) + (depth (gensym "DEPTH")) + (pprint-args (gensym "PPRINT-ARGS"))) + `(progn + (defstruct (,name (:print-function ,printer)) + ,@(loop for field in fields + collect (field->struct-spec field))) + (defun ,printer (,struc ,stream ,depth) + (declare (ignore ,depth)) + (let (,pprint-args) + ,@(loop for field in revfields + collecting + (if (field-skip-if-default field) + `(let ((value (,(field-accessor name field) ,struc))) + (unless (equal value ,(field-default field)) + (setf ,pprint-args (list* ',(field-name field) value ,pprint-args)))) + `(setf ,pprint-args (list* ',(field-name field) (,(field-accessor name field) ,struc) ,pprint-args)))) + (format ,stream "~A~<[~;~@{~_~1I~W = ~W~^, ~}~;]~:>" ',name ,pprint-args))) + (defun ,hash->name (,hash) + (when ,hash + (let ,(loop for field in fields + collect (field->let-gethash-spec field hash)) + (,make-name ,@(loop for field in fields + append (field->make-spec field)))))) + (defmethod arg-encode ((,struc ,name)) + (let ((,hash (make-hash-table))) + ,@(loop for field in fields + collect (field->sethash-spec field name struc hash)) + ,hash)) + (defmethod will-arg-encode ((,struc ,name)) + t) + (defun ,parse-name-array (,array) + (when ,array + (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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/message-entity + (:use :c2cl :iterate :ukkoclot/tg-types/macros :ukkoclot/tg-types/parsers :ukkoclot/tg-types/user) + (:export + message-entity + make-message-entity + message-entity-p + copy-message-entity + message-entity-type + message-entity-offset + message-entity-length + message-entity-url + message-entity-user + message-entity-language + message-entity-custom-emoji-id + + hash->message-entity + message-entity-extract + parse-message-entity-array)) +(in-package :ukkoclot/tg-types/message-entity) + +(define-tg-type message-entity + (type keyword nil :parser tg-string->keyword) + (offset integer) + (length integer) + (url (or string null) nil) + (user (or user null) nil) + (language (or string null) nil) + (custom-emoji-id (or string null) nil)) + +(unless (= char-code-limit #x110000) + (error "Some UTF-16 fuckery assumes that system chars are UTF-32")) + +(defun utf16-width (ch) + (if (< (char-code ch) #x10000) + 1 + 2)) + +(defun message-entity-extract (entity text) + (with-slots (length offset) entity + (if (= length 0) + "" + (let* ((start (iterate + (with curr-idx16 = 0) + (for ch in-string text with-index curr-idx32) + (for curr-width = (utf16-width ch)) + (when (or (= curr-idx16 offset) + (> (+ curr-idx16 curr-width) offset)) + (return curr-idx32)) + (setq curr-idx16 (+ curr-idx16 curr-width)) + (finally (return (length text))))) + (end (iterate + (with curr-len16 = 0) + (for ch in-string text from start with-index curr-idx32) + (for curr-width = (utf16-width ch)) + (when (>= curr-len16 length) + (return curr-idx32)) + (setq curr-len16 (+ curr-len16 curr-width)) + (finally (return (length text)))))) + (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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/message + (:use :c2cl :ukkoclot/tg-types/macros + + :ukkoclot/tg-types/chat + :ukkoclot/tg-types/message-entity + :ukkoclot/tg-types/user) + (:export + message + make-message + message-p + copy-message + message-message-id + message-message-thread-id + message-from + message-sender-boost-count + message-sender-business-bot + message-date + message-business-connection-id + message-chat + message-is-topic-message + message-is-automatic-forward + message-reply-to-message + message-reply-to-checklist-task-id + message-via-bot + message-edit-date + message-has-protected-content + message-is-from-offline + message-is-paid-post + message-media-group-id + message-author-signature + message-paid-star-count + message-text + message-entities + message-effect-id + message-caption + message-show-caption-above-media + message-has-media-spoiler + message-new-chat-members + message-new-chat-title + message-delete-chat-photo + message-group-chat-created + message-supergroup-chat-created + message-channel-chat-created + message-migrate-to-chat-id + message-migrate-from-chat-id + message-pinned-message + message-connected-website + + hash->message + message-id + message-chat-id + message-thread-id + parse-message-array)) +(in-package :ukkoclot/tg-types/message) + +;; If this is a MaybeInaccessibleMessage date will be 0 if this is inaccessible +(define-tg-type message + (message-id integer) + (message-thread-id (or integer null) nil) + ;; (direct-messages-topic (or direct-messages-topic null) nil) + (from (or user null) nil :parser hash->user) + ;; (sender-chat (or chat null) nil) + (sender-boost-count (or integer null) nil) + (sender-business-bot (or user null) nil :parser hash->user) + (date integer) + (business-connection-id (or string null) nil) + (chat chat nil :parser hash->chat) + ;; (forward-origin (or message-origin null) nil) + (is-topic-message boolean nil) + (is-automatic-forward boolean nil) + (reply-to-message (or message null) nil :parser hash->message) + ;; (external-reply (or external-reply-info null) nil) + ;; (quote (or text-quote null) nil) + ;; (reply-to-story (or story null) nil) + (reply-to-checklist-task-id (or integer null) nil) + (via-bot (or user null) nil :parser hash->user) + (edit-date (or integer null) nil) + (has-protected-content boolean nil) + (is-from-offline boolean nil) + (is-paid-post boolean nil) + (media-group-id (or string null) nil) + (author-signature (or string null) nil) + (paid-star-count (or string null) nil) + (text (or string null) nil) + (entities (or (array message-entity) null) nil :parser parse-message-entity-array) + ;; (link-preview-options (or link-preview-options null) nil) + ;; (suggested-post-info (or suggested-post-info null) nil) + (effect-id (or string null) nil) + ;; (animation (or animation null) nil) + ;; (audio (or audio null) nil) + ;; (document (or document null) nil) + ;; (paid-media (or paid-media-info null) nil) + ;; (photo (or (array photo-size) null) nil) + ;; (sticker (or sticker null) nil) + ;; (story (or story null) nil) + ;; (video (or video null) nil) + ;; (video-note (or video-note null) nil) + ;; (voice (or voice null) nil) + (caption (or string null) nil) + ;; (caption-entities (or (array message-entity) null) nil) + (show-caption-above-media boolean nil) + (has-media-spoiler boolean nil) + ;; (contact (or contact null) nil) + ;; (dice (or dice null) nil) + ;; (game (or game null) nil) + ;; (poll (or poll null) nil) + ;; (venue (or venue null) nil) + ;; (location (or location null) nil) + (new-chat-members (or (array user) null) nil :parser parse-user-array) + ;; (left-chat-member (or user null) nil) + (new-chat-title (or string null) nil) + ;; (new-chat-photo (or (array photo-size) null) nil) + (delete-chat-photo boolean nil) + (group-chat-created boolean nil) + (supergroup-chat-created boolean nil) + (channel-chat-created boolean nil) + ;; (message-auto-delete-timer-changed (orp message-auto-delete-timer-changed null) nil) + (migrate-to-chat-id (or integer null) nil) + (migrate-from-chat-id (or integer null) nil) + (pinned-message (or message null) nil :parser hash->message) + ;; (invoice (or invoice null) nil) + ;; (successful-payment (or successful-payment null) nil) + ;; (refunded-payment (or refunded-payment null) nil) + ;; (users-shared (or users-shared null) nil) + ;; (chat-shared (or chat-shared null) nil) + ;; (gift (or gift-info null) nil) + ;; (unique-gift (or unique-gift-info null) nil) + (connected-website (or string null) nil) + ;; (write-access-allowed (or write-access-allowed null) nil) + ;; (passport-data (or passport-data null) nil) + ;; (proximity-alert-triggered (or proximity-alert-triggered null) nil) + ;; (boost-added (or chat-boost-added null) nil) + ;; (chat-background-set (or chat-background null) nil) + ;; (checklist-tasks-added (or checklist-tasks-added null) nil) + ;; (direct-message-price-changed (or direct-message-price-changed null) nil) + ;; (forum-topic-created (or forum-topic-created null) nil) + ;; (forum-topic-edited (or forum-topic-edited null) nil) + ;; (forum-topic-closed (or forum-topic-closed null) nil) + ;; (forum-topic-reopened (or forum-topic-reopened null) nil) + ;; (general-forum-topic-hidden (or general-forum-topic-hidden null) nil) + ;; (general-forum-topic-unhidden (or general-forum-topic-unhidden null) nil) + ;; (giveaway-created (or giveaway-created null) nil) + ;; (giveaway-winners (or giveaway-winners null) nil) + ;; (giveaway-completed (or giveaway-completed null) nil) + ;; (paid-message-price-changed (or paid-message-price-changed null) nil) + ;; (suggested-post-approved (or suggested-post-approved null) nil) + ;; (suggested-post-approval-failed (or suggested-post-approval-failed null) nil) + ;; (suggested-post-declined (or suggested-post-declined null) nil) + ;; (suggested-post-paid (or suggested-post-paid null) nil) + ;; (suggested-post-refunded (or suggested-post-refunded null) nil) + ;; (video-chat-scheduled (or video-chat-scheduled null) nil) + ;; (video-chat-started (or video-chat-started null) nil) + ;; (video-chat-ended (or video-chat-ended null) nil) + ;; (video-chat-participants-invited (or video-chat-participants-invited null) nil) + ;; (web-app-data (or web-app-data null) nil) + ;; (reply-markup (or inline-keyboard-markup null) nil) + ) + +(defun message-id (msg) + (message-message-id msg)) + +(defun message-chat-id (msg) + (chat-id (message-chat msg))) + +(defun message-thread-id (msg) + (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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/parsers + (:use :c2cl :ukkoclot/strings) + (:export tg-string->keyword)) +(in-package :ukkoclot/tg-types/parsers) + +(defun tg-string->keyword (str) + (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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/reply-parameters + (:use :c2cl :ukkoclot/tg-types/macros :ukkoclot/tg-types/message-entity) + (:export + reply-parameters + make-reply-parameters + reply-parameters-p + copy-reply-parameters + reply-parameters-message-id + reply-parameters-chat-id + reply-parameters-allow-sending-without-reply + reply-parameters-quote + reply-parameters-quote-parse-mode + reply-parameters-quote-entities + reply-parameters-quote-position + reply-parameters-checklist-task-id + + hash->reply-parameters + parse-reply-parameters-array)) +(in-package :ukkoclot/tg-types/reply-parameters) + +(define-tg-type reply-parameters + (message-id integer) + (chat-id (or integer string null) nil) + ;; Technically true if on a business account but yeah right lmao + (allow-sending-without-reply boolean nil) + (quote (or string null) nil) + (quote-parse-mode (or string null) nil) + (quote-entities (or (array message-entity) null) nil) + (quote-position (or integer null) nil) + (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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/update + (:use :c2cl :ukkoclot/tg-types/macros + :ukkoclot/tg-types/callback-query + :ukkoclot/tg-types/message) + (:export + update update-p + + hash->update make-update parse-update-array + + update-update-id update-message update-edited-message update-channel-post update-edited-channel-post + ;; update-business-connection + update-business-message update-edited-business-message + ;; update-deleted-business-messages update-message-reaction update-message-reaction-count update-inline-query + ;; update-chosen-inline-result + update-callback-query + ;; update-shipping-query update-pre-checkout-query update-poll update-poll-answer update-my-chat-member + ;; update-chat-member update-chat-join-request update-chat-boost update-removed-chat-boost + )) +(in-package :ukkoclot/tg-types/update) + +(define-tg-type update + (update-id integer) + (message (or message null) nil :parser hash->message) + (edited-message (or message null) nil :parser hash->message) + (channel-post (or message null) nil :parser hash->message) + (edited-channel-post (or message null) nil :parser hash->message) + ;; (business-connection (or business-connection null) nil) + (business-message (or message null) nil :parser hash->message) + (edited-business-message (or message null) nil :parser hash->message) + ;; (deleted-business-messages (or business-messages-deleted null) nil) + ;; (message-reaction (or message-reaction-updated null) nil) + ;; (message-reaction-count (or message-reaction-count-updated null) nil) + ;; (inline-query (or inline-query null) nil) + ;; (chosen-inline-result (or chosen-inline-result null) nil) + (callback-query (or callback-query null) nil :parser hash->callback-query) + ;; (shipping-query (or shipping-query null) nil) + ;; (pre-checkout-query (or pre-checkout-query null) nil) + ;; (poll (or poll null) nil) + ;; (poll-answer (or poll-answer null) nil) + ;; (my-chat-member (or chat-member-updated null) nil) + ;; (chat-member (or chat-member-updated null) nil) + ;; (chat-join-request (or chat-join-request null) nil) + ;; (chat-boost (or chat-boost-updated null) nil) + ;; (removed-chat-boost (or chat-boost-removed) nil) + ) 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 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/user + (:use :c2cl :ukkoclot/tg-types/macros) + (:import-from :ukkoclot/strings :escape-xml) + (:export + user user-p + + hash->user make-user parse-user-array user-format-name + + user-id user-is-bot user-first-name user-last-name user-username user-language-code user-is-premium + user-added-to-attachment-menu user-can-join-groups user-can-read-all-group-messages user-supports-inline-queries + user-can-connect-to-business)) +(in-package :ukkoclot/tg-types/user) + +(define-tg-type user + (id integer) + (is-bot boolean) + (first-name string) + (last-name (or string null) nil) + (username (or string null) nil) + (language-code (or string null) nil) + (is-premium boolean nil) + (added-to-attachment-menu boolean nil) + (can-join-groups boolean nil) + (can-read-all-group-messages boolean nil) + (supports-inline-queries boolean nil) + (can-connect-to-business boolean nil)) + +(defun user-format-name% (user out) + (format out "" (user-id user)) + (escape-xml (user-first-name user) out) + (when (user-last-name user) + (write-char #\Space out) + (escape-xml (user-last-name user) out)) + (write-string "" out) + + (when (user-username user) + (write-string " @" out) + (escape-xml (user-username user) out)) + + (format out " [~A]" (user-id user))) + +(defun user-format-name (user &optional out) + (if out + (user-format-name% user out) + (with-output-to-string (stream) + (user-format-name% user stream)))) -- cgit v1.2.3