commit - 296689bfe0e47f5cadad7b8cfa2241da9bba0f99
commit + 4ce98dba8a372119d7219a155a26a467fd814378
blob - /dev/null
blob + 09a4edfd97ae0033f1ee98812a333943d8ee1adb (mode 644)
--- /dev/null
+++ src/blog/gemini.clj
+(ns blog.gemini
+ (:require
+ [blog.time :as time]
+ [blog.gemtext :as gemtext]))
+
+(defn with-page [_ & body]
+ (gemtext/unparse
+ (list
+ [:verbatim
+" _
+ _ _ _ _ _ __ ___ | |__
+| | | | | | | '_ ` _ \\| '_ \\
+| |_| | |_| | | | | | | | | |
+ \\__, |\\__,_|_| |_| |_|_| |_|
+ |___/"]
+ [:paragraph "Writing about things, sometimes."]
+ [:paragraph ""]
+ [:link "/" "Home"]
+ [:link "/tags.gmi" "All Tags"]
+ [:link "https://git.omarpolo.com" "Git repos"]
+ [:paragraph ""]
+ body
+ [:paragraph ""]
+ [:paragraph ""]
+ [:paragraph "Blog proudly generated with Clojure"]
+ [:link "https://git.omarpolo.com/blog/" "sources"])))
+
+(defn post-fragment
+ [{:keys [full? title-with-link?]}
+ {:keys [title date slug tags short body toot music xkcd] :as post}]
+ (list
+ (if title-with-link?
+ [:link (str "/post/" slug ".gmi") title]
+ [(if full? :h1 :h2) title])
+ (when full?
+ [:paragraph ""])
+ [:paragraph (str "Written by Omar Polo on " (time/fmt-loc date)
+ (when music
+ (str " while listening to " (:title music) (when-let [by (:by music)]
+ (str " by " by)) ))
+ ".")]
+ [:paragraph "Tagged with:"]
+ (map #(vector :link (str "/tag/" (name %) ".gmi") (str "#" (name %)))
+ tags)
+ (when xkcd
+ [:link (str "https://xkcd.com/" xkcd) (format "Relevant XKCD – #%d" xkcd)])
+ (if full?
+ (list [:paragraph ""]
+ (gemtext/parse body))
+ (when short [:blockquote short]))
+ [:paragraph ""]))
+
+(defn home-page [{:keys [posts has-next has-prev nth]}]
+ (with-page {}
+ [:h2 "Recent posts"]
+ [:paragraph ""]
+ (map (partial post-fragment {:title-with-link? true})
+ posts)
+ (when has-prev
+ [:link (str "/"
+ (if (= (dec nth) 1)
+ "index"
+ (dec nth))
+ ".gmi")
+ "Newer Posts"])
+ (when has-next
+ [:link (str "/" (inc nth) ".gmi")
+ "Older Posts"])))
+
+(defn post-page [{:keys [title short] :as post}]
+ (with-page {}
+ (post-fragment {:full? true}
+ post)))
+
+(defn tags-page [tags]
+ (with-page {}
+ [:h2 "All tags"]
+ [:paragraph ""]
+ (map #(vector :link (str "/tag/" (name %) ".gmi") (str "#" (name %)))
+ (sort (fn [a b]
+ (compare (.toLowerCase (name a))
+ (.toLowerCase (name b)))) tags))))
+
+(defn tag-page [tag posts]
+ (with-page {}
+ [:h2 (format "Posts tagged with #%s" tag)]
+ [:paragraph ""]
+ (map (partial post-fragment {:title-with-link? true})
+ (->> posts
+ (sort-by :date)
+ (reverse)))))
blob - /dev/null
blob + 95a1fcb4468cec4f86d14e8566743bfe13c7b9f5 (mode 644)
--- /dev/null
+++ src/blog/gemtext.clj
+(ns blog.gemtext
+ (:require
+ [clojure.string :as str]
+ [clojure.walk :as walk]))
+
+(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)
+
+ (and in-verbatim? marker?) ;return what we've got and go to :normal
+ (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)))
+
+(defn unparse [thing]
+ (let [sw (StringBuilder.)]
+ (walk/prewalk
+ (fn [t]
+ (cond
+ (nil? t) nil
+
+ (or (seq? t)
+ (vector? t))
+ (if (keyword? (first 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)
+ t)))
+ thing)
+ (.toString sw)))
+
+(defn to-hiccup [doc]
+ (let [l (atom [])]
+ (walk/prewalk
+ (fn [t]
+ (cond
+ (nil? t) nil
+
+ (or (seq? t)
+ (vector? t))
+ (if (keyword? (first t))
+ (let [[type a b] t]
+ (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 [:p.link [:a {:href a} b]]
+ :paragraph [:p a]))
+ nil)
+ t)))
+ 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"]))
+
+ )
