simon/smeagol
1
0
Fork 0
mirror of https://github.com/journeyman-cc/smeagol.git synced 2026-04-12 18:05:06 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

More orthogonal inclusion processing

Browse source
This commit is contained in:
Simon Brooke 2017-08-02 07:36:37 +01:00
parent 9630e16d94
commit 91367e40aa
1 changed files with 35 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

62
src/smeagol/formatting.clj
View file

@ -61,35 +61,43 @@
no-text-error)) no-text-error))
(defn yaml->vis (defn yaml->json
"Transcode this YAML fragment into the source for a Vega visualisation with this index." "Rewrite this string, assumed to be in YAML format, as JSON."
[^String yaml-src ^Integer index] [^String yaml-src]
(json/write-str (yaml/parse-string yaml-src)))
(defn process-vega
"Process this `vega-source` string, assumed to be in YAML format, into a specification
of a Vega chart, and add the plumbing to render it."
[^String vega-src ^Integer index]
(str (str
"<div class='data-visualisation' id='vis" index "'></div>\n" "<div class='data-visualisation' id='vis" index "'></div>\n"
"<script>\n//<![CDATA[\nvar vl" "<script>\n//<![CDATA[\nvar vl"
index index
" = " " = "
(json/write-str (yaml->json (str "$schema: https://vega.github.io/schema/vega-lite/v2.json\n" vega-src))
(assoc (yaml/parse-string yaml-src) (keyword "$schema") "https://vega.github.io/schema/vega-lite/v2.json"))
";\nvega.embed('#vis" index "', vl" index ");\n//]]\n</script>")) ";\nvega.embed('#vis" index "', vl" index ");\n//]]\n</script>"))
(defn process-mermaid (defn process-mermaid
"Lightly mung the mermaid specification." "Lightly mung this `graph-spec`, assumed to be a mermaid specification."
[^String graph-spec ^Integer index] [^String graph-spec ^Integer index]
(str "<div class=\"mermaid data-visualisation\">\n" (str "<div class=\"mermaid data-visualisation\">\n"
graph-spec graph-spec
"\n</div>")) "\n</div>"))
(defn process-text (defn process-text
"Process this `text`, assumed to be markdown potentially containing both local links "Process this `text`, assumed to be markdown potentially containing both local links
and YAML visualisation specifications, and return a map comprising JSON visualisation and YAML visualisation specifications, and return a map comprising JSON visualisation
specification, and HTML text with markers for where those should be reinserted. specification, and HTML text with markers for where those should be reinserted.
The map has two top-level keys: `:visualisations`, a map of constructed keywords to The map has two top-level keys: `:inclusions`, a map of constructed keywords to
visualisation specifications, and `:text`, an HTML text string with the keywords inclusion specifications, and `:text`, an HTML text string with the keywords
present where the corresponding visualisation should be inserted." present where the corresponding inclusion should be inserted."
([text] ([text]
(process-text 0 {:visualisations {}} (cs/split text #"```") '())) (process-text 0 {:inclusions {}} (cs/split text #"```") '()))
([index result fragments processed] ([index result fragments processed]
(cond (cond
(empty? fragments) (empty? fragments)
@ -100,29 +108,29 @@
:heading-anchors true))) :heading-anchors true)))
;;; TODO: refactor; generalise extension architecture ;;; TODO: refactor; generalise extension architecture
(clojure.string/starts-with? (first fragments) "vis") (clojure.string/starts-with? (first fragments) "vis")
(let [kw (keyword (str "visualisation-" index))] (let [kw (keyword (str "inclusion-" index))]
(process-text (process-text
(+ index 1) (+ index 1)
(assoc (assoc
result result
:visualisations :inclusions
(assoc (assoc
(:visualisations result) (:inclusions result)
kw kw
(yaml->vis (process-vega
(subs (first fragments) 3) (subs (first fragments) 3)
index))) index)))
(rest fragments) (rest fragments)
(cons kw processed))) (cons kw processed)))
(clojure.string/starts-with? (first fragments) "mermaid") (clojure.string/starts-with? (first fragments) "mermaid")
(let [kw (keyword (str "visualisation-" index))] (let [kw (keyword (str "inclusion-" index))]
(process-text (process-text
(+ index 1) (+ index 1)
(assoc (assoc
result result
:visualisations :inclusions
(assoc (assoc
(:visualisations result) (:inclusions result)
kw kw
(process-mermaid (process-mermaid
(subs (first fragments) 7) (subs (first fragments) 7)
@ -133,27 +141,27 @@
(process-text (+ index 1) result (rest fragments) (cons (first fragments) processed))))) (process-text (+ index 1) result (rest fragments) (cons (first fragments) processed)))))
(defn reintegrate-visualisations (defn reintegrate-inclusions
"Given a map of the form produced by `process-text`, return a string of HTML text "Given a map of the form produced by `process-text`, return a string of HTML text
with the visualisations (if any) reintegrated." with the inclusions (if any) reintegrated."
([processed-text] ([processed-text]
(reintegrate-visualisations (:visualisations processed-text) (:text processed-text))) (reintegrate-inclusions (:inclusions processed-text) (:text processed-text)))
([visualisations text] ([inclusions text]
(let [ks (keys visualisations)] (let [ks (keys inclusions)]
(if (empty? (keys visualisations)) (if (empty? (keys inclusions))
text text
(let [kw (first ks)] (let [kw (first ks)]
(reintegrate-visualisations (reintegrate-inclusions
(dissoc visualisations kw) (dissoc inclusions kw)
(cs/replace (cs/replace
text text
(str kw) (str kw)
(cs/replace (kw visualisations) "\\/" "/")))))))) (cs/replace (kw inclusions) "\\/" "/"))))))))
(defn md->html (defn md->html
"Take this markdown source, and return HTML." "Take this markdown source, and return HTML."
[md-src] [md-src]
(reintegrate-visualisations (process-text md-src))) (reintegrate-inclusions (process-text md-src)))