(module pretty-print mzscheme
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1))
           (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 1 1))
           "../../syntax/pretty-print.ss"
           "../../syntax/parse.ss"
           "../../syntax/sexp.ss"
           "../../syntax/ast.ss")

  ;; TODO: test expression statement never generates immediate function subexpression

  (define (pretty-test term)
    (printf "~v~n" (pretty-format term)))

  (define-assertion (assert-expression sexp)
    (assert-equal? sexp
                   (Expression->sexp (parse-expression (pretty-format (sexp->Expression sexp))))))

  (define-assertion (assert-source-element sexp)
    (assert-equal? sexp
                   (SourceElement->sexp (parse-source-element (pretty-format (sexp->SourceElement sexp))))))

  (define invertability-tests
    (make-test-suite
     "tests of invertability of pretty-printing"
     (make-test-case "array literal"
       (assert-expression '(array 1 2 3 4 5)))
     (make-test-case "sparse array literal"
       (assert-expression '(array 1 () 2 () 3)))
     (make-test-case "function"
       (assert-source-element '(function f (a b c)
                                 (return a))))
     (make-test-case "object literal"
       (assert-expression '(object [a "aaa"]
                                   [b 12]
                                   ["is" 42])))
     (make-test-case "block statement"
       (assert-source-element '(block "foo" (print 6))))
     (make-test-case "one-armed if"
       (assert-source-element '(if #f (print 12))))
     (make-test-case "nested ifs"
       (assert-source-element '(if #f
                                   (block (print 2))
                                   (if #f
                                       (print 3)
                                       (if #t
                                           (print)
                                           (print null))))))
     (make-test-case "empty do body"
       (assert-source-element '(do () #f)))
     (make-test-case "do with block body"
       (assert-source-element '(do (block (break)) #f)))
     (make-test-case "for-in with var declaration"
       (assert-source-element '(for-in ((var x) (array 0 1 2))
                                 (block (print x)))))
     (make-test-case "application of complex expression"
       (assert-expression '((new Function "print('hi!');"))))
     (make-test-case "nested addition"
       (assert-expression '(+ (+ 2 3) 4)))
     (make-test-case "order of operations 1"
       (assert-expression '(* (+ 2 3) 4)))
     (make-test-case "order of operations 2"
       (assert-expression '(+ (* 2 3) 4)))
     (make-test-case "order of operations 3"
       (assert-expression '(+ 2 (* 3 4))))
     (make-test-case "nested addition with different kinds of operands"
       (assert-expression '(+ "foo" (+ 2 3))))
     (make-test-case "order of operations with overloaded addition"
       (assert-expression '(+ "foo" (* 2 3))))
     (make-test-case "nested functions"
       (assert-expression '(function ()
                             (function foo () (return))
                             (foo))))
     (make-test-case "empty for init"
       (assert-source-element '(for () #t () (break))))
     (make-test-case "standard for loop"
       (assert-source-element '(for ((= i 0)) (< i 10) ((postfix i ++)) (print i))))
     (make-test-case "complex for loop"
       (assert-source-element '(for (var [i 0] [j 10]) (< i 10) ((postfix i ++) (postfix j --))
                                 (print (+ i (+ ", " j))))))
     ))

  (define pretty-print-tests
    (make-test-suite
     "pretty-print tests"
     invertability-tests
     ))

  (provide pretty-print-tests))