mirror of https://github.com/status-im/reagent.git
321 lines
9.9 KiB
Clojure
321 lines
9.9 KiB
Clojure
(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]
|
|
[goog.net Jsonp]))
|
|
|
|
(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 "<!doctype html>"
|
|
(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))))))
|