reagent/demo/sitetools/core.cljs

(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 (or (.-rswapfs a)
               (set! (.-rswapfs a) (array)))]
    (.push fs #(apply f % args))
    (if (< 1 (alength fs))
      nil
      (let [f' (fn [state]
                 ;;;; TODO: This could throw
                 (let [s ((aget fs 0) state)]
                   (.shift fs)
                   (if (-> fs alength pos?)
                     (recur s)
                     s)))]
        (swap! a f')))))


;;; Configuration

(declare page-content)

(defonce config (r/atom {: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"
                         :main-div "main-content"
                         :default-title ""}))

(defonce history nil)

(defn demo-handler [state [id v1 v2 :as event]]
  (case id
    :set-content (let [title (if v2
                               (str (:title-prefix state) v2)
                               (str (:default-title state)))]
                   (assert (vector? v1))
                   (when r/is-client
                     (r/next-tick #(set! js/document.title title)))
                   (assoc state :main-content v1 :title title))
    :set-page (do (assert (string? v1))
                  (secretary/dispatch! v1)
                  (assoc state :page-name v1))
    :goto-page (do
                 (assert (string? v1))
                 (when r/is-client
                   (.setToken history v1 false)
                   (r/next-tick #(set! js/document.body.scrollTop 0)))
                 (recur state [:set-page v1]))
    state))

(defn dispatch [event]
  ;; (dbg event)
  (rswap! config demo-handler event)
  nil)

(defn reg-page [url]
  {:pre [(string? url)]
   :post [(map? %)]}
  (swap! config update-in [:pages] conj url))

(defn register-page [url comp title]
  {:pre [(re-matches #"/.*[.]html" url)
         (vector? comp)]}
  (secretary/add-route! url #(dispatch [:set-content comp title]))
  (reg-page url))


;;; History

(defn init-history []
  (when-not history
    (let [page (:page-name @config)
          html5 (and page
                     (.isSupported Html5History)
                     (#{"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 hevt/NAVIGATE #(dispatch [:set-page (.-token %)]))
        (.setEnabled true))
      (when (and page (not html5) (-> history .getToken empty?))
        (.setToken history page)))))

(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 page-content []
  (let [{:keys [main-content]} @config]
    (assert (vector? main-content))
    main-content))


;;; Static site generation

(defn prefix [href page]
  (let [depth (-> #"/" (re-seq (to-relative page)) count)]
    (str (->> "../" (repeat depth) (apply str)) href)))

(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 (prefix "" (:page-name page-conf))}]
       [: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-name conf]
  (dispatch [:set-page page-name])
  (let [b (:body conf)
        _ (assert (vector? b))
        bhtml (r/render-component-to-string b)]
    (str "<!doctype html>"
         (html-template (assoc conf
                               :page-conf {:page-name page-name}
                               :body-html bhtml)))))

(defn mkdirs [f]
  (let [fs (js/require "fs")
        path (js/require "path")
        items (as-> f _
                (.' path dirname _)
                (.' path normalize _)
                (string/split _ #"/"))]
    (doseq [d (reductions #(str %1 "/" %2) items)]
      (when-not (.' fs existsSync d)
        (.' fs mkdirSync d)))))

(defn write-file [f content]
  (mkdirs f)
  (.' (js/require "fs") writeFileSync f content))

(defn read-file [f]
  (.' (js/require "fs") readFileSync f))

(defn path-join [& paths]
  (apply (.' (js/require "path") :join) paths))

(defn read-files [files]
  (string/join "\n" (map read-file files)))

(defn write-resources [dir {:keys [css-file css-infiles]}]
  (write-file (path-join dir css-file)
              (read-files css-infiles)))


;;; Main entry points

(defn ^:export genpages [opts]
  (log "Generating site")
  (swap! config merge (js->clj opts :keywordize-keys true))
  (let [{:keys [site-dir pages] :as state} @config
        conf (assoc state :timestamp (str "?" (js/Date.now)))]
    (doseq [f 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 [conf (when (exists? js/pageConfig)
                 (js->clj js/pageConfig :keywordize-keys true))]
      (swap! config merge conf)
      (init-history)
      (r/render-component (:body @config)
                          (js/document.getElementById (:main-div @config))))))