Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Merge branch 'f/magicaldocs' into develop

Conflicts:
	project.clj
	src/wakeful/core.clj
  • Loading branch information...
commit b606210bd38b77d53f1dcb04775ab872963733f3 2 parents cd8acd6 + 2a85f38
Alan Malloy amalloy authored

Showing 3 changed files with 116 additions and 17 deletions. Show diff stats Hide diff stats

  1. +3 1 project.clj
  2. +36 16 src/wakeful/core.clj
  3. +77 0 src/wakeful/docs.clj
4 project.clj
@@ -4,4 +4,6 @@
4 4 [useful "0.4.0"]
5 5 [org.clojars.lancepantz/clj-json "0.4.0"]
6 6 [compojure "0.6.3"]
7   - [ego "0.1.1-SNAPSHOT"]])
  7 + [ego "0.1.1-SNAPSHOT"]
  8 + [hiccup "0.3.5"]]
  9 + :dev-dependencies [[ring "0.3.8"]]) ; for some testing
52 src/wakeful/core.clj
@@ -4,9 +4,12 @@
4 4 [useful.utils :only [verify]]
5 5 [ring.middleware.params :only [wrap-params]]
6 6 [clout.core :only [route-compile]]
7   - [ego.core :only [split-id]])
  7 + [ego.core :only [split-id]]
  8 + wakeful.docs)
8 9 (:require [clj-json.core :as json]))
9 10
  11 +(defn foo [& all] "blah")
  12 +
