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

[#19]: consolidating status (improvement from @aroemers)

Browse source
This commit is contained in:
anatoly 2015-11-29 13:27:26 -05:00
parent 865c4f278b
commit 339d79e508
3 changed files with 47 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
dev/dev.clj
View file

@ -22,6 +22,7 @@
(mount/start-without #'check.start-with-test/test-conn (mount/start-without #'check.start-with-test/test-conn
#'check.start-with-test/test-nrepl #'check.start-with-test/test-nrepl
#'check.parts-test/should-not-start #'check.parts-test/should-not-start
#'check.suspend-resume-test/randomizer
#'check.suspend-resume-test/web-server #'check.suspend-resume-test/web-server
#'check.suspend-resume-test/q-listener)) ;; example on how to start app without certain states #'check.suspend-resume-test/q-listener)) ;; example on how to start app without certain states

46
src/mount/core.clj
View file

@ -36,7 +36,7 @@
(let [s-meta (cond-> {:mount-state mount-state (let [s-meta (cond-> {:mount-state mount-state
:order (make-state-seq state) :order (make-state-seq state)
:start `(fn [] ~start) :start `(fn [] ~start)
:started? false} :status #{:stopped}}
stop (assoc :stop `(fn [] ~stop)) stop (assoc :stop `(fn [] ~stop))
suspend (assoc :suspend `(fn [] ~suspend)) suspend (assoc :suspend `(fn [] ~suspend))
resume (assoc :resume `(fn [] ~resume)))] resume (assoc :resume `(fn [] ~resume)))]
@ -48,44 +48,44 @@
(swap! done conj (ns-resolve ns name)) (swap! done conj (ns-resolve ns name))
state)) state))
(defn- up [var {:keys [ns name start started? resume suspended?] :as state} done] (defn- up [var {:keys [ns name start resume status] :as state} done]
(when-not started? (when-not (:started status)
(let [s (try (if suspended? (let [s (try (if (:suspended status)
(record! state resume done) (record! state resume done)
(record! state start done)) (record! state start done))
(catch Throwable t (catch Throwable t
(throw (RuntimeException. (str "could not start [" name "] due to") t))))] (throw (RuntimeException. (str "could not start [" name "] due to") t))))]
(intern ns (symbol name) s) (intern ns (symbol name) s)
(alter-meta! var assoc :started? true :suspended? false)))) (alter-meta! var assoc :status #{:started}))))
(defn- down [var {:keys [ns name stop started? suspended?] :as state} done] (defn- down [var {:keys [ns name stop status] :as state} done]
(when (or started? suspended?) (when (some status #{:started :suspended})
(when stop (when stop
(try (try
(record! state stop done) (record! state stop done)
(catch Throwable t (catch Throwable t
(throw (RuntimeException. (str "could not stop [" name "] due to") t))))) (throw (RuntimeException. (str "could not stop [" name "] due to") t)))))
(intern ns (symbol name) (NotStartedState. name)) ;; (!) if a state does not have :stop when _should_ this might leak (intern ns (symbol name) (NotStartedState. name)) ;; (!) if a state does not have :stop when _should_ this might leak
(alter-meta! var assoc :started? false :suspended? false))) (alter-meta! var assoc :status #{:stopped})))
(defn- sigstop [var {:keys [ns name started? suspend resume] :as state} done] (defn- sigstop [var {:keys [ns name suspend resume status] :as state} done]
(when (and started? resume) ;; can't have suspend without resume, but the reverse is possible (when (and (:started status) resume) ;; can't have suspend without resume, but the reverse is possible
(when suspend ;; don't suspend if there is only resume function (just mark it :suspended?) (when suspend ;; don't suspend if there is only resume function (just mark it :suspended?)
(let [s (try (record! state suspend done) (let [s (try (record! state suspend done)
(catch Throwable t (catch Throwable t
(throw (RuntimeException. (str "could not suspend [" name "] due to") t))))] (throw (RuntimeException. (str "could not suspend [" name "] due to") t))))]
(intern ns (symbol name) s))) (intern ns (symbol name) s)))
(alter-meta! var assoc :started? false :suspended? true))) (alter-meta! var assoc :status #{:suspended})))
(defn- sigcont [var {:keys [ns name start started? resume suspended?] :as state} done] (defn- sigcont [var {:keys [ns name start resume status] :as state} done]
(when (instance? NotStartedState var) (when (instance? NotStartedState var)
(throw (RuntimeException. (str "could not resume [" name "] since it is stoppped (i.e. not suspended)")))) (throw (RuntimeException. (str "could not resume [" name "] since it is stoppped (i.e. not suspended)"))))
(when suspended? (when (:suspended status)
(let [s (try (record! state resume done) (let [s (try (record! state resume done)
(catch Throwable t (catch Throwable t
(throw (RuntimeException. (str "could not resume [" name "] due to") t))))] (throw (RuntimeException. (str "could not resume [" name "] due to") t))))]
(intern ns (symbol name) s) (intern ns (symbol name) s)
(alter-meta! var assoc :started? true :suspended? false)))) (alter-meta! var assoc :status #{:started}))))
;;TODO args might need more thinking ;;TODO args might need more thinking
(defn args [] @-args) (defn args [] @-args)
@ -110,7 +110,7 @@
(defn states-with-deps [] (defn states-with-deps []
(let [all (find-all-states)] (let [all (find-all-states)]
(->> (map (comp #(add-deps % all) (->> (map (comp #(add-deps % all)
#(select-keys % [:name :order :ns :started? :suspended?]) #(select-keys % [:name :order :ns :status])
meta) meta)
all) all)
(sort-by :order)))) (sort-by :order))))
@ -129,9 +129,9 @@
however other keys of 'state' (such as :ns,:name,:order) should not be overriden" however other keys of 'state' (such as :ns,:name,:order) should not be overriden"
([state sub] ([state sub]
(merge-lifecycles state nil sub)) (merge-lifecycles state nil sub))
([state origin {:keys [start stop suspend resume suspended?]}] ([state origin {:keys [start stop suspend resume status]}]
(assoc state :origin origin (assoc state :origin origin
:suspended? suspended? :status status
:start start :stop stop :suspend suspend :resume resume))) :start start :stop stop :suspend suspend :resume resume)))
(defn- rollback! [state] (defn- rollback! [state]
@ -140,7 +140,7 @@
(alter-meta! state #(merge-lifecycles % origin))))) (alter-meta! state #(merge-lifecycles % origin)))))
(defn- substitute! [state with] (defn- substitute! [state with]
(let [lifecycle-fns #(select-keys % [:start :stop :suspend :resume :suspended?]) (let [lifecycle-fns #(select-keys % [:start :stop :suspend :resume :status])
origin (meta state) origin (meta state)
sub (meta with)] sub (meta with)]
(alter-meta! with assoc :sub? true) (alter-meta! with assoc :sub? true)
@ -148,8 +148,7 @@
(defn- unsub [state] (defn- unsub [state]
(when (-> (meta state) :sub?) (when (-> (meta state) :sub?)
(alter-meta! state assoc :sub? nil (alter-meta! state dissoc :sub?)))
:started false)))
(defn- all-without-subs [] (defn- all-without-subs []
(remove (comp :sub? meta) (find-all-states))) (remove (comp :sub? meta) (find-all-states)))
@ -167,11 +166,8 @@
(defn stop-except [& states] (defn stop-except [& states]
(let [all (set (find-all-states)) (let [all (set (find-all-states))
states (remove (set states) all) states (remove (set states) all)]
_ (dorun (map unsub states)) ;; unmark substitutions marked by "start-with" (apply stop states)))
stopped (bring states down >)]
(dorun (map rollback! states)) ;; restore to origin from "start-with"
{:stopped stopped}))
(defn start-with-args [xs & states] (defn start-with-args [xs & states]
(reset! -args xs) (reset! -args xs)

30
test/check/suspend_resume_test.clj
View file

@ -25,9 +25,9 @@
:suspend #(suspend :q) :suspend #(suspend :q)
:resume #(resume :q)) :resume #(resume :q))
(deftest suspendable (defstate randomizer :start #(rand-int 42))
;; lifecycle (deftest suspendable-lifecycle
(testing "should suspend _only suspendable_ states that are currently started" (testing "should suspend _only suspendable_ states that are currently started"
(let [_ (mount/start) (let [_ (mount/start)
@ -66,9 +66,10 @@
(is (instance? mount.core.NotStartedState app-config)) (is (instance? mount.core.NotStartedState app-config))
(is (instance? mount.core.NotStartedState nrepl)) (is (instance? mount.core.NotStartedState nrepl))
(is (instance? mount.core.NotStartedState conn)) (is (instance? mount.core.NotStartedState conn))
(is (instance? mount.core.NotStartedState web-server)))) (is (instance? mount.core.NotStartedState web-server)))))
;; start-with
(deftest suspendable-start-with
(testing "when replacing a non suspendable state with a suspendable one, (testing "when replacing a non suspendable state with a suspendable one,
the later should be able to suspend/resume, the later should be able to suspend/resume,
@ -85,7 +86,24 @@
(mount/stop))) (mount/stop)))
;; this is a messy use case, but can still happen especially at REPL time ;; this is a messy use case, but can still happen especially at REPL time
(testing "when replacing a suspended state with a non suspendable one, ;; it also messy, because usually :stop function refers the _original_ state by name (i.e. #(disconnect conn))
;; (unchanged/not substituted in its lexical scope), and original state won't be started
(testing "when replacing a suspendable state with a non suspendable one,
the later should not be suspendable,
the original should still be suspendable and preserve its lifecycle fns after the rollback/stop"
(let [_ (mount/start-with {#'check.suspend-resume-test/web-server #'check.suspend-resume-test/randomizer})
_ (mount/suspend)]
(is (integer? web-server))
(is (instance? mount.core.NotStartedState randomizer))
(mount/stop)
(mount/start)
(mount/suspend)
(is (integer? randomizer))
(is (= web-server :w-suspended))
(mount/stop)))
;; this is a messy use case, but can still happen especially at REPL time
(testing "when replacing a suspended state with a non suspendable started one,
the later should not be suspendable, the later should not be suspendable,
the original should still be suspended and preserve its lifecycle fns after the rollback/stop" the original should still be suspended and preserve its lifecycle fns after the rollback/stop"
(let [_ (mount/start) (let [_ (mount/start)
@ -93,7 +111,7 @@
_ (mount/start-with {#'check.suspend-resume-test/web-server #'app.nyse/conn}) ;; TODO: good to WARN on started states during "start-with" _ (mount/start-with {#'check.suspend-resume-test/web-server #'app.nyse/conn}) ;; TODO: good to WARN on started states during "start-with"
_ (mount/suspend)] _ (mount/suspend)]
(is (instance? datomic.peer.LocalConnection conn)) (is (instance? datomic.peer.LocalConnection conn))
(is (instance? datomic.peer.LocalConnection web-server)) (is (= web-server :w-suspended)) ;; since the "conn" does not have a resume method, so web-server was not started
(mount/stop) (mount/stop)
(mount/start) (mount/start)
(mount/suspend) (mount/suspend)