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

;;;;;;
;;; Test

(def (function e) test-preserving-number ()
  (apply-projection (preserving) 42))

(def (function e) test-sequential-preserving-number ()
  (apply-projection (sequential
                      (preserving)
                      (preserving))
                    42))

(def (function e) test-preserving-string ()
  (apply-projection (preserving) "Hello"))

(def (function e) test-sequential-preserving-string ()
  (apply-projection (sequential
                      (preserving)
                      (preserving))
                    "Hello"))

(def (function e) test-preserving-list ()
  (apply-projection (preserving) '("a" "b" "c" "d")))

(def (function e) test-sequential-preserving-list ()
  (apply-projection (sequential
                      (preserving)
                      (preserving))
                    '("a" "b" "c" "d")))

(def (function e) test-copying-list ()
  (apply-projection (recursive (copying)) '("a" "b" "c" "d")))

(def (function e) test-sequential-copying-list ()
  (apply-projection (sequential
                      (recursive (copying))
                      (recursive (copying)))
                    '("a" "b" "c" "d")))

(def (function e) test-flat-list ()
  (apply-projection (make-projection/list->string)
                    '("a" "b" "c" "d")))

(def (function e) test-preserving-flat-list ()
  (apply-projection (sequential
                      (make-projection/list->string)
                      (preserving))
                    '("a" "b" "c" "d")))

(def (function e) test-copying-flat-list ()
  (apply-projection (sequential
                      (make-projection/list->string)
                      (copying))
                    '("a" "b" "c" "d")))

(def (function e) test-nested-list ()
  (apply-projection (recursive (make-projection/list->string))
                    '("a" ("b" "c") "d")))

(def (function e) test-preserving-nested-list ()
  (apply-projection (sequential
                      (recursive (make-projection/list->string))
                      (preserving))
                    '("a" ("b" "c") "d")))

(def (function e) test-copying-nested-list ()
  (apply-projection (sequential
                      (recursive (make-projection/list->string))
                      (copying))
                    '("a" ("b" "c") "d")))

(def (function e) test-deeply-nested-list ()
  (apply-projection (recursive (make-projection/list->string))
                    '("One" "Two" "Three" ("Alpha" "Beta" "Gamma" "Delta") ("Red" "Green" "Blue" "Black" "White") "Four")))

(def (function e) test-tree ()
  (apply-projection (sequential
                      (recursive (make-projection/tree->string-list))
                      (recursive (make-projection/list->string)))
                    (make-tree/node (list "Hello"
                                          (make-tree/node (list "head" "tail"))
                                          "World"
                                          (make-tree/node (list "This"
                                                                (make-tree/node (list "is" "deep"))
                                                                "nesting"))))))

(def (function e) test-json ()
  (apply-projection (sequential
                      (recursive (json->tree))
                      (recursive (make-projection/tree->string-list))
                      (recursive (make-projection/list->string)))
                    (make-json/array (list (make-json/null)
                                           (make-json/array (list (make-json/number 42) (make-json/boolean #f)))
                                           (make-json/array (list (make-json/string "Hello World") (make-json/boolean #t)))))))

(def (function e) test-xml ()
  (apply-projection (sequential
                      (recursive (make-projection/xml->tree))
                      (recursive (make-projection/tree->string-list))
                      (recursive (make-projection/list->string)))
                    (make-xml/element "person"
                                      (list (make-xml/attribute "name" "levy")
                                            (make-xml/attribute "sex" "male"))
                                      (list (make-xml/element "children"
                                                              nil
                                                              (list (make-xml/element "person"
                                                                                      (list (make-xml/attribute "name" "John")
                                                                                            (make-xml/attribute "sex" "female"))
                                                                                      nil)
                                                                    (make-xml/element "person"
                                                                                      (list (make-xml/attribute "name" "Mary")
                                                                                            (make-xml/attribute "sex" "male"))
                                                                                      nil)))))))

(def (function e) test-table ()
  (apply-projection (make-projection/table->string)
                    (make-table/table (list (make-table/row (list (make-table/cell "first cell of first row in a table")
                                                                  (make-table/cell "second cell of first row in a table")))
                                            (make-table/row (list (make-table/cell "first cell of second row in a table (padding)")
                                                                  (make-table/cell "second cell of second row in a table")))))))

(def (function e) test-mixed-nested ()
  (apply-projection (iterating
                      (type-dispatching
                        (string (copying))
                        (list (reference-dispatching
                                (make-projection/list->string)
                                ((elt (the list document) 1)
                                 (recursive (make-projection/list->string :separator ", ")))
                                ((elt (the list document) 2)
                                 (recursive (make-projection/list->string :separator " : ")))))
                        (tree/node (recursive (make-projection/tree->string-list)))
                        (t (recursive
                             (type-dispatching
                               (json/base (json->tree))
                               (xml/base (make-projection/xml->tree)))))))
                    (make-json/array (list (make-json/null)
                                           (make-json/array (list (make-json/number 42) (make-json/boolean #f)))
                                           (make-xml/element "person"
                                                             (list (make-xml/attribute "name" "levy")
                                                                   (make-xml/attribute "sex" "male"))
                                                             (list (make-xml/element "children"
                                                                                     nil
                                                                                     (list (make-xml/element "person"
                                                                                                             (list (make-xml/attribute "name" "John")
                                                                                                                   (make-xml/attribute "sex" "female"))
                                                                                                             nil)
                                                                                           (make-xml/element "person"
                                                                                                             (list (make-xml/attribute "name" "Mary")
                                                                                                                   (make-xml/attribute "sex" "male"))
                                                                                                             nil)))))
                                           (make-json/array (list (make-json/string "Hello World") (make-json/boolean #t)))))))

(def (function e) test-mixed-table ()
  (apply-projection (sequential
                      (recursive
                        (type-dispatching
                          (string (preserving))
                          (tree/node
                           (sequential
                             (recursive (make-projection/tree->string-list))
                             (recursive (make-projection/list->string))))
                          (json/base
                           (sequential
                             (recursive (json->tree))
                             (recursive (make-projection/tree->string-list))
                             (recursive (make-projection/list->string))))
                          (xml/base
                           (sequential
                             (recursive (make-projection/xml->tree))
                             (recursive (make-projection/tree->string-list))
                             (recursive (make-projection/list->string))))
                          (t (copying))))
                      (make-projection/table->string))
                    (make-table/table (list (make-table/row (list (make-table/cell (make-json/array (list (make-json/null)
                                                                                                          (make-json/array (list (make-json/number 42) (make-json/boolean #f)))
                                                                                                          (make-json/array (list (make-json/string "Hello World") (make-json/boolean #t))))))
                                                                  (make-table/cell (make-tree/node (list "Hello"
                                                                                                         (make-tree/node (list "head" "tail"))
                                                                                                         "World"
                                                                                                         (make-tree/node (list "This"
                                                                                                                               (make-tree/node (list "is" "deep"))
                                                                                                                               "nesting")))))))
                                            (make-table/row (list (make-table/cell (make-xml/element "person"
                                                                                                     (list (make-xml/attribute "name" "levy")
                                                                                                           (make-xml/attribute "sex" "male"))
                                                                                                     (list (make-xml/element "children"
                                                                                                                             nil
                                                                                                                             (list (make-xml/element "person"
                                                                                                                                                     (list (make-xml/attribute "name" "John")
                                                                                                                                                           (make-xml/attribute "sex" "female"))
                                                                                                                                                     nil)
                                                                                                                                   (make-xml/element "person"
                                                                                                                                                     (list (make-xml/attribute "name" "Mary")
                                                                                                                                                           (make-xml/attribute "sex" "male"))
                                                                                                                                                     nil))))))
                                                                  (make-table/cell "second cell of second row in a table")))))))