1. Krešimir Šojat
  2. neman


Kresimir Sojat  committed 11c9c3c

Added new url-for and url-for-path function to neman.web.

  • Participants
  • Parent commits 77dac61
  • Branches default

Comments (0)

Files changed (3)

File src/net/ksojat/neman/web.clj

View file
   ; TODO
-(def url-for)
+(defn iterate-butlast [coll]
+  (take (inc (count coll)) (iterate butlast coll)))
+  *paths* *rules* *routes* *current-path*)
+(defn url-for-path
+  ([path]
+    (url-for-path path {}))
+  ([path args]
+    (when-let [rule (*rules* (vec path))]
+      (let [parts (rule-parts rule)
+            types (argument-types (get-view-at *paths* path))
+            args  (into {} (map (fn [[n v]] [(name n) (to-url (types n) v)]) args))]
+        (apply str
+          (mapcat (fn [[p a]] [p (args a)]) parts))))))
+(defn url-for
+  ([path]
+    (url-for path {}))
+  ([path args]
+    (let [path (if (vector? path) path (vector path))
+          current (butlast *current-path*)
+          bases   (iterate-butlast current)
+          paths   (map #(concat % path) bases)]
+      (first (filter #(not= % nil) (map #(url-for-path % args) paths))))))
 (def redirect-to)
 (defn handle-url [url-path [[matcher path view] & rs]]
   (if-let [args (matcher url-path)]
-    (when-let [res (call-view view args)]
-      (.setHandled *request* true)
-      (.setStatus  *response* (status :ok))
-      (if (vector? res)
-        (doseq [r res] (update-response *response* r))
-        (update-response *response* res))))
+    (binding [*current-path* path]
+      (when-let [res (call-view view args)]
+        (.setHandled *request* true)
+        (.setStatus  *response* (status :ok))
+        (if (vector? res)
+          (doseq [r res] (update-response *response* r))
+          (update-response *response* res))))
     (when (seq rs) (recur url-path rs))))
 (defn mapper [paths rules]
   (let [routes (create-routes paths rules)]
       (fn [target request response dispatch]
-        (binding [*request* request, *response* response]
+        (binding [*request* request, *response* response, *paths* paths, *rules* rules, *routes* routes]
           (handle-url target routes))))))

File src/net/ksojat/neman/xml.clj

View file
     (.addContent o a)))
 (defn xml-ctor [x]
-  (if (keyword? x) (Element. (name x)) x))
+  ; Fix for strage behaviour with JDOM 1.1 when adding node with no content.
+  (.addContent
+    (if (keyword? x) (Element. (name x)) x) ""))
 (defmacro xml-node [node]
   `(binding [*ctor* #'xml-ctor] ~node))
   ([doc-type root-node]
     `(.setDocType (xml root-node) ~doc-type)))
-(defmacro render-xml[root-node]
+(defmacro render-xml [root-node]
   `(.output (org.jdom.output.XMLOutputter.) (xml ~root-node) *out*))
 ;; Templates.
-(def cx)
-(def child)
+(declare cx child)
 (defmacro template [& body]
   `(fn [context# children#]
 (defn expand [template context]
   (template context {}))
-(defn render [template context]
-  (.output (XMLOutputter.) (expand template context) *out*))
+(defn render
+  ([template]
+    (render template {}))
+  ([template context]
+    (.output (XMLOutputter.) (expand template context) *out*)))
+(defn render-str [& render-args]
+  (with-out-str (apply render render-args)))

File tests/test.clj

View file
     '()     (web/rule-names "/show")
     '()     (web/rule-names "")))
+(deftest web-absolute-url-for
+  (binding [web/*rules* {[:test :view] "/test/view/<a>"}
+            web/*paths* {:test {:view (web/view [a] "hi")}}]
+    ; TODO
+    ))