diff --git a/dev/dev.clj b/dev/dev.clj index 7b23b0a..4da3e15 100644 --- a/dev/dev.clj +++ b/dev/dev.clj @@ -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 diff --git a/src/mount/core.clj b/src/mount/core.clj index a26c0a0..44f4406 100644 --- a/src/mount/core.clj +++ b/src/mount/core.clj @@ -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 - (when suspend ;; don't suspend if there is only resume function (just mark it :suspended?) +(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) diff --git a/test/check/suspend_resume_test.clj b/test/check/suspend_resume_test.clj index 218d288..6e2b9a6 100644 --- a/test/check/suspend_resume_test.clj +++ b/test/check/suspend_resume_test.clj @@ -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)