dependencies| org.clojure/clojure |
| 1.2.0 | | org.clojure/clojure-contrib |
| 1.2.0 | | hiccup |
| 0.3.7 | | org.markdownj/markdownj |
| 0.3.0-1.0.2b4 |
dev dependencies| lein-clojars |
| 0.6.0 | | lein-marginalia |
| 0.6.0 | | jline |
| 0.9.94 | | org.clojars.autre/lein-vimclojure |
| 1.0.0 | | swank-clojure |
| 1.2.1 | | marginalia |
| 0.7.0-SNAPSHOT | | lein-marginalia |
| 0.6.1 |
|
(this space intentionally left almost blank) |
| |
| |
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
- Start by running Marginalia against your code
- Cringe at the sad state of your code commentary
- Add docstrings and code comments as appropriate
- Generate the documentation again
- Read the resulting documentation
- Make changes to code and documentation so that the “dialog” flows sensibly
- Repeat from step #4 until complete
| | (ns marginalia.core
(:require [clojure.java.io :as io]
[clojure.string :as str])
(:use [marginalia
[html :only (uberdoc-html index-html single-page-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 ^{:dynamic true} *test* "src/marginalia/core.clj")
(def ^{:dynamic true} *docs* "./docs")
(def ^{:dynamic true} *comment* #"^\s*;;\s?")
File System Utilities
| |
Performs roughly the same task as the UNIX ls. That is, returns a seq of the filenames
at a given directory. If a path to a file is supplied, then the seq contains only the
original path given.
| | (defn ls
[path]
(let [file (java.io.File. path)]
(if (.isDirectory file)
(seq (.list file))
(when (.exists file)
[path]))))
|
| | (defn mkdir [path]
(.mkdirs (io/file path)))
Ensure that the directory specified by path exists. If not then make it so.
Here is a snowman ☃
| | (defn ensure-directory!
[path]
(when-not (ls path)
(mkdir path)))
Many Marginalia fns use dir? to recursively search a filepath.
| | (defn dir?
[path]
(.isDirectory (java.io.File. path)))
Returns a seq of clojure file paths (strings) in alphabetical order.
| | (defn find-clojure-file-paths
[dir]
(->> (io/file dir)
(file-seq)
(filter #(re-find #"\.clj$" (.getAbsolutePath %)))
(map #(.getAbsolutePath %))
(sort)))
Project Info Parsing
Marginalia will parse info out of your project.clj to display in
the generated html file's header.
| |
Parses a project.clj file and returns a map in the following form
{:name
:version
:dependencies
:dev-dependencies
etc...}
by merging into the name and version information the rest of the defproject
forms (:dependencies, etc)
| | (defn parse-project-form
[[_ project-name version-number & attributes]]
(merge {:name (str project-name)
:version version-number}
(apply hash-map attributes)))
Parses a project file -- './project.clj' by default -- and returns a map
assembled according to the logic in parse-project-form.
| | (defn parse-project-file
([] (parse-project-file "./project.clj"))
([path]
(try
(let [rdr (clojure.lang.LineNumberingPushbackReader.
(java.io.FileReader.
(java.io.File. path)))]
(parse-project-form (read rdr)))
(catch Exception e
(throw (Exception.
(str
"There was a problem reading the project definition from "
path)))))))
Source File Analysis
| |
|
| | (defn end-of-block? [cur-group groups lines]
(let [line (first lines)
next-line (second lines)
next-line-code (get next-line :code-text )]
(when (or (and (:code-text line)
(:docs-text next-line))
(re-find #"^\(def" (str/trim next-line-code)))
true)))
|
| | (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))))
|
| | (defn group-lines [doc-lines]
(loop [cur-group {}
groups []
lines doc-lines]
(cond
(empty? lines) (conj groups cur-group)
(end-of-block? cur-group groups lines)
(recur (merge-line (first lines) {}) (conj groups cur-group) (rest lines))
:else (recur (merge-line (first lines) cur-group) groups (rest lines)))))
|
| | (defn path-to-doc [fn]
(let [ns (-> (java.io.File. fn)
(read-file-ns-decl)
(second)
(str))
groups (parse-file fn)]
{:ns ns
:groups groups}))
Ouput Generation
| |
|
| | (defn filename-contents
[props output-dir all-files parsed-file]
{:name (io/file output-dir (str (:ns parsed-file) ".html"))
:contents (single-page-html props parsed-file all-files)})
|
| | (defn multidoc!
[output-dir files-to-analyze props]
(let [parsed-files (map path-to-doc files-to-analyze)
index (index-html props parsed-files)
pages (map #(filename-contents props output-dir parsed-files %) parsed-files)]
(doseq [f (conj pages {:name (io/file output-dir "toc.html")
:contents index})]
(spit (:name f) (:contents f)))))
Generates an uberdoc html file from 3 pieces of information:
- The path to spit the result (
output-file-name)
- Results from processing source files (
path-to-doc)
- Project metadata as a map, containing at a minimum the following:
| | (defn uberdoc!
[output-file-name files-to-analyze props]
(let [source (uberdoc-html
props
(map path-to-doc files-to-analyze))]
(spit output-file-name source)))
External Interface (command-line, lein, cake, etc)
| |
These functions support Marginalia's use by client software or command-line
users.
| |
Given a collection of filepaths, returns a lazy sequence of filepaths to
all .clj files on those paths: directory paths will be searched recursively
for .clj files.
| | (defn format-sources
[sources]
(if (nil? sources)
(find-clojure-file-paths "./src")
(->> sources
(map #(if (dir? %)
(find-clojure-file-paths %)
[%]))
(flatten))))
|
| | (defn usage []
(println "marginalia <src1> ... <src-n>"))
|
| | (defn split-deps [deps]
(when deps
(for [d (.split deps ";")
:let [[group artifact version] (.split d ":")]]
[(if (= group artifact) artifact (str group "/" artifact))
version])))
Default generation: given a collection of filepaths in a project, find the .clj
files at these paths and, if Clojure source files are found:
- Print out a message to std out letting a user know which files are to be processed;
- Create the docs directory inside the project folder if it doesn't already exist;
Call the uberdoc! function to generate the output file at its default location,
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.
| | (defn run-marginalia
[args & [project]]
(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"]
[name n "Project name - if not given will be taken from project.clj"]
[version v "Project version - if not given will be taken from project.clj"]
[desc D "Project description - if not given will be taken from project.clj"]
[deps a "Project dependencies in the form <group1>:<artifact1>:<version1>;<group2>...
If not given will be taken from project.clj"]
[css c "Additional css resources <resource1>;<resource2>;...
If not given will be taken from project.clj."]
[js j "Additional javascript resources <resource1>;<resource2>;...
If not given will be taken from project.clj"]
src]
(let [sources (format-sources (seq src))]
(if-not sources
(do
(println "Wrong number of arguments passed to marginalia.")
(print-help))
(binding [*docs* dir]
(let [project-clj (or project
(when (.exists (io/file "project.clj"))
(parse-project-file)))
choose #(or %1 %2)
marg-opts (merge-with choose
{:css (when css (.split css ";"))
:javascript (when js (.split js ";"))}
(:marginalia project-clj))
opts (merge-with choose
{:name name
:version version
:description desc
:dependencies (split-deps deps)
:marginalia marg-opts}
project-clj)]
(println "Generating uberdoc for the following source files:")
(doseq [s sources]
(println " " s))
(println)
(ensure-directory! *docs*)
(uberdoc! (str *docs* "/" file) sources opts)
(println "Done generating your documentation, please see"
(str *docs* "/" file))
(println "")))))))
The main entry point into Marginalia.
| | (defn -main
[& sources]
(binding [marginalia.html/*resources* ""]
(run-marginalia sources)))
Example Usage
| | (comment
;; Command line example
(-main "./src/marginalia/core.clj" "./src/marginalia/html.clj")
;; This will find all marginalia source files, and then generate an uberdoc.
(apply -main (find-clojure-file-paths "./src"))
;; Move these to tests
(merge-line {:docstring-text "hello world" :line 3} {:docs ["stuff"]})
(merge-line {:code-text "(defn asdf" :line 4} {:docs ["stuff"]})
(merge-line {:docs-text "There's only one method in this module", :line 4} {})
)
| | |
| |
Utilities for converting parse results into html.
| | (ns marginalia.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)))
props (last rule)]
(str (apply str (interpose " " (map name sels)))
"{" (apply str (map #(str (name (key %)) ":" (val %) ";") props)) "}")))
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;}
| | (defn css
[& rules]
(html [:style {:type "text/css"}
(apply str (map css-rule rules))]))
Stolen from leiningen
| | (defn slurp-resource
[resource-name]
(try
(-> (.getContextClassLoader (Thread/currentThread))
(.getResourceAsStream resource-name)
(java.io.InputStreamReader.)
(slurp))
(catch java.lang.NullPointerException npe
(println (str "Could not locate resources at " resource-name))
(println " ... attempting to fix.")
(let [resource-name (str "./resources/" resource-name)]
(try
(-> (.getContextClassLoader (Thread/currentThread))
(.getResourceAsStream resource-name)
(java.io.InputStreamReader.)
(slurp))
(catch java.lang.NullPointerException npe
(println (str " STILL could not locate resources at " resource-name ". Giving up!"))))))))
|
| | (defn inline-js [resource]
(let [src (slurp-resource resource)]
(html [:script {:type "text/javascript"}
src])))
|
| | (defn inline-css [resource]
(let [src (slurp-resource resource)]
(html [:style {:type "text/css"}
(slurp-resource resource)])))
The following functions handle preparation of doc text (both comment and docstring
based) for display through html & css.
| |
Markdown processor.
| | (def mdp (com.petebevin.markdown.MarkdownProcessor.))
Markdown string to html converter. Translates strings like:
"# header!" -> "<h1>header!</h1>"
"## header!" -> "<h2>header!</h2>"
...
| | (defn md
[s]
(.markdown mdp s))
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\")"}]}
...]
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.
| |
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 />"
| | (defn docs-to-html
[docs]
(-> docs
str
(md)))
|
| | (defn codes-to-html [code-block]
(html [:pre {:class "brush: clojure"}
(escape-html code-block)]))
|
| | (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]
(when-let [deps (seq deps)]
(let [header-name (or header-name "dependencies")]
(html [:div {:class "dependencies"}
[:h3 header-name]
[:table
(map #(html [:tr
[:td {:class "dep-name"} (str (first %))]
[:td {:class "dotted"} [:hr]]
[:td {:class "dep-version"} (second %)]])
deps)]]))))
Load Optional Resources
Use external Javascript and CSS in your documentation. For example:
To format Latex math equations, download the
MathJax Javascript library to the docs
directory and then add
:marginalia {:javascript ["mathjax/MathJax.js"]}
to project.clj. Below is a simple example of both inline and block
formatted equations.
When \(a \ne 0\), there are two solutions to \(ax^2 + bx + c = 0\) and they are
$$x = {-b \pm \sqrt{b^2-4ac} \over 2a}.$$
| |
Generate script and link tags for optional external javascript and css.
| | (defn opt-resources-html
[project-info]
(let [options (:marginalia project-info)
javascript (:javascript options)
css (:css options)]
(html (concat
(when javascript
(map #(vector :script {:type "text/javascript" :src %}) javascript))
(when css
(map #(vector :link {:tyle "text/css" :rel "stylesheet" :href %}) css))))))
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
[:tr
[:td {:class "docs"}
[:div {:class "header"}
[:h1 {:class "project-name"} (:name project-info)]
[:h2 {:class "project-version"} (:version project-info)]
[:br]
(md (:description project-info))]
(dependencies-html (:dependencies project-info))
(dependencies-html (:dev-dependencies project-info) "dev dependencies")]
[:td {:class "codes"
:style "text-align: center; vertical-align: middle;color: #666;padding-right:20px"}
[:br]
[:br]
[:br]
"(this space intentionally left almost blank)"]]))
Creates an 'a' tag pointing to the namespace-name, either as an anchor (if
anchor? is true) or as a link to a separate $namespace-name.html file.
If attrs aren't empty, they are added to the resulting tag.
| | (defn link-to-namespace
[namespace-name anchor? & attrs]
[:a (into {:href (if anchor?
(str "#" namespace-name)
(str namespace-name ".html"))}
attrs)
namespace-name])
This is a hack, as in the case when anchor? is false, the link will contain
a reference to toc.html which might not even exist.
| | (defn link-to-toc
[anchor?]
(link-to-namespace "toc" anchor? {:class "toc-link"}))
|
| | (defn toc-html [props docs]
(html
[:tr
[:td {:class "docs"}
[:div {:class "toc"}
[:a {:name "toc"} [:h3 "namespaces"]]
[:ul
(map #(vector :li (link-to-namespace (:ns %) (:uberdoc? props)))
docs)]]]
[:td {:class "codes"} " "]]))
|
| | (defn floating-toc-html [docs]
[:div {:id "floating-toc"}
[:ul
(map #(vector :li {:class "floating-toc-li"
:id (str "floating-toc_" (:ns %))}
(:ns %))
docs)]])
|
| | (defn groups-html [props doc]
(html
[:tr
[:td {:class "docs"}
[:div {:class "docs-header"}
[:a {:class "anchor" :name (:ns doc) :href (str "#" (:ns doc))}
[:h1 {:class "project-name"}
(:ns doc)]
(link-to-toc (:uberdoc? props))]]]
[:td {:class "codes"}]]
(map section-to-html (:groups doc))
[:tr
[:td {:class "spacer docs"} " "]
[:td {:class "codes"}]]))
|
| | (def reset-css
(css [:html {:margin 0 :padding 0}]
[:h1 {:margin 0 :padding 0}]
[:h2 {:margin 0 :padding 0}]
[:h3 {:margin 0 :padding 0}]
[:h4 {:margin 0 :padding 0}]
[:a {:color "#261A3B"}]
[:a:visited {:color "#261A3B"}]))
|
| | (def header-css
(css [:.header {:margin-top "30px"}]
[:h1.project-name {:font-size "34px"
:display "inline"}]
[:h2.project-version {:font-size "18px"
:margin-top 0
:display "inline"
:margin-left "10px"}]
[:.toc-link {:font-size "12px"
:margin-left "10px"
:color "#252519"
:text-decoration "none"}]
[:.toc-link:hover {:color "#5050A6"}]
[:.toc :h1 {:font-size "34px"
:margin 0}]
[:.docs-header {:border-bottom "dotted #aaa 1px"
:padding-bottom "10px"
:margin-bottom "25px"}]
[:.toc :h1 {:font-size "24px"}]
[:.toc {:border-bottom "solid #bbb 1px"
:margin-bottom "40px"}]
[:.toc :ul {:margin-left "20px"
:padding-left "0px"
:padding-top 0
:margin-top 0}]
[:.toc :li {:list-style-type "none"
:padding-left 0}]
[:.dependencies {}]
[:.dependencies :table {:font-size "16px"
:width "99.99%"
:border "none"
:margin-left "20px"}]
[:.dependencies :td {:padding-right "20px;"
:white-space "nowrap"}]
[:.dependencies :.dotted {:width "99%"}]
[:.dependencies :.dotted :hr {:height 0
:noshade "noshade"
:color "transparent"
:background-color "transparent"
:border-bottom "dotted #bbb 1px"
:border-top "none"
:border-left "none"
:border-right "none"
:margin-bottom "-6px"}]
[:.dependencies :.dep-version {:text-align "right"}]
[:.plugins :ul {:margin-left "20px"
:padding-left "0px"
:padding-top 0
:margin-top 0}]
[:.plugins :li {:list-style-type "none"
:padding-left 0}]
[:.header :p {:margin-left "20px"}]))
|
| | (def floating-toc-css
(css [:#floating-toc {:position "fixed"
:top "10px"
:right "20px"
:height "20px"
:overflow "hidden"
:text-align "right"}]
[:#floating-toc :li {:list-style-type "none"
:margin 0
:padding 0}]))
|
| | (def general-css
(css
[:body {:margin 0
:padding 0
:font-family "'Palatino Linotype', 'Book Antiqua', Palatino, FreeSerif, serif;"
:font-size "16px"
:color "#252519"}]
[:h1 {:font-size "20px"
:margin-top 0}]
[:a.anchor {:text-decoration "none"
:color "#252519"}]
[:a.anchor:hover {:color "#5050A6"}]
[:table {:border-spacing 0
:border-bottom "solid #ddd 1px;"
:margin-bottom "10px"}]
[:code {:display "inline"}]
[:p {:margin-top "8px"}]
[:tr {:margin "0px"
:padding "0px"}]
[:td.docs {:width "410px"
:max-width "410px"
:vertical-align "top"
:margin "0px"
:padding-left "55px"
:padding-right "20px"
:border "none"}]
[:td.docs :pre {:font-size "12px"
:overflow "hidden"}]
[:td.codes {:width "55%"
:background-color "#F5F5FF"
:vertical-align "top"
:margin "0px"
:padding-left "20px"
:border "none"
:overflow "hidden"
:font-size "10pt"
:border-left "solid #E5E5EE 1px"}]
[:td.spacer {:padding-bottom "40px"}]
[:pre :code {:display "block"
:padding "4px"}]
[:code {:background-color "ghostWhite"
:border "solid #DEDEDE 1px"
:padding-left "3px"
:padding-right "3px"
:font-size "14px"}]
[:.syntaxhighlighter :code {:font-size "13px"}]
[:.footer {:text-align "center"}]))
Notice that we're inlining the css & javascript for SyntaxHighlighter (inline-js
& inline-css) to be able to package the output as a single file (uberdoc if you will). It goes without
saying that all this is WIP and will prabably change in the future.
| | (defn page-template
[project-metadata opt-resources header toc floating-toc content]
(html
(doctype :html5)
[:html
[:head
[:meta {:http-equiv "Content-Type" :content "text/html" :charset "utf-8"}]
[:meta {:name "description" :content (:description project-metadata)}]
#_[:script {:type "text/javascript" :src "./../resources/app.js"}]
(inline-css (str *resources* "shCore.css"))
(css
[:.syntaxhighlighter {:overflow "hidden !important"}])
(inline-css (str *resources* "shThemeEclipse.css"))
reset-css
header-css
floating-toc-css
general-css
(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"))
opt-resources
[:title (:name project-metadata) " -- Marginalia"]]
[:body
[:table
header
toc
content]
[:div {:class "footer"}
"Generated by "
[:a {:href "https://github.com/fogus/marginalia"} "Marginalia"]
". "
"Syntax highlighting provided by Alex Gorbatchev's "
[:a {:href "http://alexgorbatchev.com/SyntaxHighlighter/"}
"SyntaxHighlighter"]
floating-toc]
[:script {:type "text/javascript"}
"SyntaxHighlighter.defaults['gutter'] = false;
SyntaxHighlighter.all()"]]]))
Syntax highlighting is done a bit differently than docco. Instead of embedding
the higlighting metadata on the parse / html gen phase, we use SyntaxHighlighter
to do it in javascript.
| |
This generates a stand alone html file (think lein uberjar).
It's probably the only var consumers will use.
| | (defn uberdoc-html
[project-metadata docs]
(page-template
project-metadata
(opt-resources-html project-metadata)
(header-html project-metadata)
(toc-html {:uberdoc? true} docs)
(floating-toc-html docs)
(map #(groups-html {:uberdoc? true} %) docs)))
|
| | (defn index-html
[project-metadata docs]
(page-template
project-metadata
(opt-resources-html project-metadata)
(header-html project-metadata)
(toc-html {:uberdoc? false} docs)
;; no floating toc)) ;; no contents
no contents
| |
|
| | (defn single-page-html
[project-metadata doc all-docs]
(page-template
project-metadata
(opt-resources-html project-metadata)
;; no header
;; no toc
(floating-toc-html all-docs)
(groups-html {:uberdoc? false} doc)))
| | |
| |
Provides the parsing facilities for Marginalia.
This file contains the complete Marginalia parser.
It leverages the Clojure reader instead of implementing a complete
Clojure parsing solution.
| | (ns marginalia.parser
(:refer-clojure :exclude [replace])
(:use [clojure.contrib [reflect :only (get-field call-method)]]
[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))
|
| | (defrecord DoubleColonKeyword [content])
|
| | (defmethod print-method DoubleColonKeyword [dck ^java.io.Writer out]
(.write out (str \: (.content dck))))
|
| | (letfn [(read-token [reader c]
(call-method clojure.lang.LispReader :readToken
[java.io.PushbackReader Character/TYPE]
nil reader c))
(match-symbol [s]
(call-method clojure.lang.LispReader :matchSymbol
[String]
nil s))]
(defn read-keyword [reader colon]
(let [c (.read reader)]
(if (= \: c)
(-> (read-token reader c)
match-symbol
DoubleColonKeyword.)
(do (.unread reader c)
(-> (read-token reader colon)
match-symbol))))))
|
| | (defn set-keyword-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 #"#?\^\{\s*:doc\s*\}" )
(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 _ _]
(if (seq? form) (first form) form)))
|
| | (defn- extract-common-docstring
[form raw nspace-sym]
(let [sym (second form)]
(if (symbol? sym)
(do
(when (= 'ns (first form))
(try (require sym)
(catch Exception _)))
(let [nspace (find-ns sym)
docstring (if nspace
(-> nspace meta :doc)
(get-var-docstring nspace-sym sym))]
[docstring
(strip-docstring docstring raw)
(if nspace sym nspace-sym)]))
[nil raw nspace-sym])))
|
| | (defn- extract-impl-docstring
[fn-body]
(filter string? (rest fn-body)))
|
| | (defn- extract-internal-docstrings
[body]
(mapcat #(extract-impl-docstring %)
body))
|
| | (defmethod dispatch-form 'defprotocol
[form raw nspace-sym]
(let [[ds r s] (extract-common-docstring form raw nspace-sym)]
(let [internal-dses (if ds
(extract-internal-docstrings (nthnext form 3))
(extract-internal-docstrings (nthnext form 2)))]
(with-meta
[ds r s]
{:internal-docstrings internal-dses}))))
|
| | (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 'defn-
[form raw nspace-sym]
(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]
[nil raw nspace-sym])
|
| | (defn dispatch-inner-form
[form raw nspace-sym]
(conj
(reduce (fn [[adoc araw] inner-form]
(if (seq? inner-form)
(let [[d r] (dispatch-form inner-form
araw
nspace-sym)]
[(str adoc d) r])
[adoc araw]))
[nil raw]
form)
nspace-sym))
|
| | (defn- dispatch-literal
[form raw nspace-sym]
[nil raw])
|
| | (defmethod dispatch-form :default
[form raw nspace-sym]
;; Strings which are inlined into clojure files outside of forms are parsed
;; as `String` instances, while numbers - as `Number` subclasses.
(cond (or (string? form) (number? form) (keyword? form))
(dispatch-literal form raw nspace-sym)
(re-find #"^def" (-> form first name))
(extract-common-docstring form raw nspace-sym)
:else (dispatch-inner-form form 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)
(set-keyword-reader read-keyword)
(let [parsed-code (-> reader parse* doall)]
(set-comment-reader old-cmt-rdr)
(set-keyword-reader nil)
(arrange-in-sections parsed-code lines))
(catch Exception e
(set-comment-reader old-cmt-rdr)
(set-keyword-reader nil)
(throw e)))))
|
| | (defn parse-file [file]
(parse (slurp file)))
| | |