diff --git a/src/mount/core.cljc b/src/mount/core.cljc index d983c5f..2de018e 100644 --- a/src/mount/core.cljc +++ b/src/mount/core.cljc @@ -188,14 +188,14 @@ (with-ns ns name)) v))) -(defn- state-to-sym [state] - (->> state (drop 2) (apply str) symbol)) ;; magic 2 is removing "#'" in state name +(defn- unvar-state [s] + (->> s (drop 2) (apply str))) ;; magic 2 is removing "#'" in state name #?(:clj (defn- was-removed? "checks if a state was removed from a namespace" [state] - (-> state state-to-sym resolve not))) + (-> state unvar-state symbol resolve not))) #?(:clj (defn cleanup-deleted [state] @@ -297,3 +297,11 @@ (defn resume [& states] (let [states (or (seq states) (all-without-subs))] {: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)])))) diff --git a/src/mount/system.clj b/src/mount/system.clj new file mode 100644 index 0000000..4e03756 --- /dev/null +++ b/src/mount/system.clj @@ -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))))