(in-package #:data-class)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun get-channel-element (xml-dom el)
     ($ (inline xml-dom) el (text) (node))))
 
 (defun element-name-from-symbol (sym)
   (let* ((base (string-downcase sym))
          (split (split-sequence:split-sequence #\~ base))
          (capit (cons (car split) (map 'list #'nstring-capitalize (cdr split)))))
     (apply #'concatenate 'string capit)))
 
 (defmacro ensure-slot (sym &body or-else)
   `(handler-case
      ,sym
      (unbound-slot (c)
        (declare (ignore c))
        ,@or-else)))
 
 (defmacro lazy-load-slot (class-name doc-slot root-el name tag-name &key transform value)
   `(defmethod ,name :before ((self ,class-name))
      (with-slots (,name ,doc-slot) self
        (ensure-slot ,name
          (alet ,(or value
                     `(get-channel-element ,doc-slot
                                           ,(format nil "~a > ~a" root-el tag-name)))
            ,(if transform
               `(setf ,name (when it (,transform it)))
               `(setf ,name it)))))))
 

 (defgeneric %all-slots (self format))
 (defun all-slots (self &optional format)
   (%all-slots self format))
 
 (defgeneric slot-tags (self))
 
 (defun process-slots-for-data-class (slots)

   (mapcar (fw.lu::destructuring-lambda ((slot tag . rest))
             (let ((tag (etypecase tag
                          (symbol (string-downcase tag))
                          (string tag))))
               (list* slot (make-keyword slot) tag rest)))
           (fw.lu:ensure-mapping slots)))

 
 (deftest process-slots-for-data-class ()
   (let ((tc-1 '(a))
         (tc-2 '((a b)))
         (tc-3 '((a "b")))
         (tc-4 '((a b c)))
         (tc-5 '((a "b" c)))
         (tc-6 '((a "bC")))
         (tc-7 '((a "bC" d))))
     (should be equal '((a :a "a")) (process-slots-for-data-class tc-1))
     (should be equal '((a :a "b")) (process-slots-for-data-class tc-2))
     (should be equal '((a :a "b")) (process-slots-for-data-class tc-3))
     (should be equal '((a :a "b" c)) (process-slots-for-data-class tc-4))
     (should be equal '((a :a "b" c)) (process-slots-for-data-class tc-5))
     (should be equal '((a :a "bC")) (process-slots-for-data-class tc-6))
     (should be equal '((a :a "bC" d)) (process-slots-for-data-class tc-7))))

 
 (defmacro define-data-class (name (doc-slot root-el) (&rest superclasses) &body slots)

   (declare (optimize (debug 3)))
   (flet ((make-slot-spec (slot slot-keyword)
            `(,slot :initarg ,slot-keyword :accessor ,slot)))
     (let ((slots (process-slots-for-data-class slots)))
       `(progn
          (defclass ,name ,superclasses
            ((slot-tags :allocation :class :initform
                        ',(loop for (_ slot-keyword tag) in slots
                                collect (cons slot-keyword tag)))
             ,@(mapcar (fw.lu::destructuring-lambda ((slot slot-keyword . r))
                         (declare (ignore r))
                         (make-slot-spec slot slot-keyword))
                       slots)))
          ,@(loop for (slot _ tag-name . rest) in slots
                  collect `(lazy-load-slot ,name ,doc-slot ,root-el ,slot ,tag-name ,@rest))
          (defmethod %all-slots ((self ,name) format)

            (pairlis (list ,@(mapcar (fw.lu::alambda (cadr fw.lu::it)) slots))

                     (list ,@(loop for (slot) in slots collect `(,slot self)))))))))