;; Copyright (C) 2022 colin@cicadas.surf ;; 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 . ;;;; 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)))) (declare (ignorable ,@names)) ,@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)))) (defmacro let-body ((&rest var-names) &body body) (let ((key (gensym "key")) (val (gensym "val")) (var (gensym "var"))) `(derrida:with-plist ,var-names (loop :for (,key ,val) :on (request-body) :by #'cddr :for ,var := (find ,key ',var-names :test #'string-equal) :when ,var :collect ,var :and :collect ,val) ,@body)))