#lang racket/base
(require rackunit
         rackunit/private/check-info
         racket/string)


(define (with-tag tag value)
  (format "<~a::>~a" tag (string-replace value "\n" "<:LF:>")))
(define complited "<COMPLITEDIN::>")
(define passed "<PASSED::>Test Passed")


(define (show-exn:test:check e)
  (format "<FAILED::>Expected ~a but instead got ~a"
          (get-check-expected e)
          (get-check-actual e)))

(define (get-check-info-value exn name)
  (ormap (lambda (info)
           (and (eq? (check-info-name info) name)
                (check-info-value info)))
         (exn:test:check-stack exn)))

(define (get-check-expected exn)
  (pretty-info-value
   (get-check-info-value exn 'expected)))
(define (get-check-actual exn)
  (pretty-info-value
   (get-check-info-value exn 'actual)))


(define (show-exn e)
  (with-tag "ERROR" (exn-message e)))


(define (fdown suite name before after seed)
  (before)
  (displayln (with-tag "DESCRIBE" name)))

(define (fup suite name before after seed kid-seed)
  (displayln complited)
  (after))

(define (fhere case name action seed)
  (when name
    (displayln (with-tag "IT" name)))
  (define result
    (with-handlers ([exn:test:check? show-exn:test:check]
                    [exn? show-exn])
      (action)
      passed))
  (displayln result)
  (when name
    (displayln complited)))


(define (run-test-and-wrap-result test)
  (define output (open-output-string))
  (parameterize ([current-output-port output])
    (foldts-test-suite fdown fup fhere '() test))
  (get-output-string output))


;;; example
(define a-test-suite
  (test-suite
   "This is a test suite"
   (check-eq? 1 1)
   (check-eq? 1 2)
   (test-case "This is a success test case"
              (check-eq? 1 1)
              (check-equal? '(10 "a string") '(10 "a string")))
   (test-case "This is a failed case"
              (check-eq? 1 2)
              (check-pred even? 3))
   (test-suite
    "Another test suite"
    (test-case "This is a test case for test printing to console"
               (println 'yes))
    (test-case "Here will be an error!"
               (/ 1 0)))))

(display (run-test-and-wrap-result a-test-suite))