Fix Lack.builder to handle normal forms properly.

This commit is contained in:
Eitaro Fukamachi 2015-03-13 12:43:12 +09:00
parent 751301fed5
commit f182f02b5a

View file

@ -22,38 +22,62 @@
(symbol-value mw-symbol)
(error "Middleware ~S is unbound or not a function" mw-symbol)))))
(defun clack-middleware-symbol-p (symbol)
(and (symbolp symbol)
(find-package :clack.middleware)
(find-class symbol nil)
(subtypep (find-class symbol)
(intern (string :<middleware>)
:clack.middleware))))
(defun convert-to-middleware-form (mw)
(let ((app (gensym "APP")))
(typecase mw
(null)
(function mw)
(keyword `(find-middleware ,mw))
;; for old Clack middlewares
(symbol (if (clack-middleware-symbol-p mw)
`(lambda (,app)
(funcall (intern (string :wrap) :clack)
(make-instance ',mw)
,app))
mw))
(cons
(typecase (car mw)
(keyword `(lambda (,app)
(funcall (find-middleware ,(car mw)) ,app
,@(cdr mw))))
(symbol
;; for old Clack middlewares
(if (clack-middleware-symbol-p (car mw))
`(lambda (,app)
(funcall (intern (string :wrap) :clack)
(make-instance ',mw ,@(cdr mw))
,app))
;; Normal form
(let ((res (gensym "RES")))
;; reconvert the result of the form
`(let ((,res ,mw))
(typecase ,res
(keyword (find-middleware ,res))
(cons (if (keywordp (car ,res))
`(lambda (,',app)
(apply (find-middleware (car ,,res)) ,',app
(cdr ,,res)))
,res))
(otherwise ,res))))))
(otherwise mw)))
(otherwise mw))))
(defmacro builder (&rest app-or-middlewares)
(let ((middlewares (butlast app-or-middlewares))
(app (gensym "APP")))
(let ((middlewares (butlast app-or-middlewares)))
`(reduce #'funcall
(remove-if
#'null
(list
,@(loop for mw in middlewares
when mw
collect (typecase mw
(null)
(function mw)
(keyword `(find-middleware ,mw))
;; for old Clack middlewares
(symbol `(lambda (,app)
(funcall (intern (string :wrap) :clack)
(make-instance ',mw)
,app)))
(cons
;; for `cl:lambda' and `cl:if' forms
(if (eq (symbol-package (car mw)) (find-package :cl))
mw
(typecase (car mw)
(keyword `(lambda (,app)
(funcall (find-middleware ,(car mw)) ,app
,@(cdr mw))))
;; for old Clack middlewares
(symbol `(lambda (,app)
(funcall (intern (string :wrap) :clack)
(make-instance ',mw ,@(cdr mw))
,app)))
(otherwise mw))))
(otherwise mw)))))
collect (convert-to-middleware-form mw))))
:initial-value ,(car (last app-or-middlewares))
:from-end t)))