commit b32bfb8fa93db6cc6f2dd1f46cb903fa9ce0ab31 from: Omar Polo date: Tue Aug 03 11:29:49 2021 UTC use my gemtext library commit - 648a6dfb248c55dfa39338ded6a2c81668240980 commit + b32bfb8fa93db6cc6f2dd1f46cb903fa9ce0ab31 blob - d664601d24d43daa0c7fda126953e2e1fae551a8 blob + ba4e410d581d23a1307afea3e4b852e2960028a9 --- deps.edn +++ deps.edn @@ -1,7 +1,8 @@ {:deps {hiccup {:mvn/version "1.0.5"} ring {:mvn/version "1.8.0"} commonmark-hiccup {:mvn/version "0.1.0"} - org.clojure/data.xml {:mvn/version "0.2.0-alpha6"}} + org.clojure/data.xml {:mvn/version "0.2.0-alpha6"} + com.omarpolo/gemtext {:mvn/version "0.1.5"}} :paths ["src" "resources"] blob - b888e62f294f8c34aacbb16239142a2a8d3bb23a blob + 7c27ddd70c8759a5a07fac72f2770d152ba3f1df --- src/blog/gemtext.clj +++ src/blog/gemtext.clj @@ -1,201 +1,49 @@ (ns blog.gemtext (:require [clojure.string :as str] - [clojure.walk :as walk])) + [clojure.walk :as walk] + [gemtext.core :as gemtext])) -(defn- starts-with? - "check if `s` starts with `substr`. Return `false` if `s` is not a - string." - [s substr] - (when (string? s) - (str/starts-with? s substr))) - -(defn- match-code-blocks [] - (fn [rf] - (let [acc (volatile! []) - state (volatile! :normal)] - (fn - ([] (rf)) - ([result] (rf result)) - ([result line] - (let [in-verbatim? (= :verbatim @state) - marker? (starts-with? line "```")] - (cond - (and (not in-verbatim?) marker?) ;go to verbatim - (do (vreset! state :verbatim) - result) - - ;; return what we've got and go to :normal - (and in-verbatim? marker?) - (let [res [:verbatim (str/join "\n" @acc)]] - (vreset! state :normal) - (vreset! acc []) - (rf result res)) - - in-verbatim? - (do (vswap! acc conj line) - result) - - :else - (rf result line)))))))) - -(defn- match-headings [] - (fn [rf] - (fn - ([] (rf)) - ([result] (rf result)) - ([result line] - (rf result - (cond - ;; the space character after the # is madatory - (starts-with? line "# ") [:h1 (subs line 2)] - (starts-with? line "## ") [:h2 (subs line 3)] - (starts-with? line "### ") [:h3 (subs line 4)] - :else line)))))) - -(defn- generic-matcher - "Return a generic matcher transducer. Will wrap line that starts with - `start` within `[type line]`." - [start type] - (fn [rf] - (fn - ([] (rf)) - ([result] (rf result)) - ([result line] - (rf result - (if (starts-with? line start) - [type (subs line (count start))] - line)))))) - -(defn- match-lists [] (generic-matcher "* " :li)) -(defn- match-blockquotes [] (generic-matcher "> " :blockquote)) - -(defn- match-links [] - (fn [rf] - (fn - ([] (rf)) - ([result] (rf result)) - ([result line] - (let [spaces? #{\space \tab} - nonblank? (complement spaces?)] - (rf result - (if-not (starts-with? line "=>") - line - (->> (seq line) - (drop 2) ; drop the marker - (drop-while spaces?) ; drop also the optional spaces - (split-with nonblank?) ; separate URL from (optional) label - (apply #(vector :link - (apply str %1) - (apply str (drop-while spaces? %2)))))))))))) - -(defn match-paragraphs [] (generic-matcher "" :paragraph)) - -(def parser - (comp (match-code-blocks) - (match-headings) - (match-lists) - (match-blockquotes) - (match-links) - (match-paragraphs))) - (defn parse "Given a string representing a gemtext document, parse it into an hiccup-like data structure." [str] - (transduce parser conj [] (str/split-lines str))) + (gemtext/parse str)) (defn unparse [thing] - (let [sw (StringBuilder.)] - (walk/prewalk - (fn [t] - (cond - (nil? t) nil + (gemtext/unparse thing)) - (or (seq? t) - (vector? t)) - (if-not (keyword? (first t)) - t - (let [[type a b] t] - (.append sw - (case type - :verbatim (str "```\n" a "\n```") - :h1 (str "# " a) - :h2 (str "## " a) - :h3 (str "### " a) - :li (str "* " a) - :blockquote (str "> " a) - :link (str "=> " a " " b) - :paragraph a)) - (.append sw "\n") - nil)))) - thing) - (.toString sw))) +(defn maybe-patch-link [[type attrs body :as t]] + (cond (not= type :a) t -(defn html-escape - "Escape HTML entities in `str`" - [str] - (str/escape str - {\< "<" - \> ">" - \& "&"})) + (re-matches #".*\.(jpg|jpeg|png|gif)" (:href attrs)) + (let [{:keys [href]} attrs] + [:figure + [:a {:href href} + [:img {:src href + :alt body}]] + [:figcaption body]]) -(defn- link->html - "Convert a (gemtext) link an HTML element. If the link is pointing to - an image (guessed by href) transform it into an image, otherwise - return a (HTML) link." - [[_ href text]] - (let [text (html-escape text)] - (cond - (re-matches #".*\.(jpg|jpeg|png|gif)" href) - [:figure - [:a {:href href} - [:img {:src href - :alt text}]] - [:figcaption text]] + (re-matches #".*\.gmi" (:href attrs)) + [:p.link [:a {:href (str/replace (:href attrs) + #"\.gmi$" + ".html")} + body]] - ;; TODO: only for local and absolute URL to my site - (re-matches #".*\.gmi" href) - [:p.link [:a {:href (str/replace href #"\.gmi$" ".html")} - text]] + :else + [:p.link [:a {:href (:href attrs)} + body]])) - :else - [:p.link [:a {:href href} - text]]))) +(defn not-empty-ps [[type body :as t]] + (not + (and (= type :p) + (= body "")))) (defn to-hiccup [doc] - (let [l (atom [])] - (walk/prewalk - (fn [t] - (cond - (nil? t) nil + (->> (gemtext/to-hiccup doc) + (filter not-empty-ps) + (map maybe-patch-link))) - (or (seq? t) - (vector? t)) - (if-not (keyword? (first t)) - t - (let [[type a & _] t - a (html-escape a)] - (swap! l conj - (case type - :verbatim [:pre [:code a]] - :h1 [:h1 a] - :h2 [:h2 a] - :h3 [:h3 a] - :li [:ul [:li a]] ;; TODO! - :blockquote [:blockquote a] - :link (link->html t) - :paragraph (when (and a (not= a "")) - [:p a]))) - nil)))) - doc) - (seq @l))) - (comment - - (unparse (parse "```\nhello there\n```\n")) - - (unparse (list [:h2 "hello there"] (list (list nil (list nil))))) - (unparse (list [:h2 "hello there"])) - - ) + (to-hiccup [[:link "http://f.com" "hello"]]) +)