Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Create a binding context within a session so binding conveyance works #24

Open
wants to merge 6 commits into
base: 2.x
Choose a base branch
from
Open

Create a binding context within a session so binding conveyance works #24

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
2713e26
Create a binding context within a session so binding conveyance works
robhanlon22 Sep 25, 2020
82fd3a1
Fix error message
robhanlon22 Sep 25, 2020
3ccc5df
Prefer session from InheritableThreadLocal
robhanlon22 Sep 25, 2020
331b3e6
Don't give InheritableThreadLocal default value
robhanlon22 Sep 25, 2020
87f8312
Ensure outer bindings are propagated to thread
robhanlon22 Sep 25, 2020
ac57ba9
Use bound-fn
robhanlon22 Sep 26, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
72 changes: 46 additions & 26 deletions src/mount/lite.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,17 +18,36 @@

;;; The state protocol implementation.

(defonce ^:private itl (InheritableThreadLocal.))
(defn new-session
[]
(gensym "mount-session-"))

(defonce ^:private default-session (new-session))

(defonce itl
(proxy [InheritableThreadLocal] []
(initialValue []
default-session)))

(defonce ^:dynamic *session* default-session)

(defn current-session
[]
(or (.get ^InheritableThreadLocal itl) *session*))
Copy link
Contributor Author

@robhanlon22 robhanlon22 Sep 25, 2020 •
edited
Loading

Choose a reason for hiding this comment

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

Combining the approaches of using the InheritableThreadLocal and a binding so we can fall back to the *session* if the InheritableThreadLocal's value is missing.


(defn- default-session?
[]
(= (current-session) default-session))

(defn- throw-started
[name]
(throw (Error. (format "state %s already started %s" name
(if (.get ^InheritableThreadLocal itl) "in this session" "")))))
(if (default-session?) "" "in this session")))))

(defn- throw-unstarted
[name]
(throw (Error. (format "state %s not started %s" name
(if (.get ^InheritableThreadLocal itl) "in this session" "")))))
(if (default-session?) "" "in this session")))))

(defn- throw-not-found
[var]
Expand All @@ -39,29 +58,29 @@
(start* [this]
(if (= :stopped (status* this))
(let [value (start-fn)]
(swap! sessions assoc (.get ^InheritableThreadLocal itl) (assoc (dissoc this :sessions) ::value value)))
(swap! sessions assoc (current-session) (assoc (dissoc this :sessions) ::value value)))
(throw-started name)))

(stop* [this]
(let [value (deref this)
stop-fn (get-in @sessions [(.get ^InheritableThreadLocal itl) :stop-fn])]
stop-fn (get-in @sessions [(current-session) :stop-fn])]
(stop-fn value)
(swap! sessions dissoc (.get ^InheritableThreadLocal itl))))
(swap! sessions dissoc (current-session))))

(status* [_]
(if (get @sessions (.get ^InheritableThreadLocal itl))
(if (get @sessions (current-session))
:started
:stopped))

(properties [this]
(-> this
(merge (get @sessions (.get ^InheritableThreadLocal itl)))
(merge (get @sessions (current-session)))
(dissoc ::value :sessions)))

IDeref
(deref [this]
(if (= :started (status* this))
(get-in @sessions [(.get ^InheritableThreadLocal itl) ::value])
(get-in @sessions [(current-session) ::value])
(throw-unstarted name))))

(prefer-method print-method Map IDeref)
Expand Down Expand Up @@ -190,25 +209,26 @@
~@body)))

(defmacro with-session
"Creates a new thread, with a new system of states. All states are
initially in the stopped status in this thread, regardless of the
status in the thread that spawns this new session. This spawned
thread and its subthreads will automatically use the states that are
started within this thread or subthreads. Exiting the spawned thread
will automatically stop all states in this session.

Returns a map with the spawned :thread and a :promise that will be
set to the result of the body or an exception."
"Creates a new thread, with a new system of states. All states are initially
in the stopped status in this thread, regardless of the status in the thread
that spawns this new session. This spawned thread and its subthreads, futures,
and agents will automatically use the states that are started within this
thread or subthreads. Exiting the spawned thread will automatically stop all
states in this session.

Returns a map with the spawned :thread and a :promise that will be set to the
result of the body or an exception."
[& body]
`(let [p# (promise)]
{:thread (doto (Thread. (fn []
(.set ^InheritableThreadLocal @#'itl (Thread/currentThread))
(try
(deliver p# (do ~@body))
(catch Throwable t#
(deliver p# t#)
(throw t#))
(finally
(stop)))))
(binding [*session* (new-session)]
(.set ^InheritableThreadLocal itl *session*)
(try
(deliver p# (do ~@body))
(catch Throwable t#
(deliver p# t#)
(throw t#))
(finally
(stop))))))
Copy link
Contributor Author

Choose a reason for hiding this comment

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

I think that this should be converted to a future, which can be derefed directly and is run within a thread implicitly. However, I didn't want to make a potentially breaking change without checking with you first, @aroemers.

(.start))
:result p#}))
25 changes: 25 additions & 0 deletions test/mount/lite_test.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -69,3 +69,28 @@
(start #'state-1)
(stop))
(is (and (realized? stopped) (= 1 @stopped)) "this is bound")))

(deftest test-with-session
(testing "with a nested future"
(start #'state-1)
(is (= (status) {#'state-1 :started #'state-2 :stopped #'state-2-a :stopped #'state-2-b :stopped #'state-3 :stopped}))
@(:result
(with-session
(is (= (status) {#'state-1 :stopped #'state-2 :stopped #'state-2-a :stopped #'state-2-b :stopped #'state-3 :stopped}))
(start #'state-2)
@(future
(is (= (status) {#'state-1 :started #'state-2 :started #'state-2-a :stopped #'state-2-b :stopped #'state-3 :stopped})))
(is (= (status) {#'state-1 :started #'state-2 :started #'state-2-a :stopped #'state-2-b :stopped #'state-3 :stopped}))))
(is (= (status) {#'state-1 :started #'state-2 :stopped #'state-2-a :stopped #'state-2-b :stopped #'state-3 :stopped})))
(testing "with a nested thread"
(start #'state-1)
(is (= (status) {#'state-1 :started #'state-2 :stopped #'state-2-a :stopped #'state-2-b :stopped #'state-3 :stopped}))
@(:result
(with-session
(is (= (status) {#'state-1 :stopped #'state-2 :stopped #'state-2-a :stopped #'state-2-b :stopped #'state-3 :stopped}))
(start #'state-2)
(-> #(is (= (status) {#'state-1 :started #'state-2 :started #'state-2-a :stopped #'state-2-b :stopped #'state-3 :stopped}))
(Thread.)
(.join))
(= (status) {#'state-1 :started #'state-2 :started #'state-2-a :stopped #'state-2-b :stopped #'state-3 :stopped})))
(is (= (status) {#'state-1 :started #'state-2 :stopped #'state-2-a :stopped #'state-2-b :stopped #'state-3 :stopped}))))