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