diff --git a/project.clj b/project.clj index f50d66c8f..e0a7e7626 100644 --- a/project.clj +++ b/project.clj @@ -76,8 +76,6 @@ ;; for pathom [org.clojure/test.check "1.1.0"] - ;; experimental - [hawk "0.2.11"] [thheller/shadow-cljsjs "0.0.21"]] :source-paths diff --git a/src/main/shadow/cljs/devtools/server/fs_watch.clj b/src/main/shadow/cljs/devtools/server/fs_watch.clj index 90297d9a0..829fe6ece 100644 --- a/src/main/shadow/cljs/devtools/server/fs_watch.clj +++ b/src/main/shadow/cljs/devtools/server/fs_watch.clj @@ -1,31 +1,84 @@ (ns shadow.cljs.devtools.server.fs-watch - (:require [shadow.jvm-log :as log] - [clojure.string :as str])) + (:require [shadow.build.api :as cljs] + [clojure.core.async :as async :refer (alt!! thread >!!)] + [shadow.cljs.devtools.server.util :as util] + [shadow.cljs.devtools.server.system-bus :as system-bus] + [clojure.java.io :as io] + [clojure.string :as str] + [shadow.build.resource :as rc]) + (:import (shadow.util FileWatcher) + (java.io File))) +(defn service? [x] + (and (map? x) + (::service x))) -;; hawk already uses the jvm watcher on win/linux -;; not much benefit doing this again +(defn poll-changes [{:keys [dir ^FileWatcher watcher]}] + (let [changes (.pollForChanges watcher)] + (when (seq changes) + (->> changes + (map (fn [[name event]] + {:dir dir + :name (rc/normalize-name name) + :ext (when-let [x (str/last-index-of name ".")] + (subs name (inc x))) + :file (io/file dir name) + :event event})) + ;; ignore empty files + (remove (fn [{:keys [event ^File file] :as x}] + (and (not= event :del) + (zero? (.length file))))) + )))) -(def os-name (System/getProperty "os.name")) +(defn watch-loop + [watch-dirs control publish-fn] + + (loop [] + (alt!! + control + ([_] + :terminated) + + (async/timeout 500) + ([_] + (let [fs-updates + (->> watch-dirs + (mapcat poll-changes) + (into []))] + + (when (seq fs-updates) + (publish-fn fs-updates)) + + (recur))))) + + ;; shut down watchers when loop ends + (doseq [{:keys [^FileWatcher watcher]} watch-dirs] + (.close watcher)) + + ::shutdown-complete) (defn start [config directories file-exts publish-fn] - (let [ns-sym - (if (and (str/includes? os-name "Mac") (not (false? (:hawk config)))) - ;; macOS doesn't have native support so it uses polling - ;; which means 2sec delay, hawk does the native stuff - ;; so its a lot faster but doesn't properly support delete - 'shadow.cljs.devtools.server.fs-watch-hawk - ;; jvm on windows/linux supports watch fine - 'shadow.cljs.devtools.server.fs-watch-jvm)] - - (log/debug ::fs-watch {:ns ns-sym}) - - (require ns-sym) - - (let [start-var (ns-resolve ns-sym 'start)] - (-> (start-var config directories file-exts publish-fn) - (assoc ::ns ns-sym))))) - -(defn stop [{::keys [ns] :as svc}] - (let [stop-var (ns-resolve ns 'stop)] - (stop-var svc))) + {:pre [(every? #(instance? File %) directories) + (coll? file-exts) + (every? string? file-exts)]} + (let [control + (async/chan) + + watch-dirs + (->> directories + (map (fn [^File dir] + {:dir dir + :watcher (FileWatcher/create dir (vec file-exts))})) + (into []))] + + {::service true + :control control + :watch-dirs watch-dirs + :thread (thread (watch-loop watch-dirs control publish-fn))})) + +(defn stop [{:keys [control thread] :as svc}] + {:pre [(service? svc)]} + (async/close! control) + (async/ buffer - (conj msg) - (recur)))) - - (async/timeout 250) - ([_] - (when (seq buffer) - (publish-fn buffer)) - (recur []) - )))) - -(defn start* [config directories file-exts publish-fn] - (let [hawk-in - (-> (async/sliding-buffer 100) - (async/chan)) - - buffer-thread - (thread (buffer-loop hawk-in publish-fn)) - - file-exts - (into #{} file-exts) - - hawk - (hawk/watch! - config - (->> directories - (distinct-by #(.getAbsolutePath %)) - (map (fn [root] - (log/debug ::adding-root {:path (.getAbsolutePath root)}) - (let [root-prefix (.getAbsolutePath root) - root-prefix-len (inc (count root-prefix))] - - {:paths [(.getAbsolutePath root)] - :handler - (fn [ctx {:keys [file kind] :as e}] - (when (or (= :delete kind) - (and (.isFile file) - (not (.isHidden file)))) - (try - (let [abs-name (.getAbsolutePath file)] - - ;; special case hack when watching the public dir - ;; we don't want to watch the files we write - (when (and (not (str/includes? abs-name "cljs-runtime")) - ;; for some reason on windows abs-name starts with - ;; C:\\Users... - ;; but root-prefix starts with - ;; c:\\Users... - ;; yet both used .getAbsolutePath, not sure why these differ - ;; this is just a sanity check so just compare the lower-case versions - (str/starts-with? - (str/lower-case abs-name) - (str/lower-case root-prefix))) - (let [name - (rc/normalize-name (subs abs-name root-prefix-len)) - - ext - (when-let [x (str/last-index-of name ".")] - (subs name (inc x)))] - - (when (contains? file-exts ext) - (async/offer! hawk-in - {:dir root - :name name - :ext ext - :file file - :event - (case kind - :create :new - :modify :mod - ;; don't seem to get delete events? - :delete :del)}))))) - (catch Exception ex - (log/debug-ex ex ::hawk-ex e)))) - - ctx)}))) - (into [])))] - - {:hawk-in hawk-in - :buffer-thread buffer-thread - :hawk hawk})) - -(defn start [config directories file-exts publish-fn] - (try - (start* config directories file-exts publish-fn) - (catch Exception e - (log/warn-ex e ::hawk-start-ex) - (fs-watch/start config directories file-exts publish-fn) - ))) - -(defn stop [{:keys [hawk-in hawk buffer-thread] :as x}] - (if-not hawk - (fs-watch/stop x) - (do (hawk/stop! hawk) - (async/close! hawk-in) - (async/!!)] - [shadow.cljs.devtools.server.util :as util] - [shadow.cljs.devtools.server.system-bus :as system-bus] - [clojure.java.io :as io] - [clojure.string :as str] - [shadow.build.resource :as rc]) - (:import (shadow.util FileWatcher) - (java.io File))) - -(defn service? [x] - (and (map? x) - (::service x))) - -(defn poll-changes [{:keys [dir ^FileWatcher watcher]}] - (let [changes (.pollForChanges watcher)] - (when (seq changes) - (->> changes - (map (fn [[name event]] - {:dir dir - :name (rc/normalize-name name) - :ext (when-let [x (str/last-index-of name ".")] - (subs name (inc x))) - :file (io/file dir name) - :event event})) - ;; ignore empty files - (remove (fn [{:keys [event ^File file] :as x}] - (and (not= event :del) - (zero? (.length file))))) - )))) - -(defn watch-loop - [watch-dirs control publish-fn] - - (loop [] - (alt!! - control - ([_] - :terminated) - - (async/timeout 500) - ([_] - (let [fs-updates - (->> watch-dirs - (mapcat poll-changes) - (into []))] - - (when (seq fs-updates) - (publish-fn fs-updates)) - - (recur))))) - - ;; shut down watchers when loop ends - (doseq [{:keys [^FileWatcher watcher]} watch-dirs] - (.close watcher)) - - ::shutdown-complete) - -(defn start [config directories file-exts publish-fn] - {:pre [(every? #(instance? File %) directories) - (coll? file-exts) - (every? string? file-exts)]} - (let [control - (async/chan) - - watch-dirs - (->> directories - (map (fn [^File dir] - {:dir dir - :watcher (FileWatcher/create dir (vec file-exts))})) - (into []))] - - {::service true - :control control - :watch-dirs watch-dirs - :thread (thread (watch-loop watch-dirs control publish-fn))})) - -(defn stop [{:keys [control thread] :as svc}] - {:pre [(service? svc)]} - (async/close! control) - (async/