Marginalia

0.0.1-SNAPSHOT





(this space intentionally left almost blank)

namespaces

 

marginalia.core

toc

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 crystallize 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
  (:require
   [clojure.edn :as edn]
   [clojure.java.io :as io]
   [clojure.string  :as str]
   [clojure.tools.cli :as cli]
   [marginalia.html :as html]
   [marginalia.log :as log]
   [marginalia.parser :as parser])
  (:import
   (java.io File FileReader)))
(set! *warn-on-reflection* true)

What to use as the base directory. This is used in tests and is unlikely to be useful otherwise. Defaults to nil, which will result in the normal working directory being used.

(def ^:dynamic *working-directory*
  nil)

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 (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 (io/file path)))

Returns a string containing the files extension.

(defn- find-file-extension
  [^File file]
  (second (re-find #"\.([^.]+)$" (.getName file))))

Predicate. Returns true for "normal" files with a file extension which passes the provided predicate.

(defn- processable-file?
  [pred ^File file]
  (when (.isFile file)
    (-> file find-file-extension pred)))

Returns a seq of processable file paths (strings) in alphabetical order by namespace.

(defn find-processable-file-paths
  [dir pred]
  (->> (io/file dir)
       (file-seq)
       (filter (partial processable-file? pred))
       (sort-by parser/parse-ns)
       (map #(.getCanonicalPath ^File %))))

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.
                (FileReader.
                 (io/file path)))]
       (loop [line (read rdr)]
         (let [found-project? (= 'defproject (first line))]
           (if found-project?
             (parse-project-form line)
             (recur (read rdr))))))
     (catch Exception _
       (throw (Exception.
               (str
                "There was a problem reading the project definition from "
                path)))))))

Config dir

Marginalia will also look in .marginalia/config.edn for config

Where Marginalia keeps project-specific config

(def cfg-dir  ".marginalia")

Returns any config that could be read from the config file (c.f. cfg-dir).

(defn- config-from-file
  []
  (let [f (io/file *working-directory* cfg-dir "config.edn")]
    (if (.exists f)
      (try
        (edn/read-string (slurp f))
        (catch Exception e
          (log/error "Could not read config file: %s" (.getMessage e))
          {}))
      {})))

Output Generation

(defn- path-to-doc [filename]
  {:ns     (parser/parse-ns (io/file filename))
   :groups (parser/parse-file filename)})
(defn- filename-contents
  [props output-dir all-files parsed-file]
  {:name     (io/file output-dir (str (:ns parsed-file) ".html"))
   :contents (html/single-page-html props parsed-file all-files)})

Generate documentation for the given files-to-analyze, write the doc files to disk in the output-dir

(defn multidoc!
  [output-dir files-to-analyze props]
  (let [parsed-files (map path-to-doc files-to-analyze)
        index        (html/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:

  1. The path to spit the result (output-file-name)
  2. Results from processing source files (path-to-doc)
  3. Project metadata as a map, containing at a minimum the following:
    • :name
    • :version
(defn uberdoc!
  [output-file-name files-to-analyze props]
  (let [source (html/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.

(def ^:private file-extensions #{"clj" "cljs" "cljx" "cljc"})

Given a collection of filepaths, returns a lazy sequence of filepaths to all .clj, .cljs, .cljx, and .cljc files on those paths: directory paths will be searched recursively for files.

(defn format-sources
  [sources]
  (if (nil? sources)
    (find-processable-file-paths (.getAbsolutePath (io/file *working-directory* "src")) file-extensions)
    (->> sources
         (mapcat #(if (dir? %)
                    (find-processable-file-paths % file-extensions)
                    [(.getCanonicalPath (io/file %))])))))
(defn- split-deps [deps]
  (when deps
    (for [d (str/split deps #";")
          :let [[group artifact version] (str/split d #":")]]
      [(if (= group artifact) artifact (str group "/" artifact))
       version])))

Check if a source file is excluded from the generated documentation

(defn source-excluded?
  [source opts]
  (if-not (empty?
           (filter #(if (re-find (re-pattern %) source)
                      true
                      false)
                   (-> opts :marginalia :exclude)))
    true
    false))
(def ^:private cli-flags
  ;; If these are modified, update the README and the `select-keys` allowlist in `resolved-opts+sources` as well
  [["-d" "--dir"
    "Directory into which the documentation will be written" :default "./docs"]
   ["-f" "--file"
    "File into which the documentation will be written" :default "uberdoc.html"]
   ["-n" "--name"
    "Project name - if not given will be taken from project.clj"]
   ["-v" "--version"
    "Project version - if not given will be taken from project.clj"]
   ["-D" "--desc"
    "Project description - if not given will be taken from project.clj"]
   ["-a" "--deps"
    "Project dependencies in the form <group1>:<artifact1>:<version1>;<group2>...
                 If not given will be taken from project.clj"]
   ["-c" "--css"
    "Additional css resources <resource1>;<resource2>;...
                 If not given will be taken from project.clj."]
   ["-j" "--js"
    "Additional javascript resources <resource1>;<resource2>;...
                 If not given will be taken from project.clj"]
   ["-m" "--multi"
    "Generate each namespace documentation as a separate file" :flag true]
   ["-l" "--leiningen"
    "Generate the documentation for a Leiningen project file."]
   ["-e" "--exclude"
    "Exclude source file(s) from the document generation process <file1>;<file2>;...
                 If not given will be taken from project.clj"]
   ["-L" "--lift-inline-comments"
    "Lift ;; inline comments to the top of the enclosing form.
                 They will be treated as if they preceded the enclosing form." :flag true]
   ["-X" "--exclude-lifted-comments"
    "If ;; inline comments are being lifted into documentation
                 then also exclude them from the source code display." :flag true]])

Parse CLI args and incorporate them with additional options specified in project.clj and .marginalia/config.edn.

Displays a help message and returns nil if the CLI args are invalid, otherwise returns a tuple of [opts sources].

The precedence is CLI > config.edn > project.clj.

(defn resolved-opts+sources
  [args project]
  (let [[cli-config files help]       (apply cli/cli args cli-flags)
        choose                        #(or %1 %2)
        {:keys        [css
                       deps
                       desc
                       exclude
                       js]
         lein         :leiningen
         ;; The precedence is CLI args > config.edn > project.clj
         ;; CLI args and config.edn are handled here; project.clj is dealt with below
         :as          cli+edn-config} (merge-with choose cli-config (config-from-file))
        sources                       (cond->> (distinct (format-sources (seq files)))
                                        lein (cons lein))]
    (if-not sources
      (do (println "Wrong number of arguments passed to Marginalia.")
          (println help)
          nil)                          ; be explicit about needing to return `nil` here
      (let [project-clj      (or project
                                 (let [proj (io/file *working-directory* "project.clj")]
                                   (when (.exists proj)
                                     (parse-project-file (.getAbsolutePath proj)))))
            marg-opts        (merge-with choose
                                         {:css        (when css (str/split css #";"))
                                          :javascript (when js (str/split js #";"))
                                          :exclude    (when exclude (str/split exclude #";"))
                                          :leiningen  lein}
                                         (:marginalia project-clj))
            opts             (merge-with choose
                                         ;; Config from the CLI/EDN file that we can pass on transparently
                                         (select-keys cli+edn-config [:dir :file :name :version :multi :exclude
                                                                      :lift-inline-comments :exclude-lifted-comments])
                                         ;; Config from the CLI/EDN file with renames or processing
                                         {:description  desc
                                          :dependencies (split-deps deps)
                                          :marginalia   marg-opts}
                                         ;; project.clj has the lowest priority
                                         project-clj)
            included-sources (->> sources
                                  (filter #(not (source-excluded? % opts)))
                                  (into []))]
        [opts included-sources]))))

Default generation: given a collection of filepaths in a project, find the .clj files at these paths and, if Clojure source files are found:

  1. Print out a message to std out letting a user know which files are to be processed;
  2. Create the docs directory inside the project folder if it doesn't already exist;

  3. 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]]
  (let [[{:keys [dir file lift-inline-comments exclude-lifted-comments] :as opts}
         sources :as valid?] (resolved-opts+sources args project)]
    (when valid?
      (binding [parser/*lift-inline-comments*   lift-inline-comments
                parser/*delete-lifted-comments* exclude-lifted-comments]
        (println "Generating Marginalia documentation for the following source files:")
        (doseq [s sources]
          (println "  " s))
        (println)
        (ensure-directory! dir)
        (if (:multi opts)
          (multidoc! dir sources opts)
          (uberdoc! (str dir "/" file) sources opts))
        (println "Done generating your documentation in" dir)
        (println "")))))
 

marginalia.hiccup

toc

Library for rendering a tree of vectors into a string of HTML. Pre-compiles where possible for performance.

(ns marginalia.hiccup
  (:import
   [clojure.lang IPersistentVector ISeq]
   [java.net URI]))
(set! *warn-on-reflection* true)

Very similar to clojure.core/str, but uses name instead of str when possible:

``` (for [x [{:a 1 :b 2} :foo "bar"]] {:as-str (as-str x) :str (str x)}) ;; => ({:as-str "{:a 1, :b 2}" :str "{:a 1, :b 2}"}, {:as-str "foo" :str ":foo"}, {:as-str "bar" :str "bar"}) ```

(defn as-str
  ([] "")
  ([x] (if (instance? clojure.lang.Named x)
         (name x)
         (str x)))
  ([x & ys]
   ((fn [^StringBuilder sb more]
      (if more
        (recur (. sb  (append (as-str (first more)))) (next more))
        (str sb)))
    (new StringBuilder ^String (as-str x)) ys)))

TODO: where is this used? :O

(def ^:dynamic *html-mode* :xml)

Change special characters into HTML character entities.

(defn escape-html
  [text]
  (.. ^String (as-str text)
    (replace "&"  "&amp;")
    (replace "<"  "&lt;")
    (replace ">"  "&gt;")
    (replace "\"" "&quot;")))
(defn- xml-mode? []
  (= *html-mode* :xml))
(defn- end-tag []
  (if (xml-mode?) " />" ">"))
(defn- xml-attribute [attr-name value]
  (str " " (as-str attr-name) "=\ (escape-html value) "\))
(defn- render-attribute [[attr-name value]]
  (cond
    (true? value)
      (if (xml-mode?)
        (xml-attribute attr-name attr-name)
        (str " " (as-str attr-name)))
    (not value)
    :else
      (xml-attribute attr-name value)))
(defn- render-attr-map [attrs]
  (apply str
    (sort (map render-attribute attrs))))

Regular expression that parses a CSS-style id and class from a tag name.

(def ^{:doc  :private true}
  re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?")

A list of tags that need an explicit ending tag when rendered.

(def ^{:doc  :private true}
  container-tags
  #{"a" "b" "body" "canvas" "dd" "div" "dl" "dt" "em" "fieldset" "form" "h1" "h2" "h3"
    "h4" "h5" "h6" "head" "html" "i" "iframe" "label" "li" "ol" "option" "pre"
    "script" "span" "strong" "style" "table" "textarea" "ul"})

Ensure a tag vector is of the form [tag-name attrs content].

(defn- normalize-element
  [[tag & content]]
  (when (not (or (keyword? tag)
                 (symbol? tag)
                 (string? tag)))
    (throw (IllegalArgumentException. (str tag " is not a valid tag name."))))
  (let [[_ tag id klass] (re-matches re-tag (as-str tag))
        tag-attrs        {:id    id
                          :class (when klass (.replace ^String klass "." " "))}
        map-attrs        (first content)]
    (if (map? map-attrs)
      [tag (merge tag-attrs map-attrs) (next content)]
      [tag tag-attrs content])))

Turn a Clojure data type into a string of HTML.

(defmulti render-html
  {:private true}
  type)

Render an tag vector as a HTML element.

(defn- render-element
  [element]
  (let [[tag attrs content] (normalize-element element)]
    (if (or content (container-tags tag))
      (str "<" tag (render-attr-map attrs) ">"
           (render-html content)
           "</" tag ">")
      (str "<" tag (render-attr-map attrs) (end-tag)))))
(defmethod render-html IPersistentVector
  [element]
  (render-element element))
(defmethod render-html ISeq [coll]
  (apply str (map render-html coll)))
(defmethod render-html :default [x]
  (as-str x))

True if the expression has not been evaluated.

(defn- unevaluated?
  [expr]
  (or (symbol? expr)
      (and (seq? expr)
           (not= (first expr) `quote))))

Returns an unevaluated form that will render the supplied map as HTML attributes.

(defn compile-attr-map
  [attrs]
  (if (some unevaluated? (mapcat identity attrs))
    `(#'render-attr-map ~attrs)
    (render-attr-map attrs)))

Get the name of the supplied form.

(defn- form-name
  [form]
  (when (and (seq? form)
             (symbol? (first form)))
    (name (first form))))

Pre-compile certain standard forms, where possible.

(defmulti compile-form
  {:private true}
  form-name)
(defmethod compile-form "for"
  [[_ bindings body]]
  `(apply str (for ~bindings (html ~body))))
(defmethod compile-form "if"
  [[_ condition & body]]
  `(if ~condition ~@(for [x body] `(html ~x))))
(defmethod compile-form :default
  [expr]
  `(#'render-html ~expr))

True if x is not hinted to be the supplied type.

(defn- not-hint?
  [x the-type]
  (when-let [hint (-> x meta :tag)]
    (not (isa? (eval hint) the-type))))

True if x is hinted to be the supplied type.

(defn- hint?
  [x the-type]
  (when-let [hint (-> x meta :tag)]
    (isa? (eval hint) the-type)))

True if x is a literal value that can be rendered as-is.

(defn- literal?
  [x]
  (and (not (unevaluated? x))
       (or (not (or (vector? x) (map? x)))
           (every? literal? x))))

True if we can infer that x is not a map.

(defn- not-implicit-map?
  [x]
  (or (= (form-name x) "for")
      (not (unevaluated? x))
      (not-hint? x java.util.Map)))

Returns the compilation strategy to use for a given element.

(defn- element-compile-strategy
  [[tag attrs & _ :as element]]
  (cond
    (every? literal? element)
      ::all-literal                    ; e.g. [:span "foo"]
    (and (literal? tag) (map? attrs))
      ::literal-tag-and-attributes     ; e.g. [:span {} x]
    (and (literal? tag) (not-implicit-map? attrs))
      ::literal-tag-and-no-attributes  ; e.g. [:span ^String x]
    (literal? tag)
      ::literal-tag                    ; e.g. [:span x]
    :else
      ::default))                      ; e.g. [x]
(declare compile-html)

Returns an unevaluated form that will render the supplied vector as a HTML element.

(defmulti compile-element
  {:private true}
  element-compile-strategy)
(defmethod compile-element ::all-literal
  [element]
  (render-element (eval element)))
(defmethod compile-element ::literal-tag-and-attributes
  [[tag attrs & content]]
  (let [[tag attrs _] (normalize-element [tag attrs])]
    (if (or content (container-tags tag))
      `(str ~(str "<" tag) ~(compile-attr-map attrs) ">"
            ~@(compile-html content)
            ~(str "</" tag ">"))
      `(str "<" ~tag ~(compile-attr-map attrs) ~(end-tag)))))
(defmethod compile-element ::literal-tag-and-no-attributes
  [[tag & content]]
  (compile-element (apply vector tag {} content)))
(defmethod compile-element ::literal-tag
  [[tag attrs & content]]
  (let [[tag tag-attrs _] (normalize-element [tag])
        attrs-sym         (gensym "attrs")]
    `(let [~attrs-sym ~attrs]
       (if (map? ~attrs-sym)
         ~(if (or content (container-tags tag))
            `(str ~(str "<" tag)
                  (#'render-attr-map (merge ~tag-attrs ~attrs-sym)) ">"
                  ~@(compile-html content)
                  ~(str "</" tag ">"))
            `(str ~(str "<" tag)
                  (#'render-attr-map (merge ~tag-attrs ~attrs-sym))
                  ~(end-tag)))
         ~(if (or attrs (container-tags tag))
            `(str ~(str "<" tag (render-attr-map tag-attrs) ">")
                  ~@(compile-html (cons attrs-sym content))
                  ~(str "</" tag ">"))
            (str "<" tag (render-attr-map tag-attrs) (end-tag)))))))
(defmethod compile-element :default
  [element]
  `(#'render-element
     [~(first element)
      ~@(for [x (rest element)]
          (if (vector? x)
            (compile-element x)
            x))]))

Pre-compile data structures into HTML where possible.

(defn- compile-html
  [content]
  (doall (for [expr content]
           (cond
            (vector? expr) (compile-element expr)
            (literal? expr) expr
            (hint? expr String) expr
            (hint? expr Number) expr
            (seq? expr) (compile-form expr)
            :else `(#'render-html ~expr)))))

Collapse nested str expressions into one, where possible.

(defn- collapse-strs
  [expr]
  (if (seq? expr)
    (cons
     (first expr)
     (mapcat
      #(if (and (seq? %) (symbol? (first %)) (= (first %) (first expr) `str))
         (rest (collapse-strs %))
         (list (collapse-strs %)))
      (rest expr)))
    expr))

Render Clojure data structures to a string of HTML.

(defmacro html
  [options & content]
  (letfn [(make-html [content]
           (collapse-strs `(str ~@(compile-html content))))]
    (if-let [mode (and (map? options) (:mode options))]
      (binding [*html-mode* mode]
        `(binding [*html-mode* ~mode]
           ~(make-html content)))
      (make-html (cons options content)))))

Define a function, but wrap its output in an implicit html macro.

(defmacro defhtml
  [fn-name & fdecl]
  (let [[fhead fbody] (split-with #(not (or (list? %) (vector? %))) fdecl)
        wrap-html (fn [[args & body]] `(~args (html ~@body)))]
    `(defn ~fn-name
       ~@fhead
       ~@(if (vector? (first fbody))
           (wrap-html fbody)
           (map wrap-html fbody)))))

Add an optional attribute argument to a function that returns a vector tag.

(defn add-optional-attrs
  [func]
  (fn [& args]
    (if (map? (first args))
      (let [[tag & body] (apply func (rest args))]
        (if (map? (first body))
          (apply vector tag (merge (first body) (first args)) (rest body))
          (apply vector tag (first args) body)))
      (apply func args))))

Defines a function that will return a tag vector. If the first argument passed to the resulting function is a map, it merges it with the attribute map of the returned tag value.

(defmacro defelem
  [fn-name & fdecl]
  `(do (defn ~fn-name ~@fdecl)
       (alter-var-root (var ~name) add-optional-attrs)))

Base URL to prepend to URIs (if supplied)

(def ^:dynamic *base-url*  nil)

Add a base-url that will be added to the output of the resolve-uri function.

(defmacro with-base-url
  [base-url & body]
  `(binding [*base-url* ~base-url]
     ~@body))

Prepends the base-url to the supplied URI.

(defn resolve-uri
  [uri]
  (if (.isAbsolute (URI. uri))
    uri
    (str *base-url* uri)))
 

marginalia.html

toc

Utilities for converting parse results into html.

(ns marginalia.html
  (:require
   [marginalia.hiccup :as hiccup :refer [html]])
  (:import
   [com.petebevin.markdown MarkdownProcessor]))
(set! *warn-on-reflection* true)

Directory in which to find resources (CSS, JS, etc.)

(def ^{:dynamic true} *resources*  "./vendor/")
(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 _
      (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 _
            (println (str "    STILL could not locate resources at " resource-name ". Giving up!"))))))))
(defn- inline-js [resource]
  (html [:script {:type "text/javascript"}
         (slurp-resource resource)]))
(defn- inline-css [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 ^:private ^MarkdownProcessor mdp (MarkdownProcessor.))

Markdown string to html converter. Translates strings like:

"# header!" -> "<h1>header!</h1>"

"## header!" -> "<h2>header!</h2>"

...

(defn md
  [^String 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"}
         (hiccup/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)]]))))

Generate Optional Metadata

Add metadata to your documentation.

To add to the head of the docs, specify a hash map for the :meta key :marginalia in project.clj:

:marginalia {:meta {:robots "noindex"}}

Generate meta tags from project info.

(defn metadata-html
  [project-info]
  (html (when-let [m (get-in project-info [:marginalia :meta])]
          (map #(vector :meta {:name (name (key %)) :contents (val %)}) m))))

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. :javascript and :css accept a vector of paths or URLs

Below is a simple example of both inline and block formatted equations.

Optionally, you can put the MathJax CDN URL directly as a value of :javascript like this:

:marginalia {
  :javascript
    ["http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML"]}

That way you won't have to download and carry around the MathJax library.

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)]
    (html (concat
           (when-let [js (:javascript options)]
             (map #(vector :script {:type "text/javascript" :src %}) js))
           (when-let [the-css (:css options)]
             (map #(vector :link {:tyle "text/css" :rel "stylesheet" :href %}) the-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"} (if (seq (:url project-info))
                                     [:a {:href (:url project-info)} (:name project-info)]
                                     (: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 [{:keys [uberdoc?] :as _props} docs]
  (html
   [:tr
    [:td {:class "docs"}
     [:div {:class "toc"}
      [:a {:name "toc"} [:h3 "namespaces"]]
      [:ul
       (map #(vector :li (link-to-namespace (:ns %) uberdoc?))
            docs)]]]
    [:td {:class "codes"} "&nbsp;"]]))
(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"} "&nbsp;"]
       [:td {:class "codes"}]]))
(def ^:private 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 ^:private 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 ^:private 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 ^:private general-css
  (css
   [:body {:margin 0
           :padding 0
           :font-family "'Palatino Linotype', 'Book Antiqua', Palatino, FreeSerif, serif;"
           :font-size "16px"
           :color "#252519"
           :background-color "#F5F5FF"}]
   [:h1 {:font-size "20px"
         :margin-top 0}]
   [:h2 {:font-size "18px"}]
   [:h3 {:font-size "16px"}]
   [: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"
              :background-color "#FFF"}]
   [: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 and 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 probably change in the future.

(defn page-template
  [project-metadata opt-resources header toc content floating-toc]
  (html
   "<!DOCTYPE html>\n"
   [:html
    [:head
     [:meta {:http-equiv "Content-Type" :content "text/html" :charset "utf-8"}]
     [:meta {:name "description" :content (:description project-metadata)}]
     (metadata-html project-metadata)
     (inline-css (str *resources* "shCore.css"))
     (css
      [:.syntaxhighlighter {:overflow "hidden !important"}])
     (inline-css (str *resources* "shThemeMarginalia.css"))
     reset-css
     header-css
     floating-toc-css
     general-css
     (inline-js (str *resources* "jquery-1.7.1.min.js"))
     (inline-js (str *resources* "xregexp-min.js"))
     (inline-js (str *resources* "shCore.js"))
     (inline-js (str *resources* "shBrushClojure.js"))
     opt-resources
     [:title (:name project-metadata) " -- Marginalia"]]
    [:body
     [:table
      header
      toc
      content]
     [:div {:class "footer"}
      "Generated by "
      [:a {:href "https://github.com/clj-commons/marginalia"} "Marginalia"]
      ".&nbsp;&nbsp;"
      "Syntax highlighting provided by Alex Gorbatchev's "
      [:a {:href "http://alexgorbatchev.com/SyntaxHighlighter/"}
       "SyntaxHighlighter"]
      floating-toc]
     (inline-js (str *resources* "app.js"))]]))

Syntax highlighting is done a bit differently than docco. Instead of embedding the highlighting 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)
   (map #(groups-html {:uberdoc? true} %) docs)
   (floating-toc-html docs)))

Generate the HTML for the index page (in multi-page mode)

(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 contents
   "")) ;; no floating toc

no floating toc

Generate a given page's HTML

(defn single-page-html
  [project-metadata doc _all-docs]
  (page-template
   project-metadata
   (opt-resources-html project-metadata)
   "" ;; no header
   "" ;; no toc
   (groups-html {:uberdoc? false} doc)
   "" ;; no floating toc))
 

marginalia.latex

toc

Utilities for converting parse results into LaTeX.

(ns marginalia.latex
  (:require
   [clojure.java.shell :as shell]
   [clojure.string :as str]
   [clostache.parser :as mustache]
   [marginalia.html :as html]))
(set! *warn-on-reflection* true)

Mustache-format template to use for the document

(def template  (html/slurp-resource "latex.mustache"))

Namespace header calculation

(def ^:private ^clojure.lang.APersistentVector headers ["subsubsection" "subsection" "section"])
(def ^:private section-re #"\\((sub){0,2}section)\s*\{")

It calculates the suitable header for a namespace ns. For example, if the generated output has subsections a section must be generated for each namespace in the table of contents. If it has subsubsections a subsection should be generated and so on.

(defn get-section-type
  [groups]
  (let [matches        (->> groups
                            (map :doc)
                            (mapcat (partial re-seq section-re))
                            (map second))
        matches        (or (seq matches) ["none"])
        most-important (apply max (map #(.indexOf headers %) matches))
        position       (min (-> most-important inc)
                            (-> (count headers) dec))]
    (nth headers (max position 0))))
(defn- get-header
  [the-type ns']
  (str "\\" the-type "{" ns' "}"))

Markdown to LaTeX conversion

(def ^:private mark (str/join (repeat 3 "marginalialatex")))
(def ^:private separator-marker (str "\n\n" mark "\n\n"))
(def ^:private separator-marker-re (re-pattern (str "\n?\n?" mark "\n?\n?")))

We use pandoc to convert markdown-input to LaTeX.

(defn invoke-pandoc
  [markdown-input]
  (let [{:keys [exit out err]} (shell/sh "pandoc"
                                         "-f" "markdown" "-t" "latex"
                                         :in markdown-input)]
    (when (not= exit 0)
      (throw
       (RuntimeException. (str "Error code: " exit ", calling pandoc.\n" err))))
    out))

It applies pandoc in a string joined by separator-marker. The output is split using a regex created from separator-marker

(defn md->latex
  [docs]
  (let [joined (str/join separator-marker docs)
        output (invoke-pandoc joined)
        result (str/split output separator-marker-re (count docs))]
    (assert (= (count docs) (count result))
            "The converted docs must have the same number")
    result))
(defn- to-latex
  [groups]
  (map #(assoc %1 :doc %2) groups (md->latex (map :doc groups))))

Code and doc extraction

(defn- docs-from-group [group]
  (or (:docstring group)
      (and (= (:type group) :comment) (:raw group))))
(defn- code-from-group [group]
  (if (= (:type group) :code)
    (:raw group)))

From the original data in each group we extract the code and the documentation.

(defn extract-code-and-doc
  [groups]
  (map (fn [group] {:code (code-from-group group) :doc (docs-from-group group)})
       groups))

Uberdoc generation

(def ^:private convert-groups (comp to-latex extract-code-and-doc))
  1. Converts each groups data to the format expected by the template.
    1. Calculates the correct header level for namespaces.
(defn as-data-for-template
  [project-metadata docs]
  (let [namespaces   (map #(update % :groups convert-groups) docs)
        section-type (get-section-type (mapcat :groups namespaces))
        namespaces   (map #(assoc % :ns-header (get-header section-type (:ns %)))
                          namespaces)]
    {:namespaces namespaces :project project-metadata}))

It uses mustache to generate the LaTeX contents using a template. Before it needs to convert the data to the format expected for the template

(defn uberdoc-latex
  [project-metadata docs]
    (mustache/render template (as-data-for-template project-metadata docs)))
 

marginalia.log

toc

Using a third-party logging library would be too much, but this namespace provides some lightweight functions to at least centralize where logging happens.

(ns marginalia.log)

Print the message to stderr, substituting any provided format-args in (as in format).

(defn error
  [msg & format-args]
  (binding [*out* *err*]
    (println (apply format msg format-args))))
 

marginalia.main

toc
(ns marginalia.main
  (:require
   [marginalia.core :as marginalia]
   [marginalia.html :as html])
  (:gen-class))

The main entry point into Marginalia.

(defn -main
  [& sources]
  (binding [html/*resources* ""]
    (marginalia/run-marginalia sources)
    (shutdown-agents)))

Example Usage

(comment
  ;; Command line example
  (-main "./src/marginalia/core.clj" "./src/marginalia/html.clj"))
 

marginalia.parser

toc

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
  (:require
   [cljs.tagged-literals :as cljs]
   [clojure.string :as str]
   [clojure.tools.namespace :as tools.ns])
  (:import
   [clojure.lang LineNumberingPushbackReader LispReader]
   [java.io File Reader Writer]))
(set! *warn-on-reflection* true)

Access to private or protected field. field-name is a symbol or keyword.

Extracted from clojure.contrib.reflect

(defn get-field
  [^Class klass field-name obj]
  (->  klass
      (.getDeclaredField (name field-name))
      (doto (.setAccessible true))
      (.get obj)))

Calls a private or protected method.

params is a vector of classes which correspond to the arguments to the method e

obj is nil for static methods, the instance object otherwise.

The method-name is given a symbol or a keyword (something Named).

Extracted from clojure.contrib.reflect

(defn call-method
  [^Class klass method-name params obj & args]
  (-> klass
      (.getDeclaredMethod (name method-name)
                          (into-array Class params))
      (doto (.setAccessible true))
      (.invoke obj (into-array Object args))))
(defrecord Comment [content])
(defmethod print-method Comment [^Comment the-comment ^Writer out]
  (.write out (str \" (.content the-comment) \")))
(def ^:private top-level-comments (atom []))
(def ^:private sub-level-comments (atom []))

TODO: document

TODO: document

TODO: document

TODO: document

(def ^:dynamic *comments*  nil)
(def ^:dynamic *comments-enabled*  nil)
(def ^:dynamic *lift-inline-comments*  nil)
(def ^:dynamic *delete-lifted-comments* nil)
(defn- comments-enabled?
  []
  @*comments-enabled*)

Marginalia can be given directives in comments. A directive is a comment line containing a directive name, in the form ;; @DirectiveName. Directives change the behavior of the parser within the files that contain them.

The following directives are defined:

  • @MargDisable suppresses subsequent comments from the docs
  • @MargEnable includes subsequent comments in the docs
(def directives
  {"MargDisable" (fn [] (swap! *comments-enabled* (constantly false)))
   "MargEnable"  (fn [] (swap! *comments-enabled* (constantly true)))})

If the given line is a directive, applies it. Returns a value indicating whether the line should be included in the comments list.

(defn process-directive!
  [line]
  (let [directive (->> (re-find #"^;+\s*@(\w+)" line)
                       (last)
                       (get directives))]
    (when directive
      (directive))
    (not directive)))
(defn- read-comment
  ([^LineNumberingPushbackReader 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))
                 text (.toString sb)
                 include? (process-directive! text)]
             (when (and include? (comments-enabled?))
               (swap! *comments* conj {:form (Comment. text)
                                       :text [text]
                                       :start line
                                       :end line}))
             reader)
           (do
             (.append sb (Character/toString ch))
             (recur (.read reader))))))))
  ([^Reader reader semicolon _opts _pending] ;; TODO: who uses this?
   (read-comment reader semicolon)))
(defn- set-comment-reader [^Reader reader]
  (aset ^"[Lclojure.lang.IFn;" (get-field LispReader :macros nil)
        (int \;)
        reader))
(defrecord DoubleColonKeyword [content])
(defmethod print-method DoubleColonKeyword [^DoubleColonKeyword dck ^java.io.Writer out]
  (.write out (str \: (.content dck))))
(defmethod print-dup DoubleColonKeyword [dck ^java.io.Writer out]
  (print-method dck out))
(defn ^:private read-token [reader c]
  (call-method clojure.lang.LispReader :readToken
               [java.io.PushbackReader Character/TYPE]
               nil reader c))

Clojure 1.9 changed the signature of LispReader/matchSymbol, taking a new parameter of type LispReader$Resolver. Conveniently, we can test for the existence of the reader-resolver var to detect running under 1.9.

We must take care to use the correct overload for the project's runtime, else we will crash and fail people's builds.

(if-let [resolver-var (resolve '*reader-resolver*)]
  (defn ^:private match-symbol [s]
    (call-method LispReader :matchSymbol
                 [String, (Class/forName "clojure.lang.LispReader$Resolver")]
                 nil s (deref resolver-var)))
  (defn ^:private match-symbol [s]
    (call-method LispReader :matchSymbol
                 [String]
                 nil s)))
(defn- read-keyword
  ([^LineNumberingPushbackReader reader colon]
   (let [c (.read reader)]
     (if (= (int \:) c)
       (-> (read-token reader (char c))
           match-symbol
           DoubleColonKeyword.)
       (do (.unread reader c)
           (-> (read-token reader colon)
               match-symbol)))))
  ([^LineNumberingPushbackReader reader colon _opts _pending] ;; TODO: who uses this?
   (read-keyword reader colon)))
(defn- set-keyword-reader [reader]
  (aset ^"[Lclojure.lang.IFn;" (get-field LispReader :macros nil)
        (int \:)
        reader))
(defn- skip-spaces-and-comments [^LineNumberingPushbackReader 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))))
(declare adjacent?)
(declare merge-comments)
(defn- parse* [^LineNumberingPushbackReader reader]
  (take-while
   #(not= :_eof (:form %))
   (flatten
    (repeatedly
     (fn []
       (binding [*comments* top-level-comments]
         (skip-spaces-and-comments reader))
       (let [start                 (.getLineNumber reader)
             form                  (binding [*comments* sub-level-comments]
                                     (try (. LispReader
                                             (read reader {:read-cond :allow
                                                           :eof       :_eof}))
                                          (catch Exception ex
                                            (let [msg (str "Problem parsing near line " start
                                                           " <" (.readLine reader) ">"
                                                           " original reported cause is "
                                                           (.getCause ex) " -- "
                                                           (.getMessage ex))
                                                  e (RuntimeException. msg)]
                                              (.setStackTrace e (.getStackTrace ex))
                                              (throw e)))))
             end                   (.getLineNumber reader)
             code                  {:form form :start start :end end}
             ;; We optionally lift inline comments to the top of the form.
             ;; This monstrosity ensures that each consecutive group of inline
             ;; comments is treated as a mergable block, but with a fake
             ;; blank comment between non-adjacent inline comments. When merged
             ;; and converted to markdown, this will produce a paragraph for
             ;; each separate block of inline comments.
             paragraph-comment     {:form (Comment. ";;")
                                    :text [";;"]}
             merge-inline-comments (fn [cs c]
                                     (if (re-find #"^;(\s|$)"
                                                  (.content ^Comment (:form c)))
                                       cs
                                       (if-let [t (peek cs)]
                                         (if (adjacent? t c)
                                           (conj cs c)
                                           (conj cs paragraph-comment c))
                                         (conj cs c))))
             inline-comments       (when (and *lift-inline-comments*
                                              (seq @sub-level-comments))
                                     (cond->> (reduce merge-inline-comments
                                                      []
                                                      @sub-level-comments)
                                       (seq @top-level-comments)
                                       (into [paragraph-comment])
                                       true
                                       (mapv #(assoc % :start start :end (dec start)))))
             comments              (concat @top-level-comments inline-comments)]
         (swap! top-level-comments (constantly []))
         (swap! sub-level-comments (constantly []))
         (if (empty? comments)
           [code]
           (vec (concat comments [code])))))))))
(defn- strip-docstring [docstring raw]
  (-> raw
      (str/replace (str \" (-> docstring
                               str
                               (str/replace "\ "\\\))
                        \"))
      (str/replace #"#?\^\{\s*:doc\s*\}" )
      (str/replace #"\n\s*\n" "\n")
      (str/replace #"\n\s*\)" ")")))
(defn- get-var-docstring [nspace-sym sym]
  (let [s (if nspace-sym
            (symbol (str nspace-sym) (str sym))
            (symbol (str sym)))]
    (try
      (-> `(var ~s) eval meta :doc)
      ;; HACK: to handle types
      (catch Exception _))))

TODO: document

(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)
      (let [maybe-metadocstring  (:doc (meta sym))
            nspace               (find-ns sym)
            [maybe-ds remainder] (let [[_ _ ? & more?] form] [? more?])
            docstring            (if (and (string? maybe-ds) remainder)
                                   maybe-ds
                                   (if (= (first form) 'ns)
                                     (if (not maybe-metadocstring)
                                       (when (string? maybe-ds) maybe-ds)
                                       maybe-metadocstring)
                                     (if-let [ds maybe-metadocstring]
                                       ds
                                       (when nspace
                                         (-> nspace meta :doc)
                                         (get-var-docstring nspace-sym sym)))))]
        [#_form
         (when docstring
           ;; Exclude flush left docstrings from adjustment:
           (if (re-find #"\n[^\s]" docstring)
             docstring
             (str/replace docstring #"\n  " "\n")))
         #_raw
         (strip-docstring docstring raw)
         #_nspace-sym
         (if (or (= 'ns (first form)) 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)
        ;; Clojure 1.10 added `:extend-via-metadata` to the `defprotocol` macro.
        ;; If the flag is present, `extract-internal-docstrings` needs to start
        ;; 2 forms later, to account for the presence of a keyword,
        ;; `:extend-via-metadata` and a boolean `true` in the macro body.
        evm           (contains? (set form) :extend-via-metadata)
        internal-dses (cond
                        (and evm ds) (extract-internal-docstrings (nthnext form 5))
                        evm          (extract-internal-docstrings (nthnext form 4))
                        ds           (extract-internal-docstrings (nthnext form 3))
                        :else        (extract-internal-docstrings (nthnext form 2)))]
    (with-meta
      [ds r s]
      {:internal-docstrings internal-dses})))
(defmethod dispatch-form 'ns
  [form raw nspace-sym]
  (extract-common-docstring form raw nspace-sym))
(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])
(defn- literal-form? [form]
  (or (string? form) (number? form) (keyword? form) (symbol? form)
      (char? form) (true? form) (false? form) (instance? java.util.regex.Pattern form)))
(defmethod dispatch-form :default
  [form raw nspace-sym]
  (cond (literal-form? form)
        (dispatch-literal form raw nspace-sym)
        (and (first form)
             (.isInstance clojure.lang.Named (first form))
             (re-find #"^def" (-> form first name)))
          (extract-common-docstring form raw nspace-sym)
        :else
          (dispatch-inner-form form raw nspace-sym)))
(defn- extract-docstring [{:keys [start end form]} raw-lines nspace-sym]
  (let [new-lines (str/join "\n" (subvec raw-lines (dec start) (min end (count raw-lines))))]
    (dispatch-form form new-lines nspace-sym)))
(defn- ->str [{:keys [form]}]
  (-> (.content ^Comment form)
      (str/replace #"^;+\s(\s*)" "$1")
      (str/replace #"^;+" )))
(defn- merge-comments [f s]
  {:form (Comment. (str (->str f) "\n" (->str s)))
   :text (into (:text f) (:text s))
   :start (:start f)
   :end (:end s)})
(defn- comment? [{:keys [form]}]
  (instance? Comment form))
(defn- code? [{:keys [form] :as o}]
  (and (not (nil? form))
       (not (comment? o))))

Two parsed objects are adjacent if the end of the first is followed by the start of the second.

(defn adjacent?
  [{:keys [end] :as _first} {:keys [start] :as _second}]
  (= end (dec start)))
(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|$)" (.content ^Comment (:form f))))
        (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 (if *delete-lifted-comments*
                                        ;; this is far from perfect but should work
                                        ;; for most cases: erase matching comments
                                        ;; and then remove lines that are blank
                                        (-> (reduce (fn [raw the-comment]
                                                      (str/replace raw
                                                                   (str the-comment "\n")
                                                                   "\n"))
                                                    code
                                                    (:text f))
                                            (str/replace #"\n\s+\n" "\n"))
                                        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)))

Return a parse tree for the given code (provided as a string)

(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 ^"[Lclojure.lang.IFn;" (get-field 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- cljs-file? [filepath]
  (str/ends-with? (str/lower-case filepath) "cljs"))
(defn- cljx-file? [filepath]
  (str/ends-with? (str/lower-case filepath) "cljx"))
(def ^:private cljx-data-readers {'+clj identity
                        '+cljs identity})
(defmacro ^:private with-readers-for [file & body]
  `(let [readers# (merge {}
                        (when (cljs-file? ~file) cljs/*cljs-data-readers*)
                        (when (cljx-file? ~file) cljx-data-readers)
                        default-data-readers)]
     (binding [*data-readers* readers#]
       ~@body)))

Return a parse tree for the given filename

(defn parse-file
  [filename]
  (with-readers-for filename
    (binding [*comments-enabled* (atom true)]
      (parse (slurp filename)))))

Return a parse tree for all the files in the namespace

(defn parse-ns
  [^File file]
  (let [filename (.getName file)]
    (with-readers-for filename
      (or (not-empty (-> file
                         (tools.ns/read-file-ns-decl)
                         (second)
                         (str)))
          filename))))
 

problem-cases.general

toc

A place to examine poor parser behavior. These should go in tests when they get written.

(ns problem-cases.general)
[::foo]
{:foo 43}
{::foo 42}

private docstring

(defn ^:private private-fn  [])

docstring

(defn public-fn  []
  (let [x (private-fn)]
        (count x)))

Should have only this comment in the left margin. See https://github.com/clj-commons/marginalia/issues/4

(defn parse-bool [v] (condp = (.trim (str v))
                         "0" false
                         "1" true
                         "throw exception here"))

Here is a docstring. It should be to the left.

(defn a-function 
  [x]
  (* x x))

Here is a docstring. It should be to the left.

(defn b-function
  [x]
  "Here is just a string.  It should be to the right."
  (* x x))

Defines a relation... duh!

(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)))"))

This is a defmulti docstring, it should also be on the left

(defmulti bazfoo
  class)
(defmethod bazfoo String [s]
  "This is a defmethod docstring.  It should be on the left."
  (vec (seq s)))
(bazfoo "abc")

This is a protocol docstring. It should be on the left.

(defprotocol Foo
  (lookup  [cache e])
  (has?    [cache e] )
  (hit     [cache e])
  (miss    [cache e ret]))

This is also a docstring via metadata. It should be on the left.

(def 
  a 42)

This is also a docstring via metadata. It should be on the left.

(def 
  b 42)

This is also a docstring via metadata. It should be on the left.

(def 
  c
  "This is just a value.  It should be on the right.")

From fnparse

Padded on the front with optional whitespace.

(comment
  (do-template [rule-name token]
               (h/defrule rule-name
                 (h/lit token))
               <escape-char-start> \\
               <str-delimiter>   \"
               <value-separator> \,
               <name-separator>  \:
               <array-start>     \[
               <array-end>       \]
               <object-start>    \{
               <object-end>      \}))

Issue #26: Angle-bracket in Function Name Breaks Layout

(defn <test [] nil)

(defn test-html-entities-in-doc
  []
  nil)
(defmulti kompile identity)
(defmethod kompile [:standard]
  [_]
  "GENERATED ALWAYS AS IDENTITY")

strict-eval-op-fn is used to define functions of the above pattern for functions such as +, *, etc. Cljs special forms defined this way are applyable, such as (apply + [1 2 3]).

Resulting expressions are wrapped in an anonymous function and, down the line, called, like so:

 (+ 1 2 3) -> (function(){...}.call(this, 1 2 3)

(defn strict-eval-op-fn
  [op inc-ind-str ind-str op nl]
  (ind-str
   "(function() {" nl
   (inc-ind-str
    "var _out = arguments[0];" nl
    "for(var _i=1; _i<arguments.length; _i++) {" nl
    (inc-ind-str
     "_out = _out " op " arguments[_i];")
    nl
    "}" nl
    "return _out;")
   nl
   "})"))
'(defn special-forms []
  {'def     handle-def
   'fn      handle-fn
   'fn*     handle-fn
   'set!    handle-set
   'let     handle-let
   'defn    handle-defn
   'aget    handle-aget
   'aset    handle-aset
   'if      handle-if
   'while   handle-while
   'when    handle-when
   'doto    handle-doto
   '->      handle-->
   '->>     handle-->>
   'not     handle-not
   'do      handle-do
   'cond    handle-cond
   '=       (make-lazy-op '==)
   '>       (make-lazy-op '>)
   '<       (make-lazy-op '<)
   '>=      (make-lazy-op '>=)
   '<=      (make-lazy-op '<=)
   'or      (make-lazy-op '||)
   'and     (make-lazy-op '&&)
   'doseq   handle-doseq
   'instanceof handle-instanceof
   'gensym handle-gensym
   'gensym-str handle-gensym-str})
'(defn greater [a b]
  (>= a b))
'(fact
  (greater 2 1) => truthy)
'(file->tickets commits)
(defmulti ns-kw-mm identity)
(defmethod ns-kw-mm ::foo [_] :problem-cases.general/foo)
(defmethod ns-kw-mm :user/foo [_] :user/foo)
(defmethod ns-kw-mm :foo [_] :foo)
 

marginalia.core-test

toc
(ns marginalia.core-test
  (:require
   [clojure.java.io :as io]
   [clojure.test :refer :all]
   [marginalia.core :as marginalia]
   [marginalia.test.helpers :refer [in-project]]))
(set! *warn-on-reflection* true)
(deftest parse-project-file-simple
  (is (= "project-name"
         (:name (marginalia/parse-project-file "test/marginalia/resources/multi-def-project.clj")))))
(deftest config-test
  (let [expected-config {:description             "Overridden description" ; config.edn
                         :marginalia              {:css        nil
                                                   :javascript ["http://example.com/magic.js"] ; project.clj
                                                   :exclude    nil
                                                   :leiningen  nil}
                         :dir                     "./docs"
                         :name                    "configurationpalooza" ; project.clj
                         :file                    "uberdoc.html"
                         :lift-inline-comments    false ; config.edn
                         :multi                   true ; CLI > config.edn
                         :version                 "0.2.1-SNAPSHOT" ; project.clj
                         :dependencies            [['org.clojure/clojure "1.11.1"] ; project.clj
                                                   ['org.markdownj/markdownj-core "0.4"]]
                         :exclude-lifted-comments false}  ; default
        expected-sources [(.getAbsolutePath (io/file "test_projects" "highly_configured" "src" "core.clj"))]]
    (is (= [expected-config expected-sources]
           (in-project "highly_configured"
             (marginalia/resolved-opts+sources ["--multi"] nil))))))
 

marginalia.multidoc-test

toc
(ns marginalia.multidoc-test
  (:require
   [clojure.test :refer :all]
   [marginalia.core :as core]
   [marginalia.test.helpers :refer :all]))
(deftest multi-page-test
  (with-project "multi_page"
    (fn [source-dir output-dir metadata]
      (core/multidoc! output-dir
                      (find-clojure-file-paths source-dir)
                      metadata))
    (is (= 3 number-of-generated-pages))))
 

marginalia.parse-test

toc

This module does stuff

(ns marginalia.parse-test
  (:require
   [clojure.test :refer :all]
   [marginalia.parser :as p]))
(deftest test-inline-literals
  (is (= (count (marginalia.parser/parse "(ns test)")) 1))
  (is (= (count (marginalia.parser/parse "(ns test)\n123")) 1))
  (is (= (count (marginalia.parser/parse "(ns test)\n123\n")) 1))
  (is (= (count (marginalia.parser/parse "(ns test)\n\"string\)) 1))
  (is (= (count (marginalia.parser/parse "(ns test)\n\"some string\)) 1))
  (is (= (count (marginalia.parser/parse "(ns test (:require [marginalia.parser :as parser]))\n(defn foo [] ::parser/foo)")) 1)))
(deftest extend-via-metadata
  (is (marginalia.parser/parse "(ns test)\n(defprotocol Foo \"Does a Foo\" :extend-via-metadata true (do-foo! [_ opts] \"Foo!\"))")))
(def simple-fn
  "(defn some-fn
  \"the docstring\"
  [x]
  (* x x))")
(deftest test-parse-fn-docstring
  (let [{docstring :docstring the-type :type} (first (marginalia.parser/parse simple-fn))]
    (is (= :code the-type))
    (is (= "the docstring" docstring))))
(def reader-conditional-fn
  "(defn error
  \"Returns a language-appropriate error\"
  [^String msg]
  #?(:clj  (Exception. msg)
     :cljs (js/Error. msg)))")
(deftest test-reader-conditional
  (let [{docstring :docstring the-type :type} (first (marginalia.parser/parse reader-conditional-fn))]
    (is (= :code the-type))
    (is (= "Returns a language-appropriate error" docstring))))
(deftest inline-comments
  (testing "inline comments ignored by default"
    (binding [p/*comments-enabled* (atom true)]
      (let [result (p/parse
                    "(ns test)
                     (defn foo
                       \"docstring\"
                       []
                       (let [x 1]
                         ;; A
                         x))")]
        (is (= 2 (count result)))
        (is (re-find #";; A" (:raw (second result))))
        (is (= "docstring" (:docstring (second result))))))
    (binding [p/*comments-enabled* (atom true)]
      ;; tests that prelude is appended to docstring
      (let [result (p/parse
                    "(ns test)
                     ;; A
                     (defn foo
                       \"docstring\"
                       []
                       (let [x 1]
                         ;; B
                         x))")]
        (is (= 2 (count result)))
        (is (re-find #";; B" (:raw (second result))))
        (is (= "docstring\n\nA" (:docstring (second result)))))))
  (testing "inline single ; comments still ignored"
    (binding [p/*comments-enabled* (atom true)
              p/*lift-inline-comments* true]
      (let [result (p/parse
                    "(ns test)
                     (defn foo
                       \"docstring\"
                       []
                       (let [x 1]
                         ; A
                         x))")]
        (is (= 2 (count result)))
        (is (re-find #"; A" (:raw (second result))))
        (is (= "docstring" (:docstring (second result)))))))
  (testing "inline comments added to docstring as paragraphs"
    (binding [p/*comments-enabled* (atom true)
              p/*lift-inline-comments* true]
      (let [result (p/parse
                    "(ns test)
                     (defn foo
                       \"docstring\"
                       []
                       (let [x 1]
                         ;; A
                         x))")]
        (is (= 2 (count result)))
        (is (re-find #";; A" (:raw (second result))))
        (is (= "docstring\n\nA" (:docstring (second result))))))
    (binding [p/*comments-enabled* (atom true)
              p/*lift-inline-comments* true]
      ;; A and B should be separate paragraphs
      (let [result (p/parse
                    "(ns test)
                     (defn foo
                       \"docstring\"
                       []
                       ;; A
                       (let [x 1]
                         ;; B
                         x))")]
        (is (= 2 (count result)))
        (is (re-find #";; A" (:raw (second result))))
        (is (re-find #";; B" (:raw (second result))))
        (is (= "docstring\n\nA\n\nB" (:docstring (second result)))))))
  (testing "inline comments added to prelude after docstring"
    (binding [p/*comments-enabled* (atom true)
              p/*lift-inline-comments* true]
      ;; prelude A follows docstring, then B and C as separate paragraphs
      (let [result (p/parse
                    "(ns test)
                     ;; A
                     (defn foo
                       \"docstring\"
                       []
                       ;; B
                       (let [x 1]
                         ;; C
                         x))")]
        (is (= 2 (count result)))
        (is (not (re-find #";; A" (:raw (second result)))))
        (is (re-find #";; B" (:raw (second result))))
        (is (re-find #";; C" (:raw (second result))))
        (is (= "docstring\n\nA\n\nB\n\nC" (:docstring (second result))))))
    (binding [p/*comments-enabled* (atom true)
              p/*lift-inline-comments* true]
      ;; this checks that consecutive comment lines stay in the same paragraph
      (let [result (p/parse
                    "(ns test)
                     ;; A
                     (defn foo
                       \"docstring\"
                       []
                       ;; B
                       ;; C
                       (let [x 1]
                         ;; D
                         x))")]
        (is (= 2 (count result)))
        (is (re-find #";; B" (:raw (second result))))
        (is (re-find #";; C" (:raw (second result))))
        (is (re-find #";; D" (:raw (second result))))
        (is (= "docstring\n\nA\n\nB\nC\n\nD" (:docstring (second result))))))
    (binding [p/*comments-enabled* (atom true)
              p/*lift-inline-comments* true]
      ;; this checks that a comment above the function doesn't merge in
      ;; when separated by a blank line
      (let [result (p/parse
                    "(ns test)
                     ;; A
                     (defn foo
                       \"docstring\"
                       []
                       ;; B
                       ;; C
                       (let [x 1]
                         ;; D
                         x))")]
        (is (= 3 (count result)))
        (is (= "A" (:raw (second result))))
        (is (re-find #";; B" (:raw (nth result 2))))
        (is (re-find #";; C" (:raw (nth result 2))))
        (is (re-find #";; D" (:raw (nth result 2))))
        (is (= "docstring\n\n\nB\nC\n\nD" (:docstring (nth result 2))))))
    (binding [p/*comments-enabled* (atom true)
              p/*lift-inline-comments* true]
      ;; this checks that a comment above the function does merge in
      ;; when a blank comment joins it to the function
      (let [result (p/parse
                    "(ns test)
                     ;; A
                     ;;
                     (defn foo
                       \"docstring\"
                       []
                       ;; B
                       ;; C
                       (let [x 1]
                         ;; D
                         x))")]
        (is (= 2 (count result)))
        (is (not (re-find #";; A" (:raw (second result)))))
        (is (re-find #";; B" (:raw (second result))))
        (is (re-find #";; C" (:raw (second result))))
        (is (re-find #";; D" (:raw (second result))))
        (is (= "docstring\n\nA\n\n\nB\nC\n\nD" (:docstring (second result))))))))
(deftest inline-comments-deleted
  (testing "inline comments added to docstring as paragraphs and deleted"
    (binding [p/*comments-enabled* (atom true)
              p/*lift-inline-comments* true
              p/*delete-lifted-comments* true]
      (let [result (p/parse
                     "(ns test)
                     (defn foo
                       \"docstring\"
                       []
                       (let [x 1]
                         ;; A
                         x))")]
        (is (= 2 (count result)))
        (is (not (re-find #";; A" (:raw (second result)))))
        (is (= "docstring\n\nA" (:docstring (second result))))))
    (binding [p/*comments-enabled* (atom true)
              p/*lift-inline-comments* true
              p/*delete-lifted-comments* true]
      ;; A and B should be separate paragraphs
      (let [result (p/parse
                     "(ns test)
                     (defn foo
                       \"docstring\"
                       []
                       ;; A
                       (let [x 1]
                         ;; B
                         x))")]
        (is (= 2 (count result)))
        (is (not (re-find #";; A" (:raw (second result)))))
        (is (not (re-find #";; B" (:raw (second result)))))
        (is (= "docstring\n\nA\n\nB" (:docstring (second result)))))))
  (testing "inline comments added to prelude after docstring"
    (binding [p/*comments-enabled* (atom true)
              p/*lift-inline-comments* true
              p/*delete-lifted-comments* true]
      ;; prelude A follows docstring, then B and C as separate paragraphs
      (let [result (p/parse
                     "(ns test)
                     ;; A
                     (defn foo
                       \"docstring\"
                       []
                       ;; B
                       (let [x 1]
                         ;; C
                         x))")]
        (is (= 2 (count result)))
        (is (not (re-find #";; A" (:raw (second result)))))
        (is (not (re-find #";; B" (:raw (second result)))))
        (is (not (re-find #";; C" (:raw (second result)))))
        (is (= "docstring\n\nA\n\nB\n\nC" (:docstring (second result))))))
    (binding [p/*comments-enabled* (atom true)
              p/*lift-inline-comments* true
              p/*delete-lifted-comments* true]
      ;; this checks that consecutive comment lines stay in the same paragraph
      (let [result (p/parse
                     "(ns test)
                     ;; A
                     (defn foo
                       \"docstring\"
                       []
                       ;; B
                       ;; C
                       (let [x 1]
                         ;; D
                         x))")]
        (is (= 2 (count result)))
        (is (not (re-find #";; B" (:raw (second result)))))
        (is (not (re-find #";; C" (:raw (second result)))))
        (is (not (re-find #";; D" (:raw (second result)))))
        (is (= "docstring\n\nA\n\nB\nC\n\nD" (:docstring (second result))))))
    (binding [p/*comments-enabled* (atom true)
              p/*lift-inline-comments* true
              p/*delete-lifted-comments* true]
      ;; this checks that a comment above the function doesn't merge in
      ;; when separated by a blank line
      (let [result (p/parse
                     "(ns test)
                     ;; A
                     (defn foo
                       \"docstring\"
                       []
                       ;; B
                       ;; C
                       (let [x 1]
                         ;; D
                         x))")]
        (is (= 3 (count result)))
        (is (= "A" (:raw (second result))))
        (is (not (re-find #";; B" (:raw (nth result 2)))))
        (is (not (re-find #";; C" (:raw (nth result 2)))))
        (is (not (re-find #";; D" (:raw (nth result 2)))))
        (is (= "docstring\n\n\nB\nC\n\nD" (:docstring (nth result 2))))))
    (binding [p/*comments-enabled* (atom true)
              p/*lift-inline-comments* true
              p/*delete-lifted-comments* true]
      ;; this checks that a comment above the function does merge in
      ;; when a blank comment joins it to the function
      (let [result (p/parse
                     "(ns test)
                     ;; A
                     ;;
                     (defn foo
                       \"docstring\"
                       []
                       ;; B
                       ;; C
                       (let [x 1]
                         ;; D
                         x))")]
        (is (= 2 (count result)))
        (is (not (re-find #";; A" (:raw (second result)))))
        (is (not (re-find #";; B" (:raw (second result)))))
        (is (not (re-find #";; C" (:raw (second result)))))
        (is (not (re-find #";; D" (:raw (second result)))))
        (is (= "docstring\n\nA\n\n\nB\nC\n\nD" (:docstring (second result))))))))
 

marginalia.test.helpers

toc
(ns marginalia.test.helpers
  (:require
   [clojure.java.io :as io]
   [clojure.test :refer :all]
   [marginalia.core :as marginalia]
   [marginalia.html :as html])
  (:import
   [java.io File]))
(set! *warn-on-reflection* true)

Delete file f. If it's a directory, recursively delete all its contents. Raise an exception if any deletion fails unless silently is true.

copied from http://clojuredocs.org/clojure_contrib/clojure.contrib.io/delete-file-recursively N.B. that Raynes's filesystem library could possibly replace this, but that's a separate task.

(defn delete-file-recursively
  [f & [silently]]
  (let [f (io/file f)]
    (when (.isDirectory f)
      (doseq [child (.listFiles f)]
        (delete-file-recursively child silently)))
    (io/delete-file f silently)))

Returns a seq of string paths for Clojure files in the given source-dir

(defn find-clojure-file-paths
  [source-dir]
  (marginalia/find-processable-file-paths source-dir #(re-find #"clj$" %)))

A seq of Files in the dir

(defn files-in
  [dir]
  (seq (.listFiles (io/file dir))))

Returns a file object pointed at the given test project's directory

(defn test-project
  [project-name]
  (io/file "test_projects" project-name))

Runs body in the context of the given test project

(defmacro in-project
  [project-name & body]
  `(binding [marginalia/*working-directory* ~(.getAbsolutePath ^File (test-project project-name))]
     ~@body))

Runs assertions in the context of a project set up for testing in the test_projects directory. Anaphorically provides the following variables to the assertion context:

  • number-of-generated-pages - result of running the doc-generator function (which should ultimately call one of the Marginalia's own functions.

  • project-name - the name of the project

  • doc-generator - function which invokes marginalia (actually produces output). Function accepts three arguments: path to source files, path to output files and test project metadata

  • tests - assertions to be run after the output has been produced

(defmacro with-project
  [project-name doc-generator & tests]
  (let [project             (test-project project-name)
        test-project-src    (str (io/file project "src"))
        test-project-target (str (io/file project "docs"))
        test-metadata       {:dependencies     [["some/dep" "0.0.1"]]
                             :description      "Test project"
                             :name             "test"
                             :dev-dependencies []
                             :version          "0.0.1"}]
    `(do
       (delete-file-recursively ~test-project-target true)
       (.mkdirs (io/file ~test-project-target))
       (binding [html/*resources* ""]
         (~doc-generator ~test-project-src ~test-project-target ~test-metadata))
       (let [~'number-of-generated-pages (count (files-in ~test-project-target))]
         ;; We need to `deftest` in order for test runners (e.g. `lein test`) to pick up failures
         (deftest ~(gensym (str project-name "-"))
           ~@tests))
       (delete-file-recursively ~test-project-target true))))
 

marginalia.uberdoc-test

toc
(ns marginalia.uberdoc-test
  (:require
   [clojure.java.io :as io]
   [clojure.test :refer :all]
   [marginalia.core :as core]
   [marginalia.test.helpers :refer :all]))
(deftest single-page-test
  (with-project "single_page"
    (fn [source-dir output-dir metadata]
      (marginalia.core/uberdoc! (io/file output-dir "index.html")
                                (find-clojure-file-paths source-dir)
                                metadata))
    (is (= 1 number-of-generated-pages))))
 

multi-def-project.clj

toc

There was a bug where we didn't support forms before the defproject

(defn some-other-form
  []
  (= 1 1))

0.1.0-SNAPSHOT

(defproject project-name 
  :description "FIXME: write description"
  :url "http://example.com/FIXME"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.6.0"]])
 
Generated by Marginalia.  Syntax highlighting provided by Alex Gorbatchev's SyntaxHighlighter