10 13 (defn resolve-method [ns-prefix type method]
11 14 (let [ns (symbol (if type (str (name ns-prefix) "." (name type)) ns-prefix))
12 15 method (symbol (if (string? method) method (apply str method)))]
@@ -23,13 +26,15 @@
23 26 (defn- assoc-type [route-params]
24 27 (assoc route-params :type (node-type (:id route-params))))
25 28
26   -(defn- wrap-json [handler]
27   - (fn [{body :body :as request}]
28   - (let [body (when body (json/parse-string (if (string? body) body (slurp body))))]
29   - (when-let [response (handler (assoc request :body body :form-params {}))]
30   - (-> response
31   - (update :body json/generate-string)
32   - (assoc-in [:headers "Content-Type"] "application/json; charset=utf-8"))))))
  29 +(defn- wrap-content-type [handler content-type]
  30 + (let [json? (.startsWith content-type "application/json")
  31 + [fix-request fix-response] (if json?
  32 + [#(when % (-> % slurp json/parse-string))
  33 + #(update % :body json/generate-string)]
  34 + [identity identity])]
  35 + (fn [{body :body :as request}]
  36 + (when-let [response (handler (assoc request :body (fix-request body) :form-params {}))]
  37 + (fix-response (assoc-in response [:headers "Content-Type"] content-type))))))
33 38
34 39 (defn- ns-router [ns-prefix wrapper & [method-suffix]]
35 40 (fn [{{:keys [method type id]} :route-params :as request}]
@@ -39,7 +44,7 @@
39 44 (method request)))))
40 45
41 46 (defn route [pattern]
42   - (route-compile pattern {:id #"\w+-\d+" :type #"\w+" :method #"[\w-]+"}))
  47 + (route-compile pattern {:id #"\w+-\d+" :type #"\w+" :method #"[\w-]+" :ns #".*"}))
43 48
44 49 (defmacro READ [& forms]
45 50 `(fn [request#]
@@ -111,11 +116,26 @@
111 116 (POST "/bulk-write" {:as request}
112 117 (bulk-write request)))))
113 118
  119 +(defn doc-routes [ns-prefix suffix]
  120 + (routes (GET "/docs" []
  121 + (generate-top ns-prefix suffix))
  122 +
  123 + (GET (route "/docs/:ns") {{ns :ns} :params}
  124 + (generate-page ns-prefix ns suffix))))
  125 +
114 126 (defn wakeful [ns-prefix & opts]
115   - (let [opts (into-map opts)
116   - read (read-routes (ns-router ns-prefix (:read opts)))
117   - write (write-routes (ns-router ns-prefix (:write opts) (or (:write-suffix opts) "!")))
118   - bulk (bulk-routes read write opts)]
119   - (-> (routes read bulk write)
120   - wrap-params
121   - wrap-json)))
  127 + (let [{:keys [docs? write-suffix content-type]
  128 + :or {docs? true
  129 + write-suffix "!"
  130 + content-type "application/json; charset=utf-8"}
  131 + :as opts} (into-map opts)
  132 +
  133 + suffix (or (:write-suffix opts) "!")
  134 + read (read-routes (ns-router ns-prefix (:read opts)))
  135 + write (write-routes (ns-router ns-prefix (:write opts) suffix))
  136 + bulk (bulk-routes read write opts)
  137 + rs (-> (routes read bulk write) wrap-params (wrap-content-type content-type))]
  138 + (routes
  139 + (when docs?
  140 + (doc-routes ns-prefix suffix))
  141 + rs)))
77 src/wakeful/docs.clj
... ... @@ -0,0 +1,77 @@
  1 +(ns wakeful.docs
  2 + (:use compojure.core
  3 + [hiccup core page-helpers]
  4 + [clojure.string :only [join]]))
  5 +
  6 +(defn extract-info
  7 + "Extract important information from the meta map of a var."
  8 + [x] (-> x meta (select-keys [:name :arglists :doc :ns])))
  9 +
  10 +(defn group-by-method
  11 + "Returns a map of :read and :write."
  12 + [ns suffix]
  13 + (->> ns symbol ns-publics keys
  14 + (group-by
  15 + #(if (.endsWith (name %) suffix)
  16 + :write
  17 + :read))))
  18 +
  19 +(defn generate-html
  20 + "Generate HTML based on some information from metadata."
  21 + [v ns-prefix]
  22 + (let [{:keys [arglists doc name ns]} v]
  23 + (html
  24 + [:a {:name name}]
  25 + [:h3 name]
  26 + [:p (str "/" (subs (str ns) (inc (count ns-prefix))) "/" name)]
  27 + (when arglists [:p (pr-str arglists)])
  28 + [:p doc])))
  29 +
  30 +(defn build-page
  31 + "Compose a documentation page."
  32 + [ns & components] (html4 [:body [:h1 ns] (apply str components)]))
  33 +
  34 +(defn generate-page
  35 + "Generate HTML documentation for all the public methods in a group of namespaces
  36 + under a prefix."
  37 + [ns-prefix ns suffix]
  38 + (let [{:keys [read write]} (group-by-method ns suffix)
  39 + gen #(-> % extract-info (generate-html ns-prefix))]
  40 + (build-page
  41 + ns
  42 + (html
  43 + [:h2 "Read"]
  44 + (map gen read)
  45 + [:h2 "Write"]
  46 + (map gen write)))))
  47 +
  48 +(defn anchor
  49 + "Creates anchors out of each of the items."
  50 + [ns items]
  51 + (join " " (map #(html [:a {:href (str "/docs/" ns "#" %)} %]) items)))
  52 +
  53 +(defn extract-name
  54 + "Pull the name out of a var's metadata."
  55 + [v] (-> v meta :name))
  56 +
  57 +(defn generate-top
  58 + "Generate top-level page."
  59 + [ns-prefix suffix]
  60 + (let [nss (filter (partial re-find (-> ns-prefix str re-pattern))
  61 + (map str (all-ns)))]
  62 + (html4
  63 + [:h1 "Namespaces under " ns-prefix]
  64 + [:head (include-css "/css/docs.css")]
  65 + [:body
  66 + (for [ns nss]
  67 + (html
  68 + [:a {:href (str "/docs/" ns)} ns]
  69 + [:br]
  70 + (let [{:keys [read write]} (group-by-method ns suffix)
  71 + name (partial map extract-name)]
  72 + (html
  73 + (str "Read: " (anchor ns (name read)))
  74 + [:br]
  75 + (str "Write: " (anchor ns (name write)))))
  76 + [:br]
  77 + [:br]))])))

0 comments on commit b606210

Please sign in to comment.
Something went wrong with that request. Please try again.