aboutsummaryrefslogtreecommitdiff
path: root/src/client/dexador/generate.lisp
blob: dd4652c4d6e49aad92faa08e421683ce4af75078 (plain)
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
(defpackage #:weekend.client.dexador
  (:use #:cl)
  (:import-from #:flatbind #:do>)
  (:local-nicknames
   (#:wknd #:weekend)
   (#:a #:alexandria-2))
  (:export #:generate))

(in-package #:weekend.client.dexador)

(defun generate-client-for (class)
  (when (symbolp class) (setf class (find-class class)))

  (let*
      ((args
         (mapcar (a:compose #'intern #'string)
                 (wknd:class-initargs class)))
       
       (parts
         (loop
           :for part :in (wknd:route-builder-parts class)
           :when (or (stringp part) (characterp part))
             :collect part
           :else
             :collect (intern (string part))))
       (method
         (wknd:request-method class))

       (dexador-fn
         (ecase method
           (:get 'dexador:get)
           (:post 'dexador:post)
           (:put 'dexador:put)
           (:delete 'dexador:delete)
           (:patch 'dexador:patch)
           (:head 'dexador:head)))

       (reqbody
         (when (wknd:body-expected-p method)
           `(mapcar #'cons
                    ',(mapcar #'string (wknd:class-initargs class))
                    (list ,@args))))

       (host
         (loop :with var := "HOST"
               :while (find var args :test #'string-equal)
               :do (setf var (concatenate 'string var "%"))
               :finally (return (intern var))))
       (dexador-kwargs
         (loop :with var := "DEXADOR-KWARGS"
               :while (find var args :test #'string-equal)
               :do (setf var (concatenate 'string var "%"))
               :finally (return (intern var)))))

    `(defun ,(class-name class) (,host ,@args &rest ,dexador-kwargs)
       (apply #',dexador-fn
              (concatenate 'string ,host ,@parts)
              ,@(when reqbody
                  (list :content reqbody))
              ,dexador-kwargs))))

(defun generate (class)
  (eval (generate-client-for class)))