;;;
;;; Time-stamp: <2006-11-06 17:05:01 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 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)

  ;; struct database : path (list-of samples)
  (define-struct database (name samples) #f)

  ;; sample->list : sample -> (list string int int int int int)
  (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))]))
    
  
  ;; create-sample : symbol number number number number -> sample
  (define (create-sample name successes failures errors bugs)
    (make-sample
     name
     (current-seconds)
     successes
     failures
     errors
     bugs))
  
  ;; create-database : (U string path) -> db
  (define (create-database name)
    (make-database
     (if (string? name)
         (string->path name)
         name)
     null))

  ;; add-sample! : database sample -> void
  (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)))))

  ;; write-sample : db sample -> void
  (define (write-sample db sample)
    (add-sample! db sample)
    (write-database db))

  ;; read-samples : db -> (list-of sample)
  (define (read-samples db)
    (database-samples db))

  ;; delete-samples! : db -> ()
  (define (delete-samples! db)
    (set-database-samples! db null)
    (write-database db))
  )