From f069b37946186c43dff1c4aecb803b916d8758b9 Mon Sep 17 00:00:00 2001 From: colin Date: Tue, 28 May 2024 07:15:48 -0700 Subject: Add: parenscript request api function generation --- src/endpoint.lisp | 48 +++++++++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 21 deletions(-) (limited to 'src/endpoint.lisp') diff --git a/src/endpoint.lisp b/src/endpoint.lisp index 223c24a..c827036 100644 --- a/src/endpoint.lisp +++ b/src/endpoint.lisp @@ -205,29 +205,35 @@ matching regex." ":ROUTE-PARTS must be supplied to the defintion of class ~a" (class-name class))))) -(defun construct-route-builder (class) +(defun route-builder-parts (class) + "Given a list whose route is /a/b/(y)/c/(z)/(w) with extractors for slots +:Y, :Z, and :W, returns a list '(\"a\" \"b\" :Y \"c\" :Z \"/\" :W)" (assert (slot-boundp class 'route)) - (let ((build-parts nil)) - (loop - :with extractors := (copy-seq (route-extractors class)) - :for part :in (ppcre:parse-string (route class)) - :do (cond - ((or (stringp part) (characterp part)) - (push part build-parts)) - ((symbolp part) nil) - ((and (listp part) - (eq :register (first part)) - extractors) - (let ((ex (pop extractors))) - (push (if (listp ex) (first ex) ex) - build-parts))) - (t - (error "Cannot build route-builder. + (loop + :with build-parts := nil + :with extractors := (copy-seq (route-extractors class)) + :for part :in (ppcre:parse-string (route class)) + :do (cond + ((or (stringp part) (characterp part)) + (push part build-parts)) + ((symbolp part) nil) + ((and (listp part) + (eq :register (first part)) + extractors) + (let ((ex (pop extractors))) + (push (if (listp ex) (first ex) ex) + build-parts))) + (t + (error "Cannot build route-builder. Non-literal, non-line-boundary regex patterns (~s) must be surrounded by parens. There must be exactly as many patterns as there are -extractors." part)))) - (setf build-parts (nreverse build-parts)) +extractors." part))) + :finally (return (nreverse build-parts)))) + +(defun construct-route-builder (class) + (assert (slot-boundp class 'route)) + (let ((build-parts (route-builder-parts class))) (setf (route-builder class) (lambda (kwargs) (format nil "~{~a~}" @@ -317,8 +323,8 @@ Good for indicating that you've got a bonkers class option syntax" (defparameter +hunchentoot-methods-with-body+ '(:post :put :patch)) -(defun body-expected-p () - (member (http:request-method*) +hunchentoot-methods-with-body+)) +(defun body-expected-p (&optional (method http:request-method*)) + (member method +hunchentoot-methods-with-body+ :test #'eq)) (defun extract-mimetype (str) "Expects a string that looks like text/plain;encoding=utf8 where -- cgit v1.2.3