hiro/cl-telegram-bot
1
0
Fork 0
mirror of https://github.com/vale981/cl-telegram-bot synced 2025-03-05 09:41:39 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

make recursive-change-class nicer

Browse source
This commit is contained in:
Valentin Boettcher 2019-08-17 22:43:08 +02:00
parent 573bae022b
commit 16ca54e95b
1 changed files with 8 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
cl-telegram-bot.lisp
View file

@ -71,21 +71,25 @@
(defun recursive-change-class (object class) (defun recursive-change-class (object class)
"Casts and object and its members into the telegram specific classes." "Casts and object and its members into the telegram specific classes."
(when (and (listp class) (> (length class) 1) (eq (car class) 'array))
(setf class (second class)))
(unless (find class *api-types*)
(return-from recursive-change-class object))
(when (arrayp object) (when (arrayp object)
(return-from recursive-change-class (return-from recursive-change-class
(map 'vector #'(lambda (value) (map 'vector #'(lambda (value)
(recursive-change-class value class)) (recursive-change-class value class))
object))) object)))
(change-class object class) (change-class object class)
(dolist (slot (c2mop:class-slots (find-class class))) (dolist (slot (c2mop:class-slots (find-class class)))
(let* ((name (c2mop:slot-definition-name slot)) (let* ((name (c2mop:slot-definition-name slot))
(type (c2mop:slot-definition-type slot))) (type (c2mop:slot-definition-type slot)))
(when (slot-boundp object name) (when (slot-boundp object name)
(let ((value (slot-value object name))) (let ((value (slot-value object name)))
(when (and (listp type) (> (length type) 1) (eq (car type) 'array)) (when value
(setf type (second type)))
(print (list name value type))
(when (and value (find type *api-types*))
(recursive-change-class value type)))))) (recursive-change-class value type))))))
object) object)