luciano/mount
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #97 from arichiardi/self-host-support

Browse source 
self-host ClojureScript support
This commit is contained in:
Anatoly 2018-04-08 22:56:58 -04:00 committed by GitHub
commit a4552fc6ed
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
6 changed files with 128 additions and 64 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
package.json Normal file
View file

@ -0,0 +1,21 @@
{
"name": "mount",
"version": "0.1.12",
"license": "EPL-1.0",
"homepage": "https://github.com/tolitius/mount",
"repository": {
"type": "git",
"url": "https://github.com/tolitius/mount"
},
"author": {
"name" : "tolitius",
"url" : "http://www.dotkam.com"
}
,
"files": [
"src/*"
],
"directories": {
"lib": "src"
}
}

10
project.clj
View file

@ -8,9 +8,12 @@
:dependencies [] ;; for visual clarity
:tach {:test-runner-ns 'mount.test-self-host
:source-paths ["test/core"]}
:profiles {:dev {:source-paths ["dev" "dev/clj" "test/clj"]
:dependencies [[org.clojure/clojure "1.7.0"]
[org.clojure/clojurescript "1.7.170"]; :classifier "aot"]
:dependencies [[org.clojure/clojure "1.8.0"]
[org.clojure/clojurescript "1.9.946"]; :classifier "aot"]
[datascript "0.13.3"]
[compojure "1.4.0"]
[ring/ring-jetty-adapter "1.1.0"]
@ -27,7 +30,8 @@
:plugins [[lein-cljsbuild "1.1.1"]
[lein-doo "0.1.6"]
[lein-figwheel "0.5.0-2"]
[test2junit "1.1.3"]]
[test2junit "1.1.3"]
[lein-tach "1.0.0"]]
:test2junit-output-dir ~(or (System/getenv "CIRCLE_TEST_REPORTS") "target/test2junit")

78
src/mount/core.cljc
View file

@ -1,13 +1,15 @@
(ns mount.core
#?(:clj (:require [mount.tools.macro :refer [on-error throw-runtime] :as macro]
[mount.tools.macrovich :refer [deftime]]
[mount.tools.logger :refer [log]]
[clojure.set :refer [intersection]]
[clojure.string :as s])
:cljs (:require [mount.tools.macro :as macro]
:cljs (:require [mount.tools.macro]
[clojure.set :refer [intersection]]
[mount.tools.logger :refer [log]]))
#?(:cljs (:require-macros [mount.core]
[mount.tools.macro :refer [if-clj on-error throw-runtime]])))
[mount.tools.macro :refer [on-error throw-runtime]]
[mount.tools.macrovich :refer [deftime]])))
(defonce ^:private -args (atom {})) ;; mostly for command line args and external files
(defonce ^:private state-seq (atom 0))
@ -110,8 +112,8 @@
:fail? false)
:f-failed)]
(log cause :error) ;; this would mostly be useful in REPL / browser console
(alter-state! current (NotStartedState. state)))
(alter-state! current (NotStartedState. state))) ;; (!) if a state does not have :stop when _should_ this might leak
(alter-state! current (->NotStartedState state)))
(alter-state! current (->NotStartedState state))) ;; (!) if a state does not have :stop when _should_ this might leak
(swap! running dissoc state)
(update-meta! [state :status] #{:stopped})))
@ -149,7 +151,7 @@
;;TODO: make private after figuring out the inconsistency betwen cljs compile stages
;; (i.e. _sometimes_ this, if private, is not seen by expanded "defmacro" on cljs side)
(defn mount-it [s-var s-name s-meta]
(let [with-inst (assoc s-meta :inst (atom (NotStartedState. s-name))
(let [with-inst (assoc s-meta :inst (atom (->NotStartedState s-name))
:var s-var)
on-reload (on-reload-meta s-var)
existing? (when-not (= :noop on-reload)
@ -159,39 +161,41 @@
(log (str ">> starting.. " s-name " (namespace was recompiled)"))
(up s-name with-inst (atom #{})))))
#?(:clj
(defmacro defstate
"Defines a state. Restarts on recompilation.
Pass ^{:on-reload :noop} to prevent auto-restart
on ns recompilation, or :stop to stop on recompilation."
[state & body]
(let [[state params] (macro/name-with-attributes state body)
{:keys [start stop] :as lifecycle} (apply hash-map params)
state-name (with-ns *ns* state)
order (make-state-seq state-name)]
(validate lifecycle)
(let [s-meta (cond-> {:order order
:start `(fn [] ~start)
:status #{:stopped}}
stop (assoc :stop `(fn [] ~stop)))]
`(do
;; (log (str "|| mounting... " ~state-name))
;; only create/redefine a new state iff this is not a running ^{:on-reload :noop}
(if-not (running-noop? ~state-name)
(do
(~'defonce ~state (DerefableState. ~state-name))
(mount-it (~'var ~state) ~state-name ~s-meta))
(~'defonce ~state (current-state ~state-name)))
(~'var ~state))))))
(deftime
#?(:clj
(defmacro defstate! [state & {:keys [start! stop!]}]
(let [state-name (with-ns *ns* state)]
`(defstate ~state
:start (~'let [~state (mount/current-state ~state-name)]
~start!)
:stop (~'let [~state (mount/current-state ~state-name)]
~stop!)))))
(defmacro defstate
"Defines a state. Restarts on recompilation.
Pass ^{:on-reload :noop} to prevent auto-restart
on ns recompilation, or :stop to stop on recompilation."
[state & body]
(let [[state params] (mount.tools.macro/name-with-attributes state body)
{:keys [start stop] :as lifecycle} (apply hash-map params)
state-name (with-ns *ns* state)
order (make-state-seq state-name)]
(validate lifecycle)
(let [s-meta (cond-> {:order order
:start `(fn [] ~start)
:status #{:stopped}}
stop (assoc :stop `(fn [] ~stop)))]
`(do
;; (log (str "|| mounting... " ~state-name))
;; only create/redefine a new state iff this is not a running ^{:on-reload :noop}
(if-not (running-noop? ~state-name)
(do
(~'defonce ~state (->DerefableState ~state-name))
(mount-it (~'var ~state) ~state-name ~s-meta))
(~'defonce ~state (current-state ~state-name)))
(~'var ~state)))))
(defmacro defstate! [state & {:keys [start! stop!]}]
(let [state-name (with-ns *ns* state)]
`(defstate ~state
:start (~'let [~state (mount.core/current-state ~state-name)]
~start!)
:stop (~'let [~state (mount.core/current-state ~state-name)]
~stop!))))
)
(defn in-cljc-mode []
(reset! mode :cljc))

45
src/mount/tools/macro.cljc
View file

@ -1,31 +1,28 @@
(ns mount.tools.macro
#?(:cljs (:require-macros [mount.tools.macro])))
(:refer-clojure :exclude [case])
#?(:cljs (:require-macros [mount.tools.macrovich :refer [deftime]])
:clj (:require [mount.tools.macrovich :refer [deftime]])))
#?(:clj
(defmacro if-clj [then else]
(if (-> &env :ns not)
then
else)))
(deftime
#?(:clj
(defmacro on-error [msg f & {:keys [fail?]
:or {fail? true}}]
`(if-clj
(try ~f
(catch Throwable t#
(if ~fail?
(throw (RuntimeException. ~msg t#))
{:f-failed (ex-info ~msg {} t#)})))
(try ~f
(catch :default t#
(if ~fail?
(throw (~'str ~msg " " t#))
{:f-failed (ex-info ~msg {} t#)}))))))
(defmacro on-error [msg f & {:keys [fail?]
:or {fail? true}}]
`(mount.tools.macrovich/case
:clj (try ~f
(catch Throwable t#
(if ~fail?
(throw (RuntimeException. ~msg t#))
{:f-failed (ex-info ~msg {} t#)})))
:cljs (try ~f
(catch :default t#
(if ~fail?
(throw (~'str ~msg " " t#))
{:f-failed (ex-info ~msg {} t#)})))))
#?(:clj
(defmacro throw-runtime [msg]
`(throw (if-clj (RuntimeException. ~msg)
(~'str ~msg)))))
(defmacro throw-runtime [msg]
`(throw (mount.tools.macrovich/case :clj (RuntimeException. ~msg) :cljs (~'str ~msg))))
)
;; this is a one to one copy from https://github.com/clojure/tools.macro
;; to avoid a lib dependency for a single function

21
src/mount/tools/macrovich.cljc Normal file
View file

@ -0,0 +1,21 @@
(ns ^{:doc "From https://github.com/cgrand/macrovich. Licensed under EPL v1.
Copyright Cristophe Grand." }
mount.tools.macrovich
(:refer-clojure :exclude [case]))
(defmacro deftime
"This block will only be evaluated at the correct time for macro definition, at other times its content
are removed.
For Clojure it always behaves like a `do` block.
For Clojurescript/JVM the block is only visible to Clojure.
For self-hosted Clojurescript the block is only visible when defining macros in the pseudo-namespace."
[& body]
(when #?(:clj (not (:ns &env)) :cljs (re-matches #".*\$macros" (name (ns-name *ns*))))
`(do ~@body)))
(defmacro case [& {:keys [cljs clj]}]
(if (contains? &env '&env)
`(if (:ns ~'&env) ~cljs ~clj)
(if #?(:clj (:ns &env) :cljs true)
cljs
clj)))

17
test/core/mount/test_self_host.cljs Normal file
View file

@ -0,0 +1,17 @@
(ns mount.test-self-host
(:require
[cljs.test :as t]
mount.test.fun-with-values
mount.test.private-fun
mount.test.printing
))
(t/run-tests
'mount.test.fun-with-values
'mount.test.private-fun
'mount.test.printing
)
(defn run-tests []
(t/run-all-tests #"mount.test.*"))