1 (ns blog.core
2   (:require
3    [blog.gemini :as gemini]
4    [blog.http :as http]
5    [blog.net-gemini :as net-gemini]
6    [blog.rss :as rss]
7    [blog.time :as time]
8    [clojure.edn :as edn]
9    [clojure.java.io :as io]
10    [clojure.java.shell :refer [sh]]
11    [ring.adapter.jetty :as jetty]
12    [ring.middleware.content-type :refer [wrap-content-type]]
13    [ring.middleware.resource :refer [wrap-resource]])
14   (:import (java.io File)
15            (java.nio.file Files Paths))
16   (:gen-class))
17 
18 (defn copy-file [src dst]
19   (with-open [in  (io/input-stream (io/file src))
20               out (io/output-stream (io/file dst))]
21     (io/copy in out)))
22 
23 (defn post [{:keys [slug gemtext?] :as p}]
24   (let [ext  (if gemtext? ".gmi" ".md")
25         path (str "posts/" slug ext)
26         file (io/resource path)]
27     (when-not file
28       (throw (ex-info "51: post not found" {:slug     slug
29                                             :gemtext? gemtext?
30                                             :path     path})))
31     (-> p
32         (assoc  :body (slurp file))
33         (update :date time/parse))))
34 
35 (def pages (atom nil))
36 (def per-tag (atom {}))
37 (def posts (atom []))
38 
39 (defn add-post! [m]
40   (let [p (post m)]
41     (swap! posts conj p)
42     (doseq [t (:tags m)]
43       (swap! per-tag update t conj p))))
44 
45 (defn load-posts! []
46   (reset! per-tag {})
47   (reset! posts [])
48   (doseq [p (-> "posts.edn"
49                 io/resource
50                 slurp
51                 edn/read-string)]
52     (add-post! p)))
53 
54 (defn load-pages! []
55   (reset! pages (->> "pages.edn"
56                      io/resource
57                      slurp
58                      edn/read-string
59                      (map (fn [{:keys [slug] :as p}]
60                             (assoc p :body (as-> slug $
61                                                 (str "pages/" $ ".gmi")
62                                                 (io/resource $)
63                                                 (slurp $))))))))
64 
65 (defn create-dirs! []
66   (doseq [d ["resources/out"
67              "resources/out/gemini"
68              "resources/out/gemini/pages"
69              "resources/out/gemini/post"
70              "resources/out/gemini/tag"
71              "resources/out/gemini/img"
72              "resources/out/gemini/cgi"
73              "resources/out/http"
74              "resources/out/http/css"
75              "resources/out/http/pages"
76              "resources/out/http/post"
77              "resources/out/http/tag"
78              "resources/out/http/img"]]
79     (.. (File. d) mkdirs)))
80 
81 (def gemini-post :gemtext?)
82 
83 (defn post-pages [{:keys [proto]}]
84   (let [tags (keys @per-tag)
85         ext  (if (= proto :gemini) ".gmi" ".html")
86         ffn  (if (= proto :gemini) gemini-post identity)
87         ffn' #(when (ffn %)
88                 (not (:draft? %)))]
89     (map-indexed (fn [i posts]
90                    {:filename (if (= i 0)
91                                 (str "index" ext)
92                                 (str (inc i) ext))
93                     :tags tags
94                     :nth (inc i)
95                     :posts posts
96                     :has-next true
97                     :has-prev true})
98                  (partition-all 6 (filter ffn' @posts)))))
99 
100 (defn fix-next-last
101   "Fix the :has-prev/:has-next for the post pages.  This assumes
102   that `(not (empty? post-pages))`"
103   [post-pages]
104   (-> post-pages
105       (->> (into []))
106       (update 0                        assoc :has-prev false)
107       (update (dec (count post-pages)) assoc :has-next false)))
108 
109 (defn render-pages [pagefn proto ext]
110   (doseq [page @pages
111           :let [{:keys [slug]} page
112                 filename (str "resources/out/"
113                               (name proto) "/pages/"
114                               slug ext)]]
115     (spit filename
116           (pagefn page))))
117 
118 (defn render-post-list [viewfn proto]
119   (doseq [p    (fix-next-last (post-pages {:proto proto}))
120           :let [{:keys [filename]} p]]
121     (spit (str "resources/out/" (name proto) "/" filename)
122           (viewfn p))))
123 
124 (defn render-post [viewfn proto ext {s :slug, :as post}]
125   (spit (str "resources/out/" (name proto) "/post/" s ext)
126         (viewfn post)))
127 
128 (defn render-tags [viewfn proto ext tags]
129   (spit (str "resources/out/" (name proto) "/tags" ext)
130         (viewfn tags)))
131 
132 (defn render-tag [viewfn proto ext tag posts]
133   (spit (str "resources/out/" (name proto) "/tag/" tag ext)
134         (viewfn tag posts)))
135 
136 (defn render-rss []
137   (let [gemposts (->> @posts
138                       (filter gemini-post)
139                       (map #(dissoc % :body)))]
140     (spit (str "resources/out/gemini/rss.xml")
141           (rss/feed #(str "gemini://gemini.omarpolo.com/post/" % ".gmi")
142                     gemposts))
143     (spit (str "resources/out/gemini/rss.gmi")
144           (gemini/feed-page gemposts)))
145   (spit (str "resources/out/http/rss.xml")
146         (rss/feed #(str "https://www.omarpolo.com/post/" % ".html") @posts)))
147 
148 (defn generate-robots-txt []
149   (spit "resources/out/gemini/robots.txt" "# block some bots from accessing gempkg/man
150 User-agent: archiver
151 Disallow: /cgi/gempkg/
152 
153 User-agent: researcher
154 Disallow: /cgi/gempkg/
155 
156 User-agent: archiver
157 Disallow: /cgi/man/
158 
159 User-agent: researcher
160 Disallow: /cgi/man/
161 "))
162 
163 (defn copy-dir
164   "Copy the content of resources/`dir` to resources/out/`proto`/`dir`,
165   assuming these two directories exists."
166   [dir proto]
167   ;; java sucks at files
168   (sh "cp" "-a"
169       (str "resources/" dir)
170       (str "resources/out/" proto "/")))
171 
172 (defn copy-assets
173   "Copy css and images to their places"
174   []
175   (copy-dir "img" "http")
176   (copy-dir "img" "gemini")
177   (copy-dir "dots" "http")
178   (copy-dir "dots" "gemini")
179   (copy-file "resources/favicon.ico" "resources/out/http/favicon.ico")
180   (copy-file "resources/css/style.css" "resources/out/http/css/style.css"))
181 
182 (defn copy-cgi
183   "Copy cgi scripts to their place."
184   []
185   (copy-dir "cgi" "gemini"))
186 
187 (comment (build)
188          (copy-cgi)
189          (count (filter gemini-post @posts))
190          (gemini/post-page (first @posts))
191          )
192 
193 (defn build
194   "Build the blog"
195   []
196   (create-dirs!)
197   (copy-assets)
198   (copy-cgi)
199   (render-rss)
200   (generate-robots-txt)
201   (doseq [[proto ffn ext homefn postfn tagsfn tagfn pagefn]
202           [[:http identity ".html" http/home-page http/post-page http/tags-page http/tag-page http/custom-page]
203            [:gemini gemini-post ".gmi" gemini/home-page gemini/post-page gemini/tags-page gemini/tag-page gemini/custom-page]]]
204     (render-pages pagefn proto ext)
205     (render-post-list homefn proto)
206     (doseq [p (filter ffn @posts)]
207       (render-post postfn proto ext p))
208     (render-tags tagsfn proto ext (keys @per-tag))
209     (doseq [t @per-tag
210             :let [[tag posts] t]]
211       (render-tag tagfn proto ext (name tag) (filter ffn posts)))))
212 
213 (def j (atom nil))
214 
215 (defn serve
216   "Serve a preview"
217   []
218   (reset!
219    j
220    (jetty/run-jetty (-> (fn [_] {:status 404, :body "not found"})
221                         (wrap-resource "out")
222                         (wrap-content-type))
223                     {:port 3030
224                      :join? false})))
225 
226 (defn clean
227   "clean the output directory"
228   []
229   (sh "rm" "-rf" "resources/out/http/")
230   (sh "rm" "-rf" "resources/out/gemini/"))
231 
232 (defn local-deploy
233   "Copy the files to the local server"
234   []
235   (sh "rsync" "-r" "--delete" "resources/out/http/" "/var/www/omarpolo.local/"))
236 
237 (defn deploy
238   "Copy the files to the server"
239   []
240   (sh "rsync" "-r" "--delete" "resources/out/http/"   "op:sites/www.omarpolo.com/")
241   (sh "rsync" "-r" "--delete" "resources/out/gemini/" "op:gemini/gemini.omarpolo.com"))
242 
243 (defn antenna
244   "Ping antenna"
245   []
246   (net-gemini/ping-antenna "gemini://gemini.omarpolo.com"))
247 
248 (defn stop-jetty []
249   (.stop @j)
250   (reset! j nil))
251 
252 (defn -main [& actions]
253   (load-posts!)
254   (load-pages!)
255   (doseq [action actions]
256     (case action
257       "clean"   (clean)
258       "build"   (build)
259       "deploy"  (deploy)
260       "antenna" (antenna)
261 
262       (println "unrecognized action" action))))
263 
264 (comment
265   (do
266     (load-posts!)
267     (load-pages!)
268     ;; (clean)
269     (build)
270     (local-deploy))
271   (serve)
272   (stop-jetty)
273 
274   (do
275     (deploy)
276     (local-deploy))
277 
278   (antenna)
279 
280   (do
281     (load-posts!)
282     (load-pages!)
283     ;; (clean)
284     (build)
285     (deploy)
286     (local-deploy))
287 )