summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Uko Kokņevičs2025-10-13 05:21:41 +0300
committerGravatar Uko Kokņevičs2025-10-13 05:21:41 +0300
commit191a27fd142af7a14ca6ad1abcd293f09e63f6ad (patch)
tree24f7384a9da0bf2d46dd38c9668f1e49ba1866ca
parentOupsie (diff)
downloadukkoclot-191a27fd142af7a14ca6ad1abcd293f09e63f6ad.tar.gz
ukkoclot-191a27fd142af7a14ca6ad1abcd293f09e63f6ad.tar.xz
ukkoclot-191a27fd142af7a14ca6ad1abcd293f09e63f6ad.zip
Move serializing stuff from bot/impl to a new file
-rw-r--r--README.md2
-rw-r--r--src/bot/impl.lisp61
-rw-r--r--src/enum.lisp2
-rw-r--r--src/main.lisp3
-rw-r--r--src/serializing.lisp68
-rw-r--r--src/tg/type-macros.lisp2
6 files changed, 76 insertions, 62 deletions
diff --git a/README.md b/README.md
index 2420d5d..daa9788 100644
--- a/README.md
+++ b/README.md
@@ -8,6 +8,8 @@ When running in a debuggy environment, consider
8(log:config :debug) 8(log:config :debug)
9``` 9```
10 10
11When connecting via remote SWANK, you might want to run `(log:config :sane2)`.
12
11# Licensing 13# Licensing
12 14
13European Union Public Licence, version 1.2. 15European Union Public Licence, version 1.2.
diff --git a/src/bot/impl.lisp b/src/bot/impl.lisp
index 652e2f7..93e63f5 100644
--- a/src/bot/impl.lisp
+++ b/src/bot/impl.lisp
@@ -6,67 +6,16 @@
6 (:import-from :cl+ssl) 6 (:import-from :cl+ssl)
7 (:import-from :dex) 7 (:import-from :dex)
8 (:import-from :log) 8 (:import-from :log)
9 (:import-from :ukkoclot/serializing :fixup-args :parse-value)
9 (:import-from :ukkoclot/strings :lisp->snake-case) 10 (:import-from :ukkoclot/strings :lisp->snake-case)
10 (:local-nicknames 11 (:local-nicknames
11 (:jzon :com.inuoe.jzon)) 12 (:jzon :com.inuoe.jzon))
12 (:export 13 (:export
13 :bot :bot-p :make-bot :fixup-value :do-call :parse-value 14 :bot :bot-p :make-bot :do-call
14 15
15 :bot-config :bot-db :bot-base-uri :bot-power-on :bot-username% :bot-id%)) 16 :bot-config :bot-db :bot-base-uri :bot-power-on :bot-username% :bot-id%))
16(in-package :ukkoclot/bot/impl) 17(in-package :ukkoclot/bot/impl)
17 18
18(defgeneric parse-value (type json)
19 (:documentation "Parse value of TYPE from the parsed JSON")
20 (:method (type json)
21 (log:error "I don't know how to parse simple type ~A!" type)
22 (error "I don't know how to parse simple type ~A!" type))
23 (:method ((type (eql 'boolean)) json)
24 (check-type json boolean)
25 json)
26 (:method ((type (eql 'integer)) json)
27 (check-type json integer)
28 json)
29 (:method ((type (eql 'null)) json)
30 (check-type json null)
31 json)
32 (:method ((type (eql 'string)) json)
33 (check-type json string)
34 json))
35
36(defun try-parse-value (type json)
37 (handler-case (values t (parse-value type json))
38 (error () (values nil nil))))
39
40(defmethod parse-value ((type cons) json)
41 (cond ((and (eq (car type) 'array)
42 (null (cddr type)))
43 (when json
44 (let ((element-type (cadr type)))
45 (iter (for element in-vector json)
46 (collect (parse-value element-type element) result-type vector)))))
47 ((eq (car type) 'or)
48 (iter (for el-type in (cdr type))
49 (multiple-value-bind (success res) (try-parse-value el-type json)
50 (when success
51 (return res)))
52 (finally
53 (error "Failed to parse ~S as ~A!" json type))))
54 (t
55 (error "I don't know how to parse complex type ~A!" type))))
56
57(defgeneric fixup-value (value)
58 (:documentation "Fixup top-level VALUE before passing it onto telegram")
59 (:method (value)
60 (jzon:stringify value :pretty *print-pretty*))
61 (:method ((value null))
62 value)
63 (:method ((value number))
64 value)
65 (:method ((value pathname))
66 value)
67 (:method ((value string))
68 value))
69
70(defstruct (bot (:constructor make-bot%)) 19(defstruct (bot (:constructor make-bot%))
71 (config (error "No value given for config") :read-only t) 20 (config (error "No value given for config") :read-only t)
72 (db (error "No value given for DB") :read-only t) 21 (db (error "No value given for DB") :read-only t)
@@ -81,12 +30,6 @@
81 (config-bot-token config) "/"))) 30 (config-bot-token config) "/")))
82 (make-bot% :config config :db db :base-uri base-uri))) 31 (make-bot% :config config :db db :base-uri base-uri)))
83 32
84(defun fixup-args (args)
85 (iter (for (key . value) in args)
86 (collect
87 (cons (string-downcase (lisp->snake-case (symbol-name key)))
88 (fixup-value value)))))
89
90(defun req (uri method content) 33(defun req (uri method content)
91 (let ((retrier (dex:retry-request 5 :interval 1))) 34 (let ((retrier (dex:retry-request 5 :interval 1)))
92 (handler-case (dex:request uri :method method :content content) 35 (handler-case (dex:request uri :method method :content content)
diff --git a/src/enum.lisp b/src/enum.lisp
index e3ceb6b..8943a90 100644
--- a/src/enum.lisp
+++ b/src/enum.lisp
@@ -2,7 +2,7 @@
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/enum 3(defpackage :ukkoclot/enum
4 (:use :c2cl :iterate) 4 (:use :c2cl :iterate)
5 (:import-from :ukkoclot/bot/impl :fixup-value :parse-value) 5 (:import-from :ukkoclot/serializing :fixup-value :parse-value)
6 (:import-from :string-case :string-case) 6 (:import-from :string-case :string-case)
7 (:local-nicknames 7 (:local-nicknames
8 (:jzon :com.inuoe.jzon)) 8 (:jzon :com.inuoe.jzon))
diff --git a/src/main.lisp b/src/main.lisp
index a113ab0..d418b78 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -6,8 +6,9 @@
6 (:import-from :anaphora :acond :awhen :it) 6 (:import-from :anaphora :acond :awhen :it)
7 (:import-from :log) 7 (:import-from :log)
8 (:import-from :swank) 8 (:import-from :swank)
9 (:import-from :ukkoclot/bot :make-bot :bot-power-on :fixup-value) 9 (:import-from :ukkoclot/bot :make-bot :bot-power-on)
10 (:import-from :ukkoclot/db :with-db) 10 (:import-from :ukkoclot/db :with-db)
11 (:import-from :ukkoclot/serializing :fixup-value)
11 (:import-from :ukkoclot/strings :escape-xml :is-tg-whitespace-str :starts-with :starts-with-ignore-case) 12 (:import-from :ukkoclot/strings :escape-xml :is-tg-whitespace-str :starts-with :starts-with-ignore-case)
12 (:local-nicknames 13 (:local-nicknames
13 (:jzon :com.inuoe.jzon)) 14 (:jzon :com.inuoe.jzon))
diff --git a/src/serializing.lisp b/src/serializing.lisp
new file mode 100644
index 0000000..7fafb3a
--- /dev/null
+++ b/src/serializing.lisp
@@ -0,0 +1,68 @@
1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/serializing
4 (:use :c2cl :iterate)
5 (:import-from :log)
6 (:import-from :ukkoclot/strings :lisp->snake-case)
7 (:local-nicknames
8 (:jzon :com.inuoe.jzon))
9 (:export :fixup-args :fixup-value :parse-value :try-parse-value))
10(in-package :ukkoclot/serializing)
11
12(defun fixup-args (args)
13 (iter (for (key . value) in args)
14 (collect
15 (cons (string-downcase (lisp->snake-case (symbol-name key)))
16 (fixup-value value)))))
17
18(defgeneric fixup-value (value)
19 (:documentation "Fixup outgoing *top-level* `value' before passing it to telegram.")
20 (:method (value)
21 (jzon:stringify value :pretty *print-pretty*))
22 (:method ((value null))
23 value)
24 (:method ((value number))
25 value)
26 (:method ((value pathname))
27 value)
28 (:method ((value string))
29 value))
30
31(defgeneric parse-value (type json)
32 (:documentation "Parse incoming value of `type' from the parsed `json'.")
33 (:method (type json)
34 (log:error "I don't know how to parse simple type ~A!" type)
35 (error "I don't know how to parse simple type ~A!" type))
36 (:method ((type (eql 'boolean)) json)
37 (check-type json boolean)
38 json)
39 (:method ((type (eql 'integer)) json)
40 (check-type json integer)
41 json)
42 (:method ((type (eql 'null)) json)
43 (check-type json null)
44 json)
45 (:method ((type (eql 'string)) json)
46 (check-type json string)
47 json))
48
49(defmethod parse-value ((type cons) json)
50 (cond ((and (eq (car type) 'array)
51 (null (cddr type)))
52 (when json
53 (let ((element-type (cadr type)))
54 (iter (for element in-vector json)
55 (collect (parse-value element-type element) result-type vector)))))
56 ((eq (car type) 'or)
57 (iter (for el-type in (cdr type))
58 (multiple-value-bind (success res) (try-parse-value el-type json)
59 (when success
60 (return res)))
61 (finally
62 (error "Failed to parse ~S as ~A!" json type))))
63 (t
64 (error "I don't know how to parse complex type ~A!" type))))
65
66(defun try-parse-value (type json)
67 (handler-case (values t (parse-value type json))
68 (error () (values nil nil))))
diff --git a/src/tg/type-macros.lisp b/src/tg/type-macros.lisp
index 7380a6d..552c908 100644
--- a/src/tg/type-macros.lisp
+++ b/src/tg/type-macros.lisp
@@ -2,7 +2,7 @@
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> 2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg/type-macros 3(defpackage :ukkoclot/tg/type-macros
4 (:use :c2cl :iterate) 4 (:use :c2cl :iterate)
5 (:import-from :ukkoclot/bot/impl :parse-value) 5 (:import-from :ukkoclot/serializing :parse-value)
6 (:import-from :ukkoclot/hash-tables :gethash-lazy) 6 (:import-from :ukkoclot/hash-tables :gethash-lazy)
7 (:import-from :ukkoclot/strings :lisp->snake-case) 7 (:import-from :ukkoclot/strings :lisp->snake-case)
8 (:local-nicknames 8 (:local-nicknames