commit 4ce98dba8a372119d7219a155a26a467fd814378
from: Omar Polo <op@omarpolo.com>
date: Sat Oct 03 12:00:28 2020 UTC

gemtext parser + gemini generator added

commit - 296689bfe0e47f5cadad7b8cfa2241da9bba0f99
commit + 4ce98dba8a372119d7219a155a26a467fd814378
blob - /dev/null
blob + 09a4edfd97ae0033f1ee98812a333943d8ee1adb (mode 644)
--- /dev/null
+++ src/blog/gemini.clj
@@ -0,0 +1,91 @@
+(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
@@ -0,0 +1,167 @@
+(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"]))
+
+  )