1 4ce98dba 2020-10-03 op (ns blog.gemtext
 2 4ce98dba 2020-10-03 op   (:require
 3 4ce98dba 2020-10-03 op    [clojure.string :as str]
 4 b32bfb8f 2021-08-03 op    [clojure.walk :as walk]
 5 b32bfb8f 2021-08-03 op    [gemtext.core :as gemtext]))
 6 4ce98dba 2020-10-03 op 
 7 d68cd6bb 2020-10-03 op (defn parse
 8 4ce98dba 2020-10-03 op   "Given a string representing a gemtext document, parse it into an
 9 4ce98dba 2020-10-03 op   hiccup-like data structure."
10 4ce98dba 2020-10-03 op   [str]
11 b32bfb8f 2021-08-03 op   (gemtext/parse str))
12 4ce98dba 2020-10-03 op 
13 4ce98dba 2020-10-03 op (defn unparse [thing]
14 b32bfb8f 2021-08-03 op   (gemtext/unparse thing))
15 d68cd6bb 2020-10-03 op 
16 b32bfb8f 2021-08-03 op (defn maybe-patch-link [[type attrs body :as t]]
17 b32bfb8f 2021-08-03 op   (cond (not= type :a) t
18 4ce98dba 2020-10-03 op 
19 b32bfb8f 2021-08-03 op         (re-matches #".*\.(jpg|jpeg|png|gif)" (:href attrs))
20 b32bfb8f 2021-08-03 op         (let [{:keys [href]} attrs]
21 b32bfb8f 2021-08-03 op           [:figure
22 b32bfb8f 2021-08-03 op            [:a {:href href}
23 b32bfb8f 2021-08-03 op             [:img {:src href
24 b32bfb8f 2021-08-03 op                    :alt body}]]
25 b32bfb8f 2021-08-03 op            [:figcaption body]])
26 14cabc53 2020-10-14 op 
27 b32bfb8f 2021-08-03 op         (re-matches #".*\.gmi" (:href attrs))
28 b32bfb8f 2021-08-03 op         [:p.link [:a {:href (str/replace (:href attrs)
29 b32bfb8f 2021-08-03 op                                          #"\.gmi$"
30 b32bfb8f 2021-08-03 op                                          ".html")}
31 b32bfb8f 2021-08-03 op                   body]]
32 8eb658e5 2020-11-07 op 
33 b32bfb8f 2021-08-03 op         :else
34 b32bfb8f 2021-08-03 op         [:p.link [:a {:href (:href attrs)}
35 b32bfb8f 2021-08-03 op                   body]]))
36 8eb658e5 2020-11-07 op 
37 b32bfb8f 2021-08-03 op (defn not-empty-ps [[type body :as t]]
38 b32bfb8f 2021-08-03 op   (not
39 b32bfb8f 2021-08-03 op    (and (= type :p)
40 b32bfb8f 2021-08-03 op         (= body ""))))
41 14cabc53 2020-10-14 op 
42 4ce98dba 2020-10-03 op (defn to-hiccup [doc]
43 b32bfb8f 2021-08-03 op   (->> (gemtext/to-hiccup doc)
44 b32bfb8f 2021-08-03 op        (filter not-empty-ps)
45 b32bfb8f 2021-08-03 op        (map maybe-patch-link)))
46 4ce98dba 2020-10-03 op 
47 4ce98dba 2020-10-03 op (comment
48 b32bfb8f 2021-08-03 op   (to-hiccup [[:link "http://f.com" "hello"]])
49 b32bfb8f 2021-08-03 op )