From 10bb613d023468f1b00f02e8f3c9a61de22610ed Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Mon, 20 Nov 2023 19:02:59 -0800
Subject: parenscript client gen
---
src/client/dexador.lisp | 2 -
src/client/parenscript.lisp | 138 ++++++++++++++++++++++++++++++++++++++++++++
src/lazybones.lisp | 3 +
src/package.lisp | 8 ++-
4 files changed, 148 insertions(+), 3 deletions(-)
diff --git a/src/client/dexador.lisp b/src/client/dexador.lisp
index 2503b5e..100d981 100644
--- a/src/client/dexador.lisp
+++ b/src/client/dexador.lisp
@@ -23,8 +23,6 @@
(in-package :lazybones/client.dexador)
-
-
(defun endpoint-defun-name (ep)
"Returns the string name of a defun for making requests to
endpoint EP."
diff --git a/src/client/parenscript.lisp b/src/client/parenscript.lisp
index 75afbd7..bb9cc3a 100644
--- a/src/client/parenscript.lisp
+++ b/src/client/parenscript.lisp
@@ -1,3 +1,141 @@
(defpackage #:lazybones/client.parenscript
(:use #:cl)
+ (:local-nicknames (#:lzb #:lazybones)
+ (#:a #:alexandria))
(:export #:generate))
+
+(in-package :lazybones/client.parenscript)
+
+(defun lispify (str)
+ #+testiere
+ (:tests
+ (equalp (lispify "a.b") "a-b")
+ (equalp (lispify "a/b") "a-b"))
+ (with-output-to-string (out)
+ (loop :for c :across str :do
+ (write-char
+ (if (find c "./") #\- c)
+ out))))
+
+(defun client-function-name (method pattern)
+ "Return a symbol; the name of the parenscript function that will make
+an HTTP request of type METHOD at the path implied by PATTERN. PATTERN
+is the value of the endpoint's DISPATCH-PATTERN slot."
+ #+testiere
+ (:tests
+ (string-equal
+ (client-function-name
+ :get '("" "session" ("doesn't" :matter) "notifications"))
+ 'get-session-notifications)
+ (string-equal
+ (client-function-name
+ :post '("" "foo.bar" "moo"))
+ 'post-foo-bar-moo))
+
+ (intern
+ (lispify
+ (string-upcase
+ (format nil "~a-~{~a~^-~}"
+ method
+ (remove-if-not (a:conjoin #'stringp (complement #'a:emptyp))
+ pattern))))))
+
+(defun client-function-lambda-list (variables body?)
+ #+testiere
+ (:tests
+ (equalp
+ (client-function-lambda-list '("*SESSION*") nil)
+ '(*session*))
+
+ (equalp
+ (butlast (client-function-lambda-list '("a.x" "b/y" "c") t))
+ '(a-x b-y c &optional)))
+
+ (nconc (mapcar (a:compose #'intern #'string-upcase #'lispify) variables)
+ (when body? (list '&optional (gensym "BODY")))))
+
+(defun client-function-endpoint-path (prefix pattern)
+ #+testiere
+ (:tests
+ (equalp
+ (client-function-endpoint-path
+ "/api" '("" "session" ("id" :blahblah) "notifications"))
+ '(+ "/api" "/" "session" "/" id "/" "notifications")))
+ (list* '+ prefix
+ (loop :for x :in pattern
+ :unless (zerop (length x))
+ :collect "/"
+ :and :collect (if (consp x)
+ (intern (string-upcase (first x)))
+ x))))
+
+(defun method-accepts-body? (m)
+ (member m '(:post :put :patch)))
+
+(defun generate-endpoint-form (app ep)
+ (let* ((method
+ (lzb:endpoint-method ep))
+
+ (method-name
+ (symbol-name method))
+
+ (content-type
+ (or (lzb:endpoint-content-type ep)
+ (lzb::default-content-type app)))
+
+ (pattern
+ (lzb:endpoint-dispatch-pattern ep))
+
+ (variables
+ (lzb:endpoint-route-variables ep))
+
+ (function-name
+ (client-function-name method pattern))
+
+ (body?
+ (method-accepts-body? method))
+
+ (lambda-list
+ (client-function-lambda-list variables body?))
+
+ (body
+ (when body?
+ (first (last lambda-list))))
+
+ (fetch-path
+ (client-function-endpoint-path (lzb::app-prefix app) pattern)))
+
+ `(defun ,function-name ,lambda-list
+ ,(if body
+ `(fetch ,fetch-path
+ (ps:create
+ method ,method-name
+ headers (ps:create "Content-Type" ,content-type)
+ redirect "follow"
+ body ,body))
+ `(fetch ,fetch-path)))))
+
+(defun generate (app)
+ (let* ((module
+ (gensym "MODULE"))
+
+ (module-name
+ (intern (lispify (symbol-name (lzb::app-name app)))))
+
+ (defuns
+ (loop :for ep :in (lzb:app-endpoints app)
+ :collect (generate-endpoint-form app ep)))
+
+ (exports
+ (loop :for defun :in defuns
+ :for name := (second defun)
+ :collect `(ps:@ ,module ,name)
+ :collect name)))
+
+ `(defvar ,module-name
+ ((lambda (,module)
+ ,@defuns
+ (setf ,@exports)
+ ,module)
+ (ps:create)))))
+
diff --git a/src/lazybones.lisp b/src/lazybones.lisp
index 97c7d40..ca168a5 100644
--- a/src/lazybones.lisp
+++ b/src/lazybones.lisp
@@ -332,6 +332,9 @@ Returns NIL on failure."
(list (string-upcase var-name) (read-from-string (first decoder?)))
(list (string-upcase var-name))))))
+(defun endpoint-route-variables (endpoint)
+ (route-variables (endpoint-dispatch-pattern endpoint)))
+
(defun route-variables (pattern)
(loop for term in pattern
when (listp term)
diff --git a/src/package.lisp b/src/package.lisp
index 04cc5bf..984288a 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -49,7 +49,6 @@
#:*debugging*
#:*allowed-keywords*
#:http-error
- #:generate-app-documentation
#:provision-app
#:app
#:canned-response
@@ -58,6 +57,13 @@
#:defendpoint
#:defendpoint*
#:endpoint
+ #:endpoint-method
+ #:endpoint-route
+ #:endpoint-params
+ #:endpoint-content-type
+ #:endpoint-dispatch-pattern
+ #:endpoint-route-variables
+ #:app-endpoints
#:let-parameters
#:map-parameters
#:http-err
--
cgit v1.2.3