(ns sitetools (:require [clojure.string :as string] [goog.events :as evt] [goog.history.EventType :as hevt] [reagent.core :as reagent :refer [atom partial]] [reagent.debug :refer-macros [dbg log dev?]] [reagent.interop :as i :refer-macros [.' .!]]) (:import [goog History] [goog.history Html5History] [goog.net Jsonp])) (when (exists? js/console) (enable-console-print!)) (declare page-content) (declare prefix) ;;; Configuration (defonce config (atom {:page-map {"index.html" (fn [] [:div "Empty"])} :page-titles {} :body (fn [] [:div (page-content)]) :site-dir "outsite/public" :css-infiles ["site/public/css/main.css"] :css-file "css/built.css" :js-file "js/main.js" :js-dir "js/out" :allow-html5-history false})) (defonce page (atom "index.html")) (defonce page-state (atom {:has-history false})) (defn register-page ([pageurl comp] (register-page pageurl comp nil)) ([pageurl comp title] (assert (string? pageurl) (str "expected string, not " pageurl)) (assert (fn? comp)) (assert (or (nil? title) (string? title))) (swap! config update-in [:page-map] assoc pageurl comp) (swap! config update-in [:page-titles] assoc pageurl title))) ;;; Components (defn link [props child] (let [p (:href props) f ((:page-map @config) p)] (assert (ifn? f) (str "couldn't resolve ppage " p)) (assert (string? p)) [:a (assoc props :href (prefix p) :on-click (if (:has-history @page-state) (fn [e] (.preventDefault e) (reset! page p) (reagent/next-tick #(set! (.-scrollTop (.-body js/document)) 0))) identity)) child])) (defn page-content [] [(get-in @config [:page-map @page] (get-in @config [:page-map "index.html"]))]) ;;; Implementation: (defn get-title [] (get-in @config [:page-titles @page] (or (get-in @config [:page-titles "index.html"]) ""))) (defn default-content [] [:div "Empty"]) (add-watch page ::title-watch (fn [_ _ _ p] (when reagent/is-client (set! (.-title js/document) (get-title))) ;; First title on a page wins #_(reset! page-title ""))) ;;; History (defn use-html5-history [] (when reagent/is-client (let [proto (.' js/window :location.protocol)] (and (:allow-html5-history @config) (.isSupported Html5History) (#{"http:" "https:"} proto))))) (defn create-history [p] (if (use-html5-history) (doto (Html5History.) (.setUseFragment false)) (let [h (History.)] (when p (.setToken h p)) h))) (def history nil) (defn token-base [] (if (use-html5-history) (:base-path @config))) (defn setup-history [p] (when (nil? history) (set! history (create-history p)) (swap! page-state assoc :has-history (some? history)) (when-let [h history] (evt/listen h hevt/NAVIGATE (fn [e] (let [t (.-token e) tb (token-base)] (reset! page (if (and tb (== 0 (.indexOf t tb))) (subs t (count tb)) t))) (reagent/flush))) (add-watch page ::history (fn [_ _ oldp newp] (when-not (= oldp newp) (.setToken h (str (token-base) newp))))) (.setEnabled h true)))) (defn base-path [loc p] ;; Find base-path for html5 history (let [split #".[^/]*" depth (->> (case p "" "." p) (re-seq split) count) base (->> loc (re-seq split) (drop-last depth) (apply str))] (string/replace (str base "/") #"^/" ""))) (defn set-start-page [p] (when (and (not (:base-path @config)) (use-html5-history)) (swap! config assoc :base-path (base-path (.' js/window -location.pathname) p))) (reset! page p)) (defn prefix [href] (let [depth (-> #"/" (re-seq @page) count)] (str (->> "../" (repeat depth) (apply str)) href))) ;;; Static site generation (defn body [] (let [b (:body @config)] (assert (fn? b)) [b])) (defn danger [t s] [t {:dangerouslySetInnerHTML {:__html s}}]) (defn html-template [{:keys [title body timestamp page-conf opt-none req]}] (let [c @config base (prefix (str (:js-dir c) "/goog/base.js")) main (str (prefix (:js-file c)) timestamp) css-file (prefix (:css-file c)) opt-none (:opt-none c)] (reagent/render-to-static-markup [:html [:head [:meta {:charset "utf-8"}] [:meta {:name 'viewport :content "width=device-width, initial-scale=1.0"}] [:link {:href (str css-file timestamp) :rel 'stylesheet}] [:title title]] [:body (danger :div body) (danger :script (str "var pageConfig = " (-> page-conf clj->js js/JSON.stringify))) (if opt-none [:script {:src base :type "text/javascript"}]) [:script {:src main :type "text/javascript"}] (if opt-none (danger :script "goog.require('devsetup');"))]]))) (defn gen-page [page-name timestamp] (reset! page page-name) (let [b (reagent/render-component-to-string (body))] (str "" (html-template {:title (get-title) :body b :page-conf {:allow-html5-history true :page-name page-name} :timestamp timestamp})))) (defn mkdirs [f] (let [fs (js/require "fs") path (js/require "path") items (as-> f _ (.' path dirname _) (.' path normalize _) (string/split _ #"/")) parts (reductions #(str %1 "/" %2) items)] (doseq [d parts] (when-not (.' fs existsSync d) (.' fs mkdirSync d))))) (defn write-file [f content] (let [fs (js/require "fs")] (mkdirs f) (.' fs writeFileSync f content))) (defn read-file [f] (let [fs (js/require "fs")] (.' fs readFileSync f))) (defn path-join [& paths] (let [path (js/require "path")] (apply (.' path :join) paths))) (defn read-css [] (clojure.string/join "\\n" (map read-file (:css-infiles @config)))) (defn write-resources [dir] (write-file (path-join dir (:css-file @config)) (read-css))) ;;; Main entry points (defn ^:export genpages [opts] (log "Generating site") (swap! config merge (js->clj opts :keywordize-keys true)) (let [dir (:site-dir @config) written (atom #{}) timestamp (str "?" (.' js/Date now)) one-page (fn [] (first (filter (fn [x] (nil? (@written x))) (keys (:page-map @config)))))] (loop [f (one-page)] (when f (swap! written conj f) (write-file (path-join dir f) (gen-page f timestamp)) (recur (one-page)))) (write-resources dir)) (log "Wrote site")) (defn start! [site-config] (swap! config merge site-config) (when reagent/is-client (let [conf (when (exists? js/pageConfig) (js->clj js/pageConfig :keywordize-keys true)) page-name (:page-name conf)] (swap! config merge conf) (when page-name (set-start-page page-name)) (setup-history page-name) (set! (.-title js/document) (get-title)) (reagent/render-component (body) (.' js/document :body)))))