From cc025f68abe0da5732ff51437d80fa9d22bac88c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 15 Mar 2022 00:43:23 +0100 Subject: Qualify functions in make-routes expansion. Previously, the user of the macro needed a correct environment. This should not be needed any more. --- module/calp/server/routes.scm | 2 -- module/web/http/make-routes.scm | 28 ++++++++++++++-------------- 2 files changed, 14 insertions(+), 16 deletions(-) diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm index 866a40d2..07ea67f0 100644 --- a/module/calp/server/routes.scm +++ b/module/calp/server/routes.scm @@ -1,14 +1,12 @@ (define-module (calp server routes) :use-module (hnh util) :use-module (hnh util path) - :use-module (hnh util options) :use-module (hnh util exceptions) :use-module (srfi srfi-1) :use-module ((ice-9 rdelim) :select (read-string)) :use-module ((ice-9 ftw) :select (scandir)) - :use-module (ice-9 regex) #| regex here due to bad macros |# :use-module (ice-9 format) :use-module ((web response) :select (build-response)) diff --git a/module/web/http/make-routes.scm b/module/web/http/make-routes.scm index 7254fcb5..abaa6870 100644 --- a/module/web/http/make-routes.scm +++ b/module/web/http/make-routes.scm @@ -3,8 +3,7 @@ :use-module (hnh util) :use-module (ice-9 regex) :use-module (srfi srfi-1) - :use-module (web response) - :use-module (web uri)) + ) @@ -54,14 +53,14 @@ ,@body)) ,@(unless (null? intersect) (map (lambda (i) - `(match:substring match-object ,i)) + `((@ (ice-9 regex) match:substring) match-object ,i)) (cdr (iota (1+ (length intersect))))))))))) (define-macro (make-routes . routes) `(lambda* (request body #:optional state) ;; (format (current-error-port) "~a~%" request) - ;; ALl these bindings generate compile time warnings since the expansion + ;; All these bindings generate compile time warnings since the expansion ;; of the macro might not use them. This isn't really a problem. (let ((r:method ((@ (web request) request-method) request)) (r:uri ((@ (web request) request-uri) request)) @@ -93,21 +92,22 @@ (lambda (return) (apply (cond ,@(map generate-case routes) - (else (lambda* _ (return (build-response #:code 404) + (else (lambda* _ (return ((@ (web response) build-response) code: 404) "404 Not Fonud")))) (append ((@ (web query) parse-query) r:query) (let ((content-type (assoc-ref r:headers 'content-type))) - (when content-type - (let ((type (car content-type)) - (args (cdr content-type))) - (when (eq? type 'application/x-www-form-urlencoded) - (let ((encoding (or (assoc-ref args 'encoding) "UTF-8"))) - ((@ (web query) parse-query) - ((@ (ice-9 iconv) bytevector->string) - body encoding) - encoding))))))))))) + ((@ (hnh util) when) content-type + (let ((type (car content-type)) + (args (cdr content-type))) + ((@ (hnh util) when) + (eq? type 'application/x-www-form-urlencoded) + (let ((encoding (or (assoc-ref args 'encoding) "UTF-8"))) + ((@ (web query) parse-query) + ((@ (ice-9 iconv) bytevector->string) + body encoding) + encoding))))))))))) (case-lambda ((headers body new-state) (values headers body new-state)) ((headers body) (values headers body state)) ((headers) (values headers "" state)))))))) -- cgit v1.2.3