diff options
Diffstat (limited to 'module/web')
-rw-r--r-- | module/web/http/make-routes.scm | 41 | ||||
-rw-r--r-- | module/web/query.scm | 15 |
2 files changed, 30 insertions, 26 deletions
diff --git a/module/web/http/make-routes.scm b/module/web/http/make-routes.scm index 105bba50..f5277ca5 100644 --- a/module/web/http/make-routes.scm +++ b/module/web/http/make-routes.scm @@ -2,8 +2,10 @@ :export (make-routes) :use-module (hnh util) :use-module (ice-9 regex) + :use-module (ice-9 match) :use-module (ice-9 curried-definitions) :use-module (srfi srfi-1) + :use-module (srfi srfi-71) ) @@ -36,26 +38,27 @@ (define ((generate-case regex-table) defn) - (let* (((method uri param-list . body) defn) - (_ tokens (parse-endpoint-string uri)) - (diff intersect (lset-diff+intersection eq? param-list tokens))) - `((and (eq? r:method (quote ,method)) - (regexp-exec ,(car (assoc-ref regex-table uri)) r:path)) - => (lambda (match-object) - ;; (assert - ;; (= (1- (match:count match-object)) - ;; (length intersect))) + (match defn + ((method uri param-list body ...) + (let* ((_ tokens (parse-endpoint-string uri)) + (diff intersect (lset-diff+intersection eq? param-list tokens))) + `((and (eq? r:method (quote ,method)) + (regexp-exec ,(car (assoc-ref regex-table uri)) r:path)) + => (lambda (match-object) + ;; (assert + ;; (= (1- (match:count match-object)) + ;; (length intersect))) - ;; Those parameters which were present in the template uri - ((lambda ,intersect - ;; Those that only are in the query string - (lambda* (,@(unless (null? diff) `(#:key ,@diff #:allow-other-keys)) - #:rest rest) - ,@body)) - ,@(unless (null? intersect) - (map (lambda (i) - `((@ (ice-9 regex) match:substring) match-object ,i)) - (cdr (iota (1+ (length intersect))))))))))) + ;; Those parameters which were present in the template uri + ((lambda ,intersect + ;; Those that only are in the query string + (lambda* (,@(unless (null? diff) `(#:key ,@diff #:allow-other-keys)) + #:rest rest) + ,@body)) + ,@(unless (null? intersect) + (map (lambda (i) + `((@ (ice-9 regex) match:substring) match-object ,i)) + (cdr (iota (1+ (length intersect))))))))))))) (define-macro (make-routes . routes) ;; Ensures that all regexes are only compiled once. diff --git a/module/web/query.scm b/module/web/query.scm index a70903bc..2d62b45d 100644 --- a/module/web/query.scm +++ b/module/web/query.scm @@ -1,6 +1,7 @@ (define-module (web query) :use-module (hnh util) :use-module (srfi srfi-1) + :use-module (srfi srfi-71) :use-module (web uri)) (define*-public (parse-query query-string optional: (encoding "UTF-8")) @@ -8,12 +9,12 @@ (fold (lambda (str list) ;; only split on the first equal. ;; Does HTTP allow multiple equal signs in a data field? - (let* ((key val - (cond ((string-index str #\=) - => (lambda (idx) - (values (uri-decode (substring str 0 idx) encoding: encoding) - (uri-decode (substring str (1+ idx)) encoding: encoding)))) - (else (let ((v (uri-decode str encoding: encoding))) - (values v v)))))) + (let ((key val + (cond ((string-index str #\=) + => (lambda (idx) + (values (uri-decode (substring str 0 idx) encoding: encoding) + (uri-decode (substring str (1+ idx)) encoding: encoding)))) + (else (let ((v (uri-decode str encoding: encoding))) + (values v v)))))) (cons* (-> key string->symbol symbol->keyword) val list))) '() (string-split query-string #\&)))) |