(module spiffy-uri-match 

(redirect-to default-response-headers uri-match/spiffy)

(import scheme)
(import (chicken base))
(import uri-match)
(import spiffy)
(import uri-common)
(import intarweb)

(define (redirect-to location #!key (code 302) (headers '()))
  (let* ((current-uri (request-uri (current-request)))
	 (location (if (uri-reference? location)
		       location
		       (uri-reference location)))
	 (location (if (absolute-uri? location)
		       location
		       (update-uri current-uri
				   fragment: (uri-fragment location)
				   query: (uri-query location)
				   path: (if (uri-path-relative? location)
					     (append (uri-path current-uri) (uri-path location))
					     (uri-path location))))))
    (send-response code: code
		   headers: `((location ,location)
			      . ,headers))))

(define default-response-headers 
  (make-parameter `((content-type #(text/html ((charset . "utf-8"))))
		    (accept-charset utf-8))))

(define (uri-match/spiffy routes)
  (let ((match (make-uri-matcher routes)))
    (lambda (continue)
      (let ((handler (match (request-method (current-request))
		            (request-uri (current-request)))))
	(if handler 
	    (with-headers (default-response-headers)
	      (lambda () (or (handler) (continue))))
	    (continue))))))

)