(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)))))) )