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

[#5]: suspendable functionality is in

Browse source
This commit is contained in:
anatoly 2015-11-21 11:23:24 -05:00
parent ed2b837555
commit 4e97280be9
4 changed files with 149 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
dev/dev.clj
View file

@ -15,13 +15,16 @@
[clojure.tools.namespace.repl :as tn]
[check.parts-test]
[check.start-with-test]
[check.suspend-resume-test]
[mount.core :as mount]
[app :refer [create-nyse-schema find-orders add-order]])) ;; <<<< replace this your "app" namespace(s) you want to be available at REPL time
(defn start []
(mount/start-without #'check.start-with-test/test-conn
#'check.start-with-test/test-nrepl
#'check.parts-test/should-not-start)) ;; example on how to start app without certain states
#'check.parts-test/should-not-start
#'check.suspend-resume-test/web-server
#'check.suspend-resume-test/q-listener)) ;; example on how to start app without certain states
(defn stop []
(mount/stop))

56
src/mount/core.clj
View file

@ -24,10 +24,11 @@
;;TODO validate the whole lifecycle
(defn- validate [{:keys [start stop suspend resume] :as lifecycle}]
(when-not start
(throw (IllegalArgumentException. "can't start a stateful thing without a start function. (i.e. missing :start fn)")))
(when (and suspend (not resume))
(throw (IllegalArgumentException. "suspendable state should have a resume function (i.e. missing :resume fn)"))))
(cond
(not start) (throw
(IllegalArgumentException. "can't start a stateful thing without a start function. (i.e. missing :start fn)"))
(and suspend (not resume)) (throw
(IllegalArgumentException. "suspendable state should have a resume function (i.e. missing :resume fn)"))))
(defmacro defstate [state & body]
(let [[state params] (macro/name-with-attributes state body)
@ -121,29 +122,39 @@
(map #(fun % (meta %)))
doall))
(defn- rollback! [state]
(let [{:keys [origin start stop sub?]} (meta state)]
(defn merge-lifecycles
"merges with overriding _certain_ non existing keys.
i.e. :suspend is in a 'state', but not in a 'substitute': it should be overriden with nil
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?]}]
(assoc state :origin origin
:suspended? suspended?
:start start :stop stop :suspend suspend :resume resume)))
(defn rollback! [state]
(let [{:keys [origin]} (meta state)]
(when origin
(alter-meta! state assoc :origin nil
:start (or (:start origin) start)
:stop (or (:stop origin) stop)))))
(alter-meta! state #(merge-lifecycles % origin)))))
(defn substitute! [state with]
(let [lifecycle-fns #(select-keys % [:start :stop :suspend :resume :suspended?])
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)))
(defn- substitute! [state with]
(let [{:keys [start stop] :as origin} (meta state)
m-with (meta with)]
(alter-meta! with assoc :sub? true :started? true) ;; pre: called by "start-with"
(alter-meta! state assoc :origin {:start start
:stop stop}
:start (:start m-with)
:stop (:stop m-with))))
(defn- all-without-subs []
(remove (comp :sub? meta) (find-all-states)))
(defn start [& states]
(let [states (or (seq states) (find-all-states))]
(let [states (or (seq states) (all-without-subs))]
(bring states up <)
:started))
@ -169,25 +180,24 @@
(start)))
(defn start-with [with]
(let [app (find-all-states)]
(doall
(for [[from to] with]
(substitute! from to)))
(start)))
(start))
(defn start-without [& states]
(if (first states)
(let [app (set (find-all-states))
(let [app (set (all-without-subs))
without (remove (set states) app)]
(apply start without))
(start)))
(defn suspend [& states]
(let [states (or (seq states) (find-all-states))]
(let [states (or (seq states) (all-without-subs))]
(bring states sigstop <)
:suspended))
(defn resume [& states]
(let [states (or (seq states) (find-all-states))]
(let [states (or (seq states) (all-without-subs))]
(bring states sigcont <)
:resumed))

6
test/check/start_with_test.clj
View file

@ -20,6 +20,12 @@
(is (= conn 42))
(mount/stop)))
(testing "should not start the substitute itself"
(let [_ (mount/start-with {#'app.nyse/conn #'check.start-with-test/test-conn})]
(is (instance? mount.core.NotStartedState test-conn))
(is (= conn 42))
(mount/stop)))
(testing "should start normally after start-with"
(let [_ (mount/start)]
(is (map? app-config))

110
test/check/suspend_resume_test.clj
View file

@ -5,23 +5,119 @@
[app :refer [nrepl]]
[clojure.test :refer :all]))
(defn koncat [k s]
(-> (name k)
(str "-" (name s))
keyword))
(defn start [s] (koncat s :started))
(defn stop [s] (koncat s :stopped))
(defn suspend [s] (koncat s :suspended))
(defn resume [s] (koncat s :resumed))
(defstate web-server :start (start :w)
:stop (stop :w)
:suspend (suspend :w)
:resume (resume :w))
(defstate q-listener :start (start :q)
:stop (stop :q)
:suspend (suspend :q)
:resume (resume :q))
(deftest suspendable
;; lifecycle
(testing "should suspend _only suspendable_ states that are currently started")
(testing "should resume _only suspendable_ states that are currently suspended")
(testing "should start all the states, except the ones that are currently suspended, should resume them instead")
(testing "should stop all: started and suspended")
(testing "should suspend _only suspendable_ states that are currently started"
(let [_ (mount/start)
_ (mount/suspend)]
(is (map? app-config))
(is (instance? clojure.tools.nrepl.server.Server nrepl))
(is (instance? datomic.peer.LocalConnection conn))
(is (= web-server :w-suspended))
(mount/stop)))
(testing "should resume _only suspendable_ states that are currently suspended"
(let [_ (mount/start)
_ (mount/stop #'app/nrepl)
_ (mount/suspend)
_ (mount/resume)]
(is (map? app-config))
(is (instance? mount.core.NotStartedState nrepl))
(is (instance? datomic.peer.LocalConnection conn))
(is (= web-server :w-resumed))
(mount/stop)))
(testing "should start all the states, except the ones that are currently suspended, should resume them instead"
(let [_ (mount/start)
_ (mount/suspend)
_ (mount/start)]
(is (map? app-config))
(is (instance? clojure.tools.nrepl.server.Server nrepl))
(is (instance? datomic.peer.LocalConnection conn))
(is (= web-server :w-resumed))
(mount/stop)))
(testing "should stop all: started and suspended"
(let [_ (mount/start)
_ (mount/suspend)
_ (mount/stop)]
(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))))
;; start-with
(testing "when replacing a non suspendable state with a suspendable one,
the later should be able to suspend/resume,
the original should not be suspendable after resume and preserve its lifecycle fns after rollback/stop")
the original should not be suspendable after resume and preserve its lifecycle fns after rollback/stop"
(let [_ (mount/start-with {#'app/nrepl #'check.suspend-resume-test/web-server})
_ (mount/suspend)]
(is (= nrepl :w-suspended))
(is (instance? mount.core.NotStartedState web-server))
(mount/stop)
(mount/start)
(mount/suspend)
(is (instance? clojure.tools.nrepl.server.Server nrepl))
(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 one,
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)
_ (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))
(mount/stop)
(mount/start)
(mount/suspend)
(is (instance? datomic.peer.LocalConnection conn))
(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 suspendable one,
the later should 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)
_ (mount/suspend)
_ (mount/start-with {#'check.suspend-resume-test/web-server #'check.suspend-resume-test/q-listener})] ;; TODO: good to WARN on started states during "start-with"
(is (= q-listener :q-suspended))
(is (= web-server :q-resumed))
(mount/suspend)
(is (= q-listener :q-suspended))
(is (= web-server :q-suspended))
(mount/stop)
(is (instance? mount.core.NotStartedState web-server))
(is (instance? mount.core.NotStartedState q-listener))
(mount/start)
(mount/suspend)
(is (= q-listener :q-suspended))
(is (= web-server :w-suspended))
(mount/stop))))