From 9e7c8dfab25da9beb86fd4ed4115895eedb4c8ab Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Sat, 18 Oct 2025 08:42:44 +0300 Subject: Replace bunch of our string utilities with str library --- src/hash-tables.lisp | 2 +- src/main.lisp | 14 ++++++------ src/serializing.lisp | 6 ++---- src/strings.lisp | 55 +++++++++-------------------------------------- src/tg/method-macros.lisp | 6 +++--- src/tg/type-macros.lisp | 4 ++-- 6 files changed, 25 insertions(+), 62 deletions(-) (limited to 'src') diff --git a/src/hash-tables.lisp b/src/hash-tables.lisp index d3b66dd..84ffbfe 100644 --- a/src/hash-tables.lisp +++ b/src/hash-tables.lisp @@ -1,7 +1,7 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/hash-tables - (:documentation "Utilities for dealing with hash tables.") + (:documentation "Hash-table-oriented utilities.") (:use :c2cl) (:import-from :alexandria :with-gensyms) (:export :alist->hash-table :gethash-lazy :plist->hash-table)) diff --git a/src/main.lisp b/src/main.lisp index 28c3801..5d3cf76 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -7,11 +7,11 @@ (:import-from :com.dieggsy.f-string :enable-f-strings) (:import-from :log) (:import-from :serapeum :drop) + (:import-from :str) (:import-from :ukkoclot/db :with-db) (:import-from :ukkoclot/serializing :fixup-value) (:import-from :ukkoclot/state :make-bot :bot-config :bot-power-on) - (:import-from :ukkoclot/strings - :escape-xml :is-tg-whitespace :is-tg-whitespace-str :starts-with :starts-with-ignore-case) + (:import-from :ukkoclot/strings :escape-xml :is-tg-whitespace :is-tg-whitespace-str) (:local-nicknames (:jzon :com.inuoe.jzon)) (:export :main)) @@ -70,7 +70,7 @@ (defun on-callback-query (bot cb) (let ((data (callback-query-data cb))) (cond ((and data - (starts-with data "bbl:") + (str:starts-with-p "bbl:" data :ignore-case nil) (= (user-id (callback-query-from cb)) (config-owner (bot-config bot)))) (let ((bot-id (read-from-string data t nil :start 4))) @@ -83,7 +83,7 @@ :callback-query-id (callback-query-id cb) :text "OK")) ((and data - (starts-with data "bwl:") + (str:starts-with-p "bwl:" data :ignore-case nil) (= (user-id (callback-query-from cb)) (config-owner (bot-config bot)))) (let ((bot-id (read-from-string data t nil :start 4))) @@ -161,7 +161,7 @@ ((equal text ">:3") (reply-message bot msg ">:3" :parse-mode html)) - ((starts-with-ignore-case text "big ") + ((str:starts-with-p "big " text) (let ((the-text (drop 4 text))) (unless (is-tg-whitespace-str the-text) (reply-message bot msg @@ -190,12 +190,12 @@ (or (message-reply-to-message msg) msg) "dio cane")) - ((starts-with-ignore-case text "say ") + ((str:starts-with-p "say " text) (let ((the-text (drop 4 text))) (unless (is-tg-whitespace-str the-text) (reply-message bot msg the-text)))) - ((starts-with-ignore-case text "tiny ") + ((str:starts-with-p "tiny " text) (let ((the-text (drop 5 text))) (unless (is-tg-whitespace-str the-text) (reply-message bot msg diff --git a/src/serializing.lisp b/src/serializing.lisp index 205190f..71b0fb2 100644 --- a/src/serializing.lisp +++ b/src/serializing.lisp @@ -3,7 +3,7 @@ (defpackage :ukkoclot/serializing (:use :c2cl :iterate) (:import-from :log) - (:import-from :ukkoclot/strings :lisp->snake-case) + (:import-from :str) (:local-nicknames (:jzon :com.inuoe.jzon)) (:export :fixup-args :fixup-value :parse-value :try-parse-value)) @@ -11,9 +11,7 @@ (defun fixup-args (args) (iter (for (key . value) in args) - (collect - (cons (string-downcase (lisp->snake-case (symbol-name key))) - (fixup-value value))))) + (collect (cons (str:snake-case key) (fixup-value value))))) (defgeneric fixup-value (value) (:documentation "Fixup outgoing *top-level* `value' before passing it to telegram.") diff --git a/src/strings.lisp b/src/strings.lisp index b1b4f00..eae8ec0 100644 --- a/src/strings.lisp +++ b/src/strings.lisp @@ -1,33 +1,30 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/strings + (:documentation "String-oriented utilities.") (:use :c2cl :iterate) (:import-from :cl-unicode :general-category) (:export - :ends-with :escape-xml :is-tg-whitespace - :is-tg-whitespace-str - :lisp->camel-case - :lisp->snake-case - :snake->lisp-case - :starts-with - :starts-with-ignore-case)) + :is-tg-whitespace-str)) (in-package :ukkoclot/strings) ;; These are very inefficient but I don't care until I profile -(defun ends-with (str suffix) - (and (> (length str) (length suffix)) - (string= str suffix :start1 (- (length str) (length suffix))))) - (defun escape-xml (str &optional out) + "Escape special XML characters in the STR. + +OUT is the output stream or `nil' for outputting to a string." (if out (escape-xml% str out) (with-output-to-string (out) (escape-xml% str out)))) (defun escape-xml% (str out) + "See `escape-xml'. + +OUT is always the stream." (loop for ch across str do (case ch (#\< (write-string "<" out)) @@ -37,6 +34,7 @@ (otherwise (write-char ch out))))) (defun is-tg-whitespace (ch) + "Checks if CH on its own would be considered whitespace by telegram." (let ((gc (general-category ch))) (or (string= gc "Zs") ; Separator, space (string= gc "Zl") ; Separator, line @@ -45,39 +43,6 @@ (= (char-code ch) #x2800)))) ; BRAILLE PATTERN BLANK (defun is-tg-whitespace-str (str) + "Checks if message containing just STR would be considered whitespace by telegram." (iter (for ch in-string str) (always (is-tg-whitespace ch)))) - -(defun lisp->camel-case (str) - (with-output-to-string (out) - (let ((should-caps nil)) - (iter (for ch in-string str) - (cond ((char= ch #\-) - (setf should-caps t)) - (should-caps - (write-char (char-upcase ch) out) - (setf should-caps nil)) - (t - (write-char (char-downcase ch) out))))))) - -(defun lisp->snake-case (str) - (with-output-to-string (out) - (loop for ch across str do - (case ch - (#\- (write-char #\_ out)) - (otherwise (write-char ch out)))))) - -(defun snake->lisp-case (str) - (with-output-to-string (out) - (loop for ch across str do - (case ch - (#\_ (write-char #\- out)) - (otherwise (write-char ch out)))))) - -(defun starts-with (str prefix) - (and (> (length str) (length prefix)) - (string= str prefix :end1 (length prefix)))) - -(defun starts-with-ignore-case (str prefix) - (and (> (length str) (length prefix)) - (string-equal str prefix :end1 (length prefix)))) diff --git a/src/tg/method-macros.lisp b/src/tg/method-macros.lisp index b924e15..0be6f00 100644 --- a/src/tg/method-macros.lisp +++ b/src/tg/method-macros.lisp @@ -6,8 +6,8 @@ (:import-from :alexandria :with-gensyms) (:import-from :com.dieggsy.f-string :enable-f-strings) (:import-from :serapeum :take) + (:import-from :str) (:import-from :ukkoclot/state :bot) - (:import-from :ukkoclot/strings :ends-with :lisp->camel-case) (:import-from :ukkoclot/transport :do-call) (:export :define-tg-method)) (in-package :ukkoclot/tg/method-macros) @@ -36,8 +36,8 @@ (collect (apply #'make-param param-spec)))) (defun path-from-name (name) - (let ((str (lisp->camel-case (symbol-name name)))) - (if (ends-with str "%") + (let ((str (str:camel-case name))) + (if (str:ends-with-p "%" str :ignore-case nil) (take (- (length str) 1) str) str))) diff --git a/src/tg/type-macros.lisp b/src/tg/type-macros.lisp index 5f99cba..75afab0 100644 --- a/src/tg/type-macros.lisp +++ b/src/tg/type-macros.lisp @@ -5,9 +5,9 @@ (:use :c2cl :iterate) (:import-from :alexandria :with-gensyms) (:import-from :com.dieggsy.f-string :enable-f-strings) + (:import-from :str) (:import-from :ukkoclot/serializing :parse-value) (:import-from :ukkoclot/hash-tables :gethash-lazy) - (:import-from :ukkoclot/strings :lisp->snake-case) (:local-nicknames (:jzon :com.inuoe.jzon)) (:export :define-tg-type)) @@ -39,7 +39,7 @@ (intern (concatenate 'string (symbol-name name) "-" (symbol-name (field-name field))))) (defun field-hash-key (field) - (string-downcase (lisp->snake-case (symbol-name (field-name field))))) + (str:snake-case (field-name field))) (defun field-keyword (field) (intern (symbol-name (field-name field)) :keyword)) -- cgit v1.2.3