diff options
author | Thomas Hintz <t@thintz.com> | 2015-05-01 11:46:08 -0700 |
---|---|---|
committer | Thomas Hintz <t@thintz.com> | 2015-05-01 11:46:08 -0700 |
commit | f9a7563ed67a89f84cc338b62c6d1eaea3f2d3a7 (patch) | |
tree | bd6f35f34e5db8b24c21acfdffbd22e940c420ae | |
parent | 935d7a0b8d04447626ff7741f0b0005d819adad5 (diff) | |
download | simple-f9a7563ed67a89f84cc338b62c6d1eaea3f2d3a7.tar.gz |
Using URIs everywhere instead of converting URIs to strings.
-rw-r--r-- | simple.scm | 36 |
1 files changed, 14 insertions, 22 deletions
@@ -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))))))) |