diff --git a/simple.scm b/simple.scm index 6f689c2..14860ee 100644 --- a/simple.scm +++ b/simple.scm @@ -113,21 +113,12 @@ (handle-not-found (let ((old-handler (handle-not-found))) (lambda (_) - (let* ((path-list (uri-path (request-uri (current-request)))) - (method (request-method (current-request))) - (dir? (equal? (last path-list) "")) - (path (if (null? (cdr path-list)) - (car path-list) - (string-append "/" (concat (cdr path-list) "/")))) - (proc (resource-ref path method))) + (let* ((method (request-method (current-request))) + (uri (request-uri (current-request))) + (proc (resource-ref uri method))) (if proc - (run-resource proc path) - (if dir? ;; try to find a procedure with the trailing slash removed - (let ((proc (resource-ref (string-chomp path "/") method))) - (if proc - (run-resource proc path) - (old-handler _))) - (old-handler _)))))))) + (run-resource proc uri) + (old-handler _))))))) (define (run-resource proc path) (reset-per-request-parameters) @@ -158,11 +149,11 @@ (loop (cdr resources)))) (loop (cdr resources))))))) -(define (resource-ref path method) - (if (hash-table-exists? *static-resources* (list path method)) - (let ((proc (hash-table-ref *static-resources* (list path method)))) - (lambda () (proc path))) - (resource-match/procedure path method))) +(define (resource-ref uri method) + (if (hash-table-exists? *static-resources* (list (uri-path uri) method)) + (let ((proc (hash-table-ref *static-resources* (list (uri-path uri) method)))) + (lambda () (proc uri))) + (resource-match/procedure uri method))) (define (add-resource! path proc method) (let ((methods (if (list? method) method (list method)))) @@ -174,8 +165,8 @@ (set! *proc-resources* (cons (list path upcase-method proc) *proc-resources*)) (hash-table-set! *static-resources* (list - (cond ((string? path) path) - ((uri-reference? path) (uri->string path)) + (cond ((string? path) (uri-path (uri-reference path))) + ((uri-reference? path) (uri-path path)) (else (abort "unknown path type"))) upcase-method) proc)))) methods))) @@ -188,7 +179,8 @@ (handle-directory (let ((old-handler (handle-directory))) (lambda (path) - (cond ((resource-ref path (request-method (current-request))) + (cond ((resource-ref (request-uri (current-request)) + (request-method (current-request))) => (cut run-resource <> path)) (else (old-handler path)))))))