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

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

;;;;;;
;;; Projection

(def suite* (test/projection :in test))

(def function make-test-projection/string->output (&key color-provider font-provider)
  ;; KLUDGE:
  (if (search "SLIME" (symbol-name (class-name (class-of (make-editor)))))
      (sequential
        (string->styled-string :color-provider color-provider :font-provider font-provider)
        ;; TODO:
        #+nil(word-wrapping :wrap-width 800))
      (sequential
        (string->styled-string :color-provider color-provider :font-provider font-provider)
        ;; TODO:
        #+nil (word-wrapping :wrap-width 800)
        (styled-string->graphics))))

;;;;;;
;;; Graphics

(def function make-test-projection/graphics->graphics ()
  (nesting
    (widget->graphics)
    (document->graphics)
    (preserving)))

;;;;;;
;;; String

(def function make-test-projection/string->graphics ()
  (nesting
    (widget->graphics)
    (document->graphics)
    (make-test-projection/string->output)))

;;;;;;
;;; Text

(def function make-test-projection/text->string ()
  (text->string))

(def function make-test-projection/text->graphics ()
  (nesting
    (widget->graphics)
    (sequential
      (nesting
        (document->document)
        (text->string))
      (nesting
        (document->graphics)
        (make-test-projection/string->output)))))

;;;;;;
;;; List

(def function make-test-projection/list->string ()
  (list->string))

(def function make-test-projection/list->graphics ()
  (nesting
    (widget->graphics)
    (sequential
      (nesting
        (document->document)
        (make-test-projection/list->string))
      (nesting
        (document->graphics)
        (make-test-projection/string->output :color-provider 'list-color-provider)))))

;;;;;;
;;; Table

(def function make-test-projection/table->string ()
  (recursive
    (type-dispatching
      (table/table (table->string))
      (t (preserving)))))

(def function make-test-projection/table->graphics ()
  (nesting
    (widget->graphics)
    (sequential
      (nesting
        (document->document)
        (make-test-projection/table->string))
      (nesting
        (document->graphics)
        (make-test-projection/string->output :color-provider 'table-color-provider)))))

;;;;;;
;;; Tree

(def function make-test-projection/tree->string ()
  (tree->string :delimiter-provider 'tree-delimiter-provider :separator-provider 'tree-separator-provider :indentation-provider 'tree-indentation-provider ))

(def function make-test-projection/tree->graphics ()
  (nesting
    (widget->graphics)
    (sequential (nesting (document->document) (make-test-projection/tree->string))
                (nesting (document->graphics) (make-test-projection/string->output :color-provider 'tree-color-provider)))))

;;;;;;
;;; Book

(def function make-test-projection/book->string ()
  (sequential
    (recursive (book->tree))
    (tree->string :delimiter-provider 'book-delimiter-provider :separator-provider 'book-separator-provider :indentation-provider 'book-indentation-provider)))

(def function make-test-projection/book->graphics ()
  (nesting
    (widget->graphics)
    (sequential
      (nesting
        (document->document)
        (make-test-projection/book->string))
      (nesting
        (document->graphics)
        (make-test-projection/string->output :color-provider 'book-color-provider :font-provider 'book-font-provider)))))

;;;;;;
;;; XML

(def function make-test-projection/xml->string ()
  (sequential
    (recursive (xml->tree))
    (tree->string :delimiter-provider 'xml-delimiter-provider :separator-provider 'xml-separator-provider :indentation-provider 'xml-indentation-provider)))

(def function make-test-projection/xml->graphics ()
  (nesting
    (widget->graphics)
    (sequential
      (nesting
        (document->document)
        (make-test-projection/xml->string))
      (nesting
        (document->graphics)
        (make-test-projection/string->output :color-provider 'xml-color-provider)))))

;;;;;;
;;; JSON

(def function make-test-projection/json->string ()
  (sequential
    (recursive (json->tree))
    (tree->string :delimiter-provider 'json-delimiter-provider :separator-provider 'json-separator-provider :indentation-provider 'json-indentation-provider)))

(def function make-test-projection/json->graphics ()
  (nesting
    (widget->graphics)
    (sequential
      (nesting
        (document->document)
        (make-test-projection/json->string))
      (nesting
        (document->graphics)
        (make-test-projection/string->output :color-provider 'json-color-provider)))))

;;;;;;
;;; Java

(def function make-test-projection/java->tree ()
  (java->tree))

(def function make-test-projection/java->string ()
  (sequential
    (recursive (make-test-projection/java->tree))
    (tree->string :delimiter-provider 'java-delimiter-provider :separator-provider 'java-separator-provider :indentation-provider 'java-indentation-provider)))

(def function make-test-projection/java->graphics ()
  (nesting
    (widget->graphics)
    (sequential
      (nesting
        (document->document)
        (make-test-projection/java->string))
      (nesting
        (document->graphics)
        (make-test-projection/string->output :color-provider 'java-color-provider)))))

;;;;;;
;;; Lisp form

(def function make-test-projection/lisp-form->tree ()
  (recursive (lisp-form->tree)))

(def function make-test-projection/lisp-form->string ()
  (sequential
    (make-test-projection/lisp-form->tree)
    (tree->string :delimiter-provider 'lisp-form-delimiter-provider :separator-provider 'lisp-form-separator-provider :indentation-provider 'lisp-form-indentation-provider)))

(def function make-test-projection/lisp-form->graphics ()
  (nesting
    (widget->graphics)
    (sequential
      (nesting
        (document->document)
        (make-test-projection/lisp-form->string))
      (nesting
        (document->graphics)
        (make-test-projection/string->output :color-provider 'lisp-form-color-provider)))))

;;;;;;
;;; Walked lisp form

(def function make-test-projection/walked-lisp-form->lisp-form ()
  (recursive (walked-lisp-form->lisp-form)))

(def function make-test-projection/walked-lisp-form->string ()
  (sequential
    (make-test-projection/walked-lisp-form->lisp-form)
    (make-test-projection/lisp-form->tree)
    (tree->string :delimiter-provider 'walked-lisp-form-delimiter-provider :separator-provider 'walked-lisp-form-separator-provider :indentation-provider 'walked-lisp-form-indentation-provider)))

(def function make-test-projection/walked-lisp-form->graphics ()
  (nesting
    (widget->graphics)
    (sequential
      (nesting
        (document->document)
        (make-test-projection/walked-lisp-form->string))
      (nesting
        (document->graphics)
        (make-test-projection/string->output :color-provider 'walked-lisp-form-color-provider)))))

;;;;;;
;;; T

(def function make-test-projection/t->string ()
  (sequential
    (recursive (t->table))
    (recursive
      (type-dispatching
        (table/table (table->string))
        (t (preserving))))))

(def function make-test-projection/t->graphics ()
  (nesting
    (widget->graphics)
    (sequential
      (nesting
        (document->document)
        (make-test-projection/t->string))
      (nesting
        (document->graphics)
        (make-test-projection/string->output :color-provider (provider-combinator 'table-color-provider 't-color-provider))))))

;;;;;;
;;; Nested

(def function make-test-projection/nested->string ()
  (sequential
    (recursive (walked-lisp-form->lisp-form))
    (recursive (lisp-form->tree))
    (reference-dispatching
      (copying)
      ((the document (elt (the list (children-of (the tree/node (elt (the list (children-of (the tree/node (content-of (the document document))))) 2)))) 2))
       (json->tree)
       (the document (elt (the list (children-of (the tree/node (elt (the list (children-of (the tree/node (content-of (the document document))))) 2)))) 3))
       (xml->tree)))
    (tree->string :delimiter-provider (lambda (iomap xml-reference)
                                        (or (walked-lisp-form-delimiter-provider iomap xml-reference)
                                            (json-delimiter-provider iomap xml-reference)
                                            (xml-delimiter-provider iomap xml-reference)))
                  :separator-provider (lambda (iomap previous-child-reference next-child-reference)
                                        (or (walked-lisp-form-separator-provider iomap previous-child-reference next-child-reference)
                                            (json-separator-provider iomap previous-child-reference next-child-reference)
                                            (xml-separator-provider iomap previous-child-reference next-child-reference)))
                  :indentation-provider (lambda (iomap previous-child-reference next-child-reference)
                                          (or (walked-lisp-form-indentation-provider iomap previous-child-reference next-child-reference)
                                              (json-indentation-provider iomap previous-child-reference next-child-reference)
                                              (xml-indentation-provider iomap previous-child-reference next-child-reference))))))

(def function make-test-projection/nested->graphics ()
  (nesting
    (widget->graphics)
    (sequential
      (nesting
        (document->document)
        (make-test-projection/nested->string))
      (nesting
        (document->graphics)
        (make-test-projection/string->output :color-provider (lambda (document reference)
                                                               (or (walked-lisp-form-color-provider document reference)
                                                                   (json-color-provider document reference)
                                                                   (xml-color-provider document reference))))))))

;;;;;;
;;; Complex

(def function make-test-projection/complex->string ()
  (sequential
    (reference-dispatching
      (copying)
      ((the document (content-of (the table/cell (elt (the list (cells-of (the table/row (elt (the list (rows-of (the table/table (content-of (the document document))))) 0)))) 0))))
       (make-test-projection/xml->string)
       (the document (content-of (the table/cell (elt (the list (cells-of (the table/row (elt (the list (rows-of (the table/table (content-of (the document document))))) 0)))) 1))))
       (make-test-projection/json->string)
       (the document (content-of (the table/cell (elt (the list (cells-of (the table/row (elt (the list (rows-of (the table/table (content-of (the document document))))) 1)))) 0))))
       (make-test-projection/java->string)
       (the document (content-of (the table/cell (elt (the list (cells-of (the table/row (elt (the list (rows-of (the table/table (content-of (the document document))))) 1)))) 1))))
       (make-test-projection/walked-lisp-form->string)))
    (table->string)))

(def function make-test-projection/complex->graphics ()
  (nesting
    (widget->graphics)
    (sequential
      (nesting
        (document->document)
        (make-test-projection/complex->string))
      (nesting
        (document->document)
        (text->string)))))

;;;;;;
;;; Wow

(def function make-test-projection/wow->graphics ()
  (nesting
    (widget->graphics)
    (sequential
      (nesting
        (document->document)
        (recursive
          (type-dispatching
            (json/base (json->tree))
            (xml/base (xml->tree))
            (book/base (book->tree))
            (java/base (java->tree))
            (cons (recursive (lisp-form->tree)))
            (hu.dwim.walker::walked-form
             (sequential
               (recursive (walked-lisp-form->lisp-form))
               (recursive (lisp-form->tree))))
            (table/base (table->string))
            (text/base (text->string))
            (list/base (list->string))
            (t (preserving)))))
      (nesting
        (document->document)
        (tree->string :delimiter-provider (provider-combinator 'book-delimiter-provider 'json-delimiter-provider 'xml-delimiter-provider 'lisp-form-delimiter-provider 'java-delimiter-provider) ;  'tree-delimiter-provider)
                      :separator-provider (provider-combinator 'book-separator-provider 'json-separator-provider 'xml-separator-provider 'lisp-form-separator-provider 'java-separator-provider) ;  'tree-separator-provider)
                      :indentation-provider (provider-combinator 'book-indentation-provider 'json-indentation-provider 'xml-indentation-provider 'java-indentation-provider))) ; 'lisp-form-indentation-provider 'tree-indentation-provider)))
      (nesting
        (document->graphics)
        (make-test-projection/string->output :color-provider (provider-combinator 'book-color-provider 'json-color-provider 'xml-color-provider 'lisp-form-color-provider 'java-color-provider 'tree-color-provider)
                                             :font-provider 'book-font-provider)))))

;;;;;;
;;; Test

(def test test/projection/string->graphics ()
  (finishes (apply-printer (make-test-document/string) (make-test-projection/string->graphics))))

(def test test/projection/text->graphics ()
  (finishes (apply-printer (make-test-document/text) (make-test-projection/text->graphics))))

(def test test/projection/list->string ()
  (finishes (apply-printer (make-test-document/list) (make-test-projection/list->string))))

(def test test/projection/list->graphics ()
  (finishes (apply-printer (make-test-document/list) (make-test-projection/list->graphics))))

(def test test/projection/table->string ()
  (finishes (apply-printer (make-test-document/table) (make-test-projection/table->string))))

(def test test/projection/table->graphics ()
  (finishes (apply-printer (make-test-document/table) (make-test-projection/table->graphics))))

(def test test/projection/tree->string ()
  (finishes (apply-printer (make-test-document/tree) (make-test-projection/tree->string))))

(def test test/projection/tree->graphics ()
  (finishes (apply-printer (make-test-document/tree) (make-test-projection/tree->graphics))))

(def test test/projection/book->string ()
  (finishes (apply-printer (make-test-document/book) (make-test-projection/book->string))))

(def test test/projection/book->graphics ()
  (finishes (apply-printer (make-test-document/book) (make-test-projection/book->graphics))))

(def test test/projection/xml->string ()
  (finishes (apply-printer (make-test-document/xml) (make-test-projection/xml->string))))

(def test test/projection/xml->graphics ()
  (finishes (apply-printer (make-test-document/xml) (make-test-projection/xml->graphics))))

(def test test/projection/json->string ()
  (finishes (apply-printer (make-test-document/json) (make-test-projection/json->string))))

(def test test/projection/json->graphics ()
  (finishes (apply-printer (make-test-document/json) (make-test-projection/json->graphics))))

(def test test/projection/lisp-form->tree ()
  (finishes (apply-printer (make-test-document/lisp-form) (make-test-projection/lisp-form->tree))))

(def test test/projection/lisp-form->string ()
  (finishes (apply-printer (make-test-document/lisp-form) (make-test-projection/lisp-form->string))))

(def test test/projection/lisp-form->graphics ()
  (finishes (apply-printer (make-test-document/lisp-form) (make-test-projection/lisp-form->graphics))))

(def test test/projection/walked-lisp-form->lisp-form ()
  (finishes (apply-printer (make-test-document/walked-lisp-form) (make-test-projection/walked-lisp-form->lisp-form))))

(def test test/projection/walked-lisp-form->string ()
  (finishes (apply-printer (make-test-document/walked-lisp-form) (make-test-projection/walked-lisp-form->string))))

(def test test/projection/walked-lisp-form->graphics ()
  (finishes (apply-printer (make-test-document/walked-lisp-form) (make-test-projection/walked-lisp-form->graphics))))

(def test test/projection/t->string ()
  (finishes (apply-printer (make-test-document/t) (make-test-projection/t->string))))

(def test test/projection/t->graphics ()
  (finishes (apply-printer (make-test-document/t) (make-test-projection/t->graphics))))

(def test test/projection/nested->string ()
  (finishes (apply-printer (make-test-document/nested) (make-test-projection/nested->string))))

(def test test/projection/nested->graphics ()
  (finishes (apply-printer (make-test-document/nested) (make-test-projection/nested->graphics))))

(def test test/projection/complex->string ()
  (finishes (apply-printer (make-test-document/complex) (make-test-projection/complex->string))))

(def test test/projection/complex->graphics ()
  (finishes (apply-printer (make-test-document/complex) (make-test-projection/complex->graphics))))