From 31a972d6825114b1a971e42cdc86e1bd7a9834c3 Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Sun, 12 Oct 2025 22:14:39 +0300 Subject: Introduce enums and a pretty parse-mode type --- src/bot/methods.lisp | 7 +++--- src/enum.lisp | 59 ++++++++++++++++++++++++++++++++++++++++++++ src/inline-bots.lisp | 2 +- src/main.lisp | 14 ++++++----- src/tg-types.lisp | 1 + src/tg-types/parse-mode.lisp | 11 +++++++++ 6 files changed, 83 insertions(+), 11 deletions(-) create mode 100644 src/enum.lisp create mode 100644 src/tg-types/parse-mode.lisp (limited to 'src') diff --git a/src/bot/methods.lisp b/src/bot/methods.lisp index 7ccc4ad..984646a 100644 --- a/src/bot/methods.lisp +++ b/src/bot/methods.lisp @@ -23,7 +23,7 @@ (message-id (or integer null) nil) (inline-message-id (or string null) nil) (text string) - (parse-mode (or string null) nil) + (parse-mode (or parse-mode null) nil) (entities (or (array message-entity) null) nil) (link-preview-options (or link-preview-options null) nil) (reply-markup (or inline-keyboard-markup null) nil)) @@ -56,7 +56,7 @@ (height (or integer null) nil) (thumbnail (or pathname string null) nil) (caption (or string null) nil) - (parse-mode (or string null) nil) + (parse-mode (or parse-mode null) nil) (caption-entities (or (array message-entity) null) nil) (show-caption-above-media boolean nil) (has-spoiler boolean nil) @@ -73,8 +73,7 @@ (chat-id (or integer string)) (message-thread-id (or integer null) nil) (text string) - ;; TODO: parse-mode should maybe be keywords? - (parse-mode (or string null) nil) + (parse-mode (or parse-mode null) nil) (entities (or (array message-entity) null) nil) (link-preview-options (or link-preview-options null) nil) (disable-notification (or boolean null) nil) diff --git a/src/enum.lisp b/src/enum.lisp new file mode 100644 index 0000000..c678ec7 --- /dev/null +++ b/src/enum.lisp @@ -0,0 +1,59 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/enum + (:use :c2cl :iterate) + (:import-from :ukkoclot/bot/impl :fixup-value :parse-value) + (:import-from :string-case :string-case) + (:local-nicknames + (:jzon :com.inuoe.jzon)) + (:export :define-enum)) +(in-package :ukkoclot/enum) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defstruct (field (:constructor make-field%)) name string) + + (defun make-field (name string) + (make-field% :name name :string string)) + + (defun parse-field-specs (field-specs) + (iter (for field-spec in field-specs) + (collect (apply #'make-field field-spec)))) + + (defun emit-defconst (field) + `(defconstant ,(field-name field) ',(field-name field))) + + (defun emit-deftype (name fields) + `(deftype ,name () + '(member ,@(iter (for field in fields) (collect (field-name field)))))) + + (defun emit-fixup-method (field) + (let ((arg (gensym "ARG"))) + `(defmethod fixup-value ((,arg (eql ',(field-name field)))) + ,(field-string field)))) + + (defun emit-jzon-write-method (field) + (let ((writer (gensym "WRITER")) + (arg (gensym "ARG"))) + `(defmethod jzon:write-value (,writer (,arg (eql ',(field-name field)))) + (jzon::write-string ,(field-string field) ,writer)))) + + (defun emit-parse-value (name fields) + (let ((type (gensym "TYPE")) + (source (gensym "SOURCE"))) + `(defmethod parse-value ((,type (eql ',name)) ,source) + ;; nil in, nil out + (when ,source + (string-case (,source) + ,@(iter (for field in fields) + (collect `(,(field-string field) ,(field-name field)))))))))) + +(defmacro define-enum (name &body field-specs) + (let ((fields (parse-field-specs field-specs))) + `(progn + ,(emit-deftype name fields) + ,(emit-parse-value name fields) + ,@(iter (for field in fields) + (collect `(progn + ,(emit-defconst field) + ,(emit-fixup-method field) + ,(emit-jzon-write-method field))))))) diff --git a/src/inline-bots.lisp b/src/inline-bots.lisp index eb20f21..3ed85e9 100644 --- a/src/inline-bots.lisp +++ b/src/inline-bots.lisp @@ -32,7 +32,7 @@ :text (format nil "Deleted a message sent via inline bot @~A ~A" (user-username via) (user-id via)) - :parse-mode "HTML" + :parse-mode html :reply-markup (make-inline-keyboard-markup :inline-keyboard (make-array '(1 2) :initial-contents (list (list whitelist blacklist))))))) diff --git a/src/main.lisp b/src/main.lisp index 96f73a0..4b05ee2 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -110,7 +110,7 @@ :text (concatenate 'string "Hello there, " (user-format-name new-member) "! Be on your bestest behaviour now!!") - :parse-mode "HTML" + :parse-mode html :caption-above t :allow-sending-without-reply t))) @@ -138,11 +138,12 @@ (= (message-entity-offset entity) 0)) do (on-text-command bot msg text (message-entity-extract entity text)))) + ;; TODO: Replace this cond with a nicer dispatch. Something like string-case? (cond ((equal text ":3") (reply-message bot msg ">:3")) ((equal text ">:3") - (reply-message bot msg ">:3" :parse-mode "HTML")) + (reply-message bot msg ">:3" :parse-mode html)) ((starts-with-ignore-case text "big ") (let ((the-text (subseq text 4))) @@ -152,7 +153,7 @@ "" (escape-xml (string-upcase the-text)) "") - :parse-mode "HTML")))) + :parse-mode html)))) ((string-equal text "dio cane") (reply-message bot @@ -166,7 +167,7 @@ (reply-message bot msg "idgi")) ((string= text "H") - (reply-message bot msg "Randomly selected reminder that h > H." :parse-mode "HTML")) + (reply-message bot msg "Randomly selected reminder that h > H." :parse-mode html)) ((string-equal text "porco dio") (reply-message bot @@ -216,9 +217,10 @@ (defun on-text-command (bot msg text cmd) (let ((simple-cmd (simplify-cmd bot cmd))) (log-debug "text-command: ~A AKA ~A" cmd simple-cmd) + ;; TODO: Replace this cond with a nicer dispatch. Something like string-case? (acond ((equal simple-cmd "chatid") - (reply-message bot msg (format nil "~A" (message-chat-id msg)) :parse-mode "HTML")) + (reply-message bot msg (format nil "~A" (message-chat-id msg)) :parse-mode html)) ((and (equal simple-cmd "msginfo") (message-reply-to-message msg)) @@ -252,4 +254,4 @@ Send time: ...")) (send-message bot :chat-id (config-dev-group (bot-config bot)) :text msg - :parse-mode "HTML"))) + :parse-mode html))) diff --git a/src/tg-types.lisp b/src/tg-types.lisp index ba3ec3b..ec14363 100644 --- a/src/tg-types.lisp +++ b/src/tg-types.lisp @@ -18,6 +18,7 @@ :ukkoclot/tg-types/link-preview-options :ukkoclot/tg-types/message :ukkoclot/tg-types/message-entity + :ukkoclot/tg-types/parse-mode :ukkoclot/tg-types/photo-size :ukkoclot/tg-types/reply-keyboard-markup :ukkoclot/tg-types/reply-keyboard-remove diff --git a/src/tg-types/parse-mode.lisp b/src/tg-types/parse-mode.lisp new file mode 100644 index 0000000..80c24aa --- /dev/null +++ b/src/tg-types/parse-mode.lisp @@ -0,0 +1,11 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/parse-mode + (:use :c2cl :ukkoclot/enum) + (:export :html :markdown-legacy :markdown :parse-mode)) +(in-package :ukkoclot/tg-types/parse-mode) + +(define-enum parse-mode + (markdown-legacy "Markdown") + (markdown "MarkdownV2") + (html "HTML")) -- cgit v1.2.3