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
#'check.start-with-test/test-nrepl
#'check.parts-test/should-not-start
#'check.suspend-resume-test/randomizer
#'check.suspend-resume-test/web-server
#'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
:order (make-state-seq state)
:start `(fn [] ~start)
:started? false}
:status #{:stopped}}
stop (assoc :stop `(fn [] ~stop))
suspend (assoc :suspend `(fn [] ~suspend))
resume (assoc :resume `(fn [] ~resume)))]
@ -48,44 +48,44 @@
(swap! done conj (ns-resolve ns name))
state))
(defn- up [var {:keys [ns name start started? resume suspended?] :as state} done]
(when-not started?
(let [s (try (if suspended?
(defn- up [var {:keys [ns name start resume status] :as state} done]
(when-not (:started status)
(let [s (try (if (:suspended status)
(record! state resume done)
(record! state start done))
(catch Throwable t
(throw (RuntimeException. (str "could not start [" name "] due to") t))))]
(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]
(when (or started? suspended?)
(defn- down [var {:keys [ns name stop status] :as state} done]
(when (some status #{:started :suspended})
(when stop
(try
(record! state stop done)
(catch Throwable 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
(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]
(when (and started? resume) ;; can't have suspend without resume, but the reverse is possible
(defn- sigstop [var {:keys [ns name suspend resume status] :as state} done]
(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?)
(let [s (try (record! state suspend done)
(catch Throwable t
(throw (RuntimeException. (str "could not suspend [" name "] due to") t))))]
(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)
(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)
(catch Throwable t
(throw (RuntimeException. (str "could not resume [" name "] due to") t))))]
(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
(defn args [] @-args)
@ -110,7 +110,7 @@
(defn states-with-deps []
(let [all (find-all-states)]
(->> (map (comp #(add-deps % all)
#(select-keys % [:name :order :ns :started? :suspended?])
#(select-keys % [:name :order :ns :status])
meta)
all)
(sort-by :order))))
@ -129,9 +129,9 @@
however other keys of 'state' (such as :ns,:name,:order) should not be overriden"
([state 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
:suspended? suspended?
:status status
:start start :stop stop :suspend suspend :resume resume)))
(defn- rollback! [state]
@ -140,7 +140,7 @@
(alter-meta! state #(merge-lifecycles % origin)))))
(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)
sub (meta with)]
(alter-meta! with assoc :sub? true)
@ -148,8 +148,7 @@
(defn- unsub [state]
(when (-> (meta state) :sub?)
(alter-meta! state assoc :sub? nil
:started false)))
(alter-meta! state dissoc :sub?)))
(defn- all-without-subs []
(remove (comp :sub? meta) (find-all-states)))
@ -167,11 +166,8 @@
(defn stop-except [& states]
(let [all (set (find-all-states))
states (remove (set states) all)
_ (dorun (map unsub states)) ;; unmark substitutions marked by "start-with"
stopped (bring states down >)]
(dorun (map rollback! states)) ;; restore to origin from "start-with"
{:stopped stopped}))
states (remove (set states) all)]
(apply stop states)))
(defn start-with-args [xs & states]
(reset! -args xs)

30
test/check/suspend_resume_test.clj
View file

@ -25,9 +25,9 @@
:suspend #(suspend :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"
(let [_ (mount/start)
@ -66,9 +66,10 @@
(is (instance? mount.core.NotStartedState app-config))
(is (instance? mount.core.NotStartedState nrepl))
(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,
the later should be able to suspend/resume,
@ -85,7 +86,24 @@
(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 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 original should still be suspended and preserve its lifecycle fns after the rollback/stop"
(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/suspend)]
(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/start)
(mount/suspend)