(ns sitetools.core (:require [clojure.string :as string] [goog.events :as evt] [reagent.core :as r] [reagent.debug :refer-macros [dbg log dev?]] [reagent.interop :as i :refer-macros [.' .!]]) (:import goog.History [goog.history Html5History EventType])) (enable-console-print!) (defn rswap! [a f & args] ;; Like swap!, except that recursive swaps on the same atom are ok, ;; and always returns nil. {:pre [(satisfies? ISwap a) (ifn? f)]} (if a.rswapping (-> (or a.rswapfs (set! a.rswapfs (array))) (.push #(apply f % args))) (do (set! a.rswapping true) (try (swap! a (fn [state] (loop [s (apply f state args)] (if-some [sf (some-> a.rswapfs .shift)] (recur (sf s)) s)))) (finally (set! a.rswapping false))))) nil) ;;; Configuration (declare main-content) (defonce config (r/atom {:body [#'main-content] :pages {"/index.html" {:content [:div] :title ""}} :site-dir "outsite/public" :css-infiles ["site/public/css/main.css"] :css-file "css/built.css" :js-file "js/main.js" :main-div "main-content" :default-title ""})) (defonce history nil) (defn demo-handler [state [id x :as event]] (case id :set-content (let [page x title (:title page) title (if title (str (:title-prefix state) title) (str (:default-title state)))] (when r/is-client (set! js/document.title title)) (assoc state :current-page page :title title)) :set-page (let [path x _ (assert (string? path)) ps (:pages state) p (get ps path (get ps "/index.html"))] (recur state [:set-content p])) :goto-page (let [path x _ (assert (string? path))] (when-some [h history] (.setToken h x) (r/next-tick #(set! js/document.body.scrollTop 0)) state) (recur state [:set-page x])))) (defn dispatch [event] ;; (dbg event) (rswap! config demo-handler event)) (defn register-page [url comp title] {:pre [(re-matches #"/.*[.]html" url) (vector? comp)]} (swap! config update-in [:pages] assoc url {:content comp :title title})) ;;; History (defn init-history [page] (when-not history (let [html5 (and page (Html5History.isSupported) (#{"http:" "https:"} js/location.protocol))] (doto (set! history (if html5 (doto (Html5History.) (.setUseFragment false) (.setPathPrefix (-> js/location.pathname (string/replace (re-pattern (str page "$")) "") (string/replace #"/*$" "")))) (History.))) (evt/listen EventType.NAVIGATE #(when (.-isNavigation %) (dispatch [:set-page (.-token %)]))) (.setEnabled true)) (let [token (.getToken history) p (if (and page (not html5) (empty? token)) page token)] (dispatch [:set-page p]))))) (defn to-relative [f] (string/replace f #"^/" "")) ;;; Components (defn link [props child] [:a (assoc props :href (-> props :href to-relative) :on-click #(do (.preventDefault %) (dispatch [:goto-page (:href props)]))) child]) (defn main-content [] (get-in @config [:current-page :content])) ;;; Static site generation (defn base [page] (let [depth (->> page to-relative (re-seq #"/") count)] (->> "../" (repeat depth) (apply str)))) (defn danger [t s] [t {:dangerouslySetInnerHTML {:__html s}}]) (defn html-template [{:keys [title body-html timestamp page-conf js-file css-file main-div]}] (let [main (str js-file timestamp)] (r/render-to-static-markup [:html [:head [:meta {:charset 'utf-8}] [:meta {:name 'viewport :content "width=device-width, initial-scale=1.0"}] [:base {:href (-> page-conf :page-path base)}] [:link {:href (str css-file timestamp) :rel 'stylesheet}] [:title title]] [:body [:div {:id main-div} (danger :div body-html)] (danger :script (str "var pageConfig = " (-> page-conf clj->js js/JSON.stringify))) [:script {:src main :type "text/javascript"}]]]))) (defn gen-page [page-path conf] (dispatch [:set-page page-path]) (let [conf (merge conf @config) b (:body conf) bhtml (r/render-component-to-string b)] (str "\n" (html-template (assoc conf :page-conf {:page-path page-path} :body-html bhtml))))) (defn fs [] (js/require "fs")) (defn path [] (js/require "path")) (defn mkdirs [f] (doseq [d (reductions #(str %1 "/" %2) (-> (.' (path) normalize f) (string/split #"/")))] (when-not (.' (fs) existsSync d) (.' (fs) mkdirSync d)))) (defn write-file [f content] (mkdirs (.' (path) dirname f)) (.' (fs) writeFileSync f content)) (defn path-join [& paths] (apply (.' (path) :join) paths)) (defn write-resources [dir {:keys [css-file css-infiles]}] (write-file (path-join dir css-file) (->> css-infiles (map #(.' (fs) readFileSync %)) (string/join "\n")))) ;;; Main entry points (defn ^:export genpages [opts] (log "Generating site") (let [conf (swap! config merge (js->clj opts :keywordize-keys true)) conf (assoc conf :timestamp (str "?" (js/Date.now))) {:keys [site-dir pages]} conf] (doseq [f (keys pages)] (write-file (->> f to-relative (path-join site-dir)) (gen-page f conf))) (write-resources site-dir conf)) (log "Wrote site")) (defn start! [site-config] (swap! config merge site-config) (when r/is-client (let [page-conf (when (exists? js/pageConfig) (js->clj js/pageConfig :keywordize-keys true)) conf (swap! config merge page-conf) {:keys [page-path body main-div]} conf] (init-history page-path) (r/render-component body (js/document.getElementById main-div)))))