Skip to content

Commit

Permalink
[WIP] UI hooking up more features
Browse files Browse the repository at this point in the history
  • Loading branch information
@thheller
thheller committed Sep 10, 2018
1 parent 30e1844 commit 532fb53
Show file tree
Hide file tree
Showing 14 changed files with 376 additions and 219 deletions.
2 changes: 1 addition & 1 deletion project.clj
View file
Expand Up @@ -106,7 +106,7 @@
:cljs
{:java-opts ^:replace ["-XX:-OmitStackTraceInFastThrow"]
:dependencies
[[fulcrologic/fulcro "2.6.0"
[[fulcrologic/fulcro "2.6.1"
:exclusions
[clojure-future-spec
com.stuartsierra/component
Expand Down
6 changes: 4 additions & 2 deletions shadow-cljs.edn
View file
Expand Up @@ -63,9 +63,11 @@
:js-options
{:node-modules-dir "packages/ui"}

;; FIXME: code split this later
:module-loader true
:modules
{:app {:entries [shadow.cljs.ui.app]}}
{:app {:entries [shadow.cljs.ui.app]}
:repl {:entries [shadow.cljs.ui.pages.repl]
:depends-on #{:app}}}

:devtools
{:preloads [fulcro.inspect.preload]
Expand Down
4 changes: 2 additions & 2 deletions src/main/shadow/build/targets/browser.clj
View file
Expand Up @@ -52,7 +52,7 @@
(defn json [obj]
(json/write-str obj :escape-slash false))

(defn module-loader-data [{::build/keys [mode] :keys [build-options] :as state}]
(defn module-loader-data [{::build/keys [mode config] :keys [build-options] :as state}]
(let [release?
(= :release mode)

Expand All @@ -76,7 +76,7 @@
(reduce
(fn [m {:keys [module-id foreign-files sources] :as module}]
(let [uris
(if release?
(if (or release? (= :eval (get-in config [:devtools :loader-mode])))
[(str asset-path "/" (:output-name module))]

;; :dev, never bundles foreign
Expand Down
120 changes: 77 additions & 43 deletions src/main/shadow/cljs/devtools/graph/builds.clj
View file
Expand Up @@ -14,7 +14,8 @@
[shadow.cljs.devtools.server.worker :as worker]
[shadow.cljs.devtools.server.system-bus :as sys-bus]
[shadow.cljs.devtools.errors :as errors]
[shadow.build.log :as build-log]))
[shadow.build.log :as build-log]
[clojure.core.async :as async :refer (>!!)]))

(def config-attrs
[::m/build-id
Expand Down Expand Up @@ -79,6 +80,24 @@

{::m/http-servers servers})))

(add-resolver `build-http-servers
{::pc/input #{::m/build-id}
::pc/output [{::m/build-http-server [::m/http-server-id
::m/http-url
::m/https-url]}]}
(fn [{:keys [dev-http] :as env} {::m/keys [build-id] :as params}]
(let [server
(->> (:servers @dev-http)
(filter #(= build-id (:build-id %)))
(map (fn [{:keys [http-url https-url build-id]}]
{::m/http-server-id build-id
::m/build-id {::m/build-id build-id}
::m/http-url http-url
::m/https-url https-url}))
(first))]

{::m/build-http-server server})))

(add-resolver `build-worker
{::pc/input #{::m/build-id}
::pc/output [::m/build-worker-active
Expand Down Expand Up @@ -123,56 +142,71 @@
;; FIXME: can this return something useful?
{::m/build-id build-id}))

(defn do-build [{:keys [system-bus] :as env} build-id mode]
(future
(let [build-config
(config/get-build build-id)

status-ref
(atom {:status :pending
:mode mode
:log []})

log-chan
(async/chan 10)

loop
(worker/build-status-loop system-bus build-id status-ref log-chan)

pub-msg
(fn [msg]
(>!! log-chan msg)
(sys-bus/publish! system-bus ::m/worker-broadcast msg)
(sys-bus/publish! system-bus [::m/worker-output build-id] msg))]
(try
;; not at all useful to send this message but want to match worker message flow for now
(pub-msg {:type :build-configure
:build-id build-id
:build-config build-config})

(pub-msg {:type :build-start
:build-id build-id})

(let [build-state
(-> (util/new-build build-config mode {})
(build-api/with-logger
(util/async-logger log-chan))
(build/configure mode build-config)
(build/compile)
(cond->
(= :release mode)
(build/optimize))
(build/flush))]

(pub-msg {:type :build-complete
:build-id build-id
:info (::build/build-info build-state)}))

(catch Exception e
(pub-msg {:type :build-failure
:build-id build-id
:report (binding [warnings/*color* false]
(errors/error-format e))
}))
(finally
(async/close! log-chan))))))

(add-mutation 'shadow.cljs.ui.transactions/build-compile
{::pc/input #{:build-id}
::pc/output [::m/build-id]}
(fn [{:keys [system-bus] :as env} {:keys [build-id] :as input}]

(future
(let [build-config (config/get-build build-id)
pub-msg
(fn [msg]
(sys-bus/publish! system-bus ::m/worker-broadcast msg)
(sys-bus/publish! system-bus [::m/worker-output build-id] msg))]
(try
;; not at all useful to send this message but want to match worker message flow for now
(pub-msg {:type :build-configure
:build-id build-id
:build-config build-config})

(pub-msg {:type :build-start
:build-id build-id})

(let [build-state
(-> (util/new-build build-config :dev {})
(build-api/with-logger
(reify
build-log/BuildLog
(log* [this build-state log-event]
(pub-msg {:type :build-log
:build-id build-id
:event log-event}))))
(build/configure :dev build-config)
(build/compile)
(build/flush))]

(pub-msg {:type :build-complete
:build-id build-id
:info (::build/build-info build-state)}))

(catch Exception e
(pub-msg {:type :build-failure
:build-id build-id
:report (binding [warnings/*color* false]
(errors/error-format e))
})))))

(fn [env {:keys [build-id] :as input}]
(do-build env build-id :dev)
{::m/build-id build-id}
))

(add-mutation 'shadow.cljs.ui.transactions/build-release
{::pc/input #{:build-id}
::pc/output [::m/build-id]}
(fn [env {:keys [build-id] :as input}]
(log/warn ::build-compile {:input input})
(do-build env build-id :release)
{::m/build-id build-id}))
53 changes: 0 additions & 53 deletions src/main/shadow/cljs/devtools/server/web/api.clj
View file
Expand Up @@ -22,40 +22,6 @@
{:status 200
:body "foo"})

(defn transform-level
[{::repl/keys [root-id level-id lang] :as level}]
(-> level
(select-keys [::repl/root-id ::repl/level-id ::repl/lang])
(assoc ::repl/ops (->> level
(keys)
(into #{})))))

(defn transform-root
[{::repl/keys [type levels] :as root}]
(-> root
(select-keys [::repl/root-id ::repl/type])
(assoc ::repl/levels
(->> levels
(map transform-level)
(into [])))))

(defn repl-roots [req]
(common/edn req
(->> (repl/roots)
(vals)
(map transform-root)
(into []))))

(defn repl-root [req root-id]
(common/edn req
(-> (repl/root root-id)
(transform-root))))

(defn repl-level [req root-id level-id]
(common/edn req
(-> (repl/level root-id level-id)
(transform-level))))

(defn open-file [{:keys [config ring-request] :as req}]

(let [data
Expand Down Expand Up @@ -89,21 +55,6 @@
:headers {"content-type" "application/edn; charset=utf-8"}
:body (core-ext/safe-pr-str result)}))

(defn get-bundle-info [{:keys [config] :as req} build-id]
(try
(let [file (io/file (:cache-root config) "builds" (name build-id) "release" "bundle-info.edn")]
(if (.exists file)
{:status 200
:header {"content-type" "application/edn"}
:body (slurp file)}

;; could generate this on-depend but that might take a long time
{:status 404
:body "Report not found. Run shadow-cljs release."}))
(catch Exception e
{:status 503
:body "Build failed."})))

(defmulti process-api-msg (fn [state msg] (::m/op msg)) :default ::default)

(defmethod process-api-msg ::default
Expand Down Expand Up @@ -166,10 +117,6 @@
(http/route req
(:GET "" index-page)
(:POST "/graph" graph/serve)
(:GET "/repl" repl-roots)
(:GET "/repl/{root-id:long}" repl-root root-id)
(:GET "/repl/{root-id:long}/{level-id:long}" repl-level root-id level-id)
(:GET "/bundle-info/{build-id:keyword}" get-bundle-info build-id)
(:POST "/open-file" open-file)
common/not-found))

Expand Down
72 changes: 44 additions & 28 deletions src/main/shadow/cljs/devtools/server/worker.clj
View file
Expand Up @@ -170,11 +170,16 @@
(defn update-build-status [state {:keys [type] :as msg}]
(case type
:build-configure
{:status :configured}
(assoc state
:status :compiling
:active {}
:log [])

:build-start
{:status :compiling
:active {}
:log []}
(assoc state
:status :compiling
:active {}
:log [])

:build-complete
(let [{:keys [sources compiled] :as info}
Expand Down Expand Up @@ -229,6 +234,37 @@
;; mostly REPL related things
state))

(defn build-status-loop [system-bus build-id status-ref build-status-chan]
(let [flush-delay 100
flush-fn
(fn [state]
(let [msg {:type :build-status
:build-id build-id
:state state}]
(sys-bus/publish! system-bus ::m/worker-broadcast msg)
(sys-bus/publish! system-bus [::m/worker-output build-id] msg)))]

(go (loop [state {}
needs-flush? false
timeout (async/timeout flush-delay)]
(alt!
timeout
([_]
(when needs-flush?
(reset! status-ref state)
(flush-fn state))

(recur state false (async/timeout flush-delay)))

build-status-chan
([msg]
(if-not msg
(when needs-flush?
(flush-fn state))
(-> state
(update-build-status msg)
(recur true timeout)))))))))

;; SERVICE API

(defn start
Expand Down Expand Up @@ -354,7 +390,9 @@
(get-in build-config [:devtools :http-root]))

status-ref
(atom {:status :pending})
(atom {:status :pending
:build-id build-id
:mode :dev})

worker-proc
(-> {::impl/proc true
Expand Down Expand Up @@ -387,29 +425,7 @@

;; FIXME: figure out which update frequency makes sense for the UI
;; 10fps is probably more than enough?
(let [flush-delay 100]
(go (loop [state {}
needs-flush? false
timeout (async/timeout flush-delay)]
(alt!
timeout
([_]
(when needs-flush?
(reset! status-ref state)
(let [msg {:type :build-status
:build-id build-id
:state state}]
(sys-bus/publish! system-bus ::m/worker-broadcast msg)
(sys-bus/publish! system-bus [::m/worker-output build-id] msg)))

(recur state false (async/timeout flush-delay)))

build-status-chan
([msg]
(when msg
(-> state
(update-build-status msg)
(recur true timeout))))))))
(build-status-loop system-bus build-id status-ref build-status-chan)

(sys-bus/sub system-bus ::m/resource-update resource-update)
(sys-bus/sub system-bus ::m/macro-update macro-update)
Expand Down

0 comments on commit 532fb53

Please sign in to comment.