initial commit

.gitignore

@@ -0,0 +1,17 @@
+.DS_Store
+/target
+/classes
+/checkouts
+pom.xml
+pom.xml.asc
+*.jar
+*.class
+/.lein-*
+/.nrepl-port
+.settings/
+.project
+.classpath
+.idea/
+*.iml
+*.ipr
+*.iws

LICENSE

@@ -0,0 +1,21 @@
+The MIT License (MIT)
+
+Copyright (c) 2015 Gered King
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

README.md

@@ -0,0 +1,19 @@
+# clj-webtoolbox
+
+Miscellaneous helper functions and macros for Ring and Compojure.
+
+## Leiningen
+
+```clojure
+[clj-webtoolbox "0.0.1"]
+```
+
+## Usage
+
+TODO
+
+## License
+
+Copyright © 2014 Gered King
+
+Distributed under the the MIT License. See LICENSE for more details.

project.clj

@@ -0,0 +1,10 @@
+(defproject clj-webtoolbox "0.0.1"
+  :description "Miscellaneous helper functions and macros for Ring and Compojure."
+  :url         "https://github.com/gered/clj-webtoolbox"
+  :license     {:name "MIT License"
+                :url  "http://opensource.org/licenses/MIT"}
+
+  :dependencies [[org.clojure/clojure "1.6.0"]
+                 [compojure "1.3.1" :scope "provided"]
+                 [ring/ring-core "1.3.1" :scope "provided"]
+                 [cheshire "5.3.1"]])

src/clj_webtoolbox/response.clj

@@ -0,0 +1,126 @@
+(ns clj-webtoolbox.response
+  "Response helpers to compliment those provided by ring.util.response. Some
+   of these are mostly just copies with maybe slight tweaks here and there
+   just so that application code need not include both namespaces unless
+   absolutely needed for the not-so-commonly-used functions."
+  (:require
+    [cheshire.core :as json]))
+
+(def ^:private base-response
+  {:status  200
+   :headers {}
+   :body    nil})
+
+(defn content
+  "Returns a Ring response where the body is set to the value given."
+  ([body] (content base-response body))
+  ([resp body]
+    (assoc resp :body body)))
+
+(defn status
+  "Returns a Ring response where the HTTP status is set to the status code given."
+  ([http-status] (status base-response http-status))
+  ([resp http-status]
+    (assoc resp :status http-status)))
+
+(defn header
+  "Returns a Ring response where the HTTP header/value is added to the existing
+   set of headers in the response. The header name given should be a string."
+  ([name value] (header base-response name value))
+  ([resp name value]
+    (update-in resp [:headers] assoc name value)))
+
+(defn headers
+  "Returns a Ring response where the map of HTTP headers is added to the existing
+   set of headers in the response. The map should contain string keys."
+  ([m] (headers base-response m))
+  ([resp m]
+    (update-in resp [:headers] merge m)))
+
+(defn content-type
+  "Returns a Ring response where the content type is set to the value given."
+  ([type] (content-type base-response type))
+  ([resp type]
+    (header resp "Content-Type" type)))
+
+(defn plain-text
+  "Returns a Ring response containing plain text content."
+  [body]
+  (-> (content-type "text/plain; charset=utf-8")
+      (content body)))
+
+(defn html
+  "Returns a Ring response containing HTML content."
+  [body]
+  (-> (content-type "text/html; charset=utf-8")
+      (content body)))
+
+(defn xml
+  "Returns a Ring response containing XML content."
+  [body]
+  (-> (content-type "text/xml; charset=utf-8")
+      (content body)))
+
+(defn json
+  "Returns a Ring response containing JSON content. The body passed in will
+   be automatically converted to a JSON format equivalent."
+  [body]
+  (-> (content-type "application/json; charset=utf-8")
+      (content (json/generate-string body))))
+
+(defn edn
+  "Returns a Ring response containing EDN content. The body passed in should
+   be a Clojure data structure and will be serialized using pr-str."
+  [body]
+  (-> (content-type "application/edn; charset=utf-8")
+      (content (pr-str body))))
+
+(defn cookie
+  "Returns a Ring response where a cookie is appended to any existing
+   cookies set in the existing response."
+  [resp name value & [opts]]
+  (assoc-in resp [:cookies name] (merge (:value value opts))))
+
+(defn session
+  "Returns an updated Ring response with session information added. This will
+   overwrite existing session data."
+  [resp session]
+  (assoc resp :session session))
+
+(defn using-session
+  "Returns an updated Ring response with session information added from the
+   Ring request. You can use this to set the initial session to be modified
+   by subsequent functions to modify the response's session map (so as to
+   modify the existing session rather then overwrite it completely)."
+  [resp request]
+  (assoc resp :session (:session request)))
+
+(defn session-assoc
+  "Returns an updated Ring response with the new key/value set in the
+   response's session map."
+  [resp k v]
+  (assoc-in resp [:session k] v))
+
+(defn session-dissoc
+  "Returns an updated Ring response with the key removed from the response's
+   session map."
+  [resp k]
+  (update-in resp [:session] dissoc k))
+
+(defn session-assoc-in
+  "Returns an updated Ring response with the new key/value set in the
+   response's session map. ks should be a vector of keywords referring
+   to a nested value to set in the session. Any levels that do not exist
+   will be created."
+  [resp ks v]
+  (assoc-in resp (concat [:session] ks) v))
+
+(defn session-update-in
+  "Returns an updated Ring response where a specific value within the
+   existing response's session map is 'updated' using function f which
+   takes the existing value along with any supplied args and should
+   return the new value. ks should be a vector of keywords referring
+   to a nested value to update. Any levels that do not exist will be
+   created."
+  [resp ks f & args]
+  (apply update-in resp (concat [:session] ks) f args))

