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