1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
;; SPDX-License-Identifier: EUPL-1.2
;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
(defpackage :ukkoclot/src/tg/method-macros
(:documentation "Macros for easy defining TG methods.")
(:use :c2cl :iterate)
(:import-from :alexandria :make-keyword :with-gensyms)
(:import-from :com.dieggsy.f-string :enable-f-strings)
(:import-from :serapeum :take)
(:import-from :state)
(:import-from :str)
(:import-from :ukkoclot/src/transport :do-call)
(:export :define-tg-method))
(in-package :ukkoclot/src/tg/method-macros)
(eval-when (:compile-toplevel :load-toplevel :execute)
(enable-f-strings))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defstruct (param (:constructor make-param%)) name type default skip-if-default)
(defparameter +unique+ (gensym))
;; TODO: Fix optional-and-key !
(defun make-param (name type ; lint:suppress avoid-optional-and-key
&optional (default +unique+)
&key (skip-if-default (not (eq default +unique+))))
(let ((default (if (eq default +unique+)
`(error ,#f"No value given for {name}")
default)))
(make-param% :name name
:type type
:default default
:skip-if-default skip-if-default)))
(defun parse-param-specs (param-specs)
(iter (for param-spec in param-specs)
(collect (apply #'make-param param-spec))))
(defun path-from-name (name)
(let ((str (str:camel-case name)))
(if (str:ends-with-p "%" str :ignore-case nil)
(take (- (length str) 1) str)
str)))
(defun emit-append-to-args (param args)
`(setf ,args (acons ',(param-name param) ,(param-name param) ,args)))
(defun emit-arg-type (param)
`(,(make-keyword (param-name param))
,(param-type param)))
(defun emit-defun-arg (param)
`(,(param-name param) ,(param-default param)))
(defun emit-defun (name return-type params method)
(with-gensyms (args)
`(defun ,name (&key ,@(iter (for param in params) ; lint:suppress lambda-list-invalid
(collect (emit-defun-arg param))))
(let (,args)
,@(iter (for param in (reverse params))
(collect (if (param-skip-if-default param)
`(unless (equal ,(param-name param)
,(param-default param))
,(emit-append-to-args param args))
(emit-append-to-args param args))))
(do-call ,method ,(path-from-name name) ',return-type ,args)))))
(defun emit-ftype (name return-type params)
`(declaim (ftype (function (&key ,@(iter (for param in params)
(collect (emit-arg-type param))))
,return-type)
,name))))
(defmacro define-tg-method ((name type &optional (method :POST))
&body param-specs)
(let ((params (parse-param-specs param-specs)))
`(progn
,(emit-ftype name type params)
,(emit-defun name type params method))))
|
