1 (ns blog.http
2   (:require
3    [blog.time :as time]
4    [blog.gemtext :as gemtext]
5    [clojure.string :as str]
6    [clojure.walk :as walk]
7    [hiccup.page :refer [html5 include-css]]
8    [commonmark-hiccup.core :refer [markdown->hiccup default-config]]))
9 
10 (defn link-item [{:keys [url text title]}]
11   [:li [:a (cond-> {:href url}
12              title (assoc :title title))
13         text]])
14 
15 (defn header [{:keys [skip-banner?]}]
16   (list
17    [:header
18     [:nav
19      [:ul
20       (link-item {:url "/", :text "Home"})
21       (link-item {:url "/tags.html", :text "All Tags"})
22       (link-item {:url "/pages/projects.html", :text "Projects"})
23       (link-item {:url "gemini://gemini.omarpolo.com" :text "gemini://"
24                   :title "This website in the gemini space."})]]
25     (when-not skip-banner?
26       [:div
27        [:h1 [:a {:href "/"} "yumh"]]
28        [:p "writing about things, sometimes."]])]))
29 
30 (defn with-page
31   [{:keys [title class description skip-banner?], :as d} & body]
32   (html5 {:lang "en"}
33    [:head
34     [:meta {:charset "utf8"}]
35     [:meta {:name "viewport", :content "width=device-width, initial-scale=1"}]
36     [:link {:rel "shortcut icon", :href "/favicon.ico"}]
37     [:link {:rel "alternative" :type "application/rss+xml" :href "https://www.omarpolo.com/rss.xml"}]
38     (when description
39       [:meta {:name "description" :content description}])
40     [:title title]
41     (include-css "/css/style.css")]
42    [:body {:class (or class "")}
43     (header d)
44     [:main body]
45     [:footer
46      [:p "text: CC-BY-SA-4.0; code: ISC (unless specified otherwise)"]
47      [:p "Blog proudly generated with "
48       [:a {:href "https://git.omarpolo.com/blog/"}
49        [:code "(clojure)"]]]]
50     [:noscript
51      [:img {:src "https://goatcounter.omarpolo.com/count?p=/test-img"}]]
52     [:script "
53 ;(function () {
54   if (window.location.host !== 'omarpolo.com')
55     window.goatcounter = {no_onload: true}
56 })();"]
57     [:script {:data-goatcounter "https://goatcounter.omarpolo.com/count"
58               :async true
59               :src "//goatcounter.omarpolo.com/count.js"}]]))
60 
61 (defn link->images
62   "traverse `doc` and replace every link to an image to an `img` tag."
63   [doc]
64   (walk/prewalk
65    (fn [item]
66      (if-not (and (vector? item) (= (first item) :a))
67        item
68        (let [[_ {:keys [href] :as attrs} text] item]
69          [:p
70           [:a attrs
71            [:img {:src href
72                   :alt text}]]])))))
73 
74 (defn post-fragment
75   [{:keys [full? title-with-link?]}
76    {:keys [title date slug tags short body toot music xkcd gemtext?], :as post}]
77   [:article
78    [:header
79     [(if full?
80        :h1
81        :h2.fragment)
82      (if title-with-link?
83        [:a {:href (str "/post/" slug ".html")} title]
84        title)]
85     [:p.author "Written by " [:em "Omar Polo"] " on " (time/fmt-loc date)
86      (list
87       (when music
88         (list " while listening to " [:a {:href   (:url music)
89                                           :target "_blank"
90                                           :rel    "noopener"}
91                                       "“" [:em (:title music)] "”"
92                                       (when-let [by (:by music)]
93                                         (list " by " [:em by]))]))
94       ".")]
95     [:ul.tags (map #(vector :li [:a {:href (str "/tag/" (name %) ".html")}
96                                  (str "#" (name %))])
97                    tags)]
98     (when xkcd
99       [:p [:a {:href (str "https://xkcd.com/" xkcd)
100                :target "_blank"
101                :rel "noopener"}
102            "Related XKCD"]])
103     (when toot
104       [:p [:a {:href   toot,
105                :target "_blank"
106                :rel    "noopener"} "Comments over ActivityPub"]])]
107    [:section
108     (if full?
109       (if gemtext?
110         (-> body gemtext/parse gemtext/to-hiccup)
111         (markdown->hiccup default-config body))
112       [:p short])]])
113 
114 (defn home-page
115   [{:keys [posts has-next has-prev nth]}]
116   (with-page {:title "Home"}
117     (map (partial post-fragment {:title-with-link? true})
118          posts)
119     [:nav.post-navigation
120      (if has-prev
121        [:a.prev {:href (str "/" (if (= (dec nth) 1)
122                                   "index"
123                                   (dec nth)) ".html")}
124         "« Newer Posts"])
125      (if has-next
126        [:a.next {:href (str "/" (inc nth) ".html")}
127         "Older Posts »"])]))
128 
129 (defn custom-page [{:keys [title body]}]
130   (with-page {:title        title
131               :skip-banner? true}
132     ;; warning: hack ahead
133     (walk/prewalk
134      (fn [item]
135        (if-not (and (vector? item) (= (first item) :a))
136          item
137          (let [[_ attrs & body] item]
138            [:a (update attrs :href str/replace #"\.gmi$" ".html")
139             body])))
140      (-> body gemtext/parse gemtext/to-hiccup))))
141 
142 (defn post-page
143   [{:keys [title short], :as post}]
144   (with-page {:title title
145               :class "article"
146               :description short}
147     (post-fragment {:full? true}
148                    post)))
149 
150 (defn tags-page
151   [tags]
152   (with-page {:title "All tags"
153               :class "tags"}
154     [:h2 "All tags"]
155     [:nav
156      [:ul
157       (map #(vector :li [:a {:href (str "/tag/" (name %) ".html")} (str "#" (name %))])
158            (sort (fn [a b]
159                    (compare (.toLowerCase (name a))
160                             (.toLowerCase (name b)))) tags))]]))
161 
162 (defn tag-page
163   [tag posts]
164   (with-page {:title (str "Posts tagged with #" tag)
165               :class "tag"}
166     [:h2 "Posts tagged with " [:code "#" tag]]
167     (map (partial post-fragment {:title-with-link? true})
168          (->> posts
169               (sort-by :date)
170               (reverse)))))