|
| 1 | +;;;; builder.lisp |
| 2 | +(in-package :cl-user) |
| 3 | +(uiop:define-package :tiny-routes.middleware.builder |
| 4 | + (:use :cl) |
| 5 | + (:export #:wrap-request-predicate |
| 6 | + #:wrap-request-mapper |
| 7 | + #:wrap-response-mapper |
| 8 | + #:wrap-response-mapper*)) |
| 9 | + |
| 10 | +(in-package :tiny-routes.middleware.builder) |
| 11 | + |
| 12 | +(defun wrap-request-predicate (handler request-predicate) |
| 13 | + "Returns a new handler that calls HANDLER only if the request |
| 14 | +satisfies REQUEST-PREDICATE." |
| 15 | + (lambda (request) |
| 16 | + (when (funcall request-predicate request) |
| 17 | + (funcall handler request)))) |
| 18 | + |
| 19 | +(defun wrap-request-mapper (handler request-mapper) |
| 20 | + "Return a new handler that calls HANDLER with the result of applying |
| 21 | +REQUEST-MAPPER to request." |
| 22 | + (lambda (request) |
| 23 | + (funcall handler (funcall request-mapper request)))) |
| 24 | + |
| 25 | +(defun wrap-response-mapper (handler response-mapper) |
| 26 | + "Wrap HANDLER such that it returns the result of applying |
| 27 | +RESPONSE-MAPPER to response." |
| 28 | + (lambda (request) |
| 29 | + (let ((response (funcall handler request))) |
| 30 | + (typecase response |
| 31 | + (null nil) |
| 32 | + (cons (funcall response-mapper response)) |
| 33 | + ;; Clack allows async response in the form of a lambda |
| 34 | + (function |
| 35 | + (lambda (responder) |
| 36 | + (funcall response (lambda (res) |
| 37 | + (funcall responder |
| 38 | + (funcall response-mapper res)))))))))) |
| 39 | + |
| 40 | +(defun wrap-response-mapper* (handler bi-mapper) |
| 41 | + "Wrap HANDLER such that it returns the result of applying BI-MAPPER |
| 42 | +to request and response." |
| 43 | + (lambda (request) |
| 44 | + (let ((response (funcall handler request))) |
| 45 | + (typecase response |
| 46 | + (null nil) |
| 47 | + (cons (funcall bi-mapper request response)) |
| 48 | + (function |
| 49 | + (lambda (responder) |
| 50 | + (funcall response (lambda (res) |
| 51 | + (funcall responder |
| 52 | + (funcall bi-mapper request res)))))))))) |
0 commit comments