summaryrefslogtreecommitdiff
path: root/src/tg/method-macros.lisp
diff options
context:
space:
mode:
authorGravatar Uko Kokņevičs2025-10-23 10:17:00 +0300
committerGravatar Uko Kokņevičs2025-10-23 10:32:36 +0300
commitfec434a4e2d0ff65510581e461d87a945d25759a (patch)
tree676891233e6121f8801f4751d3e2d1ca7ad4e09c /src/tg/method-macros.lisp
parentUse alexandria's make-keyword & symbolicate (diff)
downloadukkoclot-fec434a4e2d0ff65510581e461d87a945d25759a.tar.gz
ukkoclot-fec434a4e2d0ff65510581e461d87a945d25759a.tar.xz
ukkoclot-fec434a4e2d0ff65510581e461d87a945d25759a.zip
Use serapeum's -> & defsubst
Diffstat (limited to 'src/tg/method-macros.lisp')
-rw-r--r--src/tg/method-macros.lisp23
1 files changed, 17 insertions, 6 deletions
diff --git a/src/tg/method-macros.lisp b/src/tg/method-macros.lisp
index 0d33ffb..9ab9e89 100644
--- a/src/tg/method-macros.lisp
+++ b/src/tg/method-macros.lisp
@@ -5,10 +5,10 @@
5 (:use :c2cl :iterate) 5 (:use :c2cl :iterate)
6 (:import-from :alexandria :make-keyword :with-gensyms) 6 (:import-from :alexandria :make-keyword :with-gensyms)
7 (:import-from :com.dieggsy.f-string :enable-f-strings) 7 (:import-from :com.dieggsy.f-string :enable-f-strings)
8 (:import-from :serapeum :take) 8 (:import-from :serapeum :-> :take)
9 (:import-from :state) 9 (:import-from :state)
10 (:import-from :str) 10 (:import-from :str)
11 (:import-from :ukkoclot/src/transport :do-call) 11 (:import-from :ukkoclot/src/transport :do-call :http-method)
12 (:export :define-tg-method)) 12 (:export :define-tg-method))
13(in-package :ukkoclot/src/tg/method-macros) 13(in-package :ukkoclot/src/tg/method-macros)
14 14
@@ -21,6 +21,7 @@
21 (defparameter +unique+ (gensym)) 21 (defparameter +unique+ (gensym))
22 22
23 ;; TODO: Fix optional-and-key ! 23 ;; TODO: Fix optional-and-key !
24 (-> make-param (symbol t &optional t &key (:skip-if-default boolean)) param)
24 (defun make-param (name type ; lint:suppress avoid-optional-and-key 25 (defun make-param (name type ; lint:suppress avoid-optional-and-key
25 &optional (default +unique+) 26 &optional (default +unique+)
26 &key (skip-if-default (not (eq default +unique+)))) 27 &key (skip-if-default (not (eq default +unique+))))
@@ -32,26 +33,34 @@
32 :default default 33 :default default
33 :skip-if-default skip-if-default))) 34 :skip-if-default skip-if-default)))
34 35
36 ;; TODO: list-of-params, list-of-param-specs
37 (-> parse-param-specs (list) list)
35 (defun parse-param-specs (param-specs) 38 (defun parse-param-specs (param-specs)
36 (iter (for param-spec in param-specs) 39 (iter (for param-spec in param-specs)
37 (collect (apply #'make-param param-spec)))) 40 (collect (apply #'make-param param-spec))))
38 41
42 (-> path-from-name (symbol) string)
39 (defun path-from-name (name) 43 (defun path-from-name (name)
40 (let ((str (str:camel-case name))) 44 (let ((str (str:camel-case name)))
41 (if (str:ends-with-p "%" str :ignore-case nil) 45 (if (str:ends-with-p "%" str :ignore-case nil)
42 (take (- (length str) 1) str) 46 (take (- (length str) 1) str)
43 str))) 47 str)))
44 48
49 (-> emit-append-to-args (param symbol) list)
45 (defun emit-append-to-args (param args) 50 (defun emit-append-to-args (param args)
46 `(setf ,args (acons ',(param-name param) ,(param-name param) ,args))) 51 `(setf ,args (acons ',(param-name param) ,(param-name param) ,args)))
47 52
53 (-> emit-arg-type (param) list)
48 (defun emit-arg-type (param) 54 (defun emit-arg-type (param)
49 `(,(make-keyword (param-name param)) 55 `(,(make-keyword (param-name param))
50 ,(param-type param))) 56 ,(param-type param)))
51 57
58 (-> emit-defun-arg (param) list)
52 (defun emit-defun-arg (param) 59 (defun emit-defun-arg (param)
53 `(,(param-name param) ,(param-default param))) 60 `(,(param-name param) ,(param-default param)))
54 61
62 ;; TODO: list-of-params
63 (-> emit-defun (symbol t list http-method) list)
55 (defun emit-defun (name return-type params method) 64 (defun emit-defun (name return-type params method)
56 (with-gensyms (args) 65 (with-gensyms (args)
57 `(defun ,name (&key ,@(iter (for param in params) ; lint:suppress lambda-list-invalid 66 `(defun ,name (&key ,@(iter (for param in params) ; lint:suppress lambda-list-invalid
@@ -65,11 +74,13 @@
65 (emit-append-to-args param args)))) 74 (emit-append-to-args param args))))
66 (do-call ,method ,(path-from-name name) ',return-type ,args))))) 75 (do-call ,method ,(path-from-name name) ',return-type ,args)))))
67 76
77 ;; TODO: list-of-params
78 (-> emit-ftype (symbol t list) list)
68 (defun emit-ftype (name return-type params) 79 (defun emit-ftype (name return-type params)
69 `(declaim (ftype (function (&key ,@(iter (for param in params) 80 `(-> ,name
70 (collect (emit-arg-type param)))) 81 (&key ,@(iter (for param in params)
71 ,return-type) 82 (collect (emit-arg-type param))))
72 ,name)))) 83 ,return-type)))
73 84
74(defmacro define-tg-method ((name type &optional (method :POST)) 85(defmacro define-tg-method ((name type &optional (method :POST))
75 &body param-specs) 86 &body param-specs)