(in-package :xmlisp2)

(defclass xml-serializer ()
  ())

(defmethod parse-instance ((source klacks:source) (parent xml-serializer) ns lname)
  (let ((subobject (parse-instance source nil ns lname)))
    (handle-subobject parent
		      (xml-name->symbol ns lname)
		      subobject)
    subobject))

(defmethod attribute-name->slot-name ((object xml-serializer) attribute-name)
  attribute-name)

(defmethod attribute->slot-definition ((object xml-serializer) attribute-name)
  (find (attribute-name->slot-name object attribute-name)
	(c2mop:class-slots (class-of object))
	:key #'c2mop:slot-definition-name))

(defmethod handle-attribute-value ((object xml-serializer) attribute-name xml-value)
  (if-bind slot-definition (attribute->slot-definition object attribute-name)
    (setf (slot-value object (c2mop:slot-definition-name slot-definition))
	  (xml->lisp-value xml-value
			   (find-cxml-type
			    (c2mop:slot-definition-type slot-definition))))
    (error "no matching slot for attribute ~A(=~S)" attribute-name xml-value)))

(defmethod handle-subobject ((object xml-serializer) tag-name subobject)
  (cond-bind slot-definition
    ((attribute->slot-definition object tag-name)
     (setf (slot-value object (c2mop:slot-definition-name slot-definition))
	   subobject))
    ((when-bind plural (plural-name tag-name)
       (attribute->slot-definition object plural))
     (setf (slot-value object (c2mop:slot-definition-name slot-definition))
	   (nconc
	    (slot-value object (c2mop:slot-definition-name slot-definition))
	    (list subobject))))
    (t (error "no slot found"))))

;; todo: non-terrible implementation
(defun plural-name (symbol)
  (find-symbol (concatenate 'string (symbol-name symbol) "*")
	       (symbol-package symbol)))

(defmethod handle-character-data ((object xml-serializer) character-data cdatap)
  nil)

(defmethod handle-processing-instruction ((object xml-serializer) target data)
  nil)

(defmethod handle-comment ((object xml-serializer) comment-data)
  nil)

(defmethod finished-parsing ((object xml-serializer))
  object)

(defmethod serialize-slot-p ((object xml-serializer) slot-name)
  (slot-boundp object slot-name))

;;; todo: non-quick-hack implementation, naturally
(defmethod serializable-as-attribute-p (type value)
  (some (lambda (att-type) (subtypep type att-type))
	'(number boolean character string)))

(defmethod serializable-as-attribute-p ((type (eql 'list)) (value list))
  (every (lambda (v) (serializable-as-attribute-p (type-of v) v))
	 value))

(defmethod serializable-as-attribute-p ((type (eql 'array)) (value array))
  (every (lambda (v) (serializable-as-attribute-p (type-of v) v))
	 value))

(defmethod serialize-as-attribute-p ((object xml-serializer) slot-name slot-type)
  (serializable-as-attribute-p slot-type (slot-value object slot-name)))

(defmethod serializable-as-subelement-p (type value)
  (subtypep type 'standard-object))

(defmethod serializable-as-subelement-p ((type (eql 'list)) (value list))
  (every (lambda (v) (serializable-as-subelement-p (type-of v) v))
	 value))

(defmethod serializable-as-subelement-p ((type (eql 'array)) (value array))
  (every (lambda (v) (serializable-as-subelement-p (type-of v) v))
	 value))

(defmethod serialize-as-subelement-p ((object xml-serializer) slot-name slot-type)
  (serializable-as-subelement-p slot-type (slot-value object slot-name)))