;;;
;;; Time-stamp: <2006-10-02 12:09:45 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 counter mzscheme

  (require 
   (planet "test.ss" ("schematics" "schemeunit.plt" 2))
   (planet "plt/monad.ss" ("schematics" "schemeunit.plt" 2))
   (planet "plt/hash-monad.ss" ("schematics" "schemeunit.plt" 2))
   "test.ss")

  (provide display-counter
           update-counter!
           put-initial-counter
           counter->vector)

  (define key (gensym))

  ;; struct counter : integer integer integer integer
  (define-struct counter (successes failures errors bugs))

  ;; display-counter : () -> (hash-monad-of ())
  (define (display-counter)
    (compose
     (get key)
     (lambda (counter)
       (let ((s (counter-successes counter))
             (f (counter-failures counter))
             (e (counter-errors counter))
             (b (counter-bugs counter)))
         (display s) (display " success(es) ")
         (display f) (display " failure(s) ")
         (display e) (display " error(s) ")
         (display b) (display " bug(s) ")
         (display (+ s f e)) (display " test(s) run")
         (newline)
         (return-hash (void))))))

  ;; counter->vector : () -> (hash-monad-of vector)
  (define (counter->vector)
    (compose
     (get key)
     (lambda (counter)
       (return-hash
        (vector (counter-successes counter)
                (counter-failures counter)
                (counter-errors counter)
                (counter-bugs counter))))))
  
  ;; update-counter! : test-case test-result -> (hash-monad-of ())
  (define (update-counter! case result)
    (define (add-success! counter)
      (set-counter-successes! counter
                              (add1 (counter-successes counter))))
    (define (add-failure! counter)
      (set-counter-failures! counter
                             (add1 (counter-failures counter))))
    (define (add-error! counter)
      (set-counter-errors! counter
                           (add1 (counter-errors counter))))
    (define (add-bug! counter)
      (set-counter-bugs! counter
                         (add1 (counter-bugs counter))))
    (compose
     (get key)
     (lambda (counter)
       (cond
        ((test-error? result)
         (add-error! counter))
        ((test-failure? result)
         (add-failure! counter))
        (else
         (add-success! counter)))
       (when (bug-test-case?  case)
         (add-bug! counter))
       (put key counter))))

  ;; put-initial-counter : () -> (hash-monad-of ())
  (define (put-initial-counter)
    (put key (make-counter 0 0 0 0)))
  )