;;!
;; A simple text interface for running tests and reporting results
(module text-ui mzscheme
        
    (require (lib "string.ss")
             (lib "match.ss")
             "schemeunit.ss"
             "assert-base.ss"
             "assert.ss"
             "assert-util.ss")

    (provide test/text-ui)

    (define-struct count (successes failures errors))
    (define (add-success! count)
      (set-count-successes! count (add1 (count-successes count))))
    (define (add-failure! count)
      (set-count-failures! count (add1 (count-failures count))))
    (define (add-error! count)
      (set-count-errors! count (add1 (count-errors count))))

    (define (print-success name result)
      (void))

    (define (print-common-info name result)
      (let* ((stack (exn:test:assertion-stack result))
             (loc (get-assertion-location stack))
             (spacer (make-string 2 #\space)))
        (printf "~a~n" name)
        (if loc (printf "~a~n" (location->string loc)))
        (let loop ((stack stack))
          (match stack
            (() 'done)
            ((first . rest)
             (if (eq? loc first)
                 (loop rest)
                 (begin
                   (display spacer)
                   (printf "~a: ~s~n"
                           (assertion-info-name first)
                           (assertion-info-value first))
                   (loop rest))))))))

    (define (print-separator length)
      (printf "~a~n" (make-string length #\-)))
    
    (define (print-failure name result)
      (printf "Failure:~n")
      (print-separator 8)
      (print-common-info name result)
      (newline))
        
    (define (print-error name result)
      (printf "Error:~n")
      (print-separator 6)
      (printf "~a~n" name)
      (cond [(exn? result)
             (printf " an error of type ~a occurred with message: ~e~n"
                     (object-name result)
                     (exn-message result))]
            [else
             (printf " an error occurred which was not an exception: ~e~n"
                     result)])
      (newline))

    (define print-summary
      (match-lambda
       [($ count successes failures errors)
        (printf "~a success(es)  ~a error(s)  ~a failure(s)~n"
                successes
                errors
                failures)]))
        
    (define (test/text-ui test)
      (define count (make-count 0 0 0))
      (define (suite-fn name seed)
        seed)
      (define (case-fn result seed)
        (match result
          [($ test-failure case result)
           (print-failure case result)
           (add-failure! count)
           count]
          [($ test-error case result)
           (print-error case result)
           (add-error! count)
           count]
          [($ test-success case result)
           (print-success case result)
           (add-success! count)
           count]))
      (fold-test-results suite-fn case-fn count test)
      (print-summary count))

    )