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

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

;;;;;;
;;; Tree to text projection

(def class* projection/tree-to-text (projection)
  ((delimiter-provider :type function)
   (separator-provider :type function)
   (indentation-provider :type function)))

;;;;;;
;;; Tree to text projection constructors

(def (function e) make-projection/tree-to-text (&key delimiter-provider separator-provider indentation-provider)
  (make-instance 'projection/tree-to-text
                 :delimiter-provider (or delimiter-provider
                                         (make-delimiter-provider "(" ")"))
                 :separator-provider (or separator-provider
                                         (lambda (source previous-child-reference next-child-reference)
                                           (declare (ignore source previous-child-reference next-child-reference))
                                           " "))
                 :indentation-provider (or indentation-provider
                                           (make-indentation-provider))))

(def (function e) make-delimiter-provider (opening-delimiter closing-delimiter)
  (lambda (source reference)
    (declare (ignore source))
    (bind ((delimiter (first reference)))
      (pattern-case (second reference)
        ((the tree/node ?a)
         (ecase delimiter
           (opening-delimiter opening-delimiter)
           (closing-delimiter closing-delimiter)))))))

(def (function e) make-indentation-provider (&key (indent-width 1) (wrap-from 0) (wrap-last-levels #f))
  (lambda (source previous-child-reference next-child-reference)
    (declare (ignore previous-child-reference))
    (pattern-case next-child-reference
      ((the ?a (elt (the ?type (?if (subtypep ?type 'sequence)) (children-of (the tree/node ?b))) ?c))
       (when (and (> ?c wrap-from)
                  (or wrap-last-levels
                      (bind ((document (document-of source))
                             (node (reference/find-value document next-child-reference))
                             (parent-node (reference/find-value document ?b)))
                        (or (typep node 'tree/node)
                            (find-if (of-type 'tree/node) (children-of parent-node))))))
         (* (count 'children-of (flatten next-child-reference)) indent-width))))))

;;;;;;
;;; Tree to text printer

(def method project-document (tree-document (projection projection/tree-to-text))
  (bind ((mapping (make-mapping))
         (source (make-source tree-document projection mapping))
         (stream nil)
         (paragraph nil)
         (paragraphs)
         (paragraph-index -1)
         (text-reference nil))
    (labels ((next-paragraph (indent)
               (when stream
                 (bind ((text (get-output-stream-string stream)))
                   (adjust-array paragraph (length text))
                   (replace paragraph text)
                   (push (make-text/paragraph (list (make-text/string paragraph))) paragraphs)))
               (setf stream (make-string-output-stream))
               (setf paragraph (make-adjustable-string ""))
               (write-string (make-string-of-spaces indent) stream)
               (incf paragraph-index)
               (setf text-reference `(content-of (the text/string (elt (the list (elements-of (the text/paragraph (elt (the list (elements-of (the text/document (content-of (the document document))))) ,paragraph-index)))) 0)))))
             (recurse (input input-reference)
               (bind ((typed-input-reference `(the ,(form-type input) ,input-reference)))
                 (insert-mapping mapping typed-input-reference `(sequence-position (the string ,text-reference) 0))
                 (awhen (funcall (delimiter-provider-of projection) source `(opening-delimiter ,typed-input-reference))
                   (insert-character-mapping mapping `(opening-delimiter ,typed-input-reference) text-reference (length it) :output-offset (file-position stream))
                   (write-string it stream))
                 (etypecase input
                   (null
                    nil)
                   (document
                    (if (eq input tree-document)
                        (recurse (content-of input) `(content-of ,typed-input-reference))
                        input))
                   (tree/node
                    (when (expanded-p input)
                      (iter (with children = (children-of input))
                            (for index :from 0)
                            (for child :in-sequence children)
                            (for child-path = `(elt (the ,(form-type children) (children-of ,typed-input-reference)) ,index))
                            (for child-reference = `(the ,(form-type child) ,child-path))
                            (for previous-child-reference :previous child-reference)
                            (unless (first-iteration-p)
                              (awhen (funcall (separator-provider-of projection) source previous-child-reference child-reference)
                                (insert-character-mapping mapping `(separator ,previous-child-reference ,child-reference) text-reference (1- (length it))
                                                          :input-offset 1 :output-offset (1+ (file-position stream)))
                                (write-string it stream)))
                            (when-bind indent (funcall (indentation-provider-of projection) source previous-child-reference child-reference)
                              (next-paragraph indent)
                              (insert-character-mapping mapping `(indent ,child-reference) text-reference indent))
                            (recurse child child-path)
                            (finally
                             (when-bind indent (funcall (indentation-provider-of projection) source child-reference nil)
                               (next-paragraph indent))))))
                   (string
                    (insert-character-mapping mapping input-reference text-reference (length input) :output-offset (file-position stream))
                    (write-string input stream)))
                 (awhen (funcall (delimiter-provider-of projection) source `(closing-delimiter ,typed-input-reference))
                   (insert-character-mapping mapping `(closing-delimiter ,typed-input-reference) text-reference (1- (length it))
                                             :input-offset 1 :output-offset (1+ (file-position stream)))
                   (write-string it stream)))))
      (next-paragraph 0)
      (recurse tree-document 'document)
      (next-paragraph 0))
    (bind ((backward-mapping (backward-mapping-of mapping)))
      (maphash (lambda (key value)
                 (setf (gethash key backward-mapping) value))
               backward-mapping)
      (bind ((text-document (make-text/document (reverse paragraphs))))
        (make-document text-document
                       :selection (map-reference-forward mapping (selection-of tree-document))
                       :source source)))))

;;;;;;
;;; Tree to text reader

(def method read-operation (tree-document (projection projection/tree-to-text) 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)
           (bind ((tree-reference (map-reference-backward (mapping-of (source-of (document-of xxx))) (target-of operation))))
             (pattern-case tree-reference
               ((sequence-position (the ?type (?if (subtypep ?type 'sequence)) ?a) ?b)
                (make-operation/sequence/replace-element-range tree-reference (replacement-of operation)))
               (?a
                (make-operation/object/replace-place-value tree-reference (replacement-of operation))))))
          (t operation))))