gered/webtools
Archived
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

initial commit

Browse source
This commit is contained in:
Gered 2015-01-04 00:11:24 -05:00
commit bd038047db
7 changed files with 294 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
.gitignore vendored Normal file
View file

@ -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

21
LICENSE Normal file
View file

@ -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.

19
README.md Normal file
View file

@ -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.

10
project.clj Normal file
View file

@ -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"]])

126
src/clj_webtoolbox/response.clj Normal file
View file

@ -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))

60
src/clj_webtoolbox/routes/checked.clj Normal file
View file

@ -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))

41
src/clj_webtoolbox/routes/core.clj Normal file
View file

@ -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))