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

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

;;;;;;
;;; Book to tree projection

(def class* projection/book-to-tree (projection)
  ())

;;;;;;
;;; Book to tree projection constructors

(def (function e) make-projection/book-to-tree ()
  (make-instance 'projection/book-to-tree))

;;;;;;
;;; Book to tree printer

(def method project-document (book-document (projection projection/book-to-tree))
  (bind ((mapping (make-mapping)))
    (labels ((recurse (input input-reference output-reference)
               (bind ((typed-input-reference `(the ,(form-type input) ,input-reference)))
                 (prog1-bind output
                     (etypecase input
                       (document
                        (if (eq input book-document)
                            (make-document (recurse (content-of input) `(content-of ,typed-input-reference) `(content-of (the document ,output-reference)))
                                           :selection (map-reference-forward mapping (selection-of book-document))
                                           :source (make-source book-document projection mapping))
                            input))
                       (string
                        (insert-character-mapping mapping input-reference output-reference (length input))
                        input)
                       (book/book
                        (make-tree/node (list* (prog1-bind title (title-of input)
                                                 (insert-string-mapping mapping `(title-of ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 0) (length title)))
                                               (iter (for index :from 0)
                                                     (for element :in-sequence (elements-of input))
                                                     (collect (recurse element
                                                                       `(elt (the list (elements-of ,typed-input-reference)) ,index)
                                                                       `(elt (the list (children-of (the tree/node ,output-reference))) ,(1+ index))))))))
                       (book/chapter
                        (make-tree/node (list* (prog1-bind title (title-of input)
                                                 (insert-string-mapping mapping `(title-of ,typed-input-reference) `(elt (the list (children-of (the tree/node ,output-reference))) 0) (length title)))
                                               (iter (for index :from 0)
                                                     (for element :in-sequence (elements-of input))
                                                     (collect (recurse element
                                                                       `(elt (the list (elements-of ,typed-input-reference)) ,index)
                                                                       `(elt (the list (children-of (the tree/node ,output-reference))) ,(1+ index)))))))))
                   (bind ((typed-output-reference `(the ,(form-type output) ,output-reference)))
                     (insert-mapping mapping typed-input-reference typed-output-reference))))))
      (recurse book-document 'document 'document))))

;;;;;;
;;; Book to tree reader

(def method read-operation (book-document (projection projection/book-to-tree) xxx)
  (bind ((operation (operation-of xxx)))
    (cond ((typep operation 'operation/replace-selection)
           (make-operation/replace-selection (map-reference-backward (mapping-of (source-of (document-of xxx))) (selection-of operation))))
          ((typep operation 'operation/sequence/replace-element-range)
           (make-operation/sequence/replace-element-range (map-reference-backward (mapping-of (source-of (document-of xxx))) (target-of operation)) (replacement-of operation)))
          (t operation))))