src/clj_webtoolbox/routes/checked.clj

@@ -0,0 +1,60 @@
+(ns clj-webtoolbox.routes.checked
+  (:require
+    [compojure.core :refer [routing]]
+    [ring.util.response :refer [response?]]
+    [clj-webtoolbox.response :as response]
+    [clj-webtoolbox.routes.core :refer [destructure-route-bindings]]))
+
+(defmacro threaded-checks [request checks fail-response]
+  `(or (some-> ~request ~@checks)
+       (if (response? ~fail-response)
+         ~fail-response
+         (~fail-response ~request))))
+
+(defmacro checked-routes
+  [checks fail-response & routes]
+  `(fn [request#]
+     (let [result# (threaded-checks request# ~checks ~fail-response)]
+       (if (response? result#)
+         result#
+         (routing result# ~@routes)))))
+
+(def default-check-error-response
+  (-> (response/content "Route checks did not all pass.")
+      (response/status 500)))
+
+(defmacro checked-route
+  {:arglists '([& body]
+                [:on-fail fail-response & body])}
+  [& body]
+  (let [has-fail-response? (= :on-fail (first body))
+        fail-response      (if has-fail-response? (second body) default-check-error-response)
+        body               (if has-fail-response? (drop 2 body) body)]
+    `(fn [request#]
+       (threaded-checks request# ~body ~fail-response))))
+
+(defmacro checked
+  {:arglists '([method-fn path & body]
+                [method-fn path :on-fail fail-response & body])}
+  [method-fn path & body]
+  `(~method-fn ~path []
+     (checked-route ~@body)))
+
+(defmacro routefn [request args & body]
+  (if (vector? args)
+    `(let [~@(destructure-route-bindings args :safe-params request)] ~@body)
+    `(let [~args ~request] ~@body)))
+
+(defn safe
+  [request & params]
+  (let [safe-params (select-keys (:params request) params)]
+    (update-in request [:safe-params] merge safe-params)))
+
+(defn validate
+  [request param f & args]
+  (if (apply f (get-in request [:params param]) args)
+    (safe request param)))
+
+(defn transform
+  [request param-k f & args]
+  (apply update-in request [:params param-k] f args))

src/clj_webtoolbox/routes/core.clj

@@ -0,0 +1,41 @@
+(ns clj-webtoolbox.routes.core
+  (:require
+    compojure.core))
+
+;; -----------------------------------------------------------------------------
+;; these are taken from compojure.core.
+
+(defn- assoc-&-binding [binds req params-parent sym]
+  (assoc binds sym `(dissoc (~params-parent ~req)
+                            ~@(map keyword (keys binds))
+                            ~@(map str (keys binds)))))
+
+(defn- assoc-symbol-binding [binds req params-parent sym]
+  (assoc binds sym `(get-in ~req [~params-parent ~(keyword sym)]
+                            (get-in ~req [~params-parent ~(str sym)]))))
+
+(defn destructure-route-bindings
+  "Given a vector of Compojure route parameter bindings, expands them to a vector
+   of symbols that can be used in, e.g. a macro, to provide Compojure-like
+   destructuring elsewhere."
+  ([args req] (destructure-route-bindings args :params req))
+  ([args params-parent req]
+    (loop [args args, binds {}]
+      (if-let [sym (first args)]
+        (cond
+          (= '& sym)    (recur (nnext args) (assoc-&-binding binds req params-parent (second args)))
+          (= :as sym)   (recur (nnext args) (assoc binds (second args) req))
+          (symbol? sym) (recur (next args) (assoc-symbol-binding binds req params-parent sym))
+          :else         (throw (Exception. (str "Unexpected binding: " sym))))
+        (mapcat identity binds)))))
+
+;; -----------------------------------------------------------------------------
+
+(defmacro with-middleware
+  "Applies a sequence of middleware functions to a series of routes wrapped
+   by this macro. For best results, use _within_ a compojure.core/context
+   call. Remember that middleware will be applied in the reverse order
+   that it is specified in."
+  [middlewares & routes]
+  `(-> (compojure.core/routes ~@routes)
+       ~@middlewares))