Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'f/magicaldocs' into develop

Conflicts:
	project.clj
	src/wakeful/core.clj
  • Loading branch information...
commit b606210bd38b77d53f1dcb04775ab872963733f3 2 parents cd8acd6 + 2a85f38
@amalloy amalloy authored
Showing with 116 additions and 17 deletions.
  1. +3 −1 project.clj
  2. +36 −16 src/wakeful/core.clj
  3. +77 −0 src/wakeful/docs.clj
View
4 project.clj
@@ -4,4 +4,6 @@
[useful "0.4.0"]
[org.clojars.lancepantz/clj-json "0.4.0"]
[compojure "0.6.3"]
- [ego "0.1.1-SNAPSHOT"]])
+ [ego "0.1.1-SNAPSHOT"]
+ [hiccup "0.3.5"]]
+ :dev-dependencies [[ring "0.3.8"]]) ; for some testing
View
52 src/wakeful/core.clj
@@ -4,9 +4,12 @@
[useful.utils :only [verify]]
[ring.middleware.params :only [wrap-params]]
[clout.core :only [route-compile]]
- [ego.core :only [split-id]])
+ [ego.core :only [split-id]]
+ wakeful.docs)
(:require [clj-json.core :as json]))
+(defn foo [& all] "blah")
+
(defn resolve-method [ns-prefix type method]
(let [ns (symbol (if type (str (name ns-prefix) "." (name type)) ns-prefix))
method (symbol (if (string? method) method (apply str method)))]
@@ -23,13 +26,15 @@
(defn- assoc-type [route-params]
(assoc route-params :type (node-type (:id route-params))))
-(defn- wrap-json [handler]
- (fn [{body :body :as request}]
- (let [body (when body (json/parse-string (if (string? body) body (slurp body))))]
- (when-let [response (handler (assoc request :body body :form-params {}))]
- (-> response
- (update :body json/generate-string)
- (assoc-in [:headers "Content-Type"] "application/json; charset=utf-8"))))))
+(defn- wrap-content-type [handler content-type]
+ (let [json? (.startsWith content-type "application/json")
+ [fix-request fix-response] (if json?
+ [#(when % (-> % slurp json/parse-string))
+ #(update % :body json/generate-string)]
+ [identity identity])]
+ (fn [{body :body :as request}]
+ (when-let [response (handler (assoc request :body (fix-request body) :form-params {}))]
+ (fix-response (assoc-in response [:headers "Content-Type"] content-type))))))
(defn- ns-router [ns-prefix wrapper & [method-suffix]]
(fn [{{:keys [method type id]} :route-params :as request}]
@@ -39,7 +44,7 @@
(method request)))))
(defn route [pattern]
- (route-compile pattern {:id #"\w+-\d+" :type #"\w+" :method #"[\w-]+"}))
+ (route-compile pattern {:id #"\w+-\d+" :type #"\w+" :method #"[\w-]+" :ns #".*"}))
(defmacro READ [& forms]
`(fn [request#]
@@ -111,11 +116,26 @@
(POST "/bulk-write" {:as request}
(bulk-write request)))))
+(defn doc-routes [ns-prefix suffix]
+ (routes (GET "/docs" []
+ (generate-top ns-prefix suffix))
+
+ (GET (route "/docs/:ns") {{ns :ns} :params}
+ (generate-page ns-prefix ns suffix))))
+
(defn wakeful [ns-prefix & opts]
- (let [opts (into-map opts)
- read (read-routes (ns-router ns-prefix (:read opts)))
- write (write-routes (ns-router ns-prefix (:write opts) (or (:write-suffix opts) "!")))
- bulk (bulk-routes read write opts)]
- (-> (routes read bulk write)
- wrap-params
- wrap-json)))
+ (let [{:keys [docs? write-suffix content-type]
+ :or {docs? true
+ write-suffix "!"
+ content-type "application/json; charset=utf-8"}
+ :as opts} (into-map opts)
+
+ suffix (or (:write-suffix opts) "!")
+ read (read-routes (ns-router ns-prefix (:read opts)))
+ write (write-routes (ns-router ns-prefix (:write opts) suffix))
+ bulk (bulk-routes read write opts)
+ rs (-> (routes read bulk write) wrap-params (wrap-content-type content-type))]
+ (routes
+ (when docs?
+ (doc-routes ns-prefix suffix))
+ rs)))
View
77 src/wakeful/docs.clj
@@ -0,0 +1,77 @@
+(ns wakeful.docs
+ (:use compojure.core
+ [hiccup core page-helpers]
+ [clojure.string :only [join]]))
+
+(defn extract-info
+ "Extract important information from the meta map of a var."
+ [x] (-> x meta (select-keys [:name :arglists :doc :ns])))
+
+(defn group-by-method
+ "Returns a map of :read and :write."
+ [ns suffix]
+ (->> ns symbol ns-publics keys
+ (group-by
+ #(if (.endsWith (name %) suffix)
+ :write
+ :read))))
+
+(defn generate-html
+ "Generate HTML based on some information from metadata."
+ [v ns-prefix]
+ (let [{:keys [arglists doc name ns]} v]
+ (html
+ [:a {:name name}]
+ [:h3 name]
+ [:p (str "/" (subs (str ns) (inc (count ns-prefix))) "/" name)]
+ (when arglists [:p (pr-str arglists)])
+ [:p doc])))
+
+(defn build-page
+ "Compose a documentation page."
+ [ns & components] (html4 [:body [:h1 ns] (apply str components)]))
+
+(defn generate-page
+ "Generate HTML documentation for all the public methods in a group of namespaces
+ under a prefix."
+ [ns-prefix ns suffix]
+ (let [{:keys [read write]} (group-by-method ns suffix)
+ gen #(-> % extract-info (generate-html ns-prefix))]
+ (build-page
+ ns
+ (html
+ [:h2 "Read"]
+ (map gen read)
+ [:h2 "Write"]
+ (map gen write)))))
+
+(defn anchor
+ "Creates anchors out of each of the items."
+ [ns items]
+ (join " " (map #(html [:a {:href (str "/docs/" ns "#" %)} %]) items)))
+
+(defn extract-name
+ "Pull the name out of a var's metadata."
+ [v] (-> v meta :name))
+
+(defn generate-top
+ "Generate top-level page."
+ [ns-prefix suffix]
+ (let [nss (filter (partial re-find (-> ns-prefix str re-pattern))
+ (map str (all-ns)))]
+ (html4
+ [:h1 "Namespaces under " ns-prefix]
+ [:head (include-css "/css/docs.css")]
+ [:body
+ (for [ns nss]
+ (html
+ [:a {:href (str "/docs/" ns)} ns]
+ [:br]
+ (let [{:keys [read write]} (group-by-method ns suffix)
+ name (partial map extract-name)]
+ (html
+ (str "Read: " (anchor ns (name read)))
+ [:br]
+ (str "Write: " (anchor ns (name write)))))
+ [:br]
+ [:br]))])))
Please sign in to comment.
Something went wrong with that request. Please try again.