#lang scheme/base
(require
(file "base.ss")
(file "monad.ss")
(file "hash-monad.ss"))
(provide display-counter
update-counter!
put-initial-counter
counter->vector)
(define key (gensym))
(define-struct counter (successes failures errors) #:mutable)
(define (display-counter)
(compose
(get key)
(lambda (counter)
(let ((s (counter-successes counter))
(f (counter-failures counter))
(e (counter-errors counter)))
(display s) (display " success(es) ")
(display f) (display " failure(s) ")
(display e) (display " error(s) ")
(display (+ s f e)) (display " test(s) run")
(newline)
(return-hash (void))))))
(define (counter->vector)
(compose
(get key)
(lambda (counter)
(return-hash
(vector (counter-successes counter)
(counter-failures counter)
(counter-errors counter))))))
(define (update-counter! 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))))
(compose
(get key)
(lambda (counter)
(cond
((test-error? result)
(add-error! counter))
((test-failure? result)
(add-failure! counter))
(else
(add-success! counter)))
(put key counter))))
(define (put-initial-counter)
(put key (make-counter 0 0 0)))