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

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

;;;;;;
;;; Nested projection

(def class* projection/nested (projection)
  ((references-to-projections :type hash-table)
   (flatten :type boolean)))

;;;;;;
;;; Projection constructors

(def (function e) make-projection/nested (references projections flatten)
  (bind ((references-to-projections (make-hash-table :test #'equal)))
    (iter (for reference :in-sequence references)
          (for projection :in-sequence projections)
          (setf (gethash reference references-to-projections) projection))
    (make-instance 'projection/nested :references-to-projections references-to-projections :flatten flatten)))

;;;;;;
;;; Nested printer

(def method project-document (input-document (projection projection/nested))
  (bind ((mapping (make-mapping))
         (input-to-output (make-hash-table)))
    (labels ((recurse (input input-reference)
               (bind ((output-reference input-reference)
                      (typed-input-reference `(the ,(form-type input) ,input-reference))
                      (nested-projection (gethash typed-input-reference (references-to-projections-of projection))))
                 (if nested-projection
                     (bind ((nested-document (project-document input nested-projection)))
                       (if (flatten-p projection)
                           (bind ((nested-mapping (mapping-of (source-of nested-document))))
                             ;; TODO: factor this out into mapping.lisp
                             (iter (for (nested-input-reference nested-output-reference) :in-hashtable (forward-mapping-of nested-mapping))
                                   (insert-mapping mapping
                                                   (subst `(the document ,(third typed-input-reference)) '(the document document) nested-input-reference :test 'equal)
                                                   (subst (third typed-input-reference) '(content-of (the document document)) nested-output-reference :test 'equal)))
                             (iter (for (nested-output-reference nested-input-reference) :in-hashtable (backward-mapping-of nested-mapping))
                                   (insert-mapping mapping
                                                   (subst `(the document ,(third typed-input-reference)) '(the document document) nested-input-reference :test 'equal)
                                                   (subst (third typed-input-reference) '(content-of (the document document)) nested-output-reference :test 'equal)))
                             (content-of nested-document))
                           nested-document))
                     (or (gethash input input-to-output)
                         (prog1-bind output
                             (etypecase input
                               (document
                                (if (eq input input-document)
                                    (recurse (content-of input) `(content-of ,typed-input-reference))
                                    input))
                               (symbol
                                input)
                               (string
                                (insert-character-mapping mapping input-reference input-reference (length input))
                                input)
                               (number
                                input)
                               (cons
                                (if (proper-list-p input)
                                    (iter (for index :from 0)
                                          (for element :in input)
                                          (collect (recurse element `(elt ,typed-input-reference ,index))))
                                    (cons (bind ((value (car input)))
                                            (recurse value `(car ,typed-input-reference)))
                                          (bind ((value (cdr input)))
                                            (recurse value `(cdr ,typed-input-reference))))))
                               (standard-object
                                (bind ((class (class-of input)))
                                  (prog1-bind clone (allocate-instance class)
                                    (dolist (slot (class-slots class))
                                      (when (slot-boundp-using-class class input slot)
                                        (setf (slot-value-using-class class clone slot)
                                              (bind ((value (slot-value-using-class class input slot))
                                                     (direct-slot (find (slot-definition-name slot) (class-direct-slots class) :key 'slot-definition-name)))
                                                (recurse value (if (and direct-slot
                                                                        (slot-definition-readers direct-slot))
                                                                   `(,(first (slot-definition-readers direct-slot)) ,typed-input-reference)
                                                                   `(slot-value ,typed-input-reference ',(slot-definition-name slot)))))))))))
                               (hash-table
                                (make-hash-table :test (hash-table-test input))))
                           (bind ((typed-output-reference `(the ,(form-type output) ,output-reference)))
                             (setf (gethash input input-to-output) output)
                             (insert-mapping mapping typed-input-reference typed-output-reference))))))))
      (bind ((output-content (recurse input-document 'document)))
        (make-document output-content
                       :selection (map-reference-forward mapping (selection-of input-document))
                       :source (make-source input-document projection mapping))))))

;;;;;;
;;; Java to tree form reader

(def method read-operation (document (projection projection/nested) xxx)
  (operation-of xxx))