diff --git a/project.clj b/project.clj index 857fbd7..c47068f 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mount "0.1.4-SNAPSHOT" +(defproject mount "0.1.5-SNAPSHOT" :description "managing Clojure app state since (reset)" :url "https://github.com/tolitius/mount" :license {:name "Eclipse Public License" @@ -6,26 +6,22 @@ :source-paths ["src"] + ;; these dependencies are here for uberjar and dev example :dependencies [[org.clojure/clojure "1.7.0"] - [ch.qos.logback/logback-classic "1.1.3"] [org.clojure/tools.logging "0.3.1"] - [org.clojure/tools.macro "0.1.2"] - [org.clojure/tools.namespace "0.2.11"]] + [ch.qos.logback/logback-classic "1.1.3"] + [compojure "1.4.0"] + [ring/ring-jetty-adapter "1.1.0"] + [cheshire "5.5.0"] + [com.datomic/datomic-free "0.9.5327" :exclusions [joda-time]] + [robert/hooke "1.3.0"] + [org.clojure/tools.nrepl "0.2.11"] + [org.clojure/tools.macro "0.1.2"]] :profiles {:dev {:source-paths ["dev" "test/app"] - :dependencies [[yesql "0.5.1"] - [compojure "1.4.0"] - [ring/ring-jetty-adapter "1.1.0"] - [cheshire "5.5.0"] - [org.clojure/tools.nrepl "0.2.11"] - [com.datomic/datomic-free "0.9.5327" :exclusions [joda-time]]]} + :dependencies [[org.clojure/tools.namespace "0.2.11"]]} ;; "test" is in sources here to just "demo" the uberjar without poluting mount "src" :uberjar {:source-paths ["test/app"] - :dependencies [[compojure "1.4.0"] - [ring/ring-jetty-adapter "1.1.0"] - [cheshire "5.5.0"] - [org.clojure/tools.nrepl "0.2.11"] - [com.datomic/datomic-free "0.9.5327" :exclusions [joda-time]]] :main app :aot :all}}) diff --git a/src/mount/core.clj b/src/mount/core.clj index c03be64..64e43e4 100644 --- a/src/mount/core.clj +++ b/src/mount/core.clj @@ -1,9 +1,5 @@ (ns mount.core - (:require [clojure.tools.macro :as macro] - [clojure.tools.namespace.repl :refer [disable-reload!]] - [clojure.tools.logging :refer [info warn debug error]])) - -(disable-reload!) + (:require [clojure.tools.macro :as macro])) ;; (defonce ^:private session-id (System/currentTimeMillis)) (defonce ^:private mount-state 42) @@ -11,6 +7,9 @@ (defonce ^:private state-seq (atom 0)) (defonce ^:private state-order (atom {})) +;; supporting tools.namespace: (disable-reload!) +(alter-meta! *ns* assoc ::load false) ;; to exclude the dependency + (defn- make-state-seq [state] (or (@state-order state) (let [nseq (swap! state-seq inc)] @@ -44,45 +43,45 @@ `(defonce ~(with-meta state (merge (meta state) s-meta)) (NotStartedState. ~(str state)))))) -(defn- up [var {:keys [ns name start started? resume suspended?]}] +(defn- record! [{:keys [ns name]} f done] + (let [state (f)] + (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? - (do (info ">> resuming.. " name) - (resume)) - (do (info ">> starting.. " name) - (start))) + (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)))) -(defn- down [var {:keys [ns name stop started? suspended?]}] +(defn- down [var {:keys [ns name stop started? suspended?] :as state} done] (when (or started? suspended?) - (info "<< stopping.. " name) (when stop (try - (stop) + (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))) -(defn- sigstop [var {:keys [ns name started? suspend resume]}] +(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 - (info ">> suspending.. " name) (when suspend ;; don't suspend if there is only resume function (just mark it :suspended?) - (let [s (try (suspend) + (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))) -(defn- sigcont [var {:keys [ns name start started? resume suspended?]}] +(defn- sigcont [var {:keys [ns name start started? resume suspended?] :as state} done] (when (instance? NotStartedState var) (throw (RuntimeException. (str "could not resume [" name "] since it is stoppped (i.e. not suspended)")))) (when suspended? - (info ">> resuming.. " name) - (let [s (try (resume) + (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) @@ -117,12 +116,14 @@ (sort-by :order)))) (defn- bring [states fun order] - (->> states - (sort-by (comp :order meta) order) - (map #(fun % (meta %))) - doall)) + (let [done (atom [])] + (->> states + (sort-by (comp :order meta) order) + (map #(fun % (meta %) done)) + dorun) + @done)) -(defn merge-lifecycles +(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" @@ -133,12 +134,12 @@ :suspended? suspended? :start start :stop stop :suspend suspend :resume resume))) -(defn rollback! [state] +(defn- rollback! [state] (let [{:keys [origin]} (meta state)] (when origin (alter-meta! state #(merge-lifecycles % origin))))) -(defn substitute! [state with] +(defn- substitute! [state with] (let [lifecycle-fns #(select-keys % [:start :stop :suspend :resume :suspended?]) origin (meta state) sub (meta with)] @@ -155,23 +156,22 @@ (defn start [& states] (let [states (or (seq states) (all-without-subs))] - (bring states up <) - :started)) + {:started (bring states up <)})) (defn stop [& states] - (let [states (or states (find-all-states))] - (doall (map unsub states)) ;; unmark substitutions marked by "start-with" - (bring states down >) - (doall (map rollback! states)) ;; restore to origin from "start-with" - :stopped)) + (let [states (or states (find-all-states)) + _ (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})) (defn stop-except [& states] (let [all (set (find-all-states)) - states (remove (set states) all)] - (doall (map unsub states)) ;; unmark substitutions marked by "start-with" - (bring states down >) - (doall (map rollback! states)) ;; restore to origin from "start-with" - :stopped)) + 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})) (defn start-with-args [xs & states] (reset! -args xs) @@ -180,9 +180,8 @@ (start))) (defn start-with [with] - (doall - (for [[from to] with] - (substitute! from to))) + (doseq [[from to] with] + (substitute! from to)) (start)) (defn start-without [& states] @@ -194,10 +193,8 @@ (defn suspend [& states] (let [states (or (seq states) (all-without-subs))] - (bring states sigstop <) - :suspended)) + {:suspended (bring states sigstop <)})) (defn resume [& states] (let [states (or (seq states) (all-without-subs))] - (bring states sigcont <) - :resumed)) + {:resumed (bring states sigcont <)})) diff --git a/test/app/utils/logging.clj b/test/app/utils/logging.clj new file mode 100644 index 0000000..7a1307d --- /dev/null +++ b/test/app/utils/logging.clj @@ -0,0 +1,46 @@ +(ns app.utils.logging ;; << change to your namespace/path + (:require [mount.core] + [robert.hooke :refer [add-hook clear-hooks]] + [clojure.string :refer [split]] + [clojure.tools.logging :refer [info]])) + +(alter-meta! *ns* assoc ::load false) + +(defn- f-to-action [f] + (let [fname (-> (str f) + (split #"@") + first)] + (case fname + "mount.core$up" :up + "mount.core$down" :down + "mount.core$sigstop" :suspend + "mount.core$sigcont" :resume + :noop))) + +(defn whatcha-doing? [{:keys [started? suspended? suspend]} action] + (case action + :up (if suspended? ">> resuming" + (if-not started? ">> starting")) + :down (if (or started? suspended?) "<< stopping") + :suspend (if (and started? suspend) "<< suspending") + :resume (if suspended? ">> resuming"))) + +(defn log-status [f & args] + (let [{:keys [ns name] :as state} (second args) + action (f-to-action f)] + (when-let [taking-over-the-world (whatcha-doing? state action)] + (info (str taking-over-the-world ".. " (ns-resolve ns name)))) + (apply f args))) + +(defonce lifecycle-fns + #{#'mount.core/up + #'mount.core/down + #'mount.core/sigstop + #'mount.core/sigcont}) + +(defn without-logging-status [] + (doall (map #(clear-hooks %) lifecycle-fns))) + +(defn with-logging-status [] + (without-logging-status) + (doall (map #(add-hook % log-status) lifecycle-fns))) diff --git a/test/app/www.clj b/test/app/www.clj index 6b68953..e3b8fb3 100644 --- a/test/app/www.clj +++ b/test/app/www.clj @@ -1,6 +1,7 @@ (ns app.www (:require [app.nyse :refer [add-order find-orders create-nyse-schema]] [app.config :refer [app-config]] + [app.utils.logging :refer [with-logging-status]] [mount.core :refer [defstate]] [cheshire.core :refer [generate-string]] [compojure.core :refer [routes defroutes GET POST]] @@ -22,6 +23,7 @@ (defn start-nyse [{:keys [www]}] (create-nyse-schema) ;; creating schema (usually done long before the app is started..) + (with-logging-status) ;; enables demo logging (-> (routes mount-example-routes) (handler/site) (run-jetty {:join? false @@ -29,13 +31,5 @@ (declare nyse-app) ;; in case it needs to be accessed in "resume-nyse" (helping out Clojure compiler) -(defn resume-nyse [conf] - ;; making decision to whether call start / do something / or resume / or just do nothing - ;; access to the current (previous/old) state is here just by its name "nyse-app" - ;; ... - (create-nyse-schema) - nyse-app) ;; returning an existing nyse-app, _so it can be stopped_, later on - (defstate nyse-app :start (start-nyse app-config) - :resume (resume-nyse app-config) :stop (.stop nyse-app)) ;; it's a "org.eclipse.jetty.server.Server" at this point