(ns metabase.util.malli.doc (:require [clojure.java.io :as io] [hiccup.core :as hiccup] [malli.core :as mc] [malli.error :as me] [metabase.util.log :as log] [metabase.util.markdown :as markdown]) (:import (org.apache.commons.io FileUtils))) | |
(set! *warn-on-reflection* true) | |
(defmulti ^:private generate-dox-method
{:arglists '([schema cache])}
(fn [schema _cache]
{:pre [(instance? malli.core.Schema schema)]}
(mc/-type (mc/-parent schema)))) | |
(defn- maybe-parse-markdown [x]
(cond-> x
(string? x) (markdown/process-markdown :html))) | |
(defn- explicit-dox [schema]
{:pre [(instance? malli.core.Schema schema)]}
;; TODO -- parse `:error/message` for Markdown-ness.
(or (when-let [x ((some-fn :description :error/message)
(mc/properties schema))]
(maybe-parse-markdown x))
(when (symbol? (mc/form schema))
(when-let [msg (me/error-message {:schema schema, :unknown false})]
(when-not (= msg "unknown error")
msg))))) | |
(defn- generate-dox
([schema]
(generate-dox schema {}))
([schema cache]
(let [schema (if (instance? malli.core.Schema schema)
schema
(mc/schema schema))
schema (or (some-> (:doc/schema (mc/-properties schema)) mc/schema)
schema)
explicit-dox (explicit-dox schema)
{generated :this, cache :cache} (generate-dox-method schema cache)
_ (assert (some? generated))
_ (assert (map? cache))
dox (if explicit-dox
[:div
[:div explicit-dox]
[:div generated]]
generated)]
{:this dox, :cache cache}))) | |
(defmethod generate-dox-method :default
[schema cache]
{:this (if (explicit-dox schema)
[:div]
(or
(me/error-message {:schema schema, :unknown false})
(do
(log/warnf "WARNING: UNKNOWN SCHEMA: %s" (pr-str schema))
[:div
{:style "border: 2px solid red;"}
[:div
[:b "UNKNOWN SCHEMA: "]
[:tt (mc/-type (mc/-parent schema))]]
[:div [:pre (pr-str schema)]]
[:div [:pre (mc/properties schema)]]])))
:cache cache}) | |
(defmethod generate-dox-method :ref
[schema cache]
(let [[child] (mc/children schema)]
(generate-dox child cache))) | |
(defmethod generate-dox-method :schema
[schema cache]
(let [[child] (mc/children schema)]
(generate-dox child cache))) | |
(defn- keyword-schema-relative-file-name [k]
{:pre [(qualified-keyword? k)]}
(format "%s__%s.html"
(munge (namespace k))
(munge (name k)))) | |
(defn- schema-title [schema]
(or (some-> (:doc/title (mc/properties schema)) maybe-parse-markdown)
(when-not (instance? malli.core.Schema schema)
(schema-title (mc/schema schema)))
(when (mc/-ref-schema? schema)
(schema-title (mc/deref schema)))
(when (keyword? schema)
[:pre (name schema)]))) | |
(defn- ^:dynamic *keyword-schema-link* [k]
[:a
{:href (keyword-schema-relative-file-name k)}
(schema-title k)]) | |
keyword schema | (defmethod generate-dox-method :malli.core/schema
[schema cache]
(let [k (mc/-form schema)]
(assert (keyword? k))
(cond
;; qualified keyword already in the cache
(and (qualified-keyword? k)
(contains? cache k))
{:this (*keyword-schema-link* k)
:cache cache}
;; qualified keyword that is not yet in the cache
(qualified-keyword? k)
(let [cache (assoc cache k nil) ; so we don't try to generate it recursively
{:keys [this cache]} (generate-dox (mc/deref (mc/schema k)) cache)]
{:this (*keyword-schema-link* k)
:cache (assoc cache k this)})
:else
((get-method generate-dox-method :default) schema cache)))) |
For things that have n children, like | (defn- generate-dox-for-schemas
[schemas cache]
(reduce
(fn [{:keys [cache these]} schema]
(let [{:keys [this cache]} (generate-dox schema cache)]
{:cache cache
:these (conj these this)}))
{:cache cache, :these []}
schemas)) |
(defmethod generate-dox-method :and
[schema cache]
(let [{:keys [cache these]} (generate-dox-for-schemas (mc/children schema) cache)]
{:this [:div
"Must satisfy all of these:"
(into [:ul]
(map (fn [child]
[:li child]))
these)]
:cache cache})) | |
(defmethod generate-dox-method :or
[schema cache]
(let [{:keys [cache these]} (generate-dox-for-schemas (mc/children schema) cache)]
{:this [:div
"Must be one of these:"
(into [:ul]
(map (fn [child]
[:li child]))
these)]
:cache cache})) | |
(defmethod generate-dox-method :enum
[schema cache]
{:this [:div
"Must be equal to one of these:"
(into [:ul]
(map (fn [child]
[:li [:pre (pr-str child)]]))
(mc/children schema))]
:cache cache}) | |
(defn- generate-table-rows-for-keyed-children [children cache]
(reduce
(fn [{:keys [cache rows]} [k opts child]]
(let [{:keys [cache this]} (generate-dox child cache)
row [:tr
{:style "border: 1px solid black;"}
[:td
{:style "border: 1px solid black; background: #cccccc;"}
[:pre k]
(when (:optional opts)
[:i "Optional."])]
[:td
{:style "border: 1px solid black;"}
[:div (maybe-parse-markdown (:description opts))]
[:div this]]]]
{:cache cache, :rows (conj rows row)}))
{:cache cache, :rows []}
children)) | |
(defmethod generate-dox-method :map
[schema cache]
(if-let [children (not-empty (mc/children schema))]
(let [{:keys [rows cache]} (generate-table-rows-for-keyed-children children cache)]
{:this [:div
"A map with the following keys:"
[:table
[:thead
[:tr [:th "Key"] [:th "Schema"]]]
(into [:tbody] rows)]]
:cache cache})
{:this "A map"
:cache cache})) | |
(defmethod generate-dox-method :merge [schema cache] (generate-dox (mc/deref schema) cache)) | |
(defmethod generate-dox-method :maybe
[schema cache]
(let [[child] (mc/children schema)
{:keys [this cache]} (generate-dox child cache)]
{:this [:div
"Either " [:code "nil"] ", or "
[:div this]]
:cache cache})) | |
(defmethod generate-dox-method :sequential
[schema cache]
(let [[child] (mc/children schema)
{:keys [this cache]} (generate-dox child cache)]
{:this [:div
[:div "A sequence of:"]
[:div this]]
:cache cache})) | |
(defmethod generate-dox-method :map-of
[schema cache]
(let [[k-schema v-schema] (mc/children schema)
{k-dox :this, :keys [cache]} (generate-dox k-schema cache)
{v-dox :this, :keys [cache]} (generate-dox v-schema cache)]
{:this [:div
"Must be a map:"
[:ul
[:li
[:div
"With keys satisfying:"
[:div k-dox]]]
[:li
[:div
"With values satisfying:"
[:div v-dox]]]]]
:cache cache})) | |
(defmethod generate-dox-method :keyword
[_schema cache]
{:this "Must be a keyword."
:cache cache}) | |
(defmethod generate-dox-method :catn
[schema cache]
(let [{:keys [rows cache]} (generate-table-rows-for-keyed-children (mc/children schema) cache)]
{:this [:div
"A sequence with the shape"
[:table
(into [:tbody] rows)]]
:cache cache})) | |
(defmethod generate-dox-method :cat
[schema cache]
(let [{:keys [these cache]} (generate-dox-for-schemas (mc/children schema) cache)]
{:this [:div
"Sequence with the shape"
(into [:ul]
(map (fn [item]
[:li item]))
these)]
:cache cache})) | |
(defmethod generate-dox-method :?
[schema cache]
(let [[child] (mc/children schema)
{:keys [this cache]} (generate-dox child cache)]
{:this [:div
"Zero or one instances of"
[:div this]]
:cache cache})) | |
(defmethod generate-dox-method :*
[schema cache]
(let [[child] (mc/children schema)
{:keys [this cache]} (generate-dox child cache)]
{:this [:div
"Zero or more instances of"
[:div this]]
:cache cache})) | |
(defmethod generate-dox-method :+
[schema cache]
(let [[child] (mc/children schema)
{:keys [this cache]} (generate-dox child cache)]
{:this [:div
"One or more instances of"
[:div this]]
:cache cache})) | |
(defmethod generate-dox-method :=
[schema cache]
(let [[child] (mc/children schema)]
{:this [:div "Must equal " [:code (pr-str child)]]
:cache cache})) | |
(defmethod generate-dox-method :any
[_schema cache]
{:this "anything"
:cache cache}) | |
we'll assume that all the possible dispatch values are possible, and treat this like an | (defmethod generate-dox-method :multi
[schema cache]
(let [{:keys [rows cache]} (generate-table-rows-for-keyed-children (mc/children schema) cache)]
{:this [:div
"One of the following types of expressions:"
[:table
[:thead
[:tr [:th "Type"] [:th "Schema"]]]
(into [:tbody] rows)]]
:cache cache})) |
(defmethod generate-dox-method :boolean
[_schema cache]
{:this [:span "must be either " [:code "true"] " or " [:code "false"] "."]
:cache cache}) | |
(defn- html [title content]
(hiccup/html
[:html
[:head]
[:body
{:style "margin: 0;"}
[:h1 title]
content]])) | |
(defn- clean-target-dir! [target-dir]
(log/infof "CLEAN %s" target-dir)
(let [target-dir (io/file target-dir)]
;; delete target directory if it already exists
(when (.exists target-dir)
(assert (.isDirectory target-dir))
(FileUtils/deleteDirectory target-dir))
;; create the target directory
(.mkdirs target-dir))) | |
(defn- index-html-body [cache]
[:div
(into [:ul]
(map (fn [keyword-schema]
[:li [:div (*keyword-schema-link* keyword-schema)]]))
(sort (keys cache)))]) | |
(defn- write-index-html! [target-dir cache]
(let [filename (str target-dir "/index.html")]
(log/infof "WRITE %s" filename)
(spit filename (html "Index" (index-html-body cache))))) | |
(defn- write-doc-pages! [target-dir cache]
(doseq [[keyword-schema content] cache
:let [filename (str target-dir "/" (keyword-schema-relative-file-name keyword-schema))]]
(log/infof "WRITE %s" filename)
(spit filename (html (schema-title keyword-schema) content)))) | |
(defn- generate-documentation! [schema target-dir]
(clean-target-dir! target-dir)
(let [{:keys [cache]} (generate-dox schema)]
(write-index-html! target-dir cache)
(write-doc-pages! target-dir cache))
(log/info "DONE.")) | |
e.g. clj -X metabase.util.malli.doc/generate-legacy-mbql-dox clj -X metabase.util.malli.doc/generate-legacy-mbql-dox :target-dir '"target/docs/schemas/legacy-mbql"' | (defn generate-legacy-mbql-dox
[{:keys [target-dir]
:or {target-dir "docs/legacy-mbql"}}]
(require 'metabase.legacy-mbql.schema)
(generate-documentation! :metabase.legacy-mbql.schema/Query
target-dir)) |
e.g. clj -X metabase.util.malli.doc/generate-pmbql-dox clj -X metabase.util.malli.doc/generate-pmbql-dox :target-dir '"target/docs/schemas/pmbql"' | (defn generate-pmbql-dox
[{:keys [target-dir]
:or {target-dir "target/docs/schemas/pmbql"}}]
(require 'metabase.lib.schema)
(generate-documentation! :metabase.lib.schema/query
target-dir)) |