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     (-> p
25         (assoc  :body (-> (str "posts/" slug ext) io/resource slurp))
26         (update :date time/parse))))
27 
28 (def pages (atom nil))
29 (def per-tag (atom {}))
30 (def posts (atom []))
31 
32 (defn add-post! [m]
33   (let [p (post m)]
34     (swap! posts conj p)
35     (doseq [t (:tags m)]
36       (swap! per-tag update t conj p))))
37 
38 (defn load-posts! []
39   (reset! per-tag {})
40   (reset! posts [])
41   (doseq [p (-> "posts.edn"
42                 io/resource
43                 slurp
44                 edn/read-string)]
45     (add-post! p)))
46 
47 (defn load-pages! []
48   (reset! pages (->> "pages.edn"
49                      io/resource
50                      slurp
51                      edn/read-string
52                      (map (fn [{:keys [slug] :as p}]
53                             (assoc p :body (as-> slug $
54                                                 (str "pages/" $ ".gmi")
55                                                 (io/resource $)
56                                                 (slurp $))))))))
57 
58 (defn create-dirs! []
59   (doseq [d ["resources/out"
60              "resources/out/gemini"
61              "resources/out/gemini/pages"
62              "resources/out/gemini/post"
63              "resources/out/gemini/tag"
64              "resources/out/gemini/img"
65              "resources/out/gemini/cgi"
66              "resources/out/http"
67              "resources/out/http/css"
68              "resources/out/http/pages"
69              "resources/out/http/post"
70              "resources/out/http/tag"
71              "resources/out/http/img"]]
72     (.. (File. d) mkdirs)))
73 
74 (defn gemini-post [{? :gemtext?}] ?)
75 
76 (defn post-pages [{:keys [proto]}]
77   (let [tags (keys @per-tag)
78         ext  (if (= proto :gemini) ".gmi" ".html")
79         ffn  (if (= proto :gemini) gemini-post identity)]
80     (map-indexed (fn [i posts]
81                    {:filename (if (= i 0)
82                                 (str "index" ext)
83                                 (str (inc i) ext))
84                     :tags tags
85                     :nth (inc i)
86                     :posts posts
87                     :has-next true
88                     :has-prev true})
89                  (partition-all 6 (filter ffn @posts)))))
90 
91 (defn fix-next-last
92   "Fix the :has-prev/:has-next for the post pages.  This assumes
93   that `(not (empty? post-pages))`"
94   [post-pages]
95   (-> post-pages
96       (->> (into []))
97       (update 0                        assoc :has-prev false)
98       (update (dec (count post-pages)) assoc :has-next false)))
99 
100 (defn render-pages [pagefn proto ext]
101   (doseq [page @pages
102           :let [{:keys [slug]} page
103                 filename (str "resources/out/"
104                               (name proto) "/pages/"
105                               slug ext)]]
106     (spit filename
107           (pagefn page))))
108 
109 (defn render-post-list [viewfn proto]
110   (doseq [p    (fix-next-last (post-pages {:proto proto}))
111           :let [{:keys [filename]} p]]
112     (spit (str "resources/out/" (name proto) "/" filename)
113           (viewfn p))))
114 
115 (defn render-post [viewfn proto ext {s :slug, :as post}]
116   (spit (str "resources/out/" (name proto) "/post/" s ext)
117         (viewfn post)))
118 
119 (defn render-tags [viewfn proto ext tags]
120   (spit (str "resources/out/" (name proto) "/tags" ext)
121         (viewfn tags)))
122 
123 (defn render-tag [viewfn proto ext tag posts]
124   (spit (str "resources/out/" (name proto) "/tag/" tag ext)
125         (viewfn tag posts)))
126 
127 (defn render-rss []
128   (let [gemposts (->> @posts
129                       (filter gemini-post)
130                       (map #(dissoc % :body)))]
131     (spit (str "resources/out/gemini/rss.xml")
132           (rss/feed #(str "gemini://gemini.omarpolo.com/post/" % ".gmi")
133                     gemposts))
134     (spit (str "resources/out/gemini/rss.gmi")
135           (gemini/feed-page gemposts)))
136   (spit (str "resources/out/http/rss.xml")
137         (rss/feed #(str "https://www.omarpolo.com/post/" % ".html") @posts)))
138 
139 (defn copy-dir
140   "Copy the content of resources/`dir` to resources/out/`proto`/`dir`,
141   assuming these two directories exists."
142   [dir proto]
143   ;; java sucks at files
144   (sh "cp" "-a"
145       (str "resources/" dir)
146       (str "resources/out/" proto "/")))
147 
148 (defn copy-assets
149   "Copy css and images to their places"
150   []
151   (copy-dir "img" "http")
152   (copy-dir "img" "gemini")
153   (copy-file "resources/favicon.ico" "resources/out/http/favicon.ico")
154   (copy-file "resources/css/style.css" "resources/out/http/css/style.css"))
155 
156 (defn copy-cgi
157   "Copy cgi scripts to their place."
158   []
159   (copy-dir "cgi" "gemini"))
160 
161 (comment (build)
162          (count (filter gemini-post @posts))
163          (gemini/post-page (first @posts))
164          )
165 
166 (defn build
167   "Build the blog"
168   []
169   (create-dirs!)
170   (copy-assets)
171   (copy-cgi)
172   (render-rss)
173   (doseq [[proto ffn ext homefn postfn tagsfn tagfn pagefn]
174           [[:http identity ".html" http/home-page http/post-page http/tags-page http/tag-page http/custom-page]
175            [:gemini gemini-post ".gmi" gemini/home-page gemini/post-page gemini/tags-page gemini/tag-page gemini/custom-page]]]
176     (render-pages pagefn proto ext)
177     (render-post-list homefn proto)
178     (doseq [p (filter ffn @posts)]
179       (render-post postfn proto ext p))
180     (render-tags tagsfn proto ext (keys @per-tag))
181     (doseq [t @per-tag
182             :let [[tag posts] t]]
183       (render-tag tagfn proto ext (name tag) (filter ffn posts)))))
184 
185 (def j (atom nil))
186 
187 (defn serve
188   "Serve a preview"
189   []
190   (reset!
191    j
192    (jetty/run-jetty (-> (fn [_] {:status 404, :body "not found"})
193                         (wrap-resource "out")
194                         (wrap-content-type))
195                     {:port 3030
196                      :join? false})))
197 
198 (defn clean
199   "clean the output directory"
200   []
201   (sh "rm" "-rf" "resources/out/http/")
202   (sh "rm" "-rf" "resources/out/gemini/"))
203 
204 (defn local-deploy
205   "Copy the files to the local server"
206   []
207   (sh "rsync" "-r" "--delete" "resources/out/http/" "/var/www/omarpolo.local/"))
208 
209 (defn deploy
210   "Copy the files to the server"
211   []
212   (sh "rsync" "-r" "--delete" "resources/out/http/"   "op:sites/www.omarpolo.com/")
213   (sh "rsync" "-r" "--delete" "resources/out/gemini/" "op:gemini"))
214 
215 (defn stop-jetty []
216   (.stop @j)
217   (reset! j nil))
218 
219 (defn -main [& actions]
220   (load-posts!)
221   (load-pages!)
222   (doseq [action actions]
223     (case action
224       "clean"  (clean)
225       "build"  (build)
226       "deploy" (deploy)
227 
228       (println "unrecognized action" action))))
229 
230 (comment
231   (do
232     (load-posts!)
233     (load-pages!)
234     ;; (clean)
235     (build)
236     (local-deploy))
237   (serve)
238   (stop-jetty)
239 
240   (do
241     (deploy)
242     (local-deploy))
243 )