aboutsummaryrefslogtreecommitdiff
path: root/macros.lisp
blob: 93f1e472973a49b4d0f8aed1a630b633f8726a0d (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
;; Copyright (C) 2022  Colin Okay

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU Affero General Public License for more details.

;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.


;;;; macros.lisp --- utility macros


(in-package :lazybones)

(defmacro let-parameters ((&rest names) &body body)
  "NAMES is a list of symbols. Binds the names to the value of the
request parameters whose keys compare string-equal to the symbol-name
of each NAME, or NIL if there is no such parameter."
  (let ((params (gensym)))
    `(let ((,params (lazybones:request-parameters)))
      (let ,(loop for name in names
                  for string-name = (symbol-name name) 
                  collect `(,name (cdr (assoc ,string-name ,params :test #'string-equal))))
        ,@body))))

(defmacro map-parameters ((&rest params) &body body)
  "PARAMS is a list of pairs (NAME PARSER).  MAP-PARAMETERS behaves
exactly like LET-PARAMETERS except that the values boudn to NAMEs are
first mapped with the PARSER function."
  (assert (loop for (name parser) in params
                always (and (symbolp name)
                            (or (symbolp parser) (functionp parser))))
          ()
          "Malformed PARAMS in MAP-PARAMETERS macro")

  (let ((names (mapcar #'car params)))
    `(let-parameters ,names
       (let ,(loop for name in names
                   collect `(,name (when ,name (funcall ',(second (assoc name params)) ,name))))
         ,@body))))