;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2009 by the authors.
;;;
;;; See LICENCE for details.

(in-package :hu.dwim.projectional-editor)

;;;;;;
;;; Projection

(def (projection e) xml/text->string ()
  ())

(def (projection e) xml/attribute->tree/node ()
  ())

(def (projection e) xml/element->tree/node ()
  ())

(def (projection e) xml->tree ()
  ())

;;;;;;
;;; Construction

(def (function e) make-projection/xml/text->string ()
  (make-projection 'xml/text->string))

(def (function e) make-projection/xml/attribute->tree/node ()
  (make-projection 'xml/attribute->tree/node))

(def (function e) make-projection/xml/element->tree/node ()
  (make-projection 'xml/element->tree/node))

(def (function e) make-projection/xml->tree ()
  (type-dispatching
    (xml/text (make-projection/xml/text->string))
    (xml/attribute (make-projection/xml/attribute->tree/node))
    (xml/element (make-projection/xml/element->tree/node))))

;;;;;;
;;; Construction

(def (macro e) xml/text->string ()
  '(make-projection/xml/text->string))

(def (macro e) xml/attribute->tree/node ()
  '(make-projection/xml/attribute->tree/node))

(def (macro e) xml/element->tree/node ()
  '(make-projection/xml/element->tree/node))

(def (macro e) xml->tree ()
  '(make-projection/xml->tree))

;;;;;;
;;; Printer

(def printer xml/text->string (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion))
  (bind ((output (text-of input)))
    (make-iomap/object input input-reference output output-reference)))

(def printer xml/attribute->tree/node (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion))
  (bind ((name (name-of input))
         (value (value-of input))
         (output (make-tree/node (list name value)))
         (typed-input-reference `(the ,(form-type input) ,input-reference))
         (name-reference `(elt (the list (children-of (the tree/node ,output-reference))) 0))
         (value-reference `(elt (the list (children-of (the tree/node ,output-reference))) 1)))
    (make-iomap/recursive input output
                          (list (make-iomap/object input input-reference output output-reference)
                                (make-iomap/string name `(name-of ,typed-input-reference) 0
                                                   name name-reference 0
                                                   (length name))
                                (make-iomap/object name `(name-of ,typed-input-reference)
                                                   name name-reference)
                                (make-iomap/string value `(value-of ,typed-input-reference) 0
                                                   value value-reference 0
                                                   (length value))
                                (make-iomap/object value `(value-of ,typed-input-reference)
                                                   value value-reference)))))

(def printer xml/element->tree/node (projection recursion input input-reference output-reference)
  (declare (ignore projection))
  (bind ((typed-input-reference `(the ,(form-type input) ,input-reference))
         (child-iomaps nil)
         (name (name-of input))
         (attributes (attributes-of input))
         (children (children-of input))
         (output (make-tree/node (append (list (prog1 name
                                                 (push (make-iomap/object* input `(the string (start-tag-of ,typed-input-reference))
                                                                           name `(the string (elt (the list (children-of (the tree/node ,output-reference))) 0)))
                                                       child-iomaps)
                                                 (push (make-iomap/string* input `(the string (start-tag-of ,typed-input-reference)) 0
                                                                           name `(the string (elt (the list (children-of (the tree/node ,output-reference))) 0)) 0
                                                                           (length name))
                                                       child-iomaps)))
                                         (when attributes
                                           (list (prog1-bind output
                                                     (make-tree/node (iter (for attribute :in attributes)
                                                                           (for attribute-index :from 0)
                                                                           (for iomap = (recurse-printer recursion attribute
                                                                                                         `(elt (the list (attributes-of ,typed-input-reference)) ,attribute-index)
                                                                                                         `(elt (the list (children-of (the tree/node (elt (the list (children-of (the tree/node ,output-reference))) ,1)))) ,attribute-index)))
                                                                           (push iomap child-iomaps)
                                                                           (collect (output-of iomap))))
                                                   (push (make-iomap/object* input `(the list (attributes-of ,typed-input-reference))
                                                                             output `(the tree/node (elt (the list (children-of (the tree/node ,output-reference))) 1)))
                                                         child-iomaps))))
                                         (when children
                                           (append (prog1-bind output
                                                       (iter (for child :in children)
                                                             (for child-index :from 0)
                                                             (for iomap = (recurse-printer recursion child
                                                                                           `(elt (the list (children-of ,typed-input-reference)) ,child-index)
                                                                                           `(elt (the list (children-of (the tree/node ,output-reference))) ,(+ child-index (if attributes 2 1)))))
                                                             (push iomap child-iomaps)
                                                             (collect (output-of iomap))))
                                                   (prog1 (list name)
                                                     (push (make-iomap/object* input `(the string (end-tag-of ,typed-input-reference))
                                                                               name `(the string (elt (the list (children-of (the tree/node ,output-reference))) ,(+ (length children) (if attributes 2 1)))))
                                                           child-iomaps)
                                                     (push (make-iomap/string* input `(the string (end-tag-of ,typed-input-reference)) 0
                                                                               name `(the string (elt (the list (children-of (the tree/node ,output-reference))) ,(+ (length children) (if attributes 2 1)))) 0
                                                                               (length name))
                                                           child-iomaps))))))))
    (make-iomap/recursive input output (list* (make-iomap/object input input-reference output output-reference) (nreverse child-iomaps)))))

;;;;;;
;;; Reader

(def reader xml/text->string (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion input input-reference output-reference))
  nil)

(def reader xml/attribute->tree/node (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion input input-reference output-reference))
  nil)

(def reader xml/element->tree/node (projection recursion input input-reference output-reference)
  (declare (ignore projection recursion input input-reference output-reference))
  nil)