Commit 7eb1aecdac9958071718e34237b357a4c7612e48
2015-06-24T18:01:31
Implement uri-template-vars and with-uri-template-vars.
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 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
diff --git a/package.lisp b/package.lisp
index 015f70b..45f980b 100644
--- a/package.lisp
+++ b/package.lisp
@@ -33,6 +33,8 @@
#:uri-template-string
#:expand-uri
;; URI Template vars
+ #:uri-template-vars
+ #:with-uri-template-vars
#:uri-var
#:uri-var-p
#:uri-let
diff --git a/uri-template.lisp b/uri-template.lisp
index becaba2..d9db199 100644
--- a/uri-template.lisp
+++ b/uri-template.lisp
@@ -185,21 +185,29 @@ URI-TEMPLATE."
(funcall var x)
(destructuring-bind (a b &optional c) x
(ecase a
- ((explode) (let ((*separator* (explode-separator *op*)))
- (funcall explode (funcall var b))))
- ((prefix) (funcall prefix b (funcall var c)))))))
+ ((explode) (if explode
+ (let ((*separator* (explode-separator *op*)))
+ (funcall explode (funcall var b)))
+ (funcall var b)))
+ ((prefix) (if prefix
+ (funcall prefix b (funcall var c))
+ (funcall var c)))))))
(do-part (part)
(typecase part
- (string (funcall string part))
+ (string (when string (funcall string part)))
(cons (destructuring-bind (op-char &rest vars) part
- (let ((*op* op-char)
- (*separator* (op-separator op-char)))
- (apply op op-char (remove-if
- #'null
- (mapcar #'do-var vars)))))))))
+ (if op
+ (let ((*op* op-char)
+ (*separator* (op-separator op-char)))
+ (apply op op-char (remove-if
+ #'null
+ (mapcar #'do-var vars))))
+ (map nil #'do-var vars)))))))
(when (stringp template)
(setq template (uri-template template)))
- (apply parts (mapcar #'do-part (uri-template-parts template)))))
+ (if parts
+ (apply parts (mapcar #'do-part (uri-template-parts template)))
+ (map 'nil #'do-part (uri-template-parts template)))))
;; Print
@@ -402,6 +410,21 @@ URI-TEMPLATE."
(:otherwise var))
var))
+(defun uri-template-vars (template)
+ (let (bindings)
+ (do-uri-template template
+ :parts nil
+ :op nil
+ :var (lambda (var)
+ (push (uri-var var) bindings)))
+ (nreverse bindings)))
+
+(defmacro with-uri-template-vars (template &body body)
+ `(let ,(mapcar (lambda (var)
+ `(,(intern (symbol-name var)) ,var))
+ (uri-template-vars template))
+ ,@body))
+
(defun uri-template-regex (template)
(let (bindings)
(values
@@ -430,9 +453,14 @@ URI-TEMPLATE."
`(lambda (,string)
(cl-ppcre:register-groups-bind ,vars
(,(cl-ppcre:create-scanner regex) ,string)
- (declare (ignorable ,@(mapcar (lambda (v) (uri-var (var-name v)))
- vars)))
- ,@body)))))
+ (let ,(mapcar (lambda (var)
+ `(,(intern (var-name var))
+ ,(uri-var (var-name var))))
+ vars)
+ (declare (ignorable ,@(mapcar (lambda (var)
+ (intern (var-name var)))
+ vars)))
+ ,@body))))))
(defun compile-uri-template-matcher (template body)
(compile nil (uri-template-matcher template body)))