Merge branch 'master' into more_marginalia
This merges Fogus's changes Jan 7 - Jan 25 into goodmike's banch for additional comments. Conflicts: src/marginalia/core.clj
This commit is contained in:
Michael Harrison
commit
2a654c2b85
7 changed files with 405 additions and 228 deletions
|
|
@ -4,10 +4,7 @@ Marginalia
|
|||
|
||||
Marginalia is a source documentation too that parses Clojure code and outputs an side-by-side source view with appropriate comments and docstrings aligned.
|
||||
|
||||
To get a quick look at what marginalia output looks like:
|
||||
|
||||
1. `git clone https://github.com/fogus/marginalia.git`
|
||||
2. `open ./marginalia/example-output/uberdoc.html` (or [look here](http://fogus.me/fun/marginalia/))
|
||||
To get a quick look at what marginalia output looks like, then [visit the official site](http://fogus.me/fun/marginalia/).
|
||||
|
||||
Usage
|
||||
-----
|
||||
|
|
@ -59,7 +56,6 @@ TODO
|
|||
----
|
||||
* paragraph anchors
|
||||
* options for non-uber-docs
|
||||
* new docstring/comment reader
|
||||
* Maven generation support
|
||||
* POM parsing
|
||||
|
||||
|
|
|
|||
10
project.clj
10
project.clj
|
|
@ -1,18 +1,18 @@
|
|||
(defproject marginalia "0.3.2"
|
||||
(defproject marginalia "0.5.0-alpha"
|
||||
:description "lightweight literate programming for clojure -- inspired by [docco](http://jashkenas.github.com/docco/)"
|
||||
:main marginalia.core
|
||||
:eval-in-leiningen true
|
||||
:dependencies
|
||||
[[org.clojure/clojure "1.2.0"]
|
||||
[org.clojars.nakkaya/markdownj "1.0.2b4"]
|
||||
[hiccup "0.3.0"]]
|
||||
[hiccup "0.3.0"]
|
||||
[org.markdownj/markdownj "0.3.0-1.0.2b4"]]
|
||||
:dev-dependencies
|
||||
[[lein-clojars "0.5.0-SNAPSHOT"]
|
||||
[jline "0.9.94"]
|
||||
[swank-clojure "1.2.1"]
|
||||
;;Needed for testing lein plugin
|
||||
[hiccup "0.3.0"]
|
||||
[org.clojars.nakkaya/markdownj "1.0.2b4"]
|
||||
[marginalia "0.3.2"]]
|
||||
[org.markdownj/markdownj "0.3.0-1.0.2b4"]]
|
||||
;;Needed for testing cake plugin
|
||||
:tasks [marginalia.tasks]
|
||||
;;Needed for testing Latex equation formatting. You must download
|
||||
|
|
|
|||
|
|
@ -1,27 +1,15 @@
|
|||
(ns leiningen.marg
|
||||
"# Leiningen plugin for running marginalia against your project.
|
||||
|
||||
## Usage
|
||||
|
||||
1. Add `[marginalia \"<current version number>\"]` to your project.clj's `:dev-dependencies` section.
|
||||
2. run `lein marg` from your project's root directory. "
|
||||
(:use [marginalia.core]))
|
||||
"Run Marginalia against your project source files."
|
||||
(:use [leiningen.compile :only [eval-in-project]]
|
||||
marginalia.core))
|
||||
|
||||
(defn marg [project & args]
|
||||
(run-marginalia args))
|
||||
|
||||
;; You can pass a file, directory, multiple files and/or directories to marginalia like so:
|
||||
;;
|
||||
;; $ lein marg # runs marginalia on all the cljs found in your ./src dir.
|
||||
;; $ lein marg ./path/to/files # runs marginalia on all cljs found in ./path/to/files
|
||||
;; $ lein marg ./path/to/file.clj # runs marginalia on ./path/to/file.clj only.
|
||||
;; $ lein marg ./path/to/one.clj ./path/to/another.clj
|
||||
;; $ lein marg ./path/to/dir ./path/to/some/random.clj
|
||||
;;
|
||||
;; This allows you to control the order in which sections appear in the generated
|
||||
;; documentation. For example, in marginalia's docs, the leiningen.marg namespace
|
||||
;; forced to the bottom of the namespace ordering by using this command:
|
||||
;;
|
||||
;; $ lein marg ./src/marginalia ./src/leiningen
|
||||
|
||||
(eval-in-project project
|
||||
`(marginalia.core/run-marginalia (list ~@args))
|
||||
nil
|
||||
nil
|
||||
'(require 'marginalia.core)))
|
||||
|
||||
(.setMeta #'marg
|
||||
(assoc (.meta #'marg)
|
||||
:doc (with-out-str (run-marginalia (list "-h")))))
|
||||
|
|
|
|||
|
|
@ -1,18 +1,51 @@
|
|||
;; ## A new way to think about programs
|
||||
;;
|
||||
;; What if your code and its documentation were one and the same?
|
||||
;;
|
||||
;; Much of the philosophy guiding literate programming is the realization of the answer to this question.
|
||||
;; However, if literate programming stands as a comprehensive programming methodology at one of end of the
|
||||
;; spectrum and no documentation stands as its antithesis, then Marginalia falls somewhere between. That is,
|
||||
;; you should always aim for comprehensive documentation, but the shortest path to a useful subset is the
|
||||
;; commented source code itself.
|
||||
;;
|
||||
;; ## The art of Marginalia
|
||||
;;
|
||||
;; If you’re fervently writing code that is heavily documented, then using Marginalia for your Clojure projects
|
||||
;; is as simple as running it on your codebase. However, if you’re unaccustomed to documenting your source, then
|
||||
;; the guidelines herein will help you make the most out of Marginalia for true-power documentation.
|
||||
;;
|
||||
;; Following the guidelines will work to make your code not only easier to follow – it will make it better.
|
||||
;; The very process of using Marginalia will help to crystalize your understanding of problem and its solution(s).
|
||||
;;
|
||||
;; The quality of the prose in your documentation will often reflect the quality of the code itself thus highlighting
|
||||
;; problem areas. The elimination of problem areas will solidify your code and its accompanying prose. Marginalia
|
||||
;; provides a virtuous circle spiraling inward toward maximal code quality.
|
||||
;;
|
||||
;; ## The one true way
|
||||
;;
|
||||
;; 1. Start by running Marginalia against your code
|
||||
;; 2. Cringe at the sad state of your code commentary
|
||||
;; 3. Add docstrings and code comments as appropriate
|
||||
;; 4. Generate the documentation again
|
||||
;; 5. Read the resulting documentation
|
||||
;; 6. Make changes to code and documentation so that the “dialog” flows sensibly
|
||||
;; 7. Repeat from step #4 until complete
|
||||
;;
|
||||
(ns marginalia.core
|
||||
"**Core** provides all of the functionality around parsing clojure source files
|
||||
into an easily consumable format."
|
||||
(:require [clojure.java.io :as io]
|
||||
[clojure.string :as str])
|
||||
(:use [marginalia.html :only (uberdoc-html)]
|
||||
[clojure.contrib.find-namespaces :only (read-file-ns-decl)])
|
||||
(:use [marginalia
|
||||
[html :only (uberdoc-html)]
|
||||
[parser :only (parse-file)]]
|
||||
[clojure.contrib
|
||||
[find-namespaces :only (read-file-ns-decl)]
|
||||
[command-line :only (print-help with-command-line)]])
|
||||
(:gen-class))
|
||||
|
||||
|
||||
(def *test* "./src/cljojo/core.clj")
|
||||
(def *docs* "docs")
|
||||
(def *comment* #"^\s*;;\s?")
|
||||
(def *divider-text* "\n;;DIVIDER\n")
|
||||
(def *divider-html* #"\n*<span class=\"c[1]?\">;;DIVIDER</span>\n*")
|
||||
(def ^{:dynamic true} *test* "src/marginalia/core.clj")
|
||||
(def ^{:dynamic true} *docs* "./docs")
|
||||
(def ^{:dynamic true} *comment* #"^\s*;;\s?")
|
||||
|
||||
;; ## File System Utilities
|
||||
|
||||
|
|
@ -53,13 +86,11 @@
|
|||
;; ## Project Info Parsing
|
||||
;; Marginalia will parse info out of your project.clj to display in
|
||||
;; the generated html file's header.
|
||||
;;
|
||||
;;  add pom.xml support.
|
||||
|
||||
|
||||
(defn parse-project-form
|
||||
"Pulls apart the seq of project information and assembles it into a map of
|
||||
the following form
|
||||
(defn parse-project-file
|
||||
"Parses a project.clj file and returns a map in the following form
|
||||
|
||||
{:name
|
||||
:version
|
||||
:dependencies
|
||||
|
|
@ -91,14 +122,6 @@
|
|||
|
||||
;; ## Source File Analysis
|
||||
|
||||
;; Marginalia will parse your code to extract doc strings for display in the
|
||||
;; generated html file.
|
||||
(defn parse [src]
|
||||
(for [line (line-seq src)]
|
||||
(if (re-find *comment* line)
|
||||
{:docs-text (str (str/replace line *comment* ""))}
|
||||
{:code-text (str line)})))
|
||||
|
||||
|
||||
(defn end-of-block? [cur-group groups lines]
|
||||
(let [line (first lines)
|
||||
|
|
@ -111,9 +134,15 @@
|
|||
|
||||
(defn merge-line [line m]
|
||||
(cond
|
||||
(:docstring-text line) (assoc m :docs (conj (get m :docs []) line))
|
||||
(:code-text line) (assoc m :codes (conj (get m :codes []) line))
|
||||
(:docs-text line) (assoc m :docs (conj (get m :docs []) line))))
|
||||
(:docstring-text line) (assoc m
|
||||
:docs
|
||||
(conj (get m :docs []) line))
|
||||
(:code-text line) (assoc m
|
||||
:codes
|
||||
(conj (get m :codes []) line))
|
||||
(:docs-text line) (assoc m
|
||||
:docs
|
||||
(conj (get m :docs []) line))))
|
||||
|
||||
(defn group-lines [doc-lines]
|
||||
(loop [cur-group {}
|
||||
|
|
@ -127,96 +156,12 @@
|
|||
|
||||
:else (recur (merge-line (first lines) cur-group) groups (rest lines)))))
|
||||
|
||||
;; Hacktastic, these ad-hoc checks should be replaced with something
|
||||
;; more robust.
|
||||
(defn docstring-line? [line sections]
|
||||
(let [l (last sections)
|
||||
last-code-text (get l :code-text "")]
|
||||
(try
|
||||
(or
|
||||
;; Last line contain defn &&
|
||||
;; last line not contain what looks like a param vector &&
|
||||
;; current line start with a quote
|
||||
(and (re-find #"\(defn" last-code-text)
|
||||
(not (re-find #"\[.*\]" last-code-text))
|
||||
(re-find #"^\"" (str/trim (str line))))
|
||||
;; Is the last line's code-text a deftask, and does the
|
||||
;; current line start with a quote?
|
||||
(and (re-find #"^\(deftask" (str/trim last-code-text))
|
||||
(re-find #"^\"" (str/trim (str line))))
|
||||
;; Is the last line's code-text the start of a ns
|
||||
;; decl, and does the current line start with a quote?
|
||||
(and (re-find #"^\(ns" last-code-text)
|
||||
(re-find #"^\"" (str/trim (str line))))
|
||||
;; Is the last line's code-text the start of a defprotocol,
|
||||
;; and does the current line start with a quote?
|
||||
(and (re-find #"^\(defprotocol" last-code-text)
|
||||
(re-find #"^\"" (str/trim (str line))))
|
||||
;; Is the last line's code-text the start of a defmulti,
|
||||
;; and does the current line start with a quote?
|
||||
(and (re-find #"^\(defmulti" last-code-text)
|
||||
(re-find #"^\"" (str/trim (str line))))
|
||||
;; Is the last line's code-text the start of a defmethod,
|
||||
;; and does the current line start with a quote?
|
||||
(and (re-find #"^\(defmethod" last-code-text)
|
||||
(re-find #"^\"" (str/trim (str line))))
|
||||
;; Is the last line's code-text the start of a defmacro,
|
||||
;; and does the current line start with a quote?
|
||||
(and (re-find #"^\(defmacro" last-code-text)
|
||||
(re-find #"^\"" (str/trim (str line))))
|
||||
;; Is the prev line a docstring, prev line not end with a quote,
|
||||
;; and the current line empty?
|
||||
(and (:docstring-text l)
|
||||
(not (re-find #"\"$" (str/trim (:docstring-text l)))))
|
||||
;; Is the prev line a docstring, the prev line not end with a quote,
|
||||
;; and the current line not an empty string?
|
||||
(and (:docstring-text l)
|
||||
(not (re-find #"[^\\]\"$" (str/trim (:docstring-text l))))
|
||||
(= "" (str/trim (str line)))))
|
||||
(catch Exception e nil))))
|
||||
|
||||
|
||||
(defn parse [src]
|
||||
(loop [[line & more] (line-seq src) cnum 1 dnum 0 sections []]
|
||||
(if line
|
||||
(if (re-find *comment* line)
|
||||
(recur more
|
||||
cnum
|
||||
(inc dnum)
|
||||
(conj sections {:docs-text (str (str/replace line *comment* "")) :line (+ cnum dnum)}))
|
||||
(recur more
|
||||
(inc cnum)
|
||||
0
|
||||
(if (docstring-line? (str line) sections)
|
||||
(conj sections {:docstring-text (str line) :line cnum})
|
||||
(conj sections {:code-text (str line) :line cnum}))))
|
||||
sections)))
|
||||
|
||||
|
||||
;; How is this handled?
|
||||
;; I wonder?
|
||||
;; No idea ne
|
||||
(defn gen-doc! [path]
|
||||
(println "Generating documentation for " path)
|
||||
(with-open [src (io/reader (io/file path))]
|
||||
(doseq [section (parse src)]
|
||||
;; and this?
|
||||
(println section))))
|
||||
|
||||
(defn gen-doc! [path]
|
||||
(with-open [src (io/reader (io/file path))]
|
||||
(parse src)))
|
||||
|
||||
(re-find *comment* " ;; this is a comment")
|
||||
|
||||
(defn path-to-doc [fn]
|
||||
(let [ns (-> (java.io.File. fn)
|
||||
(read-file-ns-decl)
|
||||
(second)
|
||||
(str))
|
||||
groups (->> fn
|
||||
(gen-doc!)
|
||||
(group-lines))]
|
||||
groups (parse-file fn)]
|
||||
{:ns ns
|
||||
:groups groups}))
|
||||
|
||||
|
|
@ -233,8 +178,7 @@
|
|||
- :version
|
||||
"
|
||||
[output-file-name files-to-analyze props]
|
||||
(spit output-file-name
|
||||
(uberdoc-html
|
||||
(let [source (uberdoc-html
|
||||
output-file-name
|
||||
(map path-to-doc files-to-analyze)
|
||||
props)))
|
||||
|
|
@ -270,27 +214,34 @@
|
|||
using the found source files and a project file expected to be in its default location.
|
||||
|
||||
If no source files are found, complain with a usage message."
|
||||
[sources]
|
||||
(let [sources (format-sources sources)]
|
||||
(if-not sources
|
||||
(do
|
||||
(println "Wrong number of arguments passed to marginalia.")
|
||||
(println "Please present paths to source files as follows:")
|
||||
(usage))
|
||||
(do
|
||||
(println "Generating uberdoc for the following source files:")
|
||||
(doseq [s sources]
|
||||
(println " " s))
|
||||
(println)
|
||||
(ensure-directory! "./docs")
|
||||
(uberdoc! "./docs/uberdoc.html" sources (parse-project-file))
|
||||
(println "Done generating your docs, please see ./docs/uberdoc.html")
|
||||
(println)))))
|
||||
[args]
|
||||
(with-command-line args
|
||||
(str "Leiningen plugin for running marginalia against your project.\n\n"
|
||||
"Usage: lein marg <options?> <src1> ... <src-n>\n")
|
||||
[[dir d "Directory into which the documentation will be written" "./docs"]
|
||||
[file f "File into which the documentation will be written" "uberdoc.html"]
|
||||
src]
|
||||
(let [sources (format-sources (seq src))]
|
||||
(if-not sources
|
||||
(do
|
||||
(println "Wrong number of arguments passed to marginalia.")
|
||||
(print-help))
|
||||
(binding [*docs* dir]
|
||||
(println "Generating uberdoc for the following source files:")
|
||||
(doseq [s sources]
|
||||
(println " " s))
|
||||
(println)
|
||||
(ensure-directory! *docs*)
|
||||
(uberdoc! (str *docs* "/" file) sources (parse-project-file))
|
||||
(println "Done generating your documentation, please see"
|
||||
(str *docs* "/" file))
|
||||
(println ""))))))
|
||||
|
||||
(defn -main
|
||||
"The main entry point into Marginalia."
|
||||
[& sources]
|
||||
(run-marginalia sources))
|
||||
(binding [marginalia.html/*resources* ""]
|
||||
(run-marginalia sources)))
|
||||
|
||||
|
||||
;; # Example Usage
|
||||
|
|
|
|||
|
|
@ -1,20 +1,11 @@
|
|||
(ns marginalia.html
|
||||
"# Utilities for converting parse results into html.
|
||||
## Plus a few other goodies.
|
||||
|
||||
Here's a random code block (println \"hi!\")
|
||||
|
||||
Like I said:
|
||||
|
||||
* utils for docs -> html
|
||||
* other goodies
|
||||
|
||||
hello world"
|
||||
"Utilities for converting parse results into html."
|
||||
(:use [hiccup.core :only (html escape-html)]
|
||||
[hiccup.page-helpers :only (doctype)])
|
||||
(:require [clojure.string :as str])
|
||||
(:import [com.petebevin.markdown MarkdownProcessor]))
|
||||
|
||||
(def ^{:dynamic true} *resources* "./resources/")
|
||||
|
||||
(defn css-rule [rule]
|
||||
(let [sels (reverse (rest (reverse rule)))
|
||||
|
|
@ -26,6 +17,7 @@
|
|||
"Quick and dirty dsl for inline css rules, similar to hiccup.
|
||||
|
||||
ex. `(css [:h1 {:color \"blue\"}] [:div.content p {:text-indent \"1em\"}])`
|
||||
|
||||
-> `h1 {color: blue;} div.content p {text-indent: 1em;}`"
|
||||
[& rules]
|
||||
(html [:style {:type "text/css"}
|
||||
|
|
@ -59,8 +51,13 @@
|
|||
(def mdp (com.petebevin.markdown.MarkdownProcessor.))
|
||||
|
||||
(defn md
|
||||
"Markdown string to html converter. Translates strings like \"# header!\"
|
||||
-> \"<h1>header!</h1>"
|
||||
"Markdown string to html converter. Translates strings like:
|
||||
|
||||
\"# header!\" -> `\"<h1>header!</h1>\"`
|
||||
|
||||
\"## header!\" -> `\"<h2>header!</h2>\"`
|
||||
|
||||
..."
|
||||
[s]
|
||||
(.markdown mdp s))
|
||||
|
||||
|
|
@ -68,13 +65,14 @@
|
|||
"Inserts super-fancy characters into the doc section."
|
||||
[s]
|
||||
(-> s
|
||||
(str/replace #"->" "→")
|
||||
(str/replace #"->" "→")
|
||||
(str/replace #""" "\"")))
|
||||
|
||||
;; As a result of docifying then grouping, you'll end up with a seq like this one:
|
||||
;;
|
||||
;; [{:docs [{:docs-text "Some doc text"}]
|
||||
;; :codes [{:code-text "(def something \"hi\")"}]}]
|
||||
;; <pre><code>[...
|
||||
;; {:docs [{:docs-text "Some doc text"}]
|
||||
;; :codes [{:code-text "(def something \"hi\")"}]}
|
||||
;; ...]</code></pre>
|
||||
;;
|
||||
;; `docs-to-html` and `codes-to-html` convert their respective entries into html,
|
||||
;; and `group-to-html` calls them on each seq item to do so.
|
||||
|
|
@ -98,33 +96,29 @@
|
|||
"Converts a docs section to html by threading each doc line through the forms
|
||||
outlined above.
|
||||
|
||||
ex. `(docs-to-html [{:doc-text \"#hello world!\"} {:docstring-text \"I'm a docstring!}])
|
||||
-> \"<h1>hello world!</h1><br />\"`
|
||||
ex. (docs-to-html [{:doc-text \"# hello world!\"} {:docstring-text \"I'm a docstring!}])
|
||||
|
||||
-> `\"<h1>hello world!</h1><br />\"`
|
||||
"
|
||||
[docs]
|
||||
(->> docs
|
||||
(map #(if (:docs-text %)
|
||||
(prep-docs-text (:docs-text %))
|
||||
(prep-docstring-text (:docstring-text %))))
|
||||
(map replace-special-chars)
|
||||
(interpose "\n")
|
||||
(apply str)
|
||||
(md)))
|
||||
(-> docs
|
||||
str
|
||||
prep-docs-text
|
||||
replace-special-chars
|
||||
(md)))
|
||||
|
||||
(defn codes-to-html [code-block]
|
||||
(html [:pre {:class "brush: clojure"} code-block]))
|
||||
|
||||
(defn codes-to-html [codes]
|
||||
(html [:pre {:class "brush: clojure"}
|
||||
(->> codes
|
||||
(map :code-text)
|
||||
(map escape-html)
|
||||
(interpose "\n")
|
||||
(apply str))]))
|
||||
|
||||
(defn group-to-html [group]
|
||||
(html
|
||||
[:tr
|
||||
[:td {:class "docs"} (docs-to-html (:docs group))]
|
||||
[:td {:class "codes"} (codes-to-html (:codes group))]]))
|
||||
(defn section-to-html [section]
|
||||
(html [:tr
|
||||
[:td {:class "docs"} (docs-to-html
|
||||
(if (= (:type section) :comment)
|
||||
(:raw section)
|
||||
(:docstring section)))]
|
||||
[:td {:class "codes"}] (if (= (:type section) :code)
|
||||
(codes-to-html (:raw section))
|
||||
"")]))
|
||||
|
||||
(defn dependencies-html [deps & header-name]
|
||||
(let [header-name (or header-name "dependencies")]
|
||||
|
|
@ -170,7 +164,7 @@
|
|||
(when css
|
||||
(map #(vector :link {:tyle "text/css" :rel "stylesheet" :href %}) css))))))
|
||||
|
||||
;; Is <h1/> overloaded? Maybe we should consider redistributing
|
||||
;; Is <h1/> overloaded? Maybe we should consider redistributing
|
||||
;; header numbers instead of adding classes to all the h1 tags.
|
||||
(defn header-html [project-info]
|
||||
(html
|
||||
|
|
@ -221,7 +215,7 @@
|
|||
[:a {:href "#toc" :class "toc-link"}
|
||||
"toc"]]]]
|
||||
[:td {:class "codes"}]]
|
||||
(map group-to-html (:groups doc))
|
||||
(map section-to-html (:groups doc))
|
||||
[:tr
|
||||
[:td {:class "spacer docs"} " "]
|
||||
[:td {:class "codes"}]]))
|
||||
|
|
@ -358,16 +352,16 @@
|
|||
[:head
|
||||
[:meta {:http-equiv "Content-Type" :content "text/html" :charset "utf-8"}]
|
||||
[:meta {:name "description" :content (:description project-metadata)}]
|
||||
(inline-js "jquery-1.4.4.min.js")
|
||||
(inline-js "xregexp-min.js")
|
||||
(inline-js "shCore.js")
|
||||
(inline-js "shBrushClojure.js")
|
||||
(inline-js "app.js")
|
||||
(inline-js (str *resources* "jquery-1.4.4.min.js"))
|
||||
(inline-js (str *resources* "xregexp-min.js"))
|
||||
(inline-js (str *resources* "shCore.js"))
|
||||
(inline-js (str *resources* "shBrushClojure.js"))
|
||||
(inline-js (str *resources* "app.js"))
|
||||
#_[:script {:type "text/javascript" :src "./../resources/app.js"}]
|
||||
(inline-css "shCore.css")
|
||||
(inline-css (str *resources* "shCore.css"))
|
||||
(css
|
||||
[:.syntaxhighlighter {:overflow "hidden !important"}])
|
||||
(inline-css "shThemeEclipse.css")
|
||||
(inline-css (str *resources* "shThemeEclipse.css"))
|
||||
reset-css
|
||||
header-css
|
||||
floating-toc-css
|
||||
|
|
|
|||
233
src/marginalia/parser.clj
Normal file
233
src/marginalia/parser.clj
Normal file
|
|
@ -0,0 +1,233 @@
|
|||
;; This file contains the complete Marginalia parser.
|
||||
;; It leverages the Clojure reader instead of implementing a complete
|
||||
;; Clojure parsing solution.
|
||||
(ns marginalia.parser
|
||||
"Provides the parsing facilities for Marginalia."
|
||||
(:refer-clojure :exclude [replace])
|
||||
(:use [clojure.contrib [reflect :only (get-field)]]
|
||||
[clojure [string :only (join replace)]]))
|
||||
|
||||
(defrecord Comment [content])
|
||||
|
||||
(defmethod print-method Comment [comment ^String out]
|
||||
(.write out (str \" (.content comment) \")))
|
||||
|
||||
(def top-level-comments (atom []))
|
||||
(def sub-level-comments (atom []))
|
||||
|
||||
(def *comments* nil)
|
||||
|
||||
(defn read-comment [reader semicolon]
|
||||
(let [sb (StringBuilder.)]
|
||||
(.append sb semicolon)
|
||||
(loop [c (.read reader)]
|
||||
(let [ch (char c)]
|
||||
(if (or (= ch \newline)
|
||||
(= ch \return))
|
||||
(let [line (dec (.getLineNumber reader))]
|
||||
(swap! *comments* conj
|
||||
{:form (Comment. (.toString sb))
|
||||
:start line
|
||||
:end line})
|
||||
reader)
|
||||
(do
|
||||
(.append sb (Character/toString ch))
|
||||
(recur (.read reader))))))))
|
||||
|
||||
(defn set-comment-reader [reader]
|
||||
(aset (get-field clojure.lang.LispReader :macros nil)
|
||||
(int \;)
|
||||
reader))
|
||||
|
||||
(defn skip-spaces-and-comments [rdr]
|
||||
(loop [c (.read rdr)]
|
||||
(cond (= c -1) nil
|
||||
(= (char c) \;)
|
||||
(do (read-comment rdr \;)
|
||||
(recur (.read rdr)))
|
||||
(#{\space \tab \return \newline \,} (char c))
|
||||
(recur (.read rdr))
|
||||
:else (.unread rdr c))))
|
||||
|
||||
(defn parse* [reader]
|
||||
(take-while
|
||||
:form
|
||||
(flatten
|
||||
(repeatedly
|
||||
(fn []
|
||||
(binding [*comments* top-level-comments]
|
||||
(skip-spaces-and-comments reader))
|
||||
(let [start (.getLineNumber reader)
|
||||
form (binding [*comments* sub-level-comments]
|
||||
(. clojure.lang.LispReader
|
||||
(read reader false nil false)))
|
||||
end (.getLineNumber reader)
|
||||
code {:form form :start start :end end}
|
||||
comments @top-level-comments]
|
||||
(swap! top-level-comments (constantly []))
|
||||
(if (empty? comments)
|
||||
[code]
|
||||
(vec (concat comments [code])))))))))
|
||||
|
||||
(defn strip-docstring [docstring raw]
|
||||
(-> raw
|
||||
(replace (str \" (-> docstring
|
||||
str
|
||||
(replace "\"" "\\\""))
|
||||
\")
|
||||
"")
|
||||
(replace #"\n\s*\n" "\n")
|
||||
(replace #"\n\s*\)" ")")))
|
||||
|
||||
(defn get-var-docstring [nspace-sym sym]
|
||||
(try
|
||||
(-> `(var ~(symbol (str nspace-sym) (str sym))) eval meta :doc)
|
||||
;; HACK: to handle types
|
||||
(catch Exception _)))
|
||||
|
||||
(defmulti dispatch-form (fn [form _ _] (first form)))
|
||||
|
||||
(defn- extract-common-docstring
|
||||
[form raw nspace-sym]
|
||||
(let [sym (second form)
|
||||
_ (if (= 'ns (first form))
|
||||
(try (require sym)
|
||||
(catch Exception _)))
|
||||
nspace (find-ns sym)]
|
||||
(let [docstring (if nspace
|
||||
(-> nspace meta :doc)
|
||||
(get-var-docstring nspace-sym sym))]
|
||||
[docstring
|
||||
(strip-docstring docstring raw)
|
||||
(if nspace sym nspace-sym)])))
|
||||
|
||||
(defmethod dispatch-form 'ns
|
||||
[form raw nspace-sym]
|
||||
(let [[ds r s] (extract-common-docstring form raw nspace-sym)]
|
||||
(let [[_ _ ds & _] form
|
||||
ds (when (string? ds) ds)]
|
||||
[ds
|
||||
(strip-docstring ds r)
|
||||
s])))
|
||||
|
||||
(defmethod dispatch-form 'def
|
||||
[form raw nspace-sym]
|
||||
(extract-common-docstring form raw nspace-sym))
|
||||
|
||||
(defmethod dispatch-form 'defn
|
||||
[form raw nspace-sym]
|
||||
(extract-common-docstring form raw nspace-sym))
|
||||
|
||||
(defmethod dispatch-form 'defprotocol
|
||||
[form raw nspace-sym]
|
||||
;; this needs some work to extract embedded docstrings
|
||||
(extract-common-docstring form raw nspace-sym))
|
||||
|
||||
(defmethod dispatch-form 'defmulti
|
||||
[form raw nspace-sym]
|
||||
(extract-common-docstring form raw nspace-sym))
|
||||
|
||||
(defmethod dispatch-form 'defmethod
|
||||
[form raw nspace-sym]
|
||||
(let [ds (nth form 3)
|
||||
docstring (when (string? ds) ds)]
|
||||
[docstring
|
||||
(strip-docstring docstring raw)
|
||||
nspace-sym]))
|
||||
|
||||
(defmethod dispatch-form :default
|
||||
[form raw nspace-sym]
|
||||
(if (re-find #"^def" (-> form first name))
|
||||
(extract-common-docstring form raw nspace-sym)
|
||||
[nil raw nspace-sym]))
|
||||
|
||||
(defn extract-docstring [m raw nspace-sym]
|
||||
(let [raw (join "\n" (subvec raw (-> m :start dec) (:end m)))
|
||||
form (:form m)]
|
||||
(dispatch-form form raw nspace-sym)))
|
||||
|
||||
(defn- ->str [m]
|
||||
(replace (-> m :form .content) #"^;+\s*" ""))
|
||||
|
||||
(defn merge-comments [f s]
|
||||
{:form (Comment. (str (->str f) "\n" (->str s)))
|
||||
:start (:start f)
|
||||
:end (:end s)})
|
||||
|
||||
(defn comment? [o]
|
||||
(->> o :form (instance? Comment)))
|
||||
|
||||
(defn code? [o]
|
||||
(and (->> o :form (instance? Comment) not)
|
||||
(->> o :form nil? not)))
|
||||
|
||||
(defn adjacent? [f s]
|
||||
(= (-> f :end) (-> s :start dec)))
|
||||
|
||||
(defn arrange-in-sections [parsed-code raw-code]
|
||||
(loop [sections []
|
||||
f (first parsed-code)
|
||||
s (second parsed-code)
|
||||
nn (nnext parsed-code)
|
||||
nspace nil]
|
||||
(if f
|
||||
(cond
|
||||
;; ignore comments with only one semicolon
|
||||
(and (comment? f) (re-find #"^;\s" (-> f :form .content)))
|
||||
(recur sections s (first nn) (next nn) nspace)
|
||||
;; merging comments block
|
||||
(and (comment? f) (comment? s) (adjacent? f s))
|
||||
(recur sections (merge-comments f s)
|
||||
(first nn) (next nn)
|
||||
nspace)
|
||||
;; merging adjacent code blocks
|
||||
(and (code? f) (code? s) (adjacent? f s))
|
||||
(let [[fdoc fcode nspace] (extract-docstring f raw-code nspace)
|
||||
[sdoc scode _] (extract-docstring s raw-code nspace)]
|
||||
(recur sections (assoc s
|
||||
:type :code
|
||||
:raw (str (or (:raw f) fcode) "\n" scode)
|
||||
:docstring (str (or (:docstring f) fdoc) "\n\n" sdoc))
|
||||
(first nn) (next nn) nspace))
|
||||
;; adjacent comments are added as extra documentation to code block
|
||||
(and (comment? f) (code? s) (adjacent? f s))
|
||||
(let [[doc code nspace] (extract-docstring s raw-code nspace)]
|
||||
(recur sections (assoc s
|
||||
:type :code
|
||||
:raw code
|
||||
:docstring (str doc "\n\n" (->str f)))
|
||||
(first nn) (next nn) nspace))
|
||||
;; adding comment section
|
||||
(comment? f)
|
||||
(recur (conj sections (assoc f :type :comment :raw (->str f)))
|
||||
s
|
||||
(first nn) (next nn)
|
||||
nspace)
|
||||
;; adding code section
|
||||
:else
|
||||
(let [[doc code nspace] (extract-docstring f raw-code nspace)]
|
||||
(recur (conj sections (if (= (:type f) :code)
|
||||
f
|
||||
{:type :code
|
||||
:raw code
|
||||
:docstring doc}))
|
||||
s (first nn) (next nn) nspace)))
|
||||
sections)))
|
||||
|
||||
(defn parse [source-string]
|
||||
(let [make-reader #(java.io.BufferedReader.
|
||||
(java.io.StringReader. (str source-string "\n")))
|
||||
lines (vec (line-seq (make-reader)))
|
||||
reader (clojure.lang.LineNumberingPushbackReader. (make-reader))
|
||||
old-cmt-rdr (aget (get-field clojure.lang.LispReader :macros nil) (int \;))]
|
||||
(try
|
||||
(set-comment-reader read-comment)
|
||||
(let [parsed-code (-> reader parse* doall)]
|
||||
(set-comment-reader old-cmt-rdr)
|
||||
(arrange-in-sections parsed-code lines))
|
||||
(catch Exception e
|
||||
(set-comment-reader old-cmt-rdr)
|
||||
(throw e)))))
|
||||
|
||||
(defn parse-file [file]
|
||||
(parse (slurp file)))
|
||||
|
|
@ -6,7 +6,7 @@
|
|||
;; Should have only this comment in the left margin.
|
||||
;; See [https://github.com/fogus/marginalia/issues/#issue/4](https://github.com/fogus/marginalia/issues/#issue/4)
|
||||
|
||||
(defn parse-bool [v] (condp = (.trim (text v))
|
||||
(defn parse-bool [v] (condp = (.trim (str v))
|
||||
"0" false
|
||||
"1" true
|
||||
"throw exception here"))
|
||||
|
|
@ -21,10 +21,17 @@
|
|||
"Here is just a string. It should be to the right."
|
||||
(* x x))
|
||||
|
||||
(defmacro foobar
|
||||
"This is a macro docstring. It should be on the left."
|
||||
[& body]
|
||||
`~body)
|
||||
(defprotocol Relation
|
||||
(select [this predicate]
|
||||
"Confines the query to rows for which the predicate is true
|
||||
|
||||
Ex. (select (table :users) (where (= :id 5)))")
|
||||
(join [this table2 join_on]
|
||||
"Joins two tables on join_on
|
||||
|
||||
Ex. (join (table :one) (table :two) :id)
|
||||
(join (table :one) (table :two)
|
||||
(where (= :one.col :two.col)))"))
|
||||
|
||||
(defmulti bazfoo
|
||||
"This is a defmulti docstring, it should also be on the left"
|
||||
|
|
@ -59,15 +66,23 @@
|
|||
|
||||
; Define single-character indicator rules.
|
||||
; I use `clojure.template/do-template` to reduce repetition.
|
||||
(do-template [rule-name token]
|
||||
(h/defrule rule-name
|
||||
"Padded on the front with optional whitespace."
|
||||
(h/lit token))
|
||||
<escape-char-start> \\
|
||||
<str-delimiter> \"
|
||||
<value-separator> \,
|
||||
<name-separator> \:
|
||||
<array-start> \[
|
||||
<array-end> \]
|
||||
<object-start> \{
|
||||
<object-end> \})
|
||||
(comment
|
||||
(do-template [rule-name token]
|
||||
(h/defrule rule-name
|
||||
"Padded on the front with optional whitespace."
|
||||
(h/lit token))
|
||||
<escape-char-start> \\
|
||||
<str-delimiter> \"
|
||||
<value-separator> \,
|
||||
<name-separator> \:
|
||||
<array-start> \[
|
||||
<array-end> \]
|
||||
<object-start> \{
|
||||
<object-end> \}))
|
||||
|
||||
(defmulti kompile identity)
|
||||
|
||||
(defmethod kompile [::standard AutoIncClause]
|
||||
"This is a docstring. On the left."
|
||||
[_]
|
||||
"GENERATED ALWAYS AS IDENTITY")
|
||||
|
|
|
|||
Loading…
Reference in a new issue