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