(module database mzscheme
(provide with-database
create-sample
write-sample
read-samples
delete-samples!
database-samples
sample
sample?
sample-name
sample-time
sample-successes
sample-failures
sample-errors
sample-bugs)
(require
(lib "plt-match.ss")
(file "base.ss"))
(define-struct sample
(name time successes failures errors bugs) #f)
(define-struct database (name samples) #f)
(define (sample->list sample)
(list (sample-name sample)
(sample-time sample)
(sample-successes sample)
(sample-failures sample)
(sample-errors sample)
(sample-bugs sample)))
(define list->sample
(match-lambda
[`(,name ,time ,successes ,failures ,errors ,bugs)
(make-sample name time successes failures errors bugs)]
[error
(raise-exn:si
(format "Sample ~a is not a valid SI sample\n" error))]))
(define (create-sample name successes failures errors bugs)
(make-sample
name
(current-seconds)
successes
failures
errors
bugs))
(define (create-database name)
(make-database
(if (string? name)
(string->path name)
name)
null))
(define (add-sample! db sample)
(let ([samples (read-samples db)])
(set-database-samples! db (cons sample samples))))
(define (write-database db)
(with-output-to-file (database-name db)
(lambda ()
(write (map sample->list (read-samples db))))
'replace))
(define (with-database name fn)
(let ((db (if (file-exists? name)
(make-database
name
(map list->sample (with-input-from-file name read)))
(create-database name))))
(if (database? db)
(fn db)
(raise-exn:si
(format "Contents of file ~a is not a SI database\n" name)))))
(define (write-sample db sample)
(add-sample! db sample)
(write-database db))
(define (read-samples db)
(database-samples db))
(define (delete-samples! db)
(set-database-samples! db null)
(write-database db))
)