Bunch of changes

- Animations
- Rewrite of serialization deserialization
- Bunch of new TG types

1 files changed, 45 insertions, 37 deletions

diff --git a/src/tg-types/macros.lisp b/src/tg-types/macros.lisp
index 668df17..a8a3d96 100644
--- a/src/tg-types/macros.lisp
+++ b/src/tg-types/macros.lisp
@@ -2,26 +2,27 @@
 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
 (defpackage :ukkoclot/tg-types/macros
   (:use :c2cl)
-  (:import-from :ukkoclot/bot/impl :arg-encode :bot :do-call :will-arg-encode)
+  (:import-from :ukkoclot/bot/impl :bot :do-call :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-method :define-tg-type))
 (in-package :ukkoclot/tg-types/macros)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (defstruct (field (:constructor make-field%)) name type default skip-if-default (parser 'identity))
+  (defstruct (field (:constructor make-field%)) name type default skip-if-default)
 
   (defparameter +unique+ (gensym))
 
-  (defun make-field (name type &optional (default +unique+) &key (parser 'identity) (skip-if-default (not (eq default +unique+))))
+  (defun make-field (name type &optional (default +unique+) &key (skip-if-default (not (eq default +unique+))))
     (let ((default (if (eq default +unique+)
                        (list 'error (format nil "No value given for ~A" name))
                        default)))
       (make-field% :name name
                    :type type
                    :default default
-                   :skip-if-default skip-if-default
-                   :parser parser)))
+                   :skip-if-default skip-if-default)))
 
   (defun parse-field-specs (field-specs)
     (loop for field-spec in field-specs
@@ -33,6 +34,11 @@
   (defun field-accessor (struc-name field)
     (intern (concatenate 'string (symbol-name struc-name) "-" (symbol-name (field-name field)))))
 
+  (defun field->coerced-field-spec (field struc-name obj-name)
+    `(list ,(string-downcase (lisp->snake-case (symbol-name (field-name field))))
+           (,(field-accessor struc-name field) ,obj-name)
+           ',(field-type field)))
+
   (defun field->defun-spec (field)
     (list (field-name field) (field-default field)))
 
@@ -58,10 +64,8 @@
           `(setf (gethash ,hash-key ,hash-table-sym) (,(field-accessor name field) ,struc)))))
 
   (defun field->let-gethash-spec (field hash-table-sym)
-    (list (field-name field)
-          (list 'funcall
-                (list 'function (field-parser field))
-                (field->gethash-spec field hash-table-sym))))
+    `(,(field-name field)
+      (parse-value ',(field-type field) ,(field->gethash-spec field hash-table-sym))))
 
   (defun field->make-spec (field)
     (list (intern (symbol-name (field-name field)) :keyword)
@@ -72,35 +76,40 @@
 
 ;; TODO: Automatically derive path from name
 ;; TODO: Automatically derive mapfn from type
-;; TODO: Skip values that are already their defaults
 (defmacro define-tg-method (
-                            (name type path mapfn &optional (method :POST))
+                            (name type path &optional (method :POST))
                             &body field-specs)
-  (let ((fields (parse-field-specs field-specs))
-        (args-plist (gensym "ARGS-PLIST-"))
-        (bot (gensym "BOT-")))
+  (let* ((fields (parse-field-specs field-specs))
+         (revfields (reverse fields))
+         (args (gensym "ARGS"))
+         (bot (gensym "BOT-")))
     `(progn
        (declaim (ftype (function (bot &key ,@(loop for field in fields
                                                  collect (field->ftype-spec field)))
                                  ,type)
                        ,name))
-       (defun ,name (,bot &rest ,args-plist &key ,@(loop for field in fields collect (field->defun-spec field)))
-         (declare ,@(loop for field in fields collect (list 'ignore (field-name field))))
-         (do-call ,bot ,method ,path ,mapfn ,args-plist)))))
+       (defun ,name (,bot &key ,@(loop for field in fields collect (field->defun-spec field)))
+         (let (,args)
+           ,@(loop for field in revfields
+                   collecting
+                   (if (field-skip-if-default field)
+                       `(unless (equal ,(field-name field) ,(field-default field))
+                          (setf ,args (acons ',(field-name field) ,(field-name field) ,args)))
+                       `(setf ,args (acons ',(field-name field) ,(field-name field) ,args))))
+           (do-call ,bot ,method ,path ',type ,args))))))
 
 (defmacro define-tg-type (name &body field-specs)
   (let* ((fields (parse-field-specs field-specs))
          (revfields (reverse fields))
          (make-name (intern (concatenate 'string "MAKE-" (symbol-name name))))
-         (hash->name (intern (concatenate 'string "HASH->" (symbol-name name))))
-         (parse-name-array (intern (concatenate 'string "PARSE-" (symbol-name name) "-ARRAY")))
          (printer (gensym (concatenate 'string "PRINT-" (symbol-name name))))
          (hash (gensym "HASH-"))
-         (array (gensym "ARRAY-"))
          (struc (gensym (symbol-name name)))
          (stream (gensym "STREAM"))
          (depth (gensym "DEPTH"))
-         (pprint-args (gensym "PPRINT-ARGS")))
+         (pprint-args (gensym "PPRINT-ARGS"))
+         (res (gensym "RES"))
+         (type (gensym "TYPE")))
     `(progn
        (defstruct (,name (:print-function ,printer))
          ,@(loop for field in fields
@@ -116,19 +125,18 @@
                             (setf ,pprint-args (list* ',(field-name field) value ,pprint-args))))
                        `(setf ,pprint-args (list* ',(field-name field) (,(field-accessor name field) ,struc) ,pprint-args))))
          (format ,stream "~A~<[~;~@{~_~1I~W = ~W~^, ~}~;]~:>" ',name ,pprint-args)))
-       (defun ,hash->name (,hash)
-         (when ,hash
-           (let ,(loop for field in fields
-                       collect (field->let-gethash-spec field hash))
-             (,make-name ,@(loop for field in fields
-                                 append (field->make-spec field))))))
-       (defmethod arg-encode ((,struc ,name))
-         (let ((,hash (make-hash-table)))
-           ,@(loop for field in fields
-                   collect (field->sethash-spec field name struc hash))
-           ,hash))
-       (defmethod will-arg-encode ((,struc ,name))
-         t)
-       (defun ,parse-name-array (,array)
-         (when ,array
-           (map 'vector #',hash->name ,array))))))
+       (defmethod parse-value ((,type (eql ',name)) ,hash)
+         (let ,(loop for field in fields
+                     collect (field->let-gethash-spec field hash))
+           (,make-name ,@(loop for field in fields
+                               append (field->make-spec field)))))
+       (defmethod jzon:coerced-fields ((,struc ,name))
+         (let (,res)
+           ,@(loop for field in revfields
+                   collecting
+                   (if (field-skip-if-default field)
+                       `(let ((value (,(field-accessor name field) ,struc)))
+                          (unless (equal value ,(field-default field))
+                            (setf ,res (cons ,(field->coerced-field-spec field name struc) ,res))))
+                       `(setf ,res (cons ,(field->coerced-field-spec field name struc) ,res))))
+           ,res)))))