;;;
;;; Time-stamp: <2006-11-07 11:46:16 nhw>
;;;
;;; Copyright (C) by Noel Welsh.
;;;

;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.

;;; This library is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE.  See the GNU Lesser General Public
;;; License for more details.

;;; You should have received a copy of the GNU Lesser
;;; General Public License along with this library; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA

;;; Author: Noel Welsh <noelwelsh@yahoo.com>
;;
;;
;; Commentary:

(module si-text-ui mzscheme

  (require
   (lib "plt-match.ss")
   (planet "test.ss" ("schematics" "schemeunit.plt" 2 1))
   (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2 1))
   (planet "plt/monad.ss" ("schematics" "schemeunit.plt" 2 1))
   (planet "plt/hash-monad.ss" ("schematics" "schemeunit.plt" 2 1))
   (planet "plt/name-collector.ss" ("schematics" "schemeunit.plt" 2 1))
   (file "database.ss")
   (file "counter.ss")
   (file "base.ss"))

  (provide test/si-text-ui)

  (define (save-results name)
    (define (write-results successes failures errors bugs)
      (lambda (monad)
        (with-database
         (name->database-name name)
         (lambda (db)
           (write-sample
            db
            (create-sample name successes failures errors bugs))))
        monad))
    (compose
     (counter->vector)
     (match-lambda
      ((vector s f e b)
       (write-results s f e b)))))

  (define (si-display-summary+return monad)
    (monad-value
       ((compose
         (sequence*
          (display-counter)
          (counter->vector))
         (match-lambda
          ((vector s f e b)
           (return-hash (+ f e)))))
        monad)))
  
  ;; test/si-text-ui : symbol test -> int
  (define (test/si-text-ui name test)
    ((sequence*
      (lambda (monad)
        (foldts (lambda (suite name before after seed)
                  (before)
                  ((push-suite-name! name) seed))
                (lambda (suite name before after seed kid-seed)
                  (after)
                  ((pop-suite-name!) kid-seed))
                (lambda (case name action seed)
                  (let ((result (run-test-case name action)))
                    ((sequence* (update-counter! case result)
                                (display-test-case-name result)
                                (lambda (hash)
                                  (display-result result)
                                  (display-check-info result)
                                  hash))
                     seed)))
                ((sequence
                   (put-initial-counter)
                   (put-initial-name))
                 monad)
                test))
      (save-results name)
      si-display-summary+return)
     (make-empty-hash)))
  

  )