1 (ns blog.gemtext
2   (:require
3    [clojure.string :as str]
4    [clojure.walk :as walk]))
5 
6 (defn- starts-with?
7   "check if `s` starts with `substr`.  Return `false` if `s` is not a
8   string."
9   [s substr]
10   (when (string? s)
11     (str/starts-with? s substr)))
12 
13 (defn- match-code-blocks []
14   (fn [rf]
15     (let [acc   (volatile! [])
16           state (volatile! :normal)]
17       (fn
18         ([] (rf))
19         ([result] (rf result))
20         ([result line]
21          (let [in-verbatim? (= :verbatim @state)
22                marker?      (starts-with? line "```")]
23            (cond
24              (and (not in-verbatim?) marker?) ;go to verbatim
25              (do (vreset! state :verbatim)
26                  result)
27 
28              ;; return what we've got and go to :normal
29              (and in-verbatim? marker?)
30              (let [res [:verbatim (str/join "\n" @acc)]]
31                (vreset! state :normal)
32                (vreset! acc [])
33                (rf result res))
34 
35              in-verbatim?
36              (do (vswap! acc conj line)
37                  result)
38 
39              :else
40              (rf result line))))))))
41 
42 (defn- match-headings []
43   (fn [rf]
44     (fn
45       ([] (rf))
46       ([result] (rf result))
47       ([result line]
48        (rf result
49            (cond
50              ;; the space character after the # is madatory
51              (starts-with? line "# ")   [:h1 (subs line 2)]
52              (starts-with? line "## ")  [:h2 (subs line 3)]
53              (starts-with? line "### ") [:h3 (subs line 4)]
54              :else                      line))))))
55 
56 (defn- generic-matcher
57   "Return a generic matcher transducer.  Will wrap line that starts with
58   `start` within `[type line]`."
59   [start type]
60   (fn [rf]
61     (fn
62       ([] (rf))
63       ([result] (rf result))
64       ([result line]
65        (rf result
66            (if (starts-with? line start)
67              [type (subs line (count start))]
68              line))))))
69 
70 (defn- match-lists [] (generic-matcher "* " :li))
71 (defn- match-blockquotes [] (generic-matcher "> " :blockquote))
72 
73 (defn- match-links []
74   (fn [rf]
75     (fn
76       ([] (rf))
77       ([result] (rf result))
78       ([result line]
79        (let [spaces?   #{\space \tab}
80              nonblank? (complement spaces?)]
81          (rf result
82              (if-not (starts-with? line "=>")
83                line
84                (->> (seq line)
85                     (drop 2)               ; drop the marker
86                     (drop-while spaces?)   ; drop also the optional spaces
87                     (split-with nonblank?) ; separate URL from (optional) label
88                     (apply #(vector :link
89                                     (apply str %1)
90                                     (apply str (drop-while spaces? %2))))))))))))
91 
92 (defn match-paragraphs [] (generic-matcher "" :paragraph))
93 
94 (def parser
95   (comp (match-code-blocks)
96         (match-headings)
97         (match-lists)
98         (match-blockquotes)
99         (match-links)
100         (match-paragraphs)))
101 
102 (defn parse
103   "Given a string representing a gemtext document, parse it into an
104   hiccup-like data structure."
105   [str]
106   (transduce parser conj [] (str/split-lines str)))
107 
108 (defn unparse [thing]
109   (let [sw (StringBuilder.)]
110     (walk/prewalk
111      (fn [t]
112        (cond
113          (nil? t) nil
114 
115          (or (seq? t)
116              (vector? t))
117          (if-not (keyword? (first t))
118            t
119            (let [[type a b] t]
120              (.append sw
121                       (case type
122                         :verbatim   (str "```\n" a "\n```")
123                         :h1         (str "# " a)
124                         :h2         (str "## " a)
125                         :h3         (str "### " a)
126                         :li         (str "* " a)
127                         :blockquote (str "> " a)
128                         :link       (str "=> " a " " b)
129                         :paragraph  a))
130              (.append sw "\n")
131              nil))))
132      thing)
133     (.toString sw)))
134 
135 (defn html-escape
136   "Escape HTML entities in `str`"
137   [str]
138   (str/escape str
139               {\< "&lt;"
140                \> "&gt;"
141                \& "&amp;"}))
142 
143 (defn- link->html
144   "Convert a (gemtext) link an HTML element.  If the link is pointing to
145   an image (guessed by href) transform it into an image, otherwise
146   return a (HTML) link."
147   [[_ href text]]
148   (let [text (html-escape text)]
149     (if (re-matches #".*\.(jpg|jpeg|png|gif)" href)
150       [:p [:a {:href href}
151            [:img {:src href
152                   :alt text}]]]
153       [:p.link [:a {:href href}
154                 text]])))
155 
156 (defn to-hiccup [doc]
157   (let [l (atom [])]
158     (walk/prewalk
159      (fn [t]
160        (cond
161          (nil? t) nil
162 
163          (or (seq? t)
164              (vector? t))
165          (if-not (keyword? (first t))
166            t
167            (let [[type a & _] t
168                  a            (html-escape a)]
169              (swap! l conj
170                     (case type
171                       :verbatim   [:pre [:code a]]
172                       :h1         [:h1 a]
173                       :h2         [:h2 a]
174                       :h3         [:h3 a]
175                       :li         [:ul [:li a]] ;; TODO!
176                       :blockquote [:blockquote a]
177                       :link       (link->html t)
178                       :paragraph  [:p a]))
179              nil))))
180      doc)
181     (seq @l)))
182 
183 (comment
184 
185   (unparse (parse "```\nhello there\n```\n"))
186 
187   (unparse (list [:h2 "hello there"] (list (list nil (list nil)))))
188   (unparse (list [:h2 "hello there"]))
189 
190   )