;;;
;;; Time-stamp: <06/01/03 14:28:46 nhw>
;;;
;;; Copyright (C) 2005 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 util mzscheme

  (require (planet "test.ss" ("schematics" "schemeunit.plt" 1))
           (only (lib "base64.ss" "net") base64-encode-stream))

  (provide (all-defined))

  (define-assertion (assert-hash-table-equal? hash1 hash2)
    (assert-hash-table-contains hash1 hash2)
    (assert-hash-table-contains hash2 hash1))

  ;; assert-hash-table-contains : hash-table hash-table -> void
  ;;
  ;; Assert that hash1 contains all the values in hash2.
  ;; I.e. that hash1 is equal to or a superset of hash2.
  (define-assertion (assert-hash-table-contains hash1 hash2)
    (hash-table-for-each
     hash2
     (lambda (key v2)
       (let ((v1
              (hash-table-get
               hash1 key
               (lambda ()
                 (with-assertion-info
                  (('message
                    (format "No value found with key ~e" key)))
                  (fail-assertion))))))
         (if (and (hash-table? v1) (hash-table? v2))
             (assert-hash-table-equal?* v1 v2)
             (assert-equal? v1 v2))))))

  ;; base64-encode : bytes -> string
  (define (base64-encode byte)
    (let ((output (open-output-string)))
      (base64-encode-stream
       (open-input-bytes byte)
       output
       #"")
      (get-output-string output)))
  
  )