[refactor] text-chunks

common.lisp

@@ -37,6 +37,7 @@
            :flatten
            :preprocess-input
            :spaced
+           :text-chunks
            :http-request
            :xml-request
            :get-by-tag

plugins/ledger.lisp

@@ -166,10 +166,12 @@
 
 (defun ledger/handle-balance (chat-id query)
   (with-chat-journal (chat-id journal updated)
-    (bot-send-message chat-id (format nil "```~%~A~%```Обновлено: ~A"
-                                      (pta-ledger:journal-balance journal query)
-                                      (ledger/format-time updated))
-                              :parse-mode "markdown")))
+    (bot-send-message chat-id
+                      (text-chunks (split-sequence:split-sequence
+                                    #\Newline
+                                    (pta-ledger:journal-balance journal query))
+                                   :text-sep #\Newline)
+                      :parse-mode "markdown")))
 
 (def-message-cmd-handler handler-balance (:balance :bal)
   (cond
@@ -181,10 +183,9 @@
     (let* ((pta-ledger:*posting-length* 40)
            (entries (pta-ledger:journal-print journal query))
            (len (length entries))
-           (count (min len 20)))
-      (bot-send-message chat-id (format nil "```~%~{~A~^ ~%~%~}```Обновлено: ~A"
-                                        (subseq entries (- len count) len)
-                                        (ledger/format-time updated))
+           (count (min len 50)))
+      (bot-send-message chat-id
+                        (text-chunks (subseq entries (- len count) len))
                         :parse-mode "markdown"))))
 
 (def-message-cmd-handler handler-journal (:journal)

plugins/raiffeisen.lisp

@@ -222,14 +222,7 @@
                              (node->alist move)))))
 
 (defun format-entries (changes)
-  (loop for entry in changes
-     for text = (pta-ledger:render entry)
-     with page
-     when (> (+ (length page) (length text) 2)
-             4096)
-     collect (format nil "```~%~A```" page) into pages and do (setf page nil)
-     do (setf page (format nil "~@[~A~%~%~]~A" page text))
-     finally (return (append pages (when page (list (format nil "```~%~A```" page)))))))
+  (text-chunks (mapcar #'pta-ledger:render changes)))
 
 (defun format-balance (accounts)
   (format nil "```~%~{~A~^~%~}```" (mapcar #'account->balance accounts)))

plugins/tinkoff.lisp

@@ -192,14 +192,7 @@
     (api/accounts)))
 
 (defun format-entries (changes)
-  (loop for entry in changes
-     for text = (pta-ledger:render entry)
-     with page
-     when (> (+ (length page) (length text) 2)
-             4096)
-     collect (format nil "```~%~A```" page) into pages and do (setf page nil)
-     do (setf page (format nil "~@[~A~%~%~]~A" page text))
-     finally (return (append pages (when page (list (format nil "```~%~A```" page)))))))
+  (text-chunks (mapcar #'pta-ledger:render changes)))
 
 (defun format-accounts (accounts)
   (with-output-to-string (s)

utils.lisp

@@ -26,6 +26,7 @@
            :read-from-string-no-punct
            :print-with-spaces
            :spaced
+           :text-chunks
            :http-request
            :xml-request
            :get-by-tag
@@ -190,6 +191,22 @@ is replaced with replacement."
 (defun spaced (list)
   (format nil "~{~A~^ ~}" list))
 
+(defparameter +lf-lf+ "
+
+")
+(defparameter +pre-pre+ "```
+")
+(defparameter +pre-post+ "```")
+
+(defun text-chunks (elements &key (chunk-size 4096) (text-sep +lf-lf+) (pre-pre +pre-pre+) (pre-post +pre-post+))
+  (loop for text in elements
+     with page
+     when (> (+ (length page) (length text) (length text-sep))
+             chunk-size)
+     collect (concatenate 'string pre-pre page pre-post) into pages and do (setf page nil)
+     do (setf page (if page (concatenate 'string page text-sep text) text))
+     finally (return (append pages (when page (list (concatenate 'string pre-pre page pre-post)))))))
+
 (defun http-default (url &optional parameters)
   (let* ((uri (quri:uri url))
          (userinfo (quri:uri-userinfo uri)))