diff --git a/figwheel-core/.gitignore b/figwheel-core/.gitignore deleted file mode 100644 index 9e97758d..00000000 --- a/figwheel-core/.gitignore +++ /dev/null @@ -1,5 +0,0 @@ -.cpcache -out/* -test_out -target -dev/example/except* diff --git a/figwheel-core/README.md b/figwheel-core/README.md deleted file mode 100644 index ae5f934a..00000000 --- a/figwheel-core/README.md +++ /dev/null @@ -1,31 +0,0 @@ -## figwheel-core - -Contains the core functionality of Figwheel. - -This allows you to get the benefits of figwheel's hot reloading and -feedback cycle without being complected with a server or a REPL -implementation. - -This is currently a work in progress. - -This has reached the feature complete state but still requires some -time to reflect, refactor and document. This will take some time as it -will be informed by the development of two other new projects -`figwheel-repl` and possibly `figwheel-main` - -# Usage - -Experts only at this point - -Add `figwheel-core` to your deps and then: - -``` -clj -m cljs.main -w src -e "(require '[figwheel.core :include-macros true])(figwheel.core/hook-cljs-build)(figwheel.core/start-from-repl)" -r -``` - -## License - -Copyright © 2018 Bruce Hauman - -Distributed under the Eclipse Public License either version 1.0 or any -later version. diff --git a/figwheel-core/deps.edn b/figwheel-core/deps.edn deleted file mode 100644 index d6f4c88a..00000000 --- a/figwheel-core/deps.edn +++ /dev/null @@ -1,2 +0,0 @@ -{:deps {org.clojure/clojure {:mvn/version "1.8.0"} - org.clojure/clojurescript {:mvn/version "1.10.238"}}} diff --git a/figwheel-core/project.clj b/figwheel-core/project.clj deleted file mode 100644 index f02d3cfa..00000000 --- a/figwheel-core/project.clj +++ /dev/null @@ -1,11 +0,0 @@ -(defproject com.bhauman/figwheel-core "0.1.3" - :description "Figwheel core provides code reloading facilities for ClojureScript." - :url "https://github.com/bhauman/lein-figwheel" - :license {:name "Eclipse Public License - v 1.0" - :url "http://www.eclipse.org/legal/epl-v10.html"} - :scm {:name "git" - :url "https://github.com/bhauman/lein-figwheel" - :dir ".."} - :dependencies - [[org.clojure/clojure "1.8.0"] - [org.clojure/clojurescript "1.10.238"]]) diff --git a/figwheel-core/src/figwheel/core.cljc b/figwheel-core/src/figwheel/core.cljc deleted file mode 100644 index 9c19565f..00000000 --- a/figwheel-core/src/figwheel/core.cljc +++ /dev/null @@ -1,939 +0,0 @@ -(ns ^:figwheel-load figwheel.core - (:require - #?@(:cljs - [[figwheel.tools.heads-up :as heads-up] - [goog.object :as gobj] - [goog.string :as gstring] - [goog.string.format] - [goog.log :as glog]]) - [clojure.set :refer [difference]] - [clojure.string :as string] - #?@(:clj - [[cljs.env :as env] - [cljs.compiler] - [cljs.closure] - [cljs.repl] - [cljs.analyzer :as ana] - [cljs.build.api :as bapi] - [clojure.data.json :as json] - [clojure.java.io :as io] - [clojure.edn :as edn] - [figwheel.tools.exceptions :as fig-ex]])) - #?(:cljs (:require-macros [figwheel.core])) - (:import #?@(:cljs [[goog] - [goog.debug Console] - [goog.async Deferred] - [goog Promise] - [goog.events EventTarget Event]]))) - -;; ------------------------------------------------- -;; utils -;; ------------------------------------------------- - -(defn distinct-by [f coll] - (let [seen (volatile! #{})] - (filter #(let [k (f %) - res (not (@seen k))] - (vswap! seen conj k) - res) - coll))) - -(defn map-keys [f coll] - (into {} - (map (fn [[k v]] [(f k) v])) - coll)) - -;; ------------------------------------------------------ -;; inline code message formatting -;; ------------------------------------------------------ - -(def ^:dynamic *inline-code-message-max-column* 80) - -(defn wrap-line [text size] - (re-seq (re-pattern (str ".{1," size "}\\s|.{1," size "}")) - (str (string/replace text #"\n" " ") " "))) - -(defn cross-format [& args] - (apply #?(:clj format :cljs gstring/format) args)) - -;; TODO this could be more sophisticated -(defn- pointer-message-lines [{:keys [message column]}] - (if (> (+ column (count message)) *inline-code-message-max-column*) - (->> (wrap-line message (- *inline-code-message-max-column* 10)) - (map #(cross-format (str "%" *inline-code-message-max-column* "s") %)) - (cons (cross-format (let [col (dec column)] - (str "%" - (when-not (zero? col) col) - "s%s")) - "" "^---")) - (mapv #(vec (concat [:error-message nil] [%])))) - [[:error-message nil (cross-format - (let [col (dec column)] - (str "%" - (when-not (zero? col) col) - "s%s %s" )) - "" "^---" message)]])) - -(defn inline-message-display-data [{:keys [message line column file-excerpt] :as message-data}] - (let [{:keys [start-line path excerpt]} file-excerpt - lines (map-indexed - (fn [i l] (let [ln (+ i start-line)] - (vector (if (= line ln) :error-in-code :code-line) ln l))) - (string/split-lines excerpt)) - [begin end] (split-with #(not= :error-in-code (first %)) lines)] - (concat - (take-last 5 begin) - (take 1 end) - (pointer-message-lines message-data) - (take 5 (rest end))))) - -(defn file-line-column [{:keys [file line column]}] - (cond-> "" - file (str "file " file) - line (str " at line " line) - (and line column) (str ", column " column))) - -#?(:cljs - (do - -;; -------------------------------------------------- -;; Logging -;; -------------------------------------------------- -;; -;; Levels -;; goog.debug.Logger.Level.(SEVERE WARNING INFO CONFIG FINE FINER FINEST) -;; -;; set level (.setLevel logger goog.debug.Logger.Level.INFO) -;; disable (.setCapturing log-console false) -(defonce logger (glog/getLogger "Figwheel")) - -(defn ^:export console-logging [] - (when-not (gobj/get goog.debug.Console "instance") - (let [c (goog.debug.Console.)] - ;; don't display time - (doto (.getFormatter c) - (gobj/set "showAbsoluteTime" false) - (gobj/set "showRelativeTime" false)) - (gobj/set goog.debug.Console "instance" c) - c)) - (when-let [console-instance (gobj/get goog.debug.Console "instance")] - (.setCapturing console-instance true) - true)) - -(defonce log-console (console-logging)) - -;; -------------------------------------------------- -;; Cross Platform event dispatch -;; -------------------------------------------------- -(def ^:export event-target (if (and (exists? js/document) - (exists? js/document.body)) - js/document.body - (EventTarget.))) - -(defonce listener-key-map (atom {})) - -(defn unlisten [ky event-name] - (when-let [f (get @listener-key-map ky)] - (.removeEventListener event-target (name event-name) f))) - -(defn listen [ky event-name f] - (unlisten ky event-name) - (.addEventListener event-target (name event-name) f) - (swap! listener-key-map assoc ky f)) - -(defn dispatch-event [event-name data] - (.dispatchEvent - event-target - (doto (if (instance? EventTarget event-target) - (Event. (name event-name) event-target) - (js/Event. (name event-name) event-target)) - (gobj/add "data" (or data {}))))) - -(defn event-data [e] - (gobj/get - (if-let [e (.-event_ e)] e e) - "data")) - -;; ------------------------------------------------------------ -;; Global state -;; ------------------------------------------------------------ - -(goog-define load-warninged-code false) -(goog-define heads-up-display true) - -(defonce state (atom {::reload-state {}})) - -;; ------------------------------------------------------------ -;; Heads up display logic -;; ------------------------------------------------------------ - -;; TODO could move the state atom and heads up display logic to heads-up display -;; TODO could probably make it run completely off of events emitted here - -(defn heads-up-display? [] - (and heads-up-display - (not (nil? goog/global.document)))) - -(let [last-reload-timestamp (atom 0) - promise-chain (Promise. (fn [r _] (r true)))] - (defn render-watcher [_ _ o n] - (when (heads-up-display?) - ;; a new reload has arrived - (if-let [ts (when-let [ts (get-in n [::reload-state :reload-started])] - (and (< @last-reload-timestamp ts) ts))] - (let [warnings (not-empty (get-in n [::reload-state :warnings])) - exception (get-in n [::reload-state :exception])] - (reset! last-reload-timestamp ts) - (cond - warnings - (.then promise-chain - (fn [] (let [warn (first warnings)] - (binding [*inline-code-message-max-column* 132] - (.then (heads-up/display-warning (assoc warn :error-inline (inline-message-display-data warn))) - (fn [] - (doseq [w (rest warnings)] - (heads-up/append-warning-message w)))))))) - exception - (.then promise-chain - (fn [] - (binding [*inline-code-message-max-column* 132] - (heads-up/display-exception - (assoc exception :error-inline (inline-message-display-data exception)))))) - :else - (.then promise-chain (fn [] (heads-up/flash-loaded))))))))) - -(add-watch state ::render-watcher render-watcher) - -;; ------------------------------------------------------------ -;; Namespace reloading -;; ------------------------------------------------------------ - -(defn immutable-ns? [ns] - (let [ns (name ns)] - (or (#{"goog" "cljs.core" "cljs.nodejs" - "figwheel.preload" - "figwheel.connect"} ns) - (goog.string/startsWith "clojure." ns) - (goog.string/startsWith "goog." ns)))) - -(defn name->path [ns] - (gobj/get js/goog.dependencies_.nameToPath ns)) - -(defn provided? [ns] - (gobj/get js/goog.dependencies_.written (name->path (name ns)))) - -(defn ns-exists? [ns] - (some? (reduce (fnil gobj/get #js{}) - goog.global (string/split (name ns) ".")))) - -(defn reload-ns? [namespace] - (let [meta-data (meta namespace)] - (and - (not (immutable-ns? namespace)) - (not (:figwheel-no-load meta-data)) - (or - (:figwheel-always meta-data) - (:figwheel-load meta-data) - ;; might want to use .-visited here - (provided? namespace) - (ns-exists? namespace))))) - -;; ---------------------------------------------------------------- -;; TODOS -;; ---------------------------------------------------------------- - -;; look at what metadata you are sending when you reload namespaces - - -;; don't unprovide for things with no-load meta data -;; look more closely at getting a signal for reloading from the env/compiler -;; have an interface that just take the current compiler env and returns a list of namespaces to reload - -;; ---------------------------------------------------------------- -;; reloading namespaces -;; ---------------------------------------------------------------- - -(defn call-hooks [hook-key & args] - (let [hooks (keep (fn [[n mdata]] - (when-let [f (get-in mdata [:figwheel-hooks hook-key])] - [n f])) - (:figwheel.core/metadata @state))] - (doseq [[n f] hooks] - (if-let [hook (reduce #(when %1 - (gobj/get %1 %2)) - goog.global - (map str (concat (string/split n #"\.") [f])))] - (do - (glog/info logger (str "Calling " (pr-str hook-key) " hook - " n "." f)) - (apply hook args)) - (glog/warning logger (str "Unable to find " (pr-str hook-key) " hook - " n "." f)))))) - -(defn ^:export reload-namespaces [namespaces figwheel-meta] - ;; reconstruct serialized data - (let [figwheel-meta (into {} - (map (fn [[k v]] [(name k) v])) - (js->clj figwheel-meta :keywordize-keys true)) - namespaces (map #(with-meta (symbol %) - (get figwheel-meta %)) - namespaces)] - (swap! state #(-> % - (assoc ::metadata figwheel-meta) - (assoc-in [::reload-state :reload-started] (.getTime (js/Date.))))) - (let [to-reload - (when-not (and (not load-warninged-code) - (not-empty (get-in @state [::reload-state :warnings]))) - (filter #(reload-ns? %) namespaces))] - (when-not (empty? to-reload) - (call-hooks :before-load {:namespaces namespaces}) - (js/setTimeout #(dispatch-event :figwheel.before-load {:namespaces namespaces}) 0)) - (doseq [ns to-reload] - ;; goog/require has to be patched by a repl bootstrap - (goog/require (name ns) true)) - (let [after-reload-fn - (fn [] - (try - (when (not-empty to-reload) - (glog/info logger (str "loaded " (pr-str to-reload))) - (call-hooks :after-load {:reloaded-namespaces to-reload}) - (dispatch-event :figwheel.after-load {:reloaded-namespaces to-reload})) - (when-let [not-loaded (not-empty (filter (complement (set to-reload)) namespaces))] - (glog/info logger (str "did not load " (pr-str not-loaded)))) - (finally - (swap! state assoc ::reload-state {}))))] - (if (and (exists? js/figwheel.repl) - (exists? js/figwheel.repl.after_reloads)) - (js/figwheel.repl.after_reloads after-reload-fn) - (js/setTimeout after-reload-fn 100))) - nil))) - -;; ---------------------------------------------------------------- -;; compiler warnings -;; ---------------------------------------------------------------- - -(defn ^:export compile-warnings [warnings] - (when-not (empty? warnings) - (js/setTimeout #(dispatch-event :figwheel.compile-warnings {:warnings warnings}) 0)) - (swap! state update-in [::reload-state :warnings] concat warnings) - (doseq [warning warnings] - (glog/warning logger (str "Compile Warning - " (:message warning) " in " (file-line-column warning))))) - -(defn ^:export compile-warnings-remote [warnings-json] - (compile-warnings (js->clj warnings-json :keywordize-keys true))) - -;; ---------------------------------------------------------------- -;; exceptions -;; ---------------------------------------------------------------- - -(defn ^:export handle-exception [{:keys [file type message] :as exception-data}] - (try - (js/setTimeout #(dispatch-event :figwheel.compile-exception exception-data) 0) - (swap! state #(-> % - (assoc-in [::reload-state :reload-started] (.getTime (js/Date.))) - (assoc-in [::reload-state :exception] exception-data))) - (glog/info logger "Compile Exception") - (when (or type message) - (glog/info logger (string/join " : "(filter some? [type message])))) - (when file - (glog/info logger (str "Error on " (file-line-column exception-data)))) - (finally - (swap! state assoc-in [::reload-state] {})))) - -(defn ^:export handle-exception-remote [exception-data] - (handle-exception (js->clj exception-data :keywordize-keys true))) - -)) - -#?(:clj - (do - -(def ^:dynamic *config* {:hot-reload-cljs true - :broadcast-reload true - :reload-dependents true}) - -(defn debug-prn [& args] - (binding [*out* *err*] - (apply prn args))) - -(def scratch (atom {})) - -(defonce last-compiler-env (atom {})) - -(defn client-eval [code] - (when-not (string/blank? code) - (cljs.repl/-evaluate - (cond-> cljs.repl/*repl-env* - (:broadcast-reload *config* true) - (assoc :broadcast true)) - "" 1 - code))) - -(defn hooks-for-namespace [ns] - (into {} - (keep - (fn [[k v]] - (when-let [hook (first - (filter - (set (keys (:meta v))) - [:before-load :after-load]))] - [hook - (cljs.compiler/munge k)])) - (get-in @cljs.env/*compiler* [:cljs.analyzer/namespaces ns :defs])))) - -(defn find-figwheel-meta [] - (into {} - (comp - (map :ns) - (map (juxt - identity - #(select-keys - (meta %) - [:figwheel-always :figwheel-load :figwheel-no-load :figwheel-hooks]))) - (filter (comp not-empty second)) - (map (fn [[ns m]] - (if (:figwheel-hooks m) - [ns (assoc m :figwheel-hooks (hooks-for-namespace ns))] - [ns m])))) - (:sources @env/*compiler*))) - -(defn in-upper-level? [topo-state current-depth dep] - (some (fn [[_ v]] (and v (v dep))) - (filter (fn [[k v]] (> k current-depth)) topo-state))) - -(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] - (when (and dep (not (in-upper-level? @state depth dep))) - (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 #(clojure.set/difference % x) xs)))))] - topo-sort*))) - -(defn invert-deps [sources] - (apply merge-with concat - {} - (map (fn [{:keys [requires ns]}] - (reduce #(assoc %1 %2 [ns]) {} requires)) - sources))) - -(defn expand-to-dependents [deps] - (reverse (apply concat - ((build-topo-sort (invert-deps (:sources @env/*compiler*))) - deps)))) - -(defn sources-with-paths [files sources] - (let [files (set files)] - (filter - #(when-let [source-file (:source-file %)] - (when (instance? java.io.File source-file) - (files (.getCanonicalPath source-file)))) - sources))) - -(defn js-dependencies-with-file-urls [js-dependency-index] - (distinct-by :url - (filter #(when-let [u (:url %)] - (= "file" (.getProtocol u))) - (vals js-dependency-index)))) - -(defn js-dependencies-with-paths [files js-dependency-index] - (let [files (set files)] - (distinct - (filter - #(when-let [source-file (.getFile (:url %))] - (files source-file)) - (js-dependencies-with-file-urls js-dependency-index))))) - -(defn clj-paths->namespaces [paths] - (->> paths - (filter #(.exists (io/file %))) - (map (comp :ns ana/parse-ns io/file)) - distinct)) - -(defn figwheel-always-namespaces [figwheel-ns-meta] - (keep (fn [[k v]] (when (:figwheel-always v) k)) - figwheel-ns-meta)) - -(defn sources->namespaces-to-reload [sources] - (let [namespace-syms (map :ns (filter :source-file sources))] - (distinct - (concat - (cond-> namespace-syms - (and (not-empty namespace-syms) - (:reload-dependents *config* true)) - expand-to-dependents) - (map symbol - (mapcat :provides (filter :url sources))))))) - -(defn paths->namespaces-to-reload [paths] - (let [cljs-paths (filter #(or (.endsWith % ".cljs") - (.endsWith % ".cljc")) - paths) - js-paths (filter #(.endsWith % ".js") paths) - clj-paths (filter #(.endsWith % ".clj") paths)] - (distinct - (concat - (sources->namespaces-to-reload - (concat - (when-not (empty? cljs-paths) - (sources-with-paths cljs-paths (:sources @env/*compiler*))) - (when-not (empty? js-paths) - (js-dependencies-with-paths - js-paths - (:js-dependency-index @env/*compiler*))))) - (when-not (empty? clj-paths) - (bapi/cljs-dependents-for-macro-namespaces - env/*compiler* - (clj-paths->namespaces clj-paths))))))) - -(defn require-map [env] - (->> env - :sources - (map (juxt :ns :requires)) - (into {}))) - -(defn changed-dependency-tree? [previous-compiler-env compiler-env] - (not= (require-map previous-compiler-env) (require-map compiler-env))) - -(defrecord FakeReplEnv [] - cljs.repl/IJavaScriptEnv - (-setup [this opts]) - (-evaluate [_ _ _ js] js) - (-load [this ns url]) - (-tear-down [_] true)) - -;; this is a hack for now, easy enough to write this without the hack -(let [noop-repl-env (FakeReplEnv.)] - (defn add-dependencies-js [ns-sym output-dir] - (cljs.repl/load-namespace noop-repl-env ns-sym {:output-dir (or output-dir "out")}))) - -(defn all-add-dependencies [ns-syms output-dir] - (string/join - "\n" - (distinct - (mapcat #(filter - (complement string/blank?) - (string/split-lines %)) - (concat - ;; this is strange because foreign libs aren't being included in add-dependencies above - (let [deps-file (io/file output-dir "cljs_deps.js")] - (when-let [deps-data (and (.exists deps-file) (slurp deps-file))] - (when-not (string/blank? deps-data) - [deps-data]))) - (map - #(add-dependencies-js % output-dir) - ns-syms)))))) - -(defn output-dir [] - (-> @env/*compiler* :options :output-dir (or "out"))) - -(defn root-namespaces [env] - (clojure.set/difference (->> env :sources (mapv :ns) (into #{})) - (->> env :sources (map :requires) (reduce into #{})))) - -;; TODO since this is the only fn that needs state perhaps isolate -;; last compiler state here? -(defn all-dependency-code [ns-syms] - (when-let [last-env (get @last-compiler-env env/*compiler*)] - (when (changed-dependency-tree? last-env @env/*compiler*) - (let [roots (root-namespaces @env/*compiler*)] - (all-add-dependencies roots (output-dir)))))) - -;; TODO change this to reload_namespace_remote interface -;; I think we only need the meta data for the current symbols -;; better to send objects that hold a namespace and its meta data -;; and have a function that reassembles this on the other side -;; this will allow us to add arbitrary data and pehaps change the -;; serialization in the future -(defn reload-namespace-code [ns-syms] - (str (all-dependency-code ns-syms) - (format "figwheel.core.reload_namespaces(%s,%s)" - (json/write-str (mapv cljs.compiler/munge ns-syms)) - (json/write-str (map-keys cljs.compiler/munge (find-figwheel-meta)))))) - -(defn reload-namespaces [ns-syms] - (let [ns-syms (if (false? (:hot-reload-cljs *config*)) [] ns-syms) - ret (client-eval (reload-namespace-code ns-syms))] - ;; currently we are saveing the value of the compiler env - ;; so that we can detect if the dependency tree changed - (swap! last-compiler-env assoc env/*compiler* @env/*compiler*) - ret)) - -;; ------------------------------------------------------------- -;; reload clojure namespaces -;; ------------------------------------------------------------- - -;; keep in mind that you need to reload clj namespaces before cljs compiling -(defn reload-clj-namespaces [nses] - (when (not-empty nses) - (doseq [ns nses] (require ns :reload)) - (let [affected-nses (bapi/cljs-dependents-for-macro-namespaces env/*compiler* nses)] - (doseq [ns affected-nses] - (bapi/mark-cljs-ns-for-recompile! ns (output-dir))) - affected-nses))) - -(defn reload-clj-files [files] - (reload-clj-namespaces (clj-paths->namespaces files))) - -;; ------------------------------------------------------------- -;; warnings -;; ------------------------------------------------------------- - -(defn str-excerpt [code-str start length & [path]] - (cond-> - {:start-line start - :excerpt (->> (string/split-lines code-str) - (drop (dec start)) - (take length) - (string/join "\n"))} - path (assoc :path path))) - -(defn file-excerpt [file start length] - (str-excerpt (slurp file) start length (.getCanonicalPath file))) - -(defn warning-info [{:keys [warning-type env extra path]}] - (when warning-type - (let [file (io/file path) - line (:line env) - file-excerpt (when (and file (.exists file)) - (file-excerpt file (max 1 (- line 10)) 20)) - message (cljs.analyzer/error-message warning-type extra)] - (cond-> {:warning-type warning-type - :line (:line env) - :column (:column env) - :ns (-> env :ns :name) - :extra extra} - message (assoc :message message) - path (assoc :file path) - file-excerpt (assoc :file-excerpt file-excerpt))))) - -(defn warnings->warning-infos [warnings] - (->> warnings - (filter - (comp cljs.analyzer/*cljs-warnings* :warning-type)) - (map warning-info) - not-empty)) - -(defn compiler-warnings-code [warning-infos] - (format "figwheel.core.compile_warnings_remote(%s);" - (json/write-str warning-infos))) - -(defn handle-warnings [warnings] - (when-let [warns (warnings->warning-infos warnings)] - (client-eval (compiler-warnings-code warns)))) - -(comment - - (binding [cljs.env/*compiler* (atom (second (first @last-compiler-env)))] - (let [paths (:paths @scratch)] - (expand-to-dependents (paths->namespaces-to-reload paths)) - #_(sources-with-paths paths (:sources @cljs.env/*compiler*)) - )) - - (def x - (first - (filter (comp cljs.analyzer/*cljs-warnings* :warning-type) (:warnings @scratch)))) - (:warning-data @scratch) - (count (:parsed-warning @scratch)) - - (warnings->warning-infos (:warnings @scratch)) - - (handle-warnings (:warnings @scratch)) - - ) - -;; ------------------------------------------------------------- -;; exceptions -;; ------------------------------------------------------------- - -(defn exception-code [parsed-exception] - (let [parsable-data? - (try (some-> parsed-exception :data pr-str edn/read-string) - (catch Throwable t - false)) - parsed-exception' (cond-> parsed-exception - (not parsable-data?) (dissoc :data))] - (format "figwheel.core.handle_exception_remote(%s);" - (json/write-str - (-> parsed-exception' - (update :tag #(string/join "/" ((juxt namespace name) %))) - pr-str - edn/read-string))))) - -(defn handle-exception [exception-o-throwable-map] - (let [{:keys [file line] :as parsed-ex} (fig-ex/parse-exception exception-o-throwable-map) - file-excerpt (when (and file line (.exists (io/file file))) - (file-excerpt (io/file file) (max 1 (- line 10)) 20)) - parsed-ex (cond-> parsed-ex - file-excerpt (assoc :file-excerpt file-excerpt))] - (when parsed-ex - (client-eval - (exception-code parsed-ex))))) - -(comment - (require 'figwheel.tools.exceptions-test) - - (handle-exception (figwheel.tools.exceptions-test/fetch-exception "(defn")) - ) - - -;; ------------------------------------------------------------- -;; listening for changes -;; ------------------------------------------------------------- - -(defn all-sources [compiler-env] - (concat - (filter :source-file (:sources compiler-env)) - (js-dependencies-with-file-urls (:js-dependency-index compiler-env)))) - -(defn source-file [source-o-js-dep] - (let [f (cond - (:url source-o-js-dep) (io/file (.getFile (:url source-o-js-dep))) - (:source-file source-o-js-dep) (:source-file source-o-js-dep))] - (when (instance? java.io.File f) f))) - -(defn sources->modified-map [sources] - (into {} - (comp - (keep source-file) - (map (juxt #(.getCanonicalPath %) #(.lastModified %)))) - sources)) - -(defn sources-modified [compiler-env last-modifieds] - (doall - (keep - (fn [source] - (when-let [file' (source-file source)] - (let [path (.getCanonicalPath file') - last-modified' (.lastModified file') - last-modified (get last-modifieds path 0)] - (when (> last-modified' last-modified) - (vary-meta source assoc ::last-modified last-modified'))))) - (all-sources compiler-env)))) - -(defn sources-modified! [compiler-env last-modified-vol] - (let [modified-sources (sources-modified compiler-env @last-modified-vol)] - (vswap! last-modified-vol merge (sources->modified-map modified-sources)) - modified-sources)) - -(defn start* - ([] (start* *config* env/*compiler* cljs.repl/*repl-env*)) - ([config compiler-env repl-env] - (add-watch - compiler-env - ::watch-hook - (let [last-modified (volatile! (sources->modified-map (all-sources @compiler-env)))] - (fn [_ _ o n] - (let [compile-data (-> n meta ::compile-data)] - (when (and (not= (-> o meta ::compile-data) compile-data) - (not-empty (-> n meta ::compile-data))) - (cond - (and (:finished compile-data) - (not (:exception compile-data))) - (binding [env/*compiler* compiler-env - cljs.repl/*repl-env* repl-env - *config* config] - (let [namespaces - (if (contains? compile-data :changed-files) - (paths->namespaces-to-reload (:changed-files compile-data)) - (->> (sources-modified! @compiler-env last-modified) - (sources->namespaces-to-reload)))] - (when-let [warnings (not-empty (:warnings compile-data))] - (handle-warnings warnings)) - (reload-namespaces namespaces))) - (:exception compile-data) - (binding [env/*compiler* compiler-env - cljs.repl/*repl-env* repl-env - *config* config] - (handle-exception (:exception compile-data))) - ;; next cond - :else nil - )))))))) - -;; TODO this is still really rough, not quite sure about this yet -(defmacro start-from-repl - ([] - (start*) nil) - ([config] - (start*) - (when config - `(swap! state merge ~config)))) - -(defn stop - ([] (stop env/*compiler*)) - ([compiler-env] (remove-watch compiler-env ::watch-hook))) - -;; ------------------------------------------------------------- -;; building -;; ------------------------------------------------------------- - -(defn notify-on-exception [compiler-env e extra-data] - (doto compiler-env - (swap! vary-meta assoc ::compile-data - {:started (System/currentTimeMillis)}) - (swap! vary-meta update ::compile-data - (fn [x] - (merge (select-keys x [:started]) - extra-data - {:exception e - :finished (System/currentTimeMillis)}))))) - -;; TODO should handle case of already having changed files -(let [cljs-build cljs.closure/build] - (defn build - ([src opts] - (with-redefs [cljs.closure/build build] - (cljs-build src opts))) - ([src opts compiler-env & [changed-files]] - (assert compiler-env "should have a compiler env") - (let [local-data (volatile! {})] - (binding [cljs.analyzer/*cljs-warning-handlers* - (conj cljs.analyzer/*cljs-warning-handlers* - (fn [warning-type env extra] - (vswap! local-data update :warnings - (fnil conj []) - {:warning-type warning-type - :env env - :extra extra - :path ana/*cljs-file*})))] - (try - (swap! compiler-env vary-meta assoc ::compile-data {:started (System/currentTimeMillis)}) - (let [res (cljs-build src opts compiler-env)] - (swap! compiler-env - vary-meta - update ::compile-data - (fn [x] - (merge (select-keys x [:started]) - @local-data - (cond-> {:finished (System/currentTimeMillis)} - (some? changed-files) ;; accept empty list here - (assoc :changed-files changed-files))))) - res) - (catch Throwable e - (swap! compiler-env - vary-meta - update ::compile-data - (fn [x] - (merge (select-keys x [:started]) - @local-data - {:exception e - :finished (System/currentTimeMillis)}))) - (throw e)) - (finally - (swap! compiler-env vary-meta assoc ::compile-data {}))))))) - - ;; invasive hook of cljs.closure/build - (defn hook-cljs-closure-build [] - (when (and (= cljs-build cljs.closure/build) (not= build cljs.closure/build)) - (alter-var-root #'cljs.closure/build (fn [_] build)))) - - (defmacro hook-cljs-build [] - (hook-cljs-closure-build) - nil) - ) - -(comment - - (def cenv (cljs.env/default-compiler-env)) - - (:cljs.analyzer/namespaces @cenv) - - (get-in @cenv [:cljs.analyzer/namespaces 'figwheel.core :defs]) - - #_(clojure.java.shell/sh "rm" "-rf" "out") - (build "src" {:main 'figwheel.core} cenv) - - (binding [cljs.env/*compiler* cenv] - (find-figwheel-meta)) - - (first (cljs.js-deps/load-library* "src")) - - (bapi/cljs-dependents-for-macro-namespaces (atom (first (vals @last-compiler-env))) - '[example.macros]) - - (swap! scratch assoc :require-map2 (require-map (first (vals @last-compiler-env)))) - - (def last-modifieds (volatile! (sources->modified-map (all-sources (first (vals @last-compiler-env)))))) - - (map source-file - (all-sources (first (vals @last-compiler-env)))) - - (let [compile-env (atom (first (vals @last-compiler-env)))] - (binding [env/*compiler* compile-env] - (paths->namespaces-to-reload [(.getCanonicalPath (io/file "src/example/fun_tester.js"))]) - - )) - (secon (:js-dependency-index (first (vals @last-compiler-env)))) - (js-dependencies-with-file-urls (:js-dependency-index (first (vals @last-compiler-env)))) - (filter (complement #(or (.startsWith % "goog") (.startsWith % "proto"))) - (mapcat :provides (vals (:js-dependency-index (first (vals @last-compiler-env)))))) - (map :provides (all-sources (first (vals @last-compiler-env)))) - (sources-last-modified (first (vals @last-compiler-env))) - - -(map source-file ) - - - - - - - (js-dependencies-with-file-urls (:js-dependency-index (first (vals @last-compiler-env)))) - -(distinct (filter #(= "file" (.getProtocol %)) (keep :url (vals )))) - - (def save (:files @scratch)) - - (clj-files->namespaces ["/Users/bhauman/workspace/lein-figwheel/example/src/example/macros.clj"]) - (js-dependencies-with-paths save (:js-dependency-index )) - (namespaces-for-paths ["/Users/bhauman/workspace/lein-figwheel/example/src/example/macros.clj"] - (first (vals @last-compiler-env))) - - (= (-> @scratch :require-map) - (-> @scratch :require-map2) - ) - - (binding [env/*compiler* (atom (first (vals @last-compiler-env)))] - #_(add-dependiencies-js 'example.core (output-dir)) - #_(all-add-dependencies '[example.core figwheel.preload] - (output-dir)) - #_(reload-namespace-code '[example.core]) - (find-figwheel-meta) - ) - - #_(require 'cljs.core) - - (count @last-compiler-env) - (map :requires (:sources (first (vals @last-compiler-env)))) - (expand-to-dependents (:sources (first (vals @last-compiler-env))) '[example.fun-tester]) - - (def scratch (atom {})) - (def comp-env (atom nil)) - - (first (:files @scratch)) - (.getAbsolutePath (:source-file (first (:sources @comp-env)))) - (sources-with-paths (:files @scratch) (:sources @comp-env)) - (invert-deps (:sources @comp-env)) - (expand-to-dependents (:sources @comp-env) '[figwheel.client.utils]) - (clojure.java.shell/sh "touch" "cljs_src/figwheel_helper/core.cljs") - ) - - -) - - - - - - - ) diff --git a/figwheel-core/src/figwheel/tools/exceptions.clj b/figwheel-core/src/figwheel/tools/exceptions.clj deleted file mode 100644 index ef1efe13..00000000 --- a/figwheel-core/src/figwheel/tools/exceptions.clj +++ /dev/null @@ -1,190 +0,0 @@ -(ns figwheel.tools.exceptions - (:require - [clojure.string :as string] - [clojure.java.io :as io])) - -;; utils - -(defn relativize-local [path] - (.getPath - (.relativize - (.toURI (io/file (.getCanonicalPath (io/file ".")))) - ;; just in case we get a URL or some such let's change it to a string first - (.toURI (io/file (str path)))))) - -;; compile time exceptions are syntax errors so we need to break them down into -;; message line column file - -;; TODO handle spec errors - -(defn cljs-analysis-ex? [tm] - (some #{:cljs/analysis-error} (keep #(get-in %[:data :tag]) (:via tm)))) - -(defn reader-ex? [{:keys [data]}] - (= :reader-exception (:type data))) - -(defn eof-reader-ex? [{:keys [data] :as tm}] - (and (reader-ex? tm) (= :eof (:ex-kind data)))) - -(defn cljs-failed-compiling? [tm] - (some #(.startsWith % "failed compiling file:") (keep :message (:via tm)))) - -(defn clj-compiler-ex? [tm] - (-> tm :via first :type pr-str (= (pr-str 'clojure.lang.Compiler$CompilerException)))) - -(defn clj-spec-error? [tm] - (-> tm :data :clojure.spec.alpha/problems)) - -(defn exception-type? [tm] - (cond - (cljs-analysis-ex? tm) :cljs/analysis-error - (eof-reader-ex? tm) :tools.reader/eof-reader-exception - (reader-ex? tm) :tools.reader/reader-exception - (cljs-failed-compiling? tm) :cljs/general-compile-failure - (clj-spec-error? tm) :clj/spec-based-syntax-error - (clj-compiler-ex? tm) :clj/compiler-exception - :else nil)) - -(derive :clj/spec-based-syntax-error :clj/compiler-exception) - -(derive :tools.reader/eof-reader-exception :tools.reader/reader-exception) - -(defmulti message exception-type?) - -(defmethod message :default [tm] (:cause tm)) - -(defmethod message :tools.reader/reader-exception [tm] - (or - (some-> tm :cause (string/split #"\[line.*\]") second string/trim) - (:cause tm))) - -(defmethod message :clj/spec-based-syntax-error [tm] - (first (string/split-lines (:cause tm)))) - -(defmulti blame-pos exception-type?) - -(defmethod blame-pos :default [tm]) - -(defmethod blame-pos :cljs/analysis-error [tm] - (select-keys - (some->> tm :via reverse (filter #(get-in % [:data :line])) first :data) - [:line :column])) - -(defmethod blame-pos :tools.reader/eof-reader-exception [tm] - (let [[line column] - (some->> tm :cause (re-matches #".*line\s(\d*)\sand\scolumn\s(\d*).*") - rest)] - (cond-> {} - line (assoc :line (Integer/parseInt line)) - column (assoc :column (Integer/parseInt column))))) - -(defmethod blame-pos :tools.reader/reader-exception [{:keys [data]}] - (let [{:keys [line col]} data] - (cond-> {} - line (assoc :line line) - col (assoc :column col)))) - -(defmethod blame-pos :clj/compiler-exception [tm] - (let [[line column] - (some->> tm :via first :message - (re-matches #"(?s).*\(.*\:(\d+)\:(\d+)\).*") - rest)] - (cond-> {} - line (assoc :line (Integer/parseInt line)) - column (assoc :column (Integer/parseInt column))))) - -;; return relative path because it isn't lossy -(defmulti source-file exception-type?) - -(defmethod source-file :default [tm]) - -(defn first-file-source [tm] - (some->> tm :via (keep #(get-in % [:data :file])) first str)) - -(defmethod source-file :cljs/general-compile-failure [tm] - (first-file-source tm)) - -(defmethod source-file :cljs/analysis-error [tm] - (first-file-source tm)) - -(defmethod source-file :tools.reader/reader-exception [tm] - (first-file-source tm)) - -(defn correct-file-path [file] - (cond - (nil? file) file - (not (.exists (io/file file))) - (if-let [f (io/resource file)] - (relativize-local (.getPath f)) - file) - :else (relativize-local file))) - -(defmethod source-file :clj/compiler-exception [tm] - (some->> tm :via first :message (re-matches #"(?s).*\(([^:]*)\:.*") second correct-file-path)) - -(defmulti data exception-type?) - -(defmethod data :default [tm] - (or (:data tm) (->> tm :via reverse (keep :data) first))) - -#_(defmethod data :clj/spec-based-syntax-error [tm] nil) - -(defn ex-type [tm] - (some-> tm :via last :type pr-str symbol)) - - -(defn parse-exception [e] - (let [tm (if (instance? Throwable e) (Throwable->map e) e) - tag (exception-type? tm) - msg (message tm) - pos (blame-pos tm) - file (source-file tm) - ex-typ (ex-type tm) - data' (data tm)] - (cond-> (vary-meta {} assoc ::orig-throwable tm) - tag (assoc :tag tag) - msg (assoc :message msg) - pos (merge pos) - file (assoc :file file) - ex-typ (assoc :type ex-typ) - data' (assoc :data data')))) - -#_(parse-exception (figwheel.tools.exceptions-test/fetch-clj-exception "(defn [])")) - -;; Excerpts - -(defn str-excerpt [code-str start length & [path]] - (cond-> - {:start-line start - :excerpt (->> (string/split-lines code-str) - (drop (dec start)) - (take length) - (string/join "\n"))} - path (assoc :path path))) - -(defn file-excerpt [file start length] - (str-excerpt (slurp file) start length (.getCanonicalPath file))) - -(defn root-source->file-excerpt [{:keys [source-form] :as root-source-info} except-data] - (let [{:keys [source column]} (when (instance? clojure.lang.IMeta source-form) - (meta source-form))] - (cond-> except-data - (and column (> column 1) (= (:line except-data) 1) (:column except-data)) - (update :column #(max 1 (- % (dec column)))) - source (assoc :file-excerpt {:start-line 1 :excerpt source})))) - -(defn add-excerpt - ([parsed] (add-excerpt parsed nil)) - ([{:keys [file line data] :as parsed} code-str] - (cond - (and line file (.isFile (io/file file))) - (let [fex (file-excerpt (io/file file) (max 1 (- line 10)) 20)] - (cond-> parsed - fex (assoc :file-excerpt fex))) - (and line (:root-source-info data)) - (root-source->file-excerpt (:root-source-info data) parsed) - (and line code-str) - (let [str-ex (str-excerpt code-str (max 1 (- line 10)) 20)] - (cond-> parsed - str-ex (assoc :file-excerpt str-ex))) - :else parsed))) diff --git a/figwheel-core/src/figwheel/tools/heads_up.cljs b/figwheel-core/src/figwheel/tools/heads_up.cljs deleted file mode 100644 index f61e9f03..00000000 --- a/figwheel-core/src/figwheel/tools/heads_up.cljs +++ /dev/null @@ -1,427 +0,0 @@ -(ns figwheel.tools.heads-up - (:require - [clojure.string :as string] - [goog.string] - [goog.dom.dataset :as data] - [goog.object :as gobj] - [goog.dom :as dom] - [cljs.pprint :as pp]) - (:import [goog Promise])) - -(declare clear cljs-logo-svg) - -;; cheap hiccup -(defn node [t attrs & children] - (let [e (.createElement js/document (name t))] - (doseq [k (keys attrs)] (.setAttribute e (name k) (get attrs k))) - (doseq [ch children] (.appendChild e ch)) ;; children - e)) - -(defmulti heads-up-event-dispatch (fn [dataset] (.-figwheelEvent dataset))) -(defmethod heads-up-event-dispatch :default [_] {}) - -;; TODO change this so that clients of this library can register -;; to catch this event -(defmethod heads-up-event-dispatch "file-selected" [dataset] - #_(socket/send! {:figwheel-event "file-selected" - :file-name (.-fileName dataset) - :file-line (.-fileLine dataset) - :file-column (.-fileColumn dataset)})) - -(defmethod heads-up-event-dispatch "close-heads-up" [dataset] (clear)) - -(defn ancestor-nodes [el] - (iterate (fn [e] (.-parentNode e)) el)) - -(defn get-dataset [el] - (first (keep (fn [x] (when (.. x -dataset -figwheelEvent) (.. x -dataset))) - (take 4 (ancestor-nodes el))))) - -(defn heads-up-onclick-handler [event] - (let [dataset (get-dataset (.. event -target))] - (.preventDefault event) - (when dataset - (heads-up-event-dispatch dataset)))) - -(defn ensure-container [] - (let [cont-id "figwheel-heads-up-container" - content-id "figwheel-heads-up-content-area"] - (if-not (.querySelector js/document (str "#" cont-id)) - (let [el (node :div { :id cont-id - :style - (str "-webkit-transition: all 0.2s ease-in-out;" - "-moz-transition: all 0.2s ease-in-out;" - "-o-transition: all 0.2s ease-in-out;" - "transition: all 0.2s ease-in-out;" - "font-size: 13px;" - "border-top: 1px solid #f5f5f5;" - "box-shadow: 0px 0px 1px #aaaaaa;" - "line-height: 18px;" - "color: #333;" - "font-family: monospace;" - "padding: 0px 10px 0px 70px;" - "position: fixed;" - "bottom: 0px;" - "left: 0px;" - "height: 0px;" - "opacity: 0.0;" - "box-sizing: border-box;" - "z-index: 10000;" - "text-align: left;" - ) })] - (set! (.-onclick el) heads-up-onclick-handler) - (set! (.-innerHTML el) cljs-logo-svg) - (.appendChild el (node :div {:id content-id})) - (-> (.-body js/document) - (.appendChild el)))) - { :container-el (.getElementById js/document cont-id) - :content-area-el (.getElementById js/document content-id) } - )) - -(defn set-style! [{:keys [container-el]} st-map] - (mapv - (fn [[k v]] - (gobj/set (.-style container-el) (name k) v)) - st-map)) - -(defn set-content! [{:keys [content-area-el] :as c} dom-str] - (set! (.-innerHTML content-area-el) dom-str)) - -(defn get-content [{:keys [content-area-el]}] - (.-innerHTML content-area-el)) - -(defn close-link [] - (str "" - "x" - "")) - -(defn display-heads-up [style msg] - (Promise. - (fn [resolve reject] - (let [c (ensure-container)] - (set-style! c (merge { - :paddingTop "10px" - :paddingBottom "10px" - :width "100%" - :minHeight "68px" - :opacity "1.0" } - style)) - (set-content! c msg) - (js/setTimeout (fn [] - (set-style! c {:height "auto"}) - (resolve true)) - 300))))) - -(defn heading - ([s] (heading s "")) - ([s sub-head] - (str "
" - s - " " - sub-head - "
"))) - -(defn file-selector-div [file-name line-number column-number msg] - (str "
" msg "
")) - -(defn format-line [msg {:keys [file line column]}] - (let [msg (goog.string/htmlEscape msg)] - (if (or file line) - (file-selector-div file line column msg) - (str "
" msg "
")))) - -(defn escape [x] - (goog.string/htmlEscape x)) - -(defn pad-line-number [n line-number] - (let [len (count ((fnil str "") line-number))] - (-> (if (< len n) - (apply str (repeat (- n len) " ")) - "") - (str line-number)))) - -(defn inline-error-line [style line-number line] - (str "" "" line-number " " (escape line) "")) - -(defn format-inline-error-line [[typ line-number line]] - (condp = typ - :code-line (inline-error-line "color: #999;" line-number line) - :error-in-code (inline-error-line "color: #ccc; font-weight: bold;" line-number line) - :error-message (inline-error-line "color: #D07D7D;" line-number line) - (inline-error-line "color: #666;" line-number line))) - -(defn pad-line-numbers [inline-error] - (let [max-line-number-length (count (str (reduce max (map second inline-error))))] - (map #(update-in % [1] - (partial pad-line-number max-line-number-length)) inline-error))) - -(defn format-inline-error [inline-error] - (let [lines (map format-inline-error-line (pad-line-numbers inline-error))] - (str "
"
-         (string/join "\n" lines)
-         "
"))) - -(def flatten-exception #(take-while some? (iterate :cause %))) - -(defn exception->display-data [{:keys [tag message line column type file data error-inline] :as exception}] - (let [last-message (cond - (and file line) - (str "Please see line " line " of file " file ) - file (str "Please see " file) - :else nil) - data-for-display (when-not (#{"cljs/analysis-error" "tools.reader/eof-reader-exception" "tools.reader/reader-exception"} - tag) - data)] - {:head (condp = tag - "clj/compiler-exception" "Couldn't load Clojure file" - "cljs/analysis-error" "Could not Analyze" - "tools.reader/eof-reader-exception" "Could not Read" - "tools.reader/reader-exception" "Could not Read" - "cljs/general-compile-failure" "Could not Compile" - "Compile Exception") - :sub-head file - :messages (concat - (map - #(str "
" % "
") - (filter - (complement string/blank?) - [(cond-> "" - type (str (escape type)) - (and type message) (str ": ") - message (str "" (escape message) "")) - (when data-for-display - (str "
"
-                          (goog.string/trimRight (with-out-str (pp/pprint data-for-display)))
-                          "
")) - (when (pos? (count error-inline)) - (format-inline-error error-inline))])) - (when last-message [(str "
" (escape last-message) "
")])) - :file file - :line line - :column column})) - -#_(defn auto-notify-source-file-line [{:keys [file line column]}] - #_(socket/send! {:figwheel-event "file-selected" - :file-name (str file) - :file-line (str line) - :file-column (str column)})) - -(defn display-exception [exception-data] - (let [{:keys [head - sub-head - messages - last-message - file - line - column]} - (-> exception-data - exception->display-data) - msg (apply str messages)] - (display-heads-up {:backgroundColor "rgba(255, 161, 161, 0.95)"} - (str (close-link) - (heading head sub-head) - (file-selector-div file line column msg))))) - -(defn warning-data->display-data [{:keys [file line column message error-inline] :as warning-data}] - (let [last-message (cond - (and file line) - (str "Please see line " line " of file " file ) - file (str "Please see " file) - :else nil)] - {:head "Compile Warning" - :sub-head file - :messages (concat - (map - #(str "
" % "
") - [(when message - (str "" (escape message) "")) - (when (pos? (count error-inline)) - (format-inline-error error-inline))]) - (when last-message - [(str "
" (escape last-message) "
")])) - :file file - :line line - :column column})) - -(defn display-system-warning [header msg] - (display-heads-up {:backgroundColor "rgba(255, 220, 110, 0.95)" } - (str (close-link) (heading header) - "
" msg "
" - #_(format-line msg {})))) - -(defn display-warning [warning-data] - (let [{:keys [head - sub-head - messages - last-message - file - line - column]} - (-> warning-data - warning-data->display-data) - msg (apply str messages)] - (display-heads-up {:backgroundColor "rgba(255, 220, 110, 0.95)" } - (str (close-link) - (heading head sub-head) - (file-selector-div file line column msg))))) - -(defn format-warning-message [{:keys [message file line column] :as warning-data}] - (cond-> message - line (str " at line " line) - (and line column) (str ", column " column) - file (str " in file " file)) ) - -(defn append-warning-message [{:keys [message file line column] :as warning-data}] - (when message - (let [{:keys [content-area-el]} (ensure-container) - el (dom/createElement "div") - child-count (.-length (dom/getChildren content-area-el))] - (if (< child-count 6) - (do - (set! (.-innerHTML el) - (format-line (format-warning-message warning-data) - warning-data)) - (dom/append content-area-el el)) - (when-let [last-child (dom/getLastElementChild content-area-el)] - (if-let [message-count (data/get last-child "figwheel_count")] - (let [message-count (inc (js/parseInt message-count))] - (data/set last-child "figwheel_count" message-count) - (set! (.-innerHTML last-child) - (str message-count " more warnings have not been displayed ..."))) - (dom/append - content-area-el - (dom/createDom "div" #js {:data-figwheel_count 1 - :style "margin-top: 3px; font-weight: bold"} - "1 more warning that has not been displayed ...")))))))) - -(defn timeout* [time-ms] - (Promise. - (fn [resolve _] - (js/setTimeout #(resolve true) time-ms)))) - -(defn clear [] - (let [c (ensure-container)] - (-> (Promise. - (fn [r _] - (set-style! c { :opacity "0.0" }) - (r true))) - (.then (fn [_] (timeout* 300))) - (.then (fn [_] - (set-style! c { :width "auto" - :height "0px" - :minHeight "0px" - :padding "0px 10px 0px 70px" - :borderRadius "0px" - :backgroundColor "transparent" }))) - (.then (fn [_] (timeout* 200))) - (.then (fn [_] (set-content! c "")))))) - -(defn display-loaded-start [] - (display-heads-up {:backgroundColor "rgba(211,234,172,1.0)" - :width "68px" - :height "68px" - :paddingLeft "0px" - :paddingRight "0px" - :borderRadius "35px" } "")) - -(defn flash-loaded [] - (-> (display-loaded-start) - (.then (fn [_] (timeout* 400))) - (.then (fn [_] (clear))))) - -(def cljs-logo-svg - " - - - - - - - - - - - -") - -;; ---- bad compile helper ui ---- - -(defn close-bad-compile-screen [] - (when-let [el (js/document.getElementById "figwheelFailScreen")] - (dom/removeNode el))) - -(defn bad-compile-screen [] - (let [body (-> (dom/getElementsByTagNameAndClass "body") - (aget 0))] - (close-bad-compile-screen) - #_(dom/removeChildren body) - (dom/append body - (dom/createDom - "div" - #js {:id "figwheelFailScreen" - :style (str "background-color: rgba(24, 26, 38, 0.95);" - "position: absolute;" - "z-index: 9000;" - "width: 100vw;" - "height: 100vh;" - "top: 0px; left: 0px;" - "font-family: monospace")} - (dom/createDom - "div" - #js {:class "message" - :style (str - "color: #FFF5DB;" - "width: 100vw;" - "margin: auto;" - "margin-top: 10px;" - "text-align: center; " - "padding: 2px 0px;" - "font-size: 13px;" - "position: relative")} - (dom/createDom - "a" - #js {:onclick (fn [e] - (.preventDefault e) - (close-bad-compile-screen)) - :href "javascript:" - :style "position: absolute; right: 10px; top: 10px; color: #666"} - "X") - (dom/createDom "h2" #js {:style "color: #FFF5DB"} - "Figwheel Says: Your code didn't compile.") - (dom/createDom "div" #js {:style "font-size: 12px"} - (dom/createDom "p" #js { :style "color: #D07D7D;"} - "Keep trying. This page will auto-refresh when your code compiles successfully.") - )))))) diff --git a/figwheel-core/test/figwheel/tools/exceptions_test.clj b/figwheel-core/test/figwheel/tools/exceptions_test.clj deleted file mode 100644 index e38c4af4..00000000 --- a/figwheel-core/test/figwheel/tools/exceptions_test.clj +++ /dev/null @@ -1,138 +0,0 @@ -(ns figwheel.tools.exceptions-test - (:require - [cljs.build.api :as bapi] - [clojure.string :as string] - [clojure.java.io :as io] - [figwheel.tools.exceptions :refer :all] - [clojure.test :refer [deftest is testing]])) - -#_(remove-ns 'figwheel.tools.exceptions-test) - -;; ----------------------------- -;; helpers to capture exceptions -;; ----------------------------- - -(defn example-test-file! [p code] - (io/make-parents (io/file p)) - (spit p (str (prn-str '(ns example.except)) code))) - -(defn fetch-exception [code] - (let [p "dev/example/except.cljs"] - (example-test-file! p code) - (.delete (io/file "target/test_out/example/except.js")) - (try - (bapi/build "dev" {:output-dir "target/test_out" :main "example.except" :output-to "target/test_out/main.js"}) - (catch Throwable e - (Throwable->map e))))) - -(defn fetch-clj-exception [code] - (let [p "dev/example/except.clj"] - (example-test-file! p code) - (try - (load-file p) - (catch Throwable e - (Throwable->map e))))) - -(defn anonymise-ex - "Remove system specific information from exceptions - so that tests produce the same results on different - systems." - [ex-map] - (update ex-map :data dissoc :file)) - -(deftest exception-parsing-test - (is (= {:tag :cljs/analysis-error, - :line 2, - :column 1, - :file "dev/example/except.cljs", - :type 'clojure.lang.ArityException, - :data - {:file "dev/example/except.cljs", - :line 2, - :column 1, - :tag :cljs/analysis-error}} - (dissoc (parse-exception (fetch-exception "(defn)")) :message))) - - (is (= "Wrong number of args (0) passed to" - (some-> (fetch-exception "(defn)") - parse-exception - :message - (string/split #":") - first))) - - (is (= {:tag :tools.reader/eof-reader-exception, - :message - "Unexpected EOF while reading item 1 of list, starting at line 2 and column 1.", - :line 2, - :column 1, - :file "dev/example/except.cljs", - :type 'clojure.lang.ExceptionInfo, - :data - {:type :reader-exception, - :ex-kind :eof, - :line 2, - :col 7}} - (anonymise-ex (parse-exception (fetch-exception "(defn "))))) - - (is (= {:tag :tools.reader/reader-exception, - :message "Unmatched delimiter ).", - :line 2, - :column 2, - :file "dev/example/except.cljs", - :type 'clojure.lang.ExceptionInfo, - :data - {:type :reader-exception, - :ex-kind :reader-error, - :file - (.getCanonicalPath (io/file "dev/example/except.cljs",)) - :line 2, - :col 2}} - (parse-exception (fetch-exception "))")))) - - (is (= {:tag :tools.reader/reader-exception, - :message "No reader function for tag asdf.", - :line 2, - :column 6, - :file "dev/example/except.cljs", - :type 'clojure.lang.ExceptionInfo, - :data - {:type :reader-exception, - :ex-kind :reader-error, - :file (.getCanonicalPath (io/file "dev/example/except.cljs",)) - :line 2, - :col 6}} - (parse-exception (fetch-exception "#asdf {}")))) - - - - (is (= {:tag :clj/compiler-exception, - :message "No reader function for tag asdf", - :line 2, - :column 9, - :file "dev/example/except.clj", - :type 'java.lang.RuntimeException - } - (parse-exception (fetch-clj-exception "#asdf {}")))) - - (is (= {:tag :clj/compiler-exception, - :message "EOF while reading, starting at line 2", - :line 2, - :column 1, - :file "dev/example/except.clj", - :type 'java.lang.RuntimeException} - (parse-exception (fetch-clj-exception " (defn")))) - - - ) - - -;; TODO work on spec exceptions -#_(def clj-version - (read-string (string/join "." - (take 2 (string/split (clojure-version) #"\."))))) - -#_(when (>= clj-version 1.9) - - #_(parse-exception (fetch-clj-exception "(defn)")) - - ) diff --git a/figwheel-main/devver.cljs.edn b/figwheel-main/devver.cljs.edn new file mode 100644 index 00000000..9a29ba3f --- /dev/null +++ b/figwheel-main/devver.cljs.edn @@ -0,0 +1,3 @@ +^{:watch-dirs ["src"]} +{:main exproj.core + :hi 1} diff --git a/figwheel-repl/.gitignore b/figwheel-repl/.gitignore deleted file mode 100644 index d70430a6..00000000 --- a/figwheel-repl/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -target -.cpcache -*.log diff --git a/figwheel-repl/README.md b/figwheel-repl/README.md deleted file mode 100644 index d97be1fa..00000000 --- a/figwheel-repl/README.md +++ /dev/null @@ -1,118 +0,0 @@ -# figwheel-repl - -Figwheel-REPL is intended to provide a best of class `repl-env` for -ClojureScript. - -> Currently a work in progress. - -Figwheel-REPL is **only** a ClojureScript `repl-env` and doesn't do anything -specific to help with automatic file reloading. As such, it is more -similar to Weasel in function than to Figwheel. - -It is intended to be a single `repl-env` that will work on as many -platforms as possible: including Browser, Node, Worker, ReactNative, -etc. - -It is also intended to handle multiple clients, think browser tabs, -much more gracefully than the current Figwheel REPL. - -It is also different in that it only evaluates code on a single client -by default. You will still be able to choose to broadcast an eval -operation to all connected clients if you prefer. You can also provide -a filter function when you create the Figwheel repl-env, to filter the -connections to the set of connected clients you want an eval operation -to be sent to. - -## Multiple REPL behavior - -The new `figwheel.repl` namespace currently offers some ClojureScript -functions to help you list and choose which connected client to focus on. - -The `figwheel.repl/conns` macro allows you to list the connected clients: - -For example: - -``` -cljs.user> (figwheel.repl/conns) -Will Eval On: Darin -Session Name Age URL -Darin 25m /figwheel-connect -Judson 152m /figwheel-connect -nil -``` - - -The above `figwheel.repl/conns` call lists the clients available for the -REPL to target. - -All connections are given easy to remember session names. The -intention is that this will help you easily identify which browser tab -your, through the REPL client feedback in the browsers dev-tool -console. - -The `Will Eval On: Darin` indicates that the `Darin` client is where -the next eval operation will be sent to because this is currently the -**youngest** connected client. - -This **youngest client** heuristic for choosing which client to -evaluate on, allows for a simple understanding of which REPL is the -current target of eval operations. Open a new browser tab, or start an -new node instance and that becomes the new eval target. - -If you want to focus on a specific client, - -``` -cljs.user> (figwheel.repl/focus Judson) -Focused On: Judson -``` - -From now on all evals will go to `Judson` unless the connection to -`Judson` is lost in which case the behavior will revert to selecting -the youngest connection. - -You can confirm that the repl is currently focused with: - -``` -cljs.user> (figwheel.repl/conns) -Focused On: Judson -Session Name Age URL -Darin 28m /figwheel-connect -Judson 155m /figwheel-connect -nil -``` - -I think this goes a long way toward solving a problem that has existed -since the very beginning of Figwheel. - -## Attention toward embedding the figwheel-repl endpoint - -The other problem that I'm currently trying to work out is how to best -support embedding the Figwheel REPL endpoint in your server. - -For larger projects it simplest to use figwheel connection as a -side-channel, a separate REPL connection, that is distinct from your -projects HTTP server. Figwheel's use of Web-sockets and CORS make this -side connection a simple matter. But inevitably there are situations -where you want to embed the Figwheel endpoint in your server. So I'm -giving this some serious attention. - -In addition to the Web-socket connection, I have implemented a simple -HTTP polling connection which should allow anyone to embed -figwheel-repl ring middleware into their stack. (Side note: I'm also -looking at long polling). - -It is too bad that as a community we haven't landed on an agreed upon -Ring web-socket interface, as this makes it much harder to allow simple -embedding of a web-socket endpoint into the server of your choice. But -I'm going to do my best to facilitate this by making it easier to -create a web-socket endpoint from the provided api. - -On a side note: I'm also considering making the default server a the -`ring.jetty.adapter` as it is such a common dependency. - -## License - -Copyright © 2018 Bruce Hauman - -Distributed under the Eclipse Public License either version 1.0 or any -later version. diff --git a/figwheel-repl/deps.edn b/figwheel-repl/deps.edn deleted file mode 100644 index 9c47cb29..00000000 --- a/figwheel-repl/deps.edn +++ /dev/null @@ -1,13 +0,0 @@ -{:deps {org.clojure/clojure {:mvn/version "1.8.0"} - org.clojure/clojurescript {:mvn/version "1.10.238"} - ring/ring-core {:mvn/version "1.6.3"} - ring/ring-defaults {:mvn/version "0.3.1"} - co.deps/ring-etag-middleware {:mvn/version "0.2.0"} - ring/ring-devel {:mvn/version "1.6.3"} - ring-cors {:mvn/version "0.1.12"}} - :aliases - {:dev {:extra-deps - {ring {:mvn/version "1.6.3"} - org.eclipse.jetty.websocket/websocket-servlet {:mvn/version "9.2.21.v20170120"} - org.eclipse.jetty.websocket/websocket-server {:mvn/version "9.2.21.v20170120"}}}} - } diff --git a/figwheel-repl/project.clj b/figwheel-repl/project.clj deleted file mode 100644 index ef34731d..00000000 --- a/figwheel-repl/project.clj +++ /dev/null @@ -1,17 +0,0 @@ -(defproject com.bhauman/figwheel-repl "0.1.3" - :description "Figwheel REPL provides a stable multiplexing REPL for ClojureScript" - :dependencies [[org.clojure/clojure "1.8.0"] - [org.clojure/clojurescript "1.10.238"] - [ring/ring-core "1.6.3"] - [ring/ring-defaults "0.3.1"] - [ring/ring-devel "1.6.3"] - [co.deps/ring-etag-middleware "0.2.0"] - [ring-cors "0.1.12"]] - - ;; for figwheel jetty server - these should probably - :profiles {:dev {:dependencies [[ring "1.6.3"] - [org.eclipse.jetty.websocket/websocket-servlet "9.2.21.v20170120"] - [org.eclipse.jetty.websocket/websocket-server "9.2.21.v20170120"]] - :resource-paths ["resources" "dev-resources"]} - } - ) diff --git a/figwheel-repl/src/cljs/repl/figwheel.clj b/figwheel-repl/src/cljs/repl/figwheel.clj deleted file mode 100644 index 20e70d7b..00000000 --- a/figwheel-repl/src/cljs/repl/figwheel.clj +++ /dev/null @@ -1,6 +0,0 @@ -(ns cljs.repl.figwheel - (:require - [figwheel.repl :as fr])) - -(defn repl-env [& {:as opts}] - (fr/repl-env* opts)) diff --git a/figwheel-repl/src/figwheel/repl.cljc b/figwheel-repl/src/figwheel/repl.cljc deleted file mode 100644 index ef6113bc..00000000 --- a/figwheel-repl/src/figwheel/repl.cljc +++ /dev/null @@ -1,1420 +0,0 @@ -(ns figwheel.repl - (:require - [clojure.string :as string] - #?@(:cljs [[goog.object :as gobj] - [goog.storage.mechanism.mechanismfactory :as storage-factory] - [goog.Uri :as guri] - [goog.string :as gstring] - [goog.net.jsloader :as loader] - [goog.net.XhrIo :as xhrio] - [goog.log :as glog] - [goog.array :as garray] - [goog.json :as gjson] - [goog.html.legacyconversions :as conv] - [goog.userAgent.product :as product]] - :clj [[clojure.data.json :as json] - [clojure.set :as set] - [clojure.edn :as edn] - [clojure.java.browse :as browse] - [cljs.repl] - [cljs.stacktrace] - [clojure.java.io :as io] - [clojure.string :as string] - [figwheel.server.ring]])) - (:import - #?@(:cljs [goog.net.WebSocket - goog.debug.Console - [goog.Uri QueryData] - [goog Promise] - [goog.storage.mechanism HTML5SessionStorage]] - :clj [java.util.concurrent.ArrayBlockingQueue - java.net.URLDecoder - [java.lang ProcessBuilder Process]]))) - -(def default-port 9500) - -#?(:cljs (do - -;; TODO dev only - -;; -------------------------------------------------- -;; Logging -;; -------------------------------------------------- -;; -;; Levels -;; goog.debug.Logger.Level.(SEVERE WARNING INFO CONFIG FINE FINER FINEST) -;; -;; set level (.setLevel logger goog.debug.Logger.Level.INFO) -;; disable (.setCapturing log-console false) - -(defonce logger (glog/getLogger "Figwheel REPL")) - -(defn ^:export console-logging [] - (when-not (gobj/get goog.debug.Console "instance") - (let [c (goog.debug.Console.)] - ;; don't display time - (doto (.getFormatter c) - (gobj/set "showAbsoluteTime" false) - (gobj/set "showRelativeTime" false)) - (gobj/set goog.debug.Console "instance" c) - c)) - (when-let [console-instance (gobj/get goog.debug.Console "instance")] - (.setCapturing console-instance true) - true)) - -(defonce log-console (console-logging)) - -(defn debug [msg] - (glog/log logger goog.debug.Logger.Level.FINEST msg)) - -;; TODO dev -#_(.setLevel logger goog.debug.Logger.Level.FINEST) - -;; -------------------------------------------------------------- -;; Bootstrap goog require reloading -;; -------------------------------------------------------------- - -(declare queued-file-reload) - -(defn unprovide! [ns] - (let [path (gobj/get js/goog.dependencies_.nameToPath 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 will not work unless bootstrap has been called -(defn figwheel-require [src reload] - ;; require is going to be called - (set! (.-require js/goog) figwheel-require) - (when (= reload "reload-all") - (set! (.-cljsReloadAll_ js/goog) true)) - (when (or reload (.-cljsReloadAll_ js/goog)) - (unprovide! src)) - (let [res (.require_figwheel_backup_ js/goog src)] - (when (= reload "reload-all") - (set! (.-cljsReloadAll_ js/goog) false)) - res)) - -(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 - (when-not (.-require_figwheel_backup_ js/goog) - (set! (.-require_figwheel_backup_ js/goog) (or js/goog.require__ js/goog.require))) - (set! (.-isProvided_ js/goog) (fn [name] false)) - (when-not (and (exists? js/cljs) - (exists? js/cljs.user)) - (goog/constructNamespace_ "cljs.user")) - (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))) - -;; -------------------------------------------------------------- -;; File reloading on different platforms -;; -------------------------------------------------------------- - -;; this assumes no query string on url -(defn add-cache-buster [url] - (.makeUnique (guri/parse url))) - -(def gloader - (cond - (exists? loader/safeLoad) - #(loader/safeLoad (conv/trustedResourceUrlFromString (str %1)) %2) - (exists? loader/load) #(loader/load (str %1) %2) - :else (throw (ex-info "No remote script loading function found." {})))) - -(defn reload-file-in-html-env - [request-url callback] - {:pre [(string? request-url) (not (nil? callback))]} - (doto (gloader (add-cache-buster request-url) #js {:cleanupWhenDone true}) - (.addCallback #(apply callback [true])) - (.addErrback #(apply callback [false])))) - -(def ^:export write-script-tag-import reload-file-in-html-env) - -(defn ^:export worker-import-script [request-url callback] - {:pre [(string? request-url) (not (nil? callback))]} - (callback (try - (do (.importScripts js/self (add-cache-buster request-url)) - true) - (catch js/Error e - (glog/error logger (str "Figwheel: Error loading file " request-url)) - (glog/error logger e) - false)))) - -(defn ^:export create-node-script-import-fn [] - (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] - (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 - (glog/error logger (str "Figwheel: Error loading file " cache-path)) - (glog/error logger e) - false))))))) - -(def host-env - (cond - (not (nil? goog/nodeGlobalRequire)) :node - (not (nil? goog/global.document)) :html - (and (exists? goog/global.navigator) - (= goog/global.navigator.product "ReactNative")) - :react-native - (and - (nil? goog/global.document) - (exists? js/self) - (exists? (.-importScripts js/self))) - :worker)) - -(def reload-file* - (condp = host-env - :node (create-node-script-import-fn) - :html write-script-tag-import - :worker worker-import-script - (fn [a b] (throw "Reload not defined for this platform")))) - -;; TODO Should just leverage the import script here somehow -(defn reload-file [{:keys [request-url] :as file-msg} callback] - {:pre [(string? request-url) (not (nil? callback))]} - (glog/fine logger (str "Attempting to load " request-url)) - ((or (gobj/get goog.global "FIGWHEEL_IMPORT_SCRIPT") reload-file*) - request-url - (fn [success?] - (if success? - (do - (glog/fine logger (str "Successfully loaded " request-url)) - (apply callback [(assoc file-msg :loaded-file true)])) - (do - (glog/error logger (str "Error loading file " request-url)) - (apply callback [file-msg])))))) - -;; for goog.require consumption -(defonce reload-promise-chain (atom (Promise. #(%1 true)))) - -(defn queued-file-reload - ([url] (queued-file-reload url nil)) - ([url opt-source-text] - (when-let [next-promise-fn - (cond opt-source-text - #(.then % - (fn [_] - (Promise. - (fn [r _] - (try (js/eval opt-source-text) - (catch js/Error e - (glog/error logger e))) - (r true))))) - url - #(.then % - (fn [_] - (Promise. - (fn [r _] - (reload-file {:request-url url} - (fn [file-msg] - (r true))))))))] - (swap! reload-promise-chain next-promise-fn)))) - -(defn ^:export after-reloads [f] - (swap! reload-promise-chain #(.then % f))) - -;; -------------------------------------------------------------- -;; REPL print forwarding -;; -------------------------------------------------------------- - -(goog-define print-output "console,repl") - -(defn print-receivers [outputs] - (->> (string/split outputs #",") - (map string/trim) - (filter (complement string/blank?)) - (map keyword) - set)) - -(defmulti out-print (fn [k args] k)) -(defmethod out-print :console [_ args] - (.apply (.-log js/console) js/console (garray/clone (to-array args)))) - -(defmulti err-print (fn [k args] k)) -(defmethod err-print :console [_ args] - (.apply (.-error js/console) js/console (garray/clone (to-array args)))) - -(defn setup-printing! [] - (let [printers (print-receivers print-output)] - (set-print-fn! (fn [& args] (doseq [p printers] (out-print p args)))) - (set-print-err-fn! (fn [& args] (doseq [p printers] (err-print p args)))))) - -#_ (printing-receivers "console,repl") - -;; -------------------------------------------------------------- -;; Websocket REPL -;; -------------------------------------------------------------- - -(goog-define connect-url "ws://[[client-hostname]]:[[client-port]]/figwheel-connect") - -(def state (atom {})) - -;; returns nil if not available -(def storage (storage-factory/createHTML5SessionStorage "figwheel.repl")) - -(defn set-state [k v] - (swap! state assoc k v) - (when storage (.set storage (str k) v))) - -(defn get-state [k] - (if storage (.get storage (str k)) (get @state k))) - -(defn ^:export session-name [] (get-state ::session-name)) -(defn ^:export session-id [] (get-state ::session-id)) - -(defn response-for [{:keys [uuid]} response-body] - (cond-> - {:session-id (session-id) - :session-name (session-name) - :response response-body} - uuid (assoc :uuid uuid))) - -;; this is a fire and forget POST -(def http-post - (condp = host-env - :node - (let [http (js/require "http")] - (fn [url post-data] - (let [data (volatile! "") - uri (guri/parse (str url))] - (-> (.request http - #js {:host (.getDomain uri) - :port (.getPort uri) - :path (str (.getPath uri) (when-let [q (.getQuery uri)] - (str "?" q))) - :method "POST" - :headers #js {"Content-Length" (js/Buffer.byteLength post-data)}} - (fn [x])) - (.on "error" #(js/console.error %)) - (doto - (.write post-data) - (.end)))))) - (fn [url response] - (xhrio/send url - (fn [e] (debug "Response Posted")) - "POST" - response)))) - -(defn respond-to [{:keys [websocket http-url] :as old-msg} response-body] - (let [response (response-for old-msg response-body)] - (cond - websocket - (.send websocket (pr-str response)) - http-url - (http-post http-url (pr-str response))))) - -(defn respond-to-connection [response-body] - (respond-to (:connection @state) response-body)) - -(defmulti message :op) -(defmethod message "naming" [msg] - (when-let [sn (:session-name msg)] (set-state ::session-name sn)) - (when-let [sid (:session-id msg)] (set-state ::session-id sid)) - (glog/info logger (str "Session ID: " (session-id))) - (glog/info logger (str "Session Name: " (session-name)))) - -(defmethod message "ping" [msg] (respond-to msg {:pong true})) - -(let [ua-product-fn - ;; TODO make sure this works on other platforms - #(cond - (not (nil? goog/nodeGlobalRequire)) :chrome - product/SAFARI :safari - product/CHROME :chrome - product/FIREFOX :firefox - product/IE :ie) - print-to-console? ((print-receivers print-output) :console)] - (defn eval-javascript** [code] - (let [ua-product (ua-product-fn)] - (try - (let [sb (js/goog.string.StringBuffer.)] - ;; TODO capture err as well? - (binding [cljs.core/*print-newline* true - cljs.core/*print-fn* (fn [x] (.append sb x))] - (let [result-value (js/eval code) - ;; the result needs to be readable - result-value (if-not (string? result-value) - (pr-str result-value) - result-value) - output-str (str sb)] - (when (and print-to-console? (not (zero? (.getLength sb)))) - (js/setTimeout #(out-print :console [output-str]) 0)) - {:status :success - :out output-str - :ua-product ua-product - :value result-value}))) - (catch js/Error e - ;; logging errors to console helpful - (when (and (exists? js/console) (exists? js/console.error)) - (js/console.error "REPL eval error" e)) - {:status :exception - :value (pr-str e) - :ua-product ua-product - :stacktrace (.-stack e)}) - (catch :default e - {:status :exception - :ua-product ua-product - :value (pr-str e) - :stacktrace "No stacktrace available."}))))) - -(defmethod message "eval" [{:keys [code] :as msg}] - (let [result (eval-javascript** code)] - (respond-to msg result))) - -(defmethod message "messages" [{:keys [messages http-url]}] - (doseq [msg messages] - (message (cond-> (js->clj msg :keywordize-keys true) - http-url (assoc :http-url http-url))))) - -(defn fill-url-template [connect-url'] - (if (= host-env :html) - (-> connect-url' - (string/replace "[[client-hostname]]" js/location.hostname) - (string/replace "[[client-port]]" js/location.port)) - connect-url')) - -(defn make-url [connect-url'] - (let [uri (guri/parse (fill-url-template (or connect-url' connect-url)))] - (cond-> (.add (.getQueryData uri) "fwsid" (or (session-id) (random-uuid))) - (session-name) (.add "fwsname" (session-name))) - uri)) - -(defn exponential-backoff [attempt] - (* 1000 (min (js/Math.pow 2 attempt) 20))) - -(defn hook-repl-printing-output! [respond-msg] - (defmethod out-print :repl [_ args] - (respond-to respond-msg - {:output true - :stream :out - :args (mapv #(if (string? %) % (gjson/serialize %)) args)})) - (defmethod err-print :repl [_ args] - (respond-to respond-msg - {:output true - :stream :err - :args (mapv #(if (string? %) % (gjson/serialize %)) args)})) - (setup-printing!)) - -(defn connection-established! [url] - (when (= host-env :html) - (let [target (.. goog.global -document -body)] - (.dispatchEvent - target - (doto (js/Event. "figwheel.repl.connected" target) - (gobj/add "data" {:url url})))))) - -(defn connection-closed! [url] - (when (= host-env :html) - (let [target (.. goog.global -document -body)] - (.dispatchEvent - target - (doto (js/Event. "figwheel.repl.disconnected" target) - (gobj/add "data" {:url url})))))) - -(defn get-websocket-class [] - (or - (gobj/get goog.global "WebSocket") - (gobj/get goog.global "FIGWHEEL_WEBSOCKET_CLASS") - (and (= host-env :node) - (try (js/require "ws") - (catch js/Error e - nil))) - (and (= host-env :worker) - (gobj/get js/self "WebSocket")))) - -(defn ensure-websocket [thunk] - (if (gobj/get goog.global "WebSocket") - (thunk) - (if-let [websocket-class (get-websocket-class)] - (do - (gobj/set goog.global "WebSocket" websocket-class) - (thunk) - (gobj/set goog.global "WebSocket" nil)) - (do - (glog/error - logger - (if (= host-env :node) - "Can't connect!! Please make sure ws is installed\n do -> 'npm install ws'" - "Can't connect!! This client doesn't support WebSockets")))))) - -(defn ws-connect [& [websocket-url']] - (ensure-websocket - #(let [websocket (goog.net.WebSocket.) - url (str (make-url websocket-url'))] - (try - (doto websocket - (.addEventListener goog.net.WebSocket.EventType.MESSAGE - (fn [e] - (when-let [msg (gobj/get e "message")] - (try - (debug msg) - (message (assoc - (js->clj (js/JSON.parse msg) :keywordize-keys true) - :websocket websocket)) - (catch js/Error e - (glog/error logger e)))))) - (.addEventListener goog.net.WebSocket.EventType.OPENED - (fn [e] - (connection-established! url) - (swap! state assoc :connection {:websocket websocket}) - (hook-repl-printing-output! {:websocket websocket}))) - (.addEventListener goog.net.WebSocket.EventType.CLOSED - (fn [e] (connection-closed! url))) - (.open url)))))) - -;; ----------------------------------------------------------- -;; HTTP simple and long polling -;; ----------------------------------------------------------- - -(def http-get - (condp = host-env - :node - (let [http (js/require "http")] - (fn [url] - (Promise. - (fn [succ err] - (let [data (volatile! "")] - (-> (.get http (str url) - (fn [response] - (.on response "data" - (fn [chunk] (vswap! data str chunk))) - (.on response "end" #(succ - (try (js/JSON.parse @data) - (catch js/Error e - (js/console.error e) - (err e))))))) - (.on "error" err))))))) - (fn [url] - (Promise. - (fn [succ err] - (xhrio/send - url - (fn [e] - (let [xhr (gobj/get e "target")] - (if (.isSuccess xhr) - (succ (.getResponseJson xhr)) - (err xhr)))))))))) - -(declare http-connect http-connect*) - -(defn poll [msg-fn connect-url'] - (.then (http-get (make-url connect-url')) - (fn [msg] - (msg-fn msg) - (js/setTimeout #(poll msg-fn connect-url') 500)) - (fn [e] ;; lost connection - (connection-closed! connect-url') - (http-connect connect-url')))) - -(defn long-poll [msg-fn connect-url'] - (.then (http-get (make-url connect-url')) - (fn [msg] - (msg-fn msg) - (long-poll msg-fn connect-url')) - (fn [e] ;; lost connection - (connection-closed! connect-url') - (http-connect connect-url')))) - -(defn http-connect* [attempt connect-url'] - (let [url (make-url connect-url') - surl (str url) - msg-fn (fn [msg] - (try - (debug (pr-str msg)) - (message (assoc (js->clj msg :keywordize-keys true) - :http-url surl)) - (catch js/Error e - (glog/error logger e))))] - (doto (.getQueryData url) - (.add "fwinit" "true")) - (.then (http-get url) - (fn [msg] - (let [typ (gobj/get msg "connection-type")] - (glog/info logger (str "Connected: " typ)) - (msg-fn msg) - (connection-established! url) - ;; after connecting setup printing redirects - (swap! state assoc :connection {:http-url surl}) - (hook-repl-printing-output! {:http-url surl}) - (if (= typ "http-long-polling") - (long-poll msg-fn connect-url') - (poll msg-fn connect-url')))) - (fn [e];; didn't connect - (when (instance? js/Error e) - (glog/error logger e)) - (when (and (instance? goog.net.XhrIo e) (.getResponseBody e)) - (debug (.getResponseBody e))) - (let [wait-time (exponential-backoff attempt)] - (glog/info logger (str "HTTP Connection Error: next connection attempt in " (/ wait-time 1000) " seconds")) - (js/setTimeout #(http-connect* (inc attempt) connect-url') - wait-time)))))) - -(defn http-connect [& [connect-url']] - (http-connect* 0 connect-url')) - -(defn switch-to-http? [url] - (if (or (gstring/startsWith url "http") - (get-websocket-class)) - url - (do - (glog/warning - logger - (str - "No WebSocket implementation found! Falling back to http-long-polling" - (when (= host-env :node) - ":\n For a more efficient connection ensure that \"ws\" is installed :: do -> 'npm install ws'"))) - (-> (guri/parse url) - (.setScheme "http") - str)))) - -(goog-define client-log-level "info") - -(def log-levels - (into {} - (map (juxt - string/lower-case - #(gobj/get goog.debug.Logger.Level %)) - (map str '(SEVERE WARNING INFO CONFIG FINE FINER FINEST))))) - -(defn set-log-level [logger' level] - (if-let [lvl (get log-levels level)] - (do - (.setLevel logger' lvl) - (debug (str "setting log level to " level))) - (glog/warn (str "Log level " (pr-str level) " doesn't exist must be one of " - (pr-str '("severe" "warning" "info" "config" "fine" "finer" "finest")))))) - -(defn init-log-level! [] - (doseq [logger' (cond-> [logger] - (exists? js/figwheel.core) - (conj js/figwheel.core.logger))] - (set-log-level logger' client-log-level))) - -(defn connect* [connect-url'] - (init-log-level!) - (patch-goog-base) - (let [url (switch-to-http? (string/trim (or connect-url' connect-url)))] - (cond - (gstring/startsWith url "ws") (ws-connect url) - (gstring/startsWith url "http") (http-connect url)))) - -(defn connect [& [connect-url']] - (defonce connected - (do (connect* connect-url') true)))) - -) - -;; end :cljs - - -#?(:clj (do - -(defonce ^:private listener-set (atom #{})) -(defn add-listener [f] (swap! listener-set conj f) nil) -(defn remove-listener [f] (swap! listener-set disj f) nil) - -(declare name-list) - -(defn log [& args] - (spit "server.log" (apply prn-str args) :append true)) - -(defonce scratch (atom {})) - -(def ^:dynamic *server* nil) - -(defn parse-query-string [qs] - (when (string? qs) - (into {} (for [[_ k v] (re-seq #"([^&=]+)=([^&]+)" qs)] - [(keyword k) (java.net.URLDecoder/decode v)])))) - -;; ------------------------------------------------------------------ -;; Connection management -;; ------------------------------------------------------------------ - -(defonce ^:dynamic *connections* (atom {})) - -(defn taken-names [connections] - (set (mapv :session-name (vals connections)))) - -(defn available-names [connections] - (set/difference name-list (taken-names connections))) - -(defn negotiate-id [ring-request connections] - (let [query (parse-query-string (:query-string ring-request)) - sid (:fwsid query (str (java.util.UUID/randomUUID))) - sname (or (some-> connections (get sid) :session-name) - (when-let [chosen-name (:fwsname query)] - (when-not ((taken-names connections) chosen-name) - chosen-name)) - (rand-nth (seq (available-names connections))))] - [sid sname])) - -(defn create-connection! [ring-request options] - (let [[sess-id sess-name] (negotiate-id ring-request @*connections*) - conn (merge (select-keys ring-request [:server-port :scheme :uri :server-name :query-string :request-method]) - (cond-> {:session-name sess-name - :session-id sess-id - ::alive-at (System/currentTimeMillis) - :created-at (System/currentTimeMillis)} - (:query-string ring-request) - (assoc :query (parse-query-string (:query-string ring-request)))) - options)] - (swap! *connections* assoc sess-id conn) - conn)) - -(defn remove-connection! [{:keys [session-id] :as conn}] - (swap! *connections* dissoc session-id)) - -(defn receive-message! [data] - (when-let [data - (try - (edn/read-string data) - (catch Throwable t - (binding [*out* *err*] (clojure.pprint/pprint (Throwable->map t)))))] - (doseq [f @listener-set] - (try (f data) (catch Throwable ex))))) - -(defn naming-response [{:keys [session-name session-id type] :as conn}] - (json/write-str {:op :naming - :session-name session-name - :session-id session-id - :connection-type type})) - -;; ------------------------------------------------------------------ -;; Websocket behavior -;; ------------------------------------------------------------------ - -(defn abstract-websocket-connection [connections] - (let [conn (volatile! nil)] - {:on-connect (fn [{:keys [request send-fn close-fn is-open-fn] - :as connect-data}] - ;; TODO remove dev only - (swap! scratch assoc :ring-request request) - (binding [*connections* connections] - (let [conn' (create-connection! - request - {:type :websocket - :is-open-fn is-open-fn - :close-fn close-fn - :send-fn (fn [_ data] - (send-fn data))})] - (vreset! conn conn') - (send-fn (naming-response conn'))))) - :on-close (fn [status] (binding [*connections* connections] - (remove-connection! @conn))) - :on-receive (fn [data] (binding [*connections* connections] - (receive-message! data)))})) - -;; ------------------------------------------------------------------ -;; http polling -;; ------------------------------------------------------------------ - -(defn json-response [json-body] - {:status 200 - :headers {"Content-Type" "application/json"} - :body json-body}) - -(defn http-polling-send [conn data] - (swap! (::comm-atom conn) update :messages (fnil conj []) data)) - -(defn http-polling-connect [ring-request] - (let [{:keys [fwsid fwinit]} (-> ring-request :query-string parse-query-string)] - ;; new connection create the connection - (cond - (not (get @*connections* fwsid)) - (let [conn (create-connection! ring-request - {:type :http-polling - ::comm-atom (atom {}) - :is-open-fn (fn [conn] - (< (- (System/currentTimeMillis) - (::alive-at conn)) - 3000)) - :send-fn http-polling-send})] - (json-response (naming-response conn))) - fwinit - (let [conn (get @*connections* fwsid)] - (swap! *connections* assoc-in [fwsid :created-at] (System/currentTimeMillis)) - (json-response (naming-response conn))) - :else - ;; otherwise we are polling - (let [messages (volatile! []) - comm-atom (get-in @*connections* [fwsid ::comm-atom])] - (swap! *connections* assoc-in [fwsid ::alive-at] (System/currentTimeMillis)) - (swap! comm-atom update :messages (fn [msgs] (vreset! messages (or msgs [])) [])) - (json-response - (json/write-str {:op :messages - :messages (mapv json/read-json @messages) - :connection-type :http-polling})))))) - -(defn http-polling-endpoint [ring-request] - (condp = (:request-method ring-request) - :get (http-polling-connect ring-request) - :post (do (receive-message! (slurp (:body ring-request))) - {:status 200 - :headers {"Content-Type" "text/html"} - :body "Received"}))) - -;; simple http polling can be included in any ring middleware stack -(defn http-polling-middleware [handler path connections] - (fn [ring-request] - (if-not (.startsWith (:uri ring-request) path) - (handler ring-request) - (binding [*connections* connections] - (http-polling-endpoint ring-request))))) - -;; ------------------------------------------------------------------ -;; http async polling - long polling -;; ------------------------------------------------------------------ -;; long polling is a bit complex - but this currently appears to work -;; as well as websockets in terms of connectivity, it is slower and heavier -;; overall and much harder to determine when it is closed - -(declare send-for-response) - -(defn ping [conn] (send-for-response [conn] {:op :ping})) - -;; could make no-response behavior configurable -(defn ping-thread [connections fwsid {:keys [interval - ping-timeout] - :or {interval 15000 - ping-timeout 2000}}] - (doto (Thread. - (fn [] - (loop [] - (Thread/sleep interval) - (when-let [conn (get @connections fwsid)] - (if-not (try - ;; TODO consider re-trying a couple times on failure - (deref (ping conn) ping-timeout false) - (catch Throwable e - false)) - (swap! connections dissoc fwsid) - (recur)))))) - (.setDaemon true) - (.start))) - -;; agents would be easier but heavier and agent clean up is harder -(defn long-poll-send [comm-atom msg] - (let [data (volatile! nil) - add-message #(if-not msg % (update % :messages (fnil conj []) msg))] - (swap! comm-atom - (fn [{:keys [respond messages] :as comm}] - (if (and respond (or (not-empty messages) msg)) - (do (vreset! data (add-message comm)) {}) - (add-message comm)))) - (when-let [{:keys [respond messages]} @data] - ;; when this fails? - (respond - (json-response - (json/write-str {:op :messages - :messages (mapv json/read-json messages) - :connection-type :http-long-polling})))))) - -(defn long-poll-capture-respond [comm-atom respond] - (let [has-messages (volatile! false)] - (swap! comm-atom (fn [{:keys [messages] :as comm}] - (vreset! has-messages (not (empty? messages))) - (assoc comm :respond respond))) - (when @has-messages (long-poll-send comm-atom nil)))) - -;; may turn this into a multi method -(defn connection-send [{:keys [send-fn] :as conn} data] - (send-fn conn data)) - -(defn send-for-response* [prom conn msg] - (let [uuid (str (java.util.UUID/randomUUID)) - listener (fn listen [msg] - (when (= uuid (:uuid msg)) - (when-let [result (:response msg)] - (deliver prom - (if (instance? clojure.lang.IMeta result) - (vary-meta result assoc ::message msg) - result))) - (remove-listener listen)))] - (add-listener listener) - (try - (connection-send - conn - (json/write-str - (-> (select-keys conn [:session-id :session-name]) - (merge msg) - (assoc :uuid uuid)))) - (catch Throwable t - (remove-listener listener) - (throw t))))) - -(def no-connection-result - (vary-meta - {:status :exception - :value "Expected REPL Connections Evaporated!" - :stacktrace "No stacktrace available."} - assoc ::no-connection-made true)) - -(defn broadcast-for-response [connections msg] - (let [prom (promise) - cnt (->> connections - (mapv #(try - (send-for-response* prom % msg) - true - (catch Throwable t - nil))) - (filter some?) - count)] - (when (zero? cnt) - (deliver prom no-connection-result)) - prom)) - -(defn send-for-response [connections msg] - (let [prom (promise) - sent (loop [[conn & xc] connections] - (when conn - (if-not (try - (send-for-response* prom conn msg) - true - (catch Throwable t - false)) - (recur xc) - true)))] - (when-not sent - (deliver prom no-connection-result)) - prom)) - -(defn http-long-polling-connect [ring-request respond raise] - (let [{:keys [fwsid fwinit]} (-> ring-request :query-string parse-query-string)] - (if (not (get @*connections* fwsid)) - (let [conn (create-connection! - ring-request - {:type :http-long-polling - ::comm-atom (atom {:messages []}) - :is-open-fn (fn [conn] - (not (> (- (System/currentTimeMillis) - (::alive-at conn)) - 20000))) - :send-fn (fn [conn msg] - (long-poll-send (::comm-atom conn) msg))})] - (respond (json-response (naming-response conn))) - - ;; keep alive with ping thread - ;; This behavior is much more subtle that it appears, it is far better - ;; than webserver triggered async timeout because it doesn't - ;; leave behind an orphaned respond-fn - ;; also it helps us remove lost connections, as I haven't found - ;; a way to discover if an HTTPChannel is closed on the remote endpoint - - ;; TODO a short ping-timeout could be a problem if an - ;; env has a long running eval - ;; this could reuse the eval timeout - (ping-thread *connections* fwsid {:interval 15000 :ping-timeout 2000})) - (let [conn (get @*connections* fwsid)] - (if fwinit - (do - (respond (json-response (naming-response conn))) - (swap! *connections* assoc-in [fwsid :created-at] (System/currentTimeMillis))) - (do - (long-poll-capture-respond (::comm-atom conn) respond) - (swap! *connections* assoc-in [fwsid ::alive-at] (System/currentTimeMillis)))))))) - -(defn http-long-polling-endpoint [ring-request send raise] - (condp = (:request-method ring-request) - :get (http-long-polling-connect ring-request send raise) - :post (do (receive-message! (slurp (:body ring-request))) - (send {:status 200 - :headers {"Content-Type" "text/html"} - :body "Received"})))) - -(defn asyc-http-polling-middleware [handler path connections] - (fn [ring-request send raise] - (swap! scratch assoc :async-request ring-request) - (if-not (.startsWith (:uri ring-request) path) - (handler ring-request send raise) - (binding [*connections* connections] - (try - (http-long-polling-endpoint ring-request send raise) - (catch Throwable e - (raise e))))))) - -;; --------------------------------------------------- -;; ReplEnv implmentation -;; --------------------------------------------------- - -(defn open-connections [] - (filter (fn [{:keys [is-open-fn] :as conn}] - (try (or (nil? is-open-fn) (is-open-fn conn)) - (catch Throwable t - false))) - (vals @*connections*))) - -(defn connections-available [repl-env] - (sort-by - :created-at > - (filter (or (some-> repl-env :connection-filter) - identity) - (open-connections)))) - -(defn wait-for-connection [repl-env] - (loop [] - (when (empty? (connections-available repl-env)) - (Thread/sleep 500) - (recur)))) - -(defn send-for-eval [{:keys [focus-session-name ;; just here for consideration - broadcast] :as repl-env} connections js] - (if broadcast - (broadcast-for-response connections {:op :eval :code js}) - (send-for-response connections {:op :eval :code js}))) - -(defn eval-connections [{:keys [focus-session-name] :as repl-env}] - (let [connections (connections-available repl-env) - ;; session focus - connections (if-let [focus-conn - (and @focus-session-name - (first (filter (fn [{:keys [session-name]}] - (= @focus-session-name - session-name)) - connections)))] - [focus-conn] - (do - (reset! focus-session-name nil) - connections))] - connections)) - -(defn trim-last-newline [args] - (if-let [args (not-empty (filter string? args))] - (conj (vec (butlast args)) - (string/trim-newline (last args))) - args)) - -(defn print-to-stream [stream args] - (condp = stream - :out (apply println args) - :err (binding [*out* *err*] - (apply println args)))) - -(defn repl-env-print [repl-env stream args] - (when-let [args (not-empty (filter string? args))] - (when (and (:out-print-fn repl-env) (= :out stream)) - (apply (:out-print-fn repl-env) args)) - (when (and (:err-print-fn repl-env) (= :err stream)) - (apply (:err-print-fn repl-env) args)) - (let [args (trim-last-newline args)] - (when (:print-to-output-streams repl-env) - (if-let [bprinter @(:bound-printer repl-env)] - (bprinter stream args) - (print-to-stream stream args)))))) - -(let [timeout-val (Object.)] - (defn evaluate [{:keys [focus-session-name ;; just here for consideration - repl-eval-timeout - broadcast] :as repl-env} js] - (reset! (:bound-printer repl-env) - (bound-fn [stream args] - (print-to-stream stream args))) - (wait-for-connection repl-env) - (let [ev-connections (eval-connections repl-env) - result (let [v (deref (send-for-eval repl-env ev-connections js) - (or repl-eval-timeout 8000) - timeout-val)] - (cond (= timeout-val v) - (do - (when @focus-session-name - (reset! focus-session-name nil)) - {:status :exception - :value "Eval timed out!" - :stacktrace "No stacktrace available."}) - (::no-connection-made (meta v)) - (do - (when @focus-session-name - (reset! focus-session-name nil)) - v) - :else v))] - (when-let [out (:out result)] - (when (not (string/blank? out)) - (repl-env-print repl-env :out [(string/trim-newline out)]))) - result))) - -(defn require-resolve [symbol-str] - (let [sym (symbol symbol-str)] - (when-let [ns (namespace sym)] - (try - (require (symbol ns)) - (resolve sym) - (catch Throwable e - nil))))) - -#_(require-resolve 'figwheel.server.jetty-websocket/run-server) - -;; TODO more precise error when loaded but fn doesn't exist -(defn dynload [ns-sym-str] - (let [resolved (require-resolve ns-sym-str)] - (if resolved - resolved - (throw (ex-info (str "Figwheel: Unable to dynamicly load " ns-sym-str) - {:not-loaded ns-sym-str}))))) - -;; taken from ring server -(defn try-port - "Try running a server under one port or a list of ports. If a list of ports - is supplied, try each port until it succeeds or runs out of ports." - [port server-fn] - (if-not (sequential? port) - (server-fn port) - (try (server-fn (first port)) - (catch java.net.BindException ex - (if-let [port (next port)] - (try-port port server-fn) - (throw ex)))))) - -(defn run-default-server* - [options connections] - ;; require and run figwheel server - (let [server-fn (dynload (get options :ring-server - 'figwheel.server.jetty-websocket/run-server)) - figwheel-connect-path (get options :figwheel-connect-path "/figwheel-connect")] - (server-fn - ((dynload (get options :ring-stack 'figwheel.server.ring/default-stack)) - (:ring-handler options) - ;; TODO this should only work for the default target of browser - (cond-> (:ring-stack-options options) - (and - (contains? #{nil :browser} (:target options)) - (:output-to options) - (not (get-in (:ring-stack-options options) [:figwheel.server.ring/dev :figwheel.server.ring/system-app-handler]))) - (assoc-in - [:figwheel.server.ring/dev :figwheel.server.ring/system-app-handler] - #(figwheel.server.ring/default-index-html - % - (figwheel.server.ring/index-html (select-keys options [:output-to])))))) - (assoc (get options :ring-server-options) - :async-handlers - {figwheel-connect-path - (-> (fn [ring-request send raise] - (send {:status 404 - :headers {"Content-Type" "text/html"} - :body "Not found: figwheel http-async-polling"})) - (asyc-http-polling-middleware figwheel-connect-path connections) - (figwheel.server.ring/wrap-async-cors - :access-control-allow-origin #".*" - :access-control-allow-methods - [:head :options :get :put :post :delete :patch]))} - ::abstract-websocket-connections - {figwheel-connect-path - (abstract-websocket-connection connections)})))) - -(defn run-default-server [options connections] - (run-default-server* (update options :ring-server-options - #(merge (select-keys options [:host :port]) %)) - connections)) - -(defn fill-server-url-template [url-str {:keys [host port]}] - (-> url-str - (string/replace "[[server-hostname]]" (or host "localhost")) - (string/replace "[[server-port]]" (str port)))) - -(defn launch-node [opts repl-env input-path & [output-log-file]] - (let [xs (cond-> [(get repl-env :node-command "node")] - (:inspect-node repl-env true) (conj "--inspect") - input-path (conj input-path)) - proc (cond-> (ProcessBuilder. (into-array xs)) - output-log-file (.redirectError (io/file output-log-file)) - output-log-file (.redirectOutput (io/file output-log-file)))] - (.start proc))) - -;; when doing a port search -;; - what needs to know the port afterwards? -;; - auto open the browser, this is easy enough. -;; - the connect-url needs to know, but it can use browser port -;; - the default index.html needs to find the main.js (it can inline it) - -(defn setup [repl-env opts] - (when (and - (or (not (bound? #'*server*)) - (nil? *server*)) - (nil? @(:server repl-env))) - (let [server (run-default-server - (merge - (select-keys repl-env [:port - :host - :target - :output-to - :ring-handler - :ring-server - :ring-server-options - :ring-stack - :ring-stack-options]) - (select-keys opts [:target - :output-to])) - *connections*)] - (reset! (:server repl-env) server))) - ;; printing - (when-not @(:printing-listener repl-env) - (let [print-listener - (bound-fn [{:keys [session-id session-name uuid response] :as msg}] - (when (and session-id (not uuid) (get response :output)) - (let [session-ids (set (map :session-id (eval-connections repl-env)))] - (when (session-ids session-id) - (let [{:keys [stream args]} response] - (when (and stream (not-empty args)) - ;; when printing a result from several sessions mark it - (let [args (if-not (= 1 (count session-ids)) - (cons (str "[Session:-----:" session-name "]\n") args) - args)] - (repl-env-print repl-env stream args))))))))] - (reset! (:printing-listener repl-env) print-listener) - (add-listener print-listener))) - (let [{:keys [target output-to output-dir]} - (apply merge - (map #(select-keys % [:target :output-to :output-dir]) [repl-env opts]))] - ;; Node REPL - (when (and (= :nodejs target) - (:launch-node repl-env true) - output-to) - (let [output-file (io/file output-dir "node.log")] - (println "Starting node ... ") - (reset! (:node-proc repl-env) (launch-node opts repl-env output-to output-file)) - (println "Node output being logged to:" output-file) - (when (:inspect-node repl-env true) - (println "For a better development experience:") - (println " 1. Open chrome://inspect/#devices ... (in Chrome)") - (println " 2. Click \"Open dedicated DevTools for Node\"")))) - - ;; open a url - (when-let [open-url - (and (not (= :nodejs target)) - (when-let [url (:open-url repl-env)] - ;; TODO the host port thing needs to be fixed ealier - (fill-server-url-template - url - (merge (select-keys repl-env [:host :port]) - (select-keys (:ring-server-options repl-env) [:host :port])))))] - (println "Opening URL" open-url) - (browse/browse-url open-url)))) - -(defrecord FigwheelReplEnv [] - cljs.repl/IJavaScriptEnv - (-setup [this opts] - (setup this opts) - #_(wait-for-connection this)) - (-evaluate [this _ _ js] - ;; print where eval occurs - (evaluate this js)) - (-load [this provides url] - ;; load a file into all the appropriate envs - (when-let [js-content (try (slurp url) (catch Throwable t))] - (evaluate this js-content))) - (-tear-down [{:keys [server printing-listener node-proc]}] - ;; don't shut things down in nrepl - (when-let [svr @server] - (reset! server nil) - (.stop svr)) - (when-let [proc @node-proc] - (.destroy proc) - #_(.waitFor proc) ;; ? - ) - (when-let [listener @printing-listener] - (remove-listener listener))) - cljs.repl/IReplEnvOptions - (-repl-options [this] - (let [main-fn (resolve 'figwheel.main/default-main)] - (cond-> - {;:browser-repl true - :preloads '[[figwheel.repl.preload]] - :cljs.cli/commands - {:groups {::repl {:desc "Figwheel REPL options"}} - :init - {["-H" "--host"] - {:group ::repl :fn #(assoc-in %1 [:repl-env-options :host] %2) - :arg "address" - :doc "Address to bind"} - ["-p" "--port"] - {:group ::repl :fn #(assoc-in %1 [:repl-env-options :port] (Integer/parseInt %2)) - :arg "number" - :doc "Port to bind"} - ["-rh" "--ring-handler"] - {:group ::repl :fn #(assoc-in %1 [:repl-env-options :ring-handler] - (when %2 - (dynload %2))) - :arg "string" - :doc "Ring Handler for default REPL server EX. \"example.server/handler\" "}}}} - main-fn (assoc :cljs.cli/main @main-fn)))) - cljs.repl/IParseStacktrace - (-parse-stacktrace [this st err opts] - (cljs.stacktrace/parse-stacktrace this st err opts))) - -(defn repl-env* [{:keys [port open-url connection-filter] - :or {connection-filter identity - open-url "http://[[server-hostname]]:[[server-port]]" - port default-port} :as opts}] - (merge (FigwheelReplEnv.) - ;; TODO move to one atom - {:server (atom nil) - :printing-listener (atom nil) - :bound-printer (atom nil) - :open-url open-url - ;; helpful for nrepl so you can easily - ;; translate output into messages - :out-print-fn nil - :err-print-fn nil - :node-proc (atom nil) - :print-to-output-streams true - :connection-filter connection-filter - :focus-session-name (atom nil) - :broadcast false - :port port} - opts)) - -;; ------------------------------------------------------ -;; Connection management -;; ------------------------------------------------------ -;; mostly for use from the REPL - -(defn list-connections [] - (let [conns (connections-available cljs.repl/*repl-env*) - longest-name (apply max (cons (count "Session Name") - (map (comp count :session-name) conns)))] - (println (format (str "%-" longest-name "s %7s %s") - "Session Name" - "Age" - "URL")) - (doseq [{:keys [session-name uri query-string created-at]} conns] - (println (format (str "%-" longest-name "s %6sm %s") - session-name - (Math/round (/ (- (System/currentTimeMillis) created-at) 60000.0)) - uri))))) - -(defn will-eval-on [] - (if-let [n @(:focus-session-name cljs.repl/*repl-env*)] - (println "Focused On: " n) - (println "Will Eval On: " (->> (connections-available cljs.repl/*repl-env*) - first - :session-name)))) - -(defn conns* [] - (will-eval-on) - (list-connections)) - -(defmacro conns [] - (conns*)) - -(defn focus* [session-name] - (let [names (map :session-name (connections-available cljs.repl/*repl-env*)) - session-name (name session-name)] - (if ((set names) session-name) - (str "Focused On: " (reset! (:focus-session-name cljs.repl/*repl-env*) session-name)) - (str "Error: " session-name " not in " (pr-str names))))) - -(defmacro focus [session-name] - (focus* session-name)) - -;; TODOS -;; - try https setup -;; - make work on node and other platforms -;; - find open port -;; - repl args from main - -;; TODO exponential backoff for websocket should max out at 20 or lower -;; TODO figwheel-repl-core package -;; TODO figwheel-repl package that includes default server - -;; TODO NPE that occurs in open-connections when websocket isn't cleared -;; happens on eval -(comment - - (def serve (run-default-server {:ring-handler - (fn [r] - (throw (ex-info "Testing" {})) - #_{:status 404 - :headers {"Content-Type" "text/html"} - :body "Yeppers now"}) - :port 9500} - *connections*)) - - (.stop serve) - - scratch - - (do - (cljs.repl/-tear-down re) - (def re (repl-env* {:output-to "dev-resources/public/out/main.js"})) - (cljs.repl/-setup re {})) - - (connections-available re) - (open-connections) - (evaluate (assoc re :broadcast true) - "88") - - (evaluate re "setTimeout(function() {cljs.core.prn(\"hey hey\")}, 1000);") - - (= (mapv #(:value (evaluate re (str %))) - (range 100)) - (range 100)) - -(def x (ping (first (vals @*connections*)))) - - (negotiate-id (:ring-request @scratch) @*connections*) - - (def channel (:body (:async-request @scratch))) - - (.isReady channel) - - (ping ( (vals @*connections*)) - - ) - (swap! *connections* dissoc "99785176-1793-4814-938a-93bf071acd2f") - - (swap! scratch dissoc :print-msg) - scratch - *connections* - (deref - - - ) - (swap! *connections* dissoc "d9ffc9ac-b2ec-4660-93c1-812afd1cb032") - (parse-query-string (:query-string (:ring-request @scratch))) - (negotiate-name (:ring-request @scratch) @*connections*) - (reset! *connections* (atom {})) - - (binding [cljs.repl/*repl-env* re] - (conns*) - #_(focus* 'Judson)) - - ) - -(def name-list - (set (map str '[Sal Julietta Dodie Janina Krista Freeman Angila Cathy Brant Porter Marty Jerrell Stephan Glenn Palmer Carmelina Monroe Eufemia Ciara Thu Stevie Dee Shamika Jazmin Doyle Roselle Lucien Laveta Marshall Rosy Hilde Yoshiko Nicola Elmo Tana Odelia Gigi Mac Tanner Johnson Roselia Gilberto Marcos Shelia Kittie Bruno Leeanne Elicia Miyoko Lilliana Tatiana Steven Vashti Rolando Korey Selene Emilio Fred Marvin Eduardo Jolie Lorine Epifania Jeramy Eloy Melodee Lilian Kim Cory Daniel Grayce Darin Russ Vanita Yan Quyen Kenda Iris Mable Hong Francisco Abdul Judson Boyce Bridget Cecil Dirk Janetta Kelle Shawn Rema Rosie Nakesha Dominick Jerald Shawnda Enrique Jose Vince]))) - -#_(defonce ^:private message-loop - (doto (Thread. - #(let [x (.take messageq) - listeners @listener-set] - (doseq [f listeners] - (try - (f x) - (catch Throwable ex))) - (recur)) - (str ::message-loop)) - (.setDaemon true) - (.start))) - - - - - )) diff --git a/figwheel-repl/src/figwheel/repl/preload.cljs b/figwheel-repl/src/figwheel/repl/preload.cljs deleted file mode 100644 index 1355671f..00000000 --- a/figwheel-repl/src/figwheel/repl/preload.cljs +++ /dev/null @@ -1,6 +0,0 @@ -(ns figwheel.repl.preload - (:require [figwheel.repl :as fr])) - -(if (= fr/host-env :html) - (.addEventListener goog.global "load" #(fr/connect)) - (fr/connect)) diff --git a/figwheel-repl/src/figwheel/server/jetty_websocket.clj b/figwheel-repl/src/figwheel/server/jetty_websocket.clj deleted file mode 100644 index eebff7a4..00000000 --- a/figwheel-repl/src/figwheel/server/jetty_websocket.clj +++ /dev/null @@ -1,216 +0,0 @@ -(ns figwheel.server.jetty-websocket - (:require - [clojure.string :as string] - [ring.adapter.jetty :as jt]) - (:import - [org.eclipse.jetty.websocket.api - WebSocketAdapter - Session - #_UpgradeRequest - #_RemoteEndpoint] - [org.eclipse.jetty.websocket.server WebSocketHandler] - [org.eclipse.jetty.server Request Handler] - [org.eclipse.jetty.server.handler - ContextHandler - ContextHandlerCollection - HandlerList] - [org.eclipse.jetty.websocket.servlet - WebSocketServletFactory WebSocketCreator - ServletUpgradeRequest ServletUpgradeResponse] - [org.eclipse.jetty.util.log Log StdErrLog] - )) - -;; ------------------------------------------------------ -;; Jetty 9 Websockets -;; ------------------------------------------------------ -;; basic code and patterns borrowed from -;; https://github.com/sunng87/ring-jetty9-adapter - -(defn- do-nothing [& args]) - -(defn- proxy-ws-adapter - [{:as ws-fns - :keys [on-connect on-error on-text on-close on-bytes] - :or {on-connect do-nothing - on-error do-nothing - on-text do-nothing - on-close do-nothing - on-bytes do-nothing}}] - (proxy [WebSocketAdapter] [] - (onWebSocketConnect [^Session session] - (let [^WebSocketAdapter this this] - (proxy-super onWebSocketConnect session)) - (on-connect this)) - (onWebSocketError [^Throwable e] - (on-error this e)) - (onWebSocketText [^String message] - (on-text this message)) - (onWebSocketClose [statusCode ^String reason] - (let [^WebSocketAdapter this this] - (proxy-super onWebSocketClose statusCode reason)) - (on-close this statusCode reason)) - (onWebSocketBinary [^bytes payload offset len] - (on-bytes this payload offset len)))) - -(defn- reify-default-ws-creator - [ws-fns] - (reify WebSocketCreator - (createWebSocket [this _ _] - (proxy-ws-adapter ws-fns)))) - -(defn proxy-ws-handler - "Returns a Jetty websocket handler" - [{:as ws-fns - :keys [ws-max-idle-time] - :or {ws-max-idle-time (* 7 24 60 60 1000)}}] ;; a week long timeout - (proxy [WebSocketHandler] [] - (configure [^WebSocketServletFactory factory] - (-> (.getPolicy factory) - (.setIdleTimeout ws-max-idle-time)) - (.setCreator factory (reify-default-ws-creator ws-fns))) - (handle [^String target, ^Request request req res] - (let [wsf (proxy-super getWebSocketFactory)] - (if (.isUpgradeRequest wsf req res) - (if (.acceptWebSocket wsf req res) - (.setHandled request true) - (when (.isCommitted res) - (.setHandled request true))) - (proxy-super handle target request req res)))))) - -(defn set-log-level! [log-lvl] - (let [level (or ({:all StdErrLog/LEVEL_ALL - :debug StdErrLog/LEVEL_DEBUG - :info StdErrLog/LEVEL_INFO - :off StdErrLog/LEVEL_OFF - :warn StdErrLog/LEVEL_WARN } log-lvl) - StdErrLog/LEVEL_WARN)] - ;; this only works for the jetty StdErrLog - (let [l (Log/getRootLogger)] - (when (instance? StdErrLog l) - (.setLevel l level))) - (doseq [[k l] (Log/getLoggers)] - (when (instance? StdErrLog l) - (.setLevel l level))))) - -(defn async-websocket-configurator [{:keys [websockets async-handlers]}] - (fn [server] - (let [existing-handler (.getHandler server) - ws-proxy-handlers - (map (fn [[context-path handler-map]] - (doto (ContextHandler. context-path) - (.setAllowNullPathInfo - (get handler-map :allow-null-path-info true)) - (.setHandler (proxy-ws-handler handler-map)))) - websockets) - async-proxy-handlers - (map - (fn [[context-path async-handler]] - (let [{:keys [allow-null-path-info async-timeout] - :or {allow-null-path-info true async-timeout 0}} - (meta async-handler)] - (doto (ContextHandler. context-path) - (.setAllowNullPathInfo allow-null-path-info) - (.setHandler (#'jt/async-proxy-handler async-handler async-timeout))))) - async-handlers) - contexts (doto (HandlerList.) - (.setHandlers - (into-array Handler - (concat - ws-proxy-handlers - async-proxy-handlers - [existing-handler]))))] - (.setHandler server contexts) - server))) - -(defn run-jetty [handler {:keys [websockets async-handlers log-level] :as options}] - (jt/run-jetty - handler - (if (or (not-empty websockets) (not-empty async-handlers)) - (assoc options :configurator - (fn [server] - (set-log-level! log-level) - ((async-websocket-configurator - (select-keys options [:websockets :async-handlers])) server))) - (assoc options - :configurator - (fn [server] - (set-log-level! log-level)))))) - -;; Figwheel REPL adapter - -(defn build-request-map [request] - {:uri (.getPath (.getRequestURI request)) - :websocket? true - :scheme (.getScheme (.getRequestURI request)) - :query-string (.getQueryString request) - :origin (.getOrigin request) - :host (.getHost request) - :port (.getPort (.getRequestURI request)) - :request-method (keyword (.toLowerCase (.getMethod request))) - :headers (reduce(fn [m [k v]] - (assoc m (keyword - (string/lower-case k)) (string/join "," v))) - {} - (.getHeaders request))}) - -;; TODO translate on close status's -;; TODO translate receiving bytes to on-receive -(defn websocket-connection-data [^WebSocketAdapter websocket-adaptor] - {:request (build-request-map (.. websocket-adaptor getSession getUpgradeRequest)) - :send-fn (fn [string-message] - (.. websocket-adaptor getRemote (sendString string-message))) - :close-fn (fn [] (.. websocket-adaptor getSession close)) - :is-open-fn (fn [conn] (.. websocket-adaptor getSession isOpen))}) - -(defn adapt-figwheel-ws [{:keys [on-connect on-receive on-close] :as ws-fns}] - (assert on-connect on-receive) - (-> ws-fns - (dissoc :on-connect :on-receive :on-close) - (assoc :on-connect (fn [websocket-adaptor] - (on-connect (websocket-connection-data websocket-adaptor))) - :on-text (fn [_ data] (on-receive data)) - :on-close (fn [_ status reason] (on-close status))))) - -;; these default options assume the context of starting a server in development-mode -;; from the figwheel repl -(def default-options {:join? false}) - -(defn run-server [handler options] - (run-jetty - handler - (cond-> (merge default-options options) - (:figwheel.repl/abstract-websocket-connections options) - ;; TODO make figwheel-path configurable - (update :websockets - merge - (into {} - (map (fn [[path v]] - [path (adapt-figwheel-ws v)]) - (:figwheel.repl/abstract-websocket-connections options))))))) - -(comment - (defonce scratch (atom {})) - (-> @scratch :adaptor (.. getSession getUpgradeRequest) build-request-map) - ) - - - -#_(def server (run-jetty - (fn [ring-request] - {:status 200 - :headers {"Content-Type" "text/html"} - :body "Received Yep"}) - {:port 9500 - :join? false - :async-handlers {"/figwheel-connect" - (fn [ring-request send err] - (swap! scratch assoc :adaptor3 ring-request) - (send {:status 200 - :headers {"Content-Type" "text/html"} - :body "Wowza"}) - )} - :websockets {"/" {:on-connect (fn [adapt] - (swap! scratch assoc :adaptor2 adapt ))}} - #_:configurator #_(websocket-configurator )})) - -#_(.stop server) diff --git a/figwheel-repl/src/figwheel/server/ring.clj b/figwheel-repl/src/figwheel/server/ring.clj deleted file mode 100644 index 36edbac9..00000000 --- a/figwheel-repl/src/figwheel/server/ring.clj +++ /dev/null @@ -1,293 +0,0 @@ -(ns figwheel.server.ring - (:require - [clojure.string :as string] - [clojure.java.io :as io] - [co.deps.ring-etag-middleware :as etag] - [ring.middleware.cors :as cors] - [ring.middleware.defaults] - [ring.middleware.head :as head] - [ring.middleware.stacktrace] - [ring.middleware.not-modified :as not-modified] - [ring.util.mime-type :as mime] - [ring.util.response :refer [resource-response] :as response])) - -;; --------------------------------------------------- -;; Async CORS -;; --------------------------------------------------- - -(defn handle-async-cors [handler request respond' raise' access-control response-handler] - (if (and (cors/preflight? request) (cors/allow-request? request access-control)) - (let [blank-response {:status 200 - :headers {} - :body "preflight complete"}] - (respond' (response-handler request access-control blank-response))) - (if (cors/origin request) - (if (cors/allow-request? request access-control) - (handler request (fn [response] - (respond' (response-handler request access-control response))) - raise') - (handler request respond' raise')) - (handler request respond' raise')))) - -(defn wrap-async-cors - "Middleware that adds Cross-Origin Resource Sharing headers. - (def handler - (-> routes - (wrap-cors - :access-control-allow-origin #\"http://example.com\" - :access-control-allow-methods [:get :put :post :delete]))) - " - [handler & access-control] - (let [access-control (cors/normalize-config access-control)] - (fn [request respond' raise'] - (handle-async-cors handler request respond' raise' access-control cors/add-access-control)))) - -;; --------------------------------------------------- -;; Default Ring Stack -;; --------------------------------------------------- - -;; File caching strategy: -;; -;; ClojureScript (as of March 2018) copies the last-modified date of Clojure -;; source files to the compiled JavaScript target files. Closure compiled -;; JavaScript (goog.base), it gets the time that it was compiled (i.e. now). -;; -;; Neither of these dates are particularly useful to use for caching. Closure -;; compiled JavaScript doesn't change from run to run, so caching based on -;; last modified date will not achieve as high a hit-rate as possible. -;; ClojureScript files can consume macros that change from run to run, but -;; will still get the same file modification date, so we would run the risk -;; of using stale cached files. -;; -;; Instead, we provide a checksum based ETag. This is based solely on the file -;; content, and so sidesteps both of the issues above. We remove the -;; Last-Modified header from the response to avoid it busting the browser cache -;; unnecessarily. - -(defn wrap-no-cache - "Add 'Cache-Control: no-cache' to responses. - This allows the client to cache the response, but - requires it to check with the server every time to make - sure that the response is still valid, before using - the locally cached file. - - This avoids stale files being served because of overzealous - browser caching, while still speeding up load times by caching - files." - [handler] - (fn [req] - (some-> (handler req) - (update :headers assoc - "Cache-Control" "no-cache")))) - -;; TODO send a fun default html from resources with inline images -(defn not-found [r] - (response/content-type - (response/not-found - (str "

Figwheel Server: Resource not found

" - "

Keep on figwheelin' yep

")) - "text/html")) - -(defn fix-index-mime-type [handler] - (fn [request] - (let [{:keys [body] :as res} (handler request)] - (if (and body (instance? java.io.File body) (= "index.html" (.getName body))) - (response/content-type res "text/html; charset=utf-8") - res)))) - -(defn wrap-figwheel-defaults [ring-handler] - (-> ring-handler - (wrap-no-cache) - (etag/wrap-file-etag) - (not-modified/wrap-not-modified) - ;; adding cors to support @font-face which has a strange cors error - ;; INSECURE: don't use figwheel server as a production server :) - ;; TODO not really sure if cors is needed - (cors/wrap-cors - :access-control-allow-origin #".*" - :access-control-allow-methods [:head :options :get :put :post :delete :patch]))) - -(defn handle-first [& handlers] - (fn [request] - (first (map #(% request) (filter some? handlers))))) - -(defn resource-root-index [handler root-s] - (let [roots (if (coll? root-s) root-s [root-s])] - (fn [request] - (if (and (= "/" (:uri request)) - (#{:head :get} (:request-method request))) - (if-let [resp (some-> (first - (map - #(resource-response - "index.html" {:root % - :allow-symlinks? true}) - roots)) - (update :headers dissoc "Last-Modified") - (response/content-type "text/html; charset=utf-8") - (head/head-response request))] - resp - (handler request)) - (handler request))))) - - -(defn best-guess-script-path [output-to] - (when output-to - (let [parts (string/split output-to #"[/\\]")] - (when ((set parts) "public") - (->> parts - (split-with (complement #{"public"})) - second - (drop 1) - (string/join "/")))))) - -(defn index-html [{:keys [output-to body]}] - (let [path (best-guess-script-path output-to) - body' (or body - (str "

Welcome to the Figwheel default index page.

" - - "

You are seeing this because the webserver was unable to locate an index page for your application.

" - - "

This page is currently hosting your REPL and application evaluation environment. " - "Validate the connection by typing (js/alert \"Hello Figwheel!\") in the REPL.

" - "

To provide your own custom page, place an index.html file on the server path (normally resources/public/index.html).

" - "
"
-                       "<!DOCTYPE html>\n"
-                       "<html>\n"
-                       "  <head>\n"
-                       "    <meta charset=\"UTF-8\">\n"
-                       "  </head>\n"
-                       "  <body>\n"
-                       "    <script src=\""
-                       (if path path
-                           (str "[correct-path-to "
-                                (or output-to "main.js file")
-                                "]"))
-                       "\" type=\"text/javascript\"></script>\n"
-                       "  </body>\n"
-                       "</html>\n"
-                       "
" - ""))] - (str - "" - "" - "" - "" - "" - "" - "" - "
" - "" - "
" - " - - - - - - - - -" - - "
" - "" - body' - "" - (when (and output-to - (.isFile (io/file output-to))) - (str - "")) - ""))) - -(defn default-index-html [handler html & [force-index?]] - (fn [r] - (let [res (handler r) - method-uri ((juxt :request-method :uri) r) - root-request? (= [:get "/"] method-uri)] - (cond - (and force-index? root-request? html) - {:status 200 - :headers {"Content-Type" "text/html"} - :body html} - (and root-request? (= 404 (:status res)) html) - {:status 200 - :headers {"Content-Type" "text/html"} - :body html} - :else res)))) - -(defn stack [ring-handler {:keys [::dev responses] :as config}] - (let [{:keys [:co.deps.ring-etag-middleware/wrap-file-etag - :ring.middleware.cors/wrap-cors - :ring.middleware.not-modified/wrap-not-modified - :ring.middleware.stacktrace/wrap-stacktrace - ::system-app-handler]} dev] - (cond-> (handle-first ring-handler not-found) - (::resource-root-index dev) (resource-root-index (get-in config [:static :resources])) - true (ring.middleware.defaults/wrap-defaults config) - (dev ::fix-index-mime-type) fix-index-mime-type - system-app-handler system-app-handler - (dev ::wrap-no-cache) wrap-no-cache - wrap-file-etag etag/wrap-file-etag - wrap-not-modified not-modified/wrap-not-modified - wrap-cors (cors/wrap-cors - :access-control-allow-origin #".*" - :access-control-allow-methods - [:head :options :get :put :post :delete :patch]) - wrap-stacktrace ring.middleware.stacktrace/wrap-stacktrace) - ;; to verify logic - #_(cond-> [] - (::resource-root-index dev) (conj resource-root-index) - true (conj ring.middleware.defaults/wrap-defaults) - (dev ::fix-index-mime-type) (conj fix-index-mime-type) - (dev ::wrap-no-cache) (conj wrap-no-cache) - wrap-file-etag (conj etag/wrap-file-etag) - wrap-not-modified (conj not-modified/wrap-not-modified) - wrap-cors (conj cors/wrap-cors) - wrap-stacktrace (conj ring.middleware.stacktrace/wrap-stacktrace)) - )) - -(def default-options - (-> ring.middleware.defaults/site-defaults - (update ::dev #(merge {::fix-index-mime-type true - ::resource-root-index true - ::wrap-no-cache true - ;::default-index-html false - :ring.middleware.not-modified/wrap-not-modified true - :co.deps.ring-etag-middleware/wrap-file-etag true - :ring.middleware.cors/wrap-cors true - :ring.middleware.stacktrace/wrap-stacktrace true - } - %)) - (dissoc :security) - (update :responses dissoc :not-modified-responses :absolute-redirects))) - -(defn default-stack [handler options] - (stack handler - (merge-with - (fn [& args] - (if (every? #(or (nil? %) (map? %)) args) - (apply merge args) - (last args))) - default-options - options)))