530 lines
20 KiB
Clojure
530 lines
20 KiB
Clojure
(ns figwheel.client.file-reloading
|
|
(:require
|
|
[figwheel.client.utils :as utils :refer-macros [dev-assert]]
|
|
[goog.Uri :as guri]
|
|
[goog.string]
|
|
[goog.object :as gobj]
|
|
[goog.net.jsloader :as loader]
|
|
[goog.string :as gstring]
|
|
[clojure.string :as string]
|
|
[clojure.set :refer [difference]]
|
|
[cljs.core.async :refer [put! chan <! map< close! timeout alts!] :as async])
|
|
(:require-macros
|
|
[cljs.core.async.macros :refer [go go-loop]])
|
|
(:import [goog]
|
|
[goog.async Deferred]))
|
|
|
|
(declare queued-file-reload)
|
|
|
|
(defonce figwheel-meta-pragmas (atom {}))
|
|
|
|
;; you can listen to this event easily like so:
|
|
;; document.body.addEventListener("figwheel.js-reload", function (e) {console.log(e.detail);} );
|
|
(defn on-jsload-custom-event [url]
|
|
(utils/dispatch-custom-event "figwheel.js-reload" url))
|
|
|
|
;; you can listen to this event easily like so:
|
|
;; document.body.addEventListener("figwheel.before-js-reload", function (e) { console.log(e.detail);} );
|
|
(defn before-jsload-custom-event [files]
|
|
(utils/dispatch-custom-event "figwheel.before-js-reload" files))
|
|
|
|
;; you can listen to this event easily like so:
|
|
;; document.body.addEventListener("figwheel.css-reload", function (e) {console.log(e.detail);} );
|
|
(defn on-cssload-custom-event [files]
|
|
(utils/dispatch-custom-event "figwheel.css-reload" files))
|
|
|
|
|
|
#_(defn all? [pred coll]
|
|
(reduce #(and %1 %2) true (map pred coll)))
|
|
|
|
(defn namespace-file-map? [m]
|
|
(or
|
|
(and (map? m)
|
|
(string? (:namespace m))
|
|
(or (nil? (:file m))
|
|
(string? (:file m)))
|
|
(= (:type m)
|
|
:namespace))
|
|
(do
|
|
(println "Error not namespace-file-map" (pr-str m))
|
|
false)))
|
|
|
|
;; this assumes no query string on url
|
|
(defn add-cache-buster [url]
|
|
(dev-assert (string? url))
|
|
(.makeUnique (guri/parse url)))
|
|
|
|
(defn name->path [ns]
|
|
(dev-assert (string? ns))
|
|
(aget js/goog.dependencies_.nameToPath ns))
|
|
|
|
(defn provided? [ns]
|
|
(aget js/goog.dependencies_.written (name->path ns)))
|
|
|
|
(defn immutable-ns? [name]
|
|
(or (#{"goog"
|
|
"cljs.core"
|
|
"an.existing.path"
|
|
"dup.base"
|
|
"far.out"
|
|
"ns"
|
|
"someprotopackage.TestPackageTypes"
|
|
"svgpan.SvgPan"
|
|
"testDep.bar"} name)
|
|
(some
|
|
(partial goog.string/startsWith name)
|
|
["goog." "cljs." "clojure." "fake." "proto2."])))
|
|
|
|
(defn get-requires [ns]
|
|
(->> ns
|
|
name->path
|
|
(aget js/goog.dependencies_.requires)
|
|
(gobj/getKeys)
|
|
(filter #(not (immutable-ns? %)))
|
|
set))
|
|
|
|
(defonce dependency-data (atom {:pathToName {} :dependents {}}))
|
|
|
|
(defn path-to-name! [path name]
|
|
(swap! dependency-data update-in [:pathToName path] (fnil clojure.set/union #{}) #{name}))
|
|
|
|
(defn setup-path->name!
|
|
"Setup a path to name dependencies map.
|
|
That goes from path -> #{ ns-names }"
|
|
[]
|
|
;; we only need this for dependents
|
|
(let [nameToPath (gobj/filter js/goog.dependencies_.nameToPath
|
|
(fn [v k o] (gstring/startsWith v "../")))]
|
|
(gobj/forEach nameToPath (fn [v k o] (path-to-name! v k)))))
|
|
|
|
(defn path->name
|
|
"returns a set of namespaces defined by a path"
|
|
[path]
|
|
(get-in @dependency-data [:pathToName path]))
|
|
|
|
(defn name-to-parent! [ns parent-ns]
|
|
(swap! dependency-data update-in [:dependents ns] (fnil clojure.set/union #{}) #{parent-ns}))
|
|
|
|
(defn setup-ns->dependents!
|
|
"This reverses the goog.dependencies_.requires for looking up ns-dependents."
|
|
[]
|
|
(let [requires (gobj/filter js/goog.dependencies_.requires
|
|
(fn [v k o] (gstring/startsWith k "../")))]
|
|
(gobj/forEach
|
|
requires
|
|
(fn [v k _]
|
|
(gobj/forEach
|
|
v
|
|
(fn [v' k' _]
|
|
(doseq [n (path->name k)]
|
|
(name-to-parent! k' n))))))))
|
|
|
|
(defn ns->dependents [ns]
|
|
(get-in @dependency-data [:dependents ns]))
|
|
|
|
(defn build-topo-sort [get-deps]
|
|
(let [get-deps (memoize get-deps)]
|
|
(letfn [(topo-sort-helper* [x depth state]
|
|
(let [deps (get-deps x)]
|
|
(when-not (empty? deps) (topo-sort* deps depth state))))
|
|
(topo-sort*
|
|
([deps]
|
|
(topo-sort* deps 0 (atom (sorted-map))))
|
|
([deps depth state]
|
|
(swap! state update-in [depth] (fnil into #{}) deps)
|
|
(doseq [dep deps]
|
|
(topo-sort-helper* dep (inc depth) state))
|
|
(when (= depth 0)
|
|
(elim-dups* (reverse (vals @state))))))
|
|
(elim-dups* [[x & xs]]
|
|
(if (nil? x)
|
|
(list)
|
|
(cons x (elim-dups* (map #(difference % x) xs)))))]
|
|
topo-sort*)))
|
|
|
|
(defn get-all-dependencies [ns]
|
|
(let [topo-sort' (build-topo-sort get-requires)]
|
|
(apply concat (topo-sort' (set [ns])))))
|
|
|
|
(defn get-all-dependents [nss]
|
|
(let [topo-sort' (build-topo-sort ns->dependents)]
|
|
(reverse (apply concat (topo-sort' (set nss))))))
|
|
|
|
#_(prn "dependents" (get-all-dependents [ "example.core" "figwheel.client.file_reloading" "cljs.core"]))
|
|
|
|
#_(prn "dependencies" (get-all-dependencies "figwheel.client.file_reloading"))
|
|
|
|
#_(time (get-all-dependents [ "example.core" "figwheel.client.file_reloading" "cljs.core"]))
|
|
|
|
(defn unprovide! [ns]
|
|
(let [path (name->path ns)]
|
|
(gobj/remove js/goog.dependencies_.visited path)
|
|
(gobj/remove js/goog.dependencies_.written path)
|
|
(gobj/remove js/goog.dependencies_.written (str js/goog.basePath path))))
|
|
|
|
;; this matches goog behavior in url resolution should actually just
|
|
;; use that code
|
|
(defn resolve-ns [ns] (str goog/basePath (name->path ns)))
|
|
|
|
(defn addDependency [path provides requires]
|
|
(doseq [prov provides]
|
|
(path-to-name! path prov)
|
|
(doseq [req requires]
|
|
(name-to-parent! req prov))))
|
|
|
|
(defn figwheel-require [src reload]
|
|
;; require is going to be called
|
|
(set! (.-require js/goog) figwheel-require)
|
|
(when (= reload "reload-all")
|
|
(doseq [ns (get-all-dependencies src)] (unprovide! ns)))
|
|
(when reload (unprovide! src))
|
|
(.require_figwheel_backup_ js/goog src))
|
|
|
|
(defn bootstrap-goog-base
|
|
"Reusable browser REPL bootstrapping. Patches the essential functions
|
|
in goog.base to support re-loading of namespaces after page load."
|
|
[]
|
|
;; The biggest problem here is that clojure.browser.repl might have
|
|
;; patched this or might patch this afterward
|
|
(when-not js/COMPILED
|
|
;;
|
|
(set! (.-require_figwheel_backup_ js/goog) (or js/goog.require__ js/goog.require))
|
|
;; suppress useless Google Closure error about duplicate provides
|
|
(set! (.-isProvided_ js/goog) (fn [name] false))
|
|
;; provide cljs.user
|
|
(setup-path->name!)
|
|
(setup-ns->dependents!)
|
|
|
|
(set! (.-addDependency_figwheel_backup_ js/goog) js/goog.addDependency)
|
|
(set! (.-addDependency js/goog)
|
|
(fn [& args]
|
|
(apply addDependency args)
|
|
(apply (.-addDependency_figwheel_backup_ js/goog) args)))
|
|
|
|
(goog/constructNamespace_ "cljs.user")
|
|
;; we must reuse Closure library dev time dependency management, under namespace
|
|
;; reload scenarios we simply delete entries from the correct
|
|
;; private locations
|
|
(set! (.-CLOSURE_IMPORT_SCRIPT goog/global) queued-file-reload)
|
|
(set! (.-require js/goog) figwheel-require)))
|
|
|
|
(defn patch-goog-base []
|
|
(defonce bootstrapped-cljs (do (bootstrap-goog-base) true)))
|
|
|
|
(def reload-file*
|
|
(condp = (utils/host-env?)
|
|
:node
|
|
(let [node-path-lib (js/require "path")
|
|
;; just finding a file that is in the cache so we can
|
|
;; figure out where we are
|
|
util-pattern (str (.-sep node-path-lib)
|
|
(.join node-path-lib "goog" "bootstrap" "nodejs.js"))
|
|
util-path (gobj/findKey js/require.cache (fn [v k o] (gstring/endsWith k util-pattern)))
|
|
parts (-> (string/split util-path #"[/\\]") pop pop)
|
|
root-path (string/join (.-sep node-path-lib) parts)]
|
|
(fn [request-url callback]
|
|
(dev-assert (string? request-url) (not (nil? callback)))
|
|
(let [cache-path (.resolve node-path-lib root-path request-url)]
|
|
(gobj/remove (.-cache js/require) cache-path)
|
|
(callback (try
|
|
(js/require cache-path)
|
|
(catch js/Error e
|
|
(utils/log :error (str "Figwheel: Error loading file " cache-path))
|
|
(utils/log :error (.-stack e))
|
|
false))))))
|
|
|
|
:html (fn [request-url callback]
|
|
(dev-assert (string? request-url) (not (nil? callback)))
|
|
(let [deferred (loader/load (add-cache-buster request-url)
|
|
#js { :cleanupWhenDone true })]
|
|
(.addCallback deferred #(apply callback [true]))
|
|
(.addErrback deferred #(apply callback [false]))))
|
|
:worker (fn [request-url callback]
|
|
(dev-assert (string? request-url) (not (nil? callback)))
|
|
(callback (try
|
|
(do (.importScripts js/self (add-cache-buster request-url))
|
|
true)
|
|
(catch js/Error e
|
|
(utils/log :error (str "Figwheel: Error loading file " request-url))
|
|
(utils/log :error (.-stack e))
|
|
false))))
|
|
(fn [a b] (throw "Reload not defined for this platform"))))
|
|
|
|
(defn reload-file [{:keys [request-url] :as file-msg} callback]
|
|
(dev-assert (string? request-url) (not (nil? callback)))
|
|
(utils/debug-prn (str "FigWheel: Attempting to load " request-url))
|
|
(reload-file* request-url
|
|
(fn [success?]
|
|
(if success?
|
|
(do
|
|
(utils/debug-prn (str "FigWheel: Successfully loaded " request-url))
|
|
(apply callback [(assoc file-msg :loaded-file true)]))
|
|
(do
|
|
(utils/log :error (str "Figwheel: Error loading file " request-url))
|
|
(apply callback [file-msg]))))))
|
|
|
|
;; for goog.require consumption
|
|
(defonce reload-chan (chan))
|
|
|
|
(defonce on-load-callbacks (atom {}))
|
|
|
|
(defonce dependencies-loaded (atom []))
|
|
|
|
(defn blocking-load [url]
|
|
(let [out (chan)]
|
|
(reload-file
|
|
{:request-url url}
|
|
(fn [file-msg]
|
|
(put! out file-msg)
|
|
(close! out)))
|
|
out))
|
|
|
|
(defonce reloader-loop
|
|
(go-loop []
|
|
(when-let [url (<! reload-chan)]
|
|
(let [file-msg (<! (blocking-load url))]
|
|
(if-let [callback (get @on-load-callbacks url)]
|
|
(callback file-msg)
|
|
(swap! dependencies-loaded conj file-msg))
|
|
(recur)))))
|
|
|
|
(defn queued-file-reload [url] (put! reload-chan url))
|
|
|
|
(defn require-with-callback [{:keys [namespace] :as file-msg} callback]
|
|
(let [request-url (resolve-ns namespace)]
|
|
(swap! on-load-callbacks assoc request-url
|
|
(fn [file-msg']
|
|
(swap! on-load-callbacks dissoc request-url)
|
|
(apply callback [(merge file-msg (select-keys file-msg' [:loaded-file]))])))
|
|
;; we are forcing reload here
|
|
(figwheel-require (name namespace) true)))
|
|
|
|
(defn figwheel-no-load? [{:keys [namespace] :as file-msg}]
|
|
(let [meta-pragmas (get @figwheel-meta-pragmas (name namespace))]
|
|
(:figwheel-no-load meta-pragmas)))
|
|
|
|
(defn reload-file? [{:keys [namespace] :as file-msg}]
|
|
(dev-assert (namespace-file-map? file-msg))
|
|
(let [meta-pragmas (get @figwheel-meta-pragmas (name namespace))]
|
|
(and
|
|
(not (figwheel-no-load? file-msg))
|
|
(or
|
|
(:figwheel-always meta-pragmas)
|
|
(:figwheel-load meta-pragmas)
|
|
;; might want to use .-visited here
|
|
(provided? (name namespace))))))
|
|
|
|
(defn js-reload [{:keys [request-url namespace] :as file-msg} callback]
|
|
(dev-assert (namespace-file-map? file-msg))
|
|
(if (reload-file? file-msg)
|
|
(require-with-callback file-msg callback)
|
|
(do
|
|
(utils/debug-prn (str "Figwheel: Not trying to load file " request-url))
|
|
(apply callback [file-msg]))))
|
|
|
|
(defn reload-js-file [file-msg]
|
|
(let [out (chan)]
|
|
(js-reload
|
|
file-msg
|
|
(fn [url]
|
|
#_(patch-goog-base)
|
|
(put! out url)
|
|
(close! out)))
|
|
out))
|
|
|
|
(defn load-all-js-files
|
|
"Returns a chanel with one collection of loaded filenames on it."
|
|
[files]
|
|
(let [out (chan)]
|
|
(go-loop [[f & fs] files]
|
|
(if-not (nil? f)
|
|
(do (put! out (<! (reload-js-file f)))
|
|
(recur fs))
|
|
(close! out)))
|
|
(async/into [] out)))
|
|
|
|
|
|
(defn eval-body [{:keys [eval-body file]} opts]
|
|
(when (and eval-body (string? eval-body))
|
|
(let [code eval-body]
|
|
(try
|
|
(utils/debug-prn (str "Evaling file " file))
|
|
(utils/eval-helper code opts)
|
|
(catch :default e
|
|
(utils/log :error (str "Unable to evaluate " file)))))))
|
|
|
|
(defn expand-files [files]
|
|
(let [deps (get-all-dependents (map :namespace files))]
|
|
(filter (comp not
|
|
(partial re-matches #"figwheel\.connect.*")
|
|
:namespace)
|
|
(map
|
|
(fn [n]
|
|
(if-let [file-msg (first (filter #(= (:namespace %) n) files))]
|
|
file-msg
|
|
{:type :namespace :namespace n}))
|
|
deps))))
|
|
|
|
(defn sort-files [files]
|
|
(if (<= (count files) 1) ;; no need to sort if only one
|
|
files
|
|
(let [keep-files (set (keep :namespace files))]
|
|
(filter (comp keep-files :namespace) (expand-files files)))))
|
|
|
|
(defn get-figwheel-always []
|
|
(map (fn [[k v]] {:namespace k :type :namespace})
|
|
(filter (fn [[k v]]
|
|
(:figwheel-always v)) @figwheel-meta-pragmas)))
|
|
|
|
(defn reload-js-files [{:keys [before-jsload on-jsload reload-dependents] :as opts}
|
|
{:keys [files figwheel-meta recompile-dependents] :as msg}]
|
|
(when-not (empty? figwheel-meta)
|
|
(reset! figwheel-meta-pragmas figwheel-meta))
|
|
(go
|
|
(before-jsload files)
|
|
(before-jsload-custom-event files)
|
|
;; evaluate the eval bodies first
|
|
;; for now this is only for updating dependencies
|
|
;; we are not handling removals
|
|
;; TODO handle removals
|
|
(let [eval-bodies (filter #(:eval-body %) files)]
|
|
(when (not-empty eval-bodies)
|
|
(doseq [eval-body-file eval-bodies]
|
|
(eval-body eval-body-file opts))))
|
|
(reset! dependencies-loaded (list))
|
|
(let [all-files (filter #(and (:namespace %)
|
|
(not (:eval-body %))
|
|
(not (figwheel-no-load? %)))
|
|
files)
|
|
;; add in figwheel always
|
|
all-files (concat all-files (get-figwheel-always))
|
|
all-files (if (or reload-dependents recompile-dependents)
|
|
(expand-files all-files)
|
|
(sort-files all-files))
|
|
;_ (prn "expand-files" (expand-files all-files))
|
|
;_ (prn "sort-files" (sort-files all-files))
|
|
res' (<! (load-all-js-files all-files))
|
|
res (filter :loaded-file res')
|
|
files-not-loaded (filter #(not (:loaded-file %)) res')
|
|
dependencies-that-loaded (filter :loaded-file @dependencies-loaded)]
|
|
(when (not-empty dependencies-that-loaded)
|
|
(utils/log :debug "Figwheel: loaded these dependencies")
|
|
(utils/log (pr-str (map (fn [{:keys [request-url]}]
|
|
(string/replace request-url goog/basePath ""))
|
|
(reverse dependencies-that-loaded)))))
|
|
(when (not-empty res)
|
|
(utils/log :debug "Figwheel: loaded these files")
|
|
(utils/log (pr-str (map (fn [{:keys [namespace file]}]
|
|
(if namespace
|
|
(name->path (name namespace))
|
|
file)) res)))
|
|
(js/setTimeout #(do
|
|
(on-jsload-custom-event res)
|
|
(apply on-jsload [res])) 10))
|
|
|
|
(when (not-empty files-not-loaded)
|
|
(utils/log :debug "Figwheel: NOT loading these files ")
|
|
(let [{:keys [figwheel-no-load not-required]}
|
|
(group-by
|
|
(fn [{:keys [namespace]}]
|
|
(let [meta-data (get @figwheel-meta-pragmas (name namespace))]
|
|
(cond
|
|
(nil? meta-data) :not-required
|
|
(meta-data :figwheel-no-load) :figwheel-no-load
|
|
:else :not-required)))
|
|
files-not-loaded)]
|
|
(when (not-empty figwheel-no-load)
|
|
(utils/log (str "figwheel-no-load meta-data: "
|
|
(pr-str (map (comp name->path :namespace) figwheel-no-load)))))
|
|
(when (not-empty not-required)
|
|
(utils/log (str "not required: " (pr-str (map :file not-required))))))))))
|
|
|
|
;; CSS reloading
|
|
|
|
(defn current-links []
|
|
(.call (.. js/Array -prototype -slice)
|
|
(.getElementsByTagName js/document "link")))
|
|
|
|
(defn truncate-url [url]
|
|
(-> (first (string/split url #"\?"))
|
|
(string/replace-first (str (.-protocol js/location) "//") "")
|
|
(string/replace-first ".*://" "")
|
|
(string/replace-first #"^//" "")
|
|
(string/replace-first #"[^\/]*" "")))
|
|
|
|
(defn matches-file?
|
|
[{:keys [file]} link]
|
|
(when-let [link-href (.-href link)]
|
|
(let [match (string/join "/"
|
|
(take-while identity
|
|
(map #(if (= %1 %2) %1 false)
|
|
(reverse (string/split file "/"))
|
|
(reverse (string/split (truncate-url link-href) "/")))))
|
|
match-length (count match)
|
|
file-name-length (count (last (string/split file "/")))]
|
|
(when (>= match-length file-name-length) ;; has to match more than the file name length
|
|
{:link link
|
|
:link-href link-href
|
|
:match-length match-length
|
|
:current-url-length (count (truncate-url link-href))}))))
|
|
|
|
(defn get-correct-link [f-data]
|
|
(when-let [res (first
|
|
(sort-by
|
|
(fn [{:keys [match-length current-url-length]}]
|
|
(- current-url-length match-length))
|
|
(keep #(matches-file? f-data %)
|
|
(current-links))))]
|
|
(:link res)))
|
|
|
|
(defn clone-link [link url]
|
|
(let [clone (.createElement js/document "link")]
|
|
(set! (.-rel clone) "stylesheet")
|
|
(set! (.-media clone) (.-media link))
|
|
(set! (.-disabled clone) (.-disabled link))
|
|
(set! (.-href clone) (add-cache-buster url))
|
|
clone))
|
|
|
|
(defn create-link [url]
|
|
(let [link (.createElement js/document "link")]
|
|
(set! (.-rel link) "stylesheet")
|
|
(set! (.-href link) (add-cache-buster url))
|
|
link))
|
|
|
|
(defn distinctify [key seqq]
|
|
(vals (reduce #(assoc %1 (get %2 key) %2) {} seqq)))
|
|
|
|
(defn add-link-to-document [orig-link klone finished-fn]
|
|
(let [parent (.-parentNode orig-link)]
|
|
(if (= orig-link (.-lastChild parent))
|
|
(.appendChild parent klone)
|
|
(.insertBefore parent klone (.-nextSibling orig-link)))
|
|
;; prevent css removal flash
|
|
(js/setTimeout #(do
|
|
(.removeChild parent orig-link)
|
|
(finished-fn))
|
|
300)))
|
|
|
|
(defonce reload-css-deferred-chain (atom (.succeed Deferred)))
|
|
|
|
(defn reload-css-file [f-data fin]
|
|
(if-let [link (get-correct-link f-data)]
|
|
(add-link-to-document link (clone-link link (.-href link))
|
|
#(fin (assoc f-data :loaded true)))
|
|
(fin f-data)))
|
|
|
|
(defn reload-css-files* [deferred f-datas on-cssload]
|
|
(-> deferred
|
|
(utils/mapConcatD reload-css-file f-datas)
|
|
(utils/liftContD (fn [f-datas' fin]
|
|
(let [loaded-f-datas (filter :loaded f-datas')]
|
|
(on-cssload-custom-event loaded-f-datas)
|
|
(when (fn? on-cssload)
|
|
(on-cssload loaded-f-datas)))
|
|
(fin)))))
|
|
|
|
(defn reload-css-files [{:keys [on-cssload]} {:keys [files] :as files-msg}]
|
|
(when (utils/html-env?)
|
|
(when-let [f-datas (not-empty (distinctify :file files))]
|
|
(swap! reload-css-deferred-chain reload-css-files* f-datas on-cssload))))
|