(ns sitetools.core (:require [clojure.string :as string] [goog.events :as evt] [goog.history.EventType :as hevt] [reagent.core :as r] [secretary.core :as secretary :refer-macros [defroute]] [reagent.debug :refer-macros [dbg log dev?]] [reagent.interop :as i :refer-macros [.' .!]]) (:import goog.History goog.history.Html5History)) (when (exists? js/console) (enable-console-print!)) (defn rswap! [a f & args] ;; Roughly like swap!, except that recursive swaps are ok (let [fs (if-some [arr (.-rswapfs a)] arr (set! (.-rswapfs a) (array)))] (.push fs #(apply f % args)) (if (< 1 (.-length fs)) nil (let [f' (fn [state] (let [s ((aget fs 0) state)] (.shift fs) (if (-> fs .-length pos?) (recur s) s)))] (swap! a f'))))) ;;; Configuration (declare page-content) (defonce config (r/atom {:page-map {"index.html" [:div "Empty"]} :page-titles {} :body [page-content] :main-content [:div] :pages #{} :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" :main-div "main-content" :default-title "" :allow-html5-history false})) (defonce page (r/atom "index.html")) (defonce page-state (r/atom {:has-history false})) (defonce history nil) (defn demo-handler [state [id v1 v2 :as event]] (case id :content (do (let [title (if v2 (str (:title-prefix @config) v2) (str (:default-title @config)))] (when r/is-client (r/next-tick #(set! js/document.title title))) (assoc state :main-content v1 :title title))) :set-page (do (secretary/dispatch! v1) (assoc state :page v1)) :goto-page (do (when r/is-client (.setToken history v1 false) (r/next-tick #(set! js/document.body.scrollTop 0))) (recur state [:set-page v1 v2])) state)) (defn dispatch [event] (dbg event) (rswap! config demo-handler event) nil) (defn reg-page [url] (swap! config update-in [:pages] conj url)) (defn init-history [] (when-not history (doto (set! history (History.)) (evt/listen hevt/NAVIGATE #(dispatch [:set-page (.-token %)])) (.setEnabled true)))) ;; (defn register-page ;; ([pageurl comp] ;; (register-page pageurl comp nil)) ;; ([pageurl comp title] ;; (assert (string? pageurl) ;; (str "expected string, not " pageurl)) ;; (assert (vector? comp) ;; (str "expected vector, not " (pr-str 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) ;; pageurl)) ;;; Components (defn link [props child] [:a (assoc props :on-click #(do (.preventDefault %) (dispatch [:goto-page (:href props)]))) child]) ;; (defn link ;; [props child] ;; (let [p (:href props) ;; f ((:page-map @config) p)] ;; (assert (vector? f) (str "couldn't resolve page " p)) ;; (assert (string? p)) ;; [:a (assoc props ;; :href p ;; :on-click (if (:has-history @page-state) ;; (fn [e] ;; (.preventDefault e) ;; (reset! page p) ;; (r/next-tick ;; #(set! (.-scrollTop (.-body js/document)) ;; 0))) ;; identity)) ;; child])) (defn page-content [] (:main-content @config)) ;;; 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 r/is-client ;; (set! (.-title js/document) (get-title))) ;; ;; First title on a page wins ;; #_(reset! page-title ""))) ;;; History ;; (defn use-html5-history [] ;; (when r/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))) ;; (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))) ;; (r/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 (vector? b) (str "body is not a vector: " 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 main (str (:js-file c) timestamp) css-file (:css-file c) opt-none (:opt-none c)] (r/render-to-static-markup [:html [:head [:meta {:charset "utf-8"}] [:meta {:name 'viewport :content "width=device-width, initial-scale=1.0"}] [:base {:href (prefix "")}] [:link {:href (str css-file timestamp) :rel 'stylesheet}] [:title title]] [:body [:div {:id (:main-div @config)} (danger :div body)] (danger :script (str "var pageConfig = " (-> page-conf clj->js js/JSON.stringify))) [:script {:src main :type "text/javascript"}]]]))) (defn gen-page [page-name timestamp] (reset! page page-name) (let [b (r/render-component-to-string (body))] (str "" (html-template {:title (:title @config) ;;(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) timestamp (str "?" (.' js/Date now))] (doseq [f (keys (:page-map @config))] (write-file (path-join dir f) (gen-page f timestamp))) (write-resources dir)) (log "Wrote site")) (defn start! [site-config] (swap! config merge site-config) (when r/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 (nil? history) ;; (when page-name ;; (set-start-page page-name)) (init-history) ;; (setup-history page-name) ;; (set! (.-title js/document) (get-title)) ) (r/render-component (body) (.' js/document getElementById (:main-div @config))))))