Commits

Anonymous committed 1fb519c

Added request guards sketch to neman.web and helper in views for new match macro.

  • Participants
  • Parent commits 04ce2a5

Comments (0)

Files changed (2)

         <artifact name='neman' type='jar' ext='jar'/>
     </publications>
     <dependencies>
-        <dependency org='clojure' name='clojure' rev='svn1132'>
+        <dependency org='clojure' name='clojure' rev='svn1205'>
             <artifact name='clojure' type='jar'/>
         </dependency>
         <dependency org='clojure' name='clojure-contrib' rev='svn328'>

src/net/ksojat/neman/web.clj

   (:require [net.ksojat.neman.jetty :as jetty])
   (:use clojure.set net.ksojat.neman.core))
 
+(declare
+  *request* *response*)
+
 ;;
 ;; URL path convertors.
 ;;
   (((convertor type) :to-url) value))
 
 ;;
+;; Request guards.
+;;
+
+(defmulti guard (fn [type request & args] type))
+
+(defmethod guard :any [& _] true)
+
+(defmethod guard :method [_ request allowed]
+  (allowed (keyword (.. request getMethod toLowerCase))))
+
+(defmethod guard :post [_ request]
+  (guard :method request #{:post}))
+
+(defmethod guard :put [_ request]
+  (guard :method request #{:put}))
+
+(defmethod guard :get [_ request]
+  (guard :method request #{:get}))
+
+(defmethod guard :head [_ request]
+  (guard :method request #{:head}))
+
+(defmethod guard :delete [_ request]
+  (guard :method request #{:delete}))
+
+;(defmethod guard :header [_ request header-map]
+;  (every? #(not= nil %)
+;    (map
+;      (fn [[k v]]
+;        (let [h (.getHeader request k)]
+;          (if (ifn? v) (v h) (when (= v h) h))))
+;      header-map)))
+
+(defmethod guard :header [_ request header-map]
+  (every? #(not= nil %)
+    (map
+      (fn [[k v]]
+        (let [h (.getHeader request k)]
+          (cond
+            (ifn?   v) (v h)
+            (true?  v) (not= nil h)
+            (false? v) (= nil h)
+            :else      (= v h))))
+      header-map)))
+
+
+(defmethod guard :xhr [_ request]
+  (guard :header request {"X-Requested-With" "XMLHttpRequest"}))
+
+;(defmethod guard :authenticated [_ request]
+;  (.getRemoteUser request))
+
+(defmacro match [& clauses]
+  (let [clauses (apply concat
+                  (map
+                    (fn [[test expr]]
+                      (if (seq? test)
+                        [`(and ~@(map (fn [t] `(guard ~t *request*)) test)) expr]
+                        [`(guard ~test *request*) expr]))
+                    (partition 2 clauses)))]
+    `(cond ~@clauses)))
+
+;;
 ;; Views.
 ;;
 
   [arg-seq]
   (or (not (seq? arg-seq)) (apply distinct? (map :name arg-seq))))
 
-(defmacro view [bindings & body]
+(defmacro view* [bindings & body]
   (let [expand   (fn
                    ([s]     [s (new-arg s :convertor :str)])
                    ([s c]   [s (new-arg s :convertor c)])
         bindings (map #(apply expand (if (vector? %) % (list %))) bindings)
         fargs (map first  bindings)
         vargs (map second bindings)]
-    (println vargs) (println fargs)
     (if (distinct-arguments? vargs)
       `(with-meta
          {:args '~(vec vargs), :fn (fn ~(vec fargs) ~@body)}
          {::view true})
       (throw-illegal-argument "View arguments must have unique names."))))
 
+(defmacro view [bindings & body]
+  (let [[f & r] body]
+    (if (and (= f '->) (seq r))
+      `(view* ~bindings (match ~@r))
+      `(view* ~bindings ~@body))))
+
 (defmacro defview [name bindings & body]
   `(def ~name (view ~bindings ~@body)))
 
           paths   (map #(concat % path) bases)]
       (first (filter #(not= % nil) (map #(url-for-path % args) paths))))))
 
+(defn internal-redirect-to
+  ([path]
+    (internal-redirect-to path {}))
+
+  ([path args]
+    nil))
+
 (def redirect-to)
 
-(declare
-  *request* *response*)
+
 
 (defn handle-url [url-path [[matcher path view] & rs]]
   (if-let [args (matcher url-path)]
       (fn [target request response dispatch]
         (binding [*request* request, *response* response, *paths* paths, *rules* rules, *routes* routes]
           (handle-url target routes))))))
+
+; TODO: Finish this code
+(defn ref-mapper [paths rules]
+  (let [paths (fn [] @paths)
+        rules (fn [] @rules)]))