Works under self-hosted Clojurescript

This commit is contained in:
Vadim Platonov 2017-06-30 10:25:03 +02:00 committed by Andrea Richiardi
parent 52e360f3ab
commit be6e9be246
2 changed files with 108 additions and 81 deletions

View file

@ -1,5 +1,5 @@
(ns mount.core (ns mount.core
#?(:clj (:require [mount.tools.macro :refer [on-error throw-runtime] :as macro] #?(:clj (:require [mount.tools.macro :refer [deftime on-error throw-runtime] :as macro]
[mount.tools.logger :refer [log]] [mount.tools.logger :refer [log]]
[clojure.set :refer [intersection]] [clojure.set :refer [intersection]]
[clojure.string :as s]) [clojure.string :as s])
@ -7,26 +7,10 @@
[clojure.set :refer [intersection]] [clojure.set :refer [intersection]]
[mount.tools.logger :refer [log]])) [mount.tools.logger :refer [log]]))
#?(:cljs (:require-macros [mount.core] #?(:cljs (:require-macros [mount.core]
[mount.tools.macro :refer [if-clj on-error throw-runtime]]))) [mount.tools.macro :refer [deftime on-error throw-runtime]])))
(defonce ^:private -args (atom {})) ;; mostly for command line args and external files (defn- with-ns [ns name]
(defonce ^:private state-seq (atom 0)) (str "#'" ns "/" name))
(defonce ^:private mode (atom :clj))
(defonce ^:private meta-state (atom {}))
(defonce ^:private running (atom {})) ;; to clean dirty states on redefs
;; supporting tools.namespace: (disable-reload!)
#?(:clj
(alter-meta! *ns* assoc ::load false)) ;; to exclude the dependency
(defn- make-state-seq [state]
(or (:order (@meta-state state))
(swap! state-seq inc)))
(deftype NotStartedState [state]
Object
(toString [this]
(str "'" state "' is not started (to start all the states call mount/start)")))
;;TODO validate the whole lifecycle ;;TODO validate the whole lifecycle
(defn- validate [{:keys [start stop suspend resume] :as lifecycle}] (defn- validate [{:keys [start stop suspend resume] :as lifecycle}]
@ -34,8 +18,24 @@
(not start) (throw-runtime "can't start a stateful thing without a start function. (i.e. missing :start fn)") (not start) (throw-runtime "can't start a stateful thing without a start function. (i.e. missing :start fn)")
(or suspend resume) (throw-runtime "suspend / resume lifecycle support was removed in \"0.1.10\" in favor of (mount/stop-except)"))) (or suspend resume) (throw-runtime "suspend / resume lifecycle support was removed in \"0.1.10\" in favor of (mount/stop-except)")))
(defn- with-ns [ns name] (defonce ^:private -args (atom {})) ;; mostly for command line args and external files
(str "#'" ns "/" name)) (defonce ^:private mode (atom :clj))
(defonce ^:private running (atom {})) ;; to clean dirty states on redefs
(defonce ^:private state-seq (atom 0))
(defonce ^:private meta-state (atom {}))
(defn- make-state-seq [state]
(or (:order (@meta-state state))
(swap! state-seq inc)))
;; supporting tools.namespace: (disable-reload!)
#?(:clj
(alter-meta! *ns* assoc ::load false)) ;; to exclude the dependency
(deftype NotStartedState [state]
Object
(toString [this]
(str "'" state "' is not started (to start all the states call mount/start)")))
(defn- pounded? [f] (defn- pounded? [f]
(let [pound "(fn* [] "] ;;TODO: think of a better (i.e. typed) way to distinguish #(f params) from (fn [params] (...))) (let [pound "(fn* [] "] ;;TODO: think of a better (i.e. typed) way to distinguish #(f params) from (fn [params] (...)))
@ -110,8 +110,8 @@
:fail? false) :fail? false)
:f-failed)] :f-failed)]
(log cause :error) ;; this would mostly be useful in REPL / browser console (log cause :error) ;; this would mostly be useful in REPL / browser console
(alter-state! current (NotStartedState. state))) (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))) ;; (!) if a state does not have :stop when _should_ this might leak
(swap! running dissoc state) (swap! running dissoc state)
(update-meta! [state :status] #{:stopped}))) (update-meta! [state :status] #{:stopped})))
@ -149,7 +149,7 @@
;;TODO: make private after figuring out the inconsistency betwen cljs compile stages ;;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) ;; (i.e. _sometimes_ this, if private, is not seen by expanded "defmacro" on cljs side)
(defn mount-it [s-var s-name s-meta] (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) :var s-var)
on-reload (on-reload-meta s-var) on-reload (on-reload-meta s-var)
existing? (when-not (= :noop on-reload) existing? (when-not (= :noop on-reload)
@ -159,39 +159,41 @@
(log (str ">> starting.. " s-name " (namespace was recompiled)")) (log (str ">> starting.. " s-name " (namespace was recompiled)"))
(up s-name with-inst (atom #{}))))) (up s-name with-inst (atom #{})))))
#?(:clj (deftime
(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))))))
#?(:clj (defmacro defstate
(defmacro defstate! [state & {:keys [start! stop!]}] "Defines a state. Restarts on recompilation.
(let [state-name (with-ns *ns* state)] Pass ^{:on-reload :noop} to prevent auto-restart
`(defstate ~state on ns recompilation, or :stop to stop on recompilation."
:start (~'let [~state (mount/current-state ~state-name)] [state & body]
~start!) (let [[state params] (macro/name-with-attributes state body)
:stop (~'let [~state (mount/current-state ~state-name)] {:keys [start stop] :as lifecycle} (apply hash-map params)
~stop!))))) 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 [] (defn in-cljc-mode []
(reset! mode :cljc)) (reset! mode :cljc))

View file

@ -1,31 +1,56 @@
(ns mount.tools.macro (ns mount.tools.macro
#?(:cljs (:require-macros [mount.tools.macro]))) (:refer-clojure :exclude [case])
#?(:cljs (:require-macros [mount.tools.macro :refer [deftime case]])))
#?(:clj ;; From https://github.com/cgrand/macrovich 0.2.0
(defmacro if-clj [then else] ;; Licensed under EPL v1. Copyright Cristophe Grand.
(if (-> &env :ns not) (defmacro deftime
then "This block will only be evaluated at the correct time for macro definition, at other times its content
else))) 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)))
#?(:clj (defmacro usetime
(defmacro on-error [msg f & {:keys [fail?] "This block content is not included at macro definition time.
:or {fail? true}}] For Clojure it always behaves like a `do` block.
`(if-clj For Clojurescript/JVM the block is only visible to Clojurescript.
(try ~f For self-hosted Clojurescript the block is invisible when defining macros in the pseudo-namespace."
(catch Throwable t# [& body]
(if ~fail? (when #?(:clj true :cljs (not (re-matches #".*\$macros" (name (ns-name *ns*)))))
(throw (RuntimeException. ~msg t#)) `(do ~@body)))
{:f-failed (ex-info ~msg {} t#)})))
(try ~f
(catch :default t#
(if ~fail?
(throw (~'str ~msg " " t#))
{:f-failed (ex-info ~msg {} t#)}))))))
#?(:clj (defmacro case [& {:keys [cljs clj]}]
(defmacro throw-runtime [msg] (if (contains? &env '&env)
`(throw (if-clj (RuntimeException. ~msg) `(if (:ns ~'&env) ~cljs ~clj)
(~'str ~msg))))) (if #?(:clj (:ns &env) :cljs true)
cljs
clj)))
(deftime
(defmacro on-error [msg f & {:keys [fail?]
:or {fail? true}}]
`(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#)})))))
(defmacro throw-runtime [msg]
`(throw (case :clj (RuntimeException. ~msg)
:cljs (~'str ~msg))))
)
;; this is a one to one copy from https://github.com/clojure/tools.macro ;; this is a one to one copy from https://github.com/clojure/tools.macro
;; to avoid a lib dependency for a single function ;; to avoid a lib dependency for a single function