Using URIs everywhere instead of converting URIs to strings.

master
Thomas Hintz 10 years ago
parent 935d7a0b8d
commit f9a7563ed6

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

Loading…
Cancel
Save