adding (mount.core/system)
This commit is contained in:
parent
b4a79f7ba3
commit
8a3ce619e8
2 changed files with 57 additions and 3 deletions
|
|
@ -188,14 +188,14 @@
|
||||||
(with-ns ns name))
|
(with-ns ns name))
|
||||||
v)))
|
v)))
|
||||||
|
|
||||||
(defn- state-to-sym [state]
|
(defn- unvar-state [s]
|
||||||
(->> state (drop 2) (apply str) symbol)) ;; magic 2 is removing "#'" in state name
|
(->> s (drop 2) (apply str))) ;; magic 2 is removing "#'" in state name
|
||||||
|
|
||||||
#?(:clj
|
#?(:clj
|
||||||
(defn- was-removed?
|
(defn- was-removed?
|
||||||
"checks if a state was removed from a namespace"
|
"checks if a state was removed from a namespace"
|
||||||
[state]
|
[state]
|
||||||
(-> state state-to-sym resolve not)))
|
(-> state unvar-state symbol resolve not)))
|
||||||
|
|
||||||
#?(:clj
|
#?(:clj
|
||||||
(defn cleanup-deleted [state]
|
(defn cleanup-deleted [state]
|
||||||
|
|
@ -297,3 +297,11 @@
|
||||||
(defn resume [& states]
|
(defn resume [& states]
|
||||||
(let [states (or (seq states) (all-without-subs))]
|
(let [states (or (seq states) (all-without-subs))]
|
||||||
{:resumed (bring states sigcont <)}))
|
{:resumed (bring states sigcont <)}))
|
||||||
|
|
||||||
|
(defn system [] ;; if/when lift vars, will be in a "system-mode" later
|
||||||
|
(let [sys @meta-state]
|
||||||
|
(into {}
|
||||||
|
(for [[k {:keys [inst var]}] sys]
|
||||||
|
[(unvar-state k) (if (= :cljc @mode)
|
||||||
|
@inst
|
||||||
|
@var)]))))
|
||||||
|
|
|
||||||
46
src/mount/system.clj
Normal file
46
src/mount/system.clj
Normal file
|
|
@ -0,0 +1,46 @@
|
||||||
|
(ns mount.system)
|
||||||
|
|
||||||
|
(defprotocol Lifecycle
|
||||||
|
(start [this] "starts a system")
|
||||||
|
(stop [this] "stops a system")
|
||||||
|
;; (start-with [this states])
|
||||||
|
;; (start-without [this states])
|
||||||
|
;; (stop-except [this states])
|
||||||
|
)
|
||||||
|
|
||||||
|
(defrecord MountSystem [components])
|
||||||
|
|
||||||
|
(defn- select-fun [states f]
|
||||||
|
(into []
|
||||||
|
(for [[name state] states]
|
||||||
|
(when-let [fun (f state)]
|
||||||
|
[name fun]))))
|
||||||
|
|
||||||
|
(defn- bring-system [funs]
|
||||||
|
(into {}
|
||||||
|
(for [[name fun] funs]
|
||||||
|
[name (fun)])))
|
||||||
|
|
||||||
|
(defn- unvar-state [s]
|
||||||
|
(->> s (drop 2) (apply str))) ;; magic 2 is removing "#'" in state name
|
||||||
|
|
||||||
|
(defn unvar-names [states]
|
||||||
|
(into {} (for [[k v] states]
|
||||||
|
[(unvar-state k) v])))
|
||||||
|
|
||||||
|
(defn- not-started [states]
|
||||||
|
(into {}
|
||||||
|
(for [state (keys states)]
|
||||||
|
[state :not-started])))
|
||||||
|
|
||||||
|
(defn new-system [meta-state]
|
||||||
|
(let [states (-> (sort-by (comp :order val) <
|
||||||
|
meta-state)
|
||||||
|
unvar-names)
|
||||||
|
up (select-fun states :start)
|
||||||
|
down (reverse (select-fun states :stop))]
|
||||||
|
(extend-type MountSystem
|
||||||
|
Lifecycle
|
||||||
|
(start [_] (bring-system up)) ;; these two will have two lift inter var deps
|
||||||
|
(stop [_] (bring-system down))) ;;
|
||||||
|
(->MountSystem (not-started states))))
|
||||||
Loading…
Reference in a new issue