Skip to content

Commit

Permalink
[#19]: consolidating status (improvement from @aroemers)
Browse files Browse the repository at this point in the history
  • Loading branch information
@tolitius
tolitius committed Nov 29, 2015
1 parent 865c4f2 commit 339d79e
Show file tree
Hide file tree
Showing 3 changed files with 47 additions and 32 deletions.
1 change: 1 addition & 0 deletions dev/dev.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
48 changes: 22 additions & 26 deletions src/mount/core.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)))]
Expand All @@ -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)
Expand All @@ -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))))
Expand All @@ -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]
Expand All @@ -140,16 +140,15 @@
(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)
(alter-meta! state #(merge-lifecycles % (lifecycle-fns origin) sub))))

(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)))
Expand All @@ -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)
Expand Down
30 changes: 24 additions & 6 deletions test/check/suspend_resume_test.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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,
Expand All @@ -85,15 +86,32 @@
(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)
_ (mount/suspend)
_ (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)
Expand Down

1 comment on commit 339d79e

@aroemers
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks for mentioning me 😄

Please sign in to comment.