Add url-for. Replace do-urlencode by quri.

myway.asd

@@ -19,7 +19,7 @@
   :author "Eitaro Fukamachi"
   :license "LLGPL"
   :depends-on (:cl-ppcre
-               :do-urlencode
+               :quri
                :map-set
                :alexandria
                :cl-utilities)

src/myway.lisp

@@ -13,7 +13,8 @@
                 :route-name
                 :route-handler
                 :equal-route
-                :match-route)
+                :match-route
+                :url-for)
   (:import-from :alexandria
                 :delete-from-plist)
   (:export :make-mapper
@@ -32,7 +33,8 @@
            :route-name
            :route-handler
            :equal-route
-           :match-route))
+           :match-route
+           :url-for))
 (in-package :myway)
 
 (defun connect (mapper url fn &key (method '(:GET)) regexp name)

src/route.lisp

@@ -4,13 +4,15 @@
   (:import-from :myway.rule
                 :make-rule
                 :match-rule
-                :equal-rule)
+                :equal-rule
+                :rule-url-for)
   (:export :route
            :route-name
            :route-rule
            :route-handler
            :match-route
-           :equal-route))
+           :equal-route
+           :url-for))
 (in-package :myway.route)
 
 (defclass route ()
@@ -34,3 +36,6 @@
 (defgeneric match-route (route method url-string &key allow-head)
   (:method ((route route) method url-string &key allow-head)
     (match-rule (route-rule route) method url-string :allow-head allow-head)))
+
+(defun url-for (route params)
+  (rule-url-for (route-rule route) params))

src/rule.lisp

@@ -1,8 +1,8 @@
 (in-package :cl-user)
 (defpackage myway.rule
   (:use :cl)
-  (:import-from :do-urlencode
-                :urlencode)
+  (:import-from :quri
+                :url-encode)
   (:import-from :map-set
                 :map-set
                 :make-map-set
@@ -15,7 +15,8 @@
            :regex-rule
            :make-rule
            :match-rule
-           :equal-rule))
+           :equal-rule
+           :rule-url-for))
 (in-package :myway.rule)
 
 (defun list-to-map-set (elements)
@@ -71,7 +72,7 @@
                  (rule-param-keys rule) names)))
 
 (defun escape-special-char (char)
-  (let ((enc (urlencode (string char))))
+  (let ((enc (url-encode (string char))))
     (cond
       ((string= char " ") (format nil "(?:~A|~A)" enc (escape-special-char #\+)))
       ((string= enc char) (ppcre:quote-meta-chars enc))
@@ -116,3 +117,24 @@
                   (ms-member-p rule2-methods rule))
                 (map-set-index (rule-methods rule1))))
        (string= (rule-url rule1) (rule-url rule2))))
+
+(defgeneric rule-url-for (rule params)
+  (:method ((rule rule) params)
+    (let ((url (apply #'format nil (rule-format-string rule)
+                      (loop for key in (rule-param-keys rule)
+                            if (eq key :splat)
+                              collect (pop (getf params key))
+                            else if (getf params key)
+                                   collect (url-encode (getf params key))
+                                   and do (remf params key)
+                            else
+                              collect ""))))
+      (values
+       (ppcre:regex-replace-all
+        "\\?"
+        (ppcre:regex-replace-all "(.\\?)+$" url "") "")
+       params)))
+  (:method ((rule regex-rule) params)
+    (values (apply #'format (rule-format-string rule)
+                   (getf params :captures))
+            (and (remf params :captures) params))))

t/rule.lisp

@@ -128,4 +128,12 @@
              '("/test%28bar%29/" nil)
              "escape ()"))
 
+(subtest "url-for"
+  (is (rule-url-for (make-rule "/hello/?:name?") '(:name "Eitaro"))
+      "/hello/Eitaro")
+  (is (rule-url-for (make-rule "/hello/?:name?") nil)
+      "/hello")
+  (is (rule-url-for (make-rule "/hello/?:name?") '(:name "Eitaro Fukamachi"))
+      "/hello/Eitaro%20Fukamachi"))
+
 (finalize)