(module roos-misc mzscheme
	(require "roos-internal.scm")
	(provide roos-copy
		 roos-add-copier
		 roos-misc-doc)

(spod-module-def)
(spod-module-add (sp (s= "Roos utilities")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Internal structures
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (any? x) #t)

(define %roos-copiers (make-hash-table))
(define %roos-preds   #f)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; api
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(spod-module-add (sp (s== "API description")))

(spod-define (spod (sp (s% "roos-copy") "copies an object or a continer with objects,"
		       "where this container can be a list, a vector a hash."
		       "More copiers can be added with the " (s% 'roos-add-copier)
		       "function."))
    (roos-copy object-or-container-of-objects)

       (define (g l)
	 (if (null? l)
	     object-or-container-of-objects
	     (if ((car l) object-or-container-of-objects)
		 ((hash-table-get %roos-copiers (car l)) object-or-container-of-objects)
		 (g (cdr l)))))

       (g (hash-table-map %roos-copiers (lambda (key val) key))))


(spod-define (spod (sp (s% "roos-add-copier") "adds a converter to the list of"
		       "possible converters. An added converter consists of a predicate"
		       "procedure to determine if given data is of the to be converted"
		       "type. The converter copies the given type to a new type and copies"
		       "as far as possible all it's subtypes (i.e. recursively calls "
		       (s% 'roos-copy))
		   (sp "If a copier for a given type has already been added, a new one"
		       "with the same predicate function will overwrite the old one."))
   (roos-add-copier pred copyf)
      (hash-table-put! %roos-copiers pred copyf))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; documentation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define roos-misc-doc (spod-module-doc))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Module initialization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(roos-add-copier list?        (lambda (l)
					      (map roos-copy l)))
(roos-add-copier vector?      (lambda (v)
					      (apply vector
						     (map roos-copy (vector->list v)))))
(roos-add-copier hash-table?  (lambda (h)
					      (let ((_weak  (hash-table? h 'weak))
						    (_equal (hash-table? h 'equal)))
						(let ((flags (append (if _weak (list 'weak) (list))
								     (if _equal (list 'equal) (list)))))
						  (let ((nh (apply make-hash-table flags)))
						    (hash-table-for-each h (lambda (k e) 
									     (hash-table-put! nh (roos-copy k) (roos-copy e))))
						    nh)))))
(roos-add-copier object?      (lambda (obj)
					      (-> obj roos-copy)))




)