├── .gitignore ├── .travis.yml ├── CHANGELOG.md ├── LICENSE ├── README.md ├── doc └── guidelines.md ├── project.clj ├── scripts └── cljs_repl.clj ├── src └── objection │ ├── core.cljc │ └── util.cljc └── test └── objection ├── core_test.clj └── core_test.cljs /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | .hgignore 11 | .hg/ 12 | *.iml 13 | /nashorn_code_cache 14 | /.cljs_nashorn_repl 15 | /.idea -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | lein: 2.6.1 3 | script: lein test -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/). 3 | 4 | ## Unreleased 5 | 6 | ### Added 7 | - ClojureScript support! Remember to `:require-macros`/`:include-macros`! 8 | - `with-open` macro that behaves similarly to `clojure.core/with-open`, but supports objection objects. 9 | ### Changed 10 | - `defsingleton` now takes an (optional) options map with an optional `:reload?` flag. 11 | 12 | ## [0.1.2] 13 | 14 | ### Fixed 15 | - identity-box not using system hash code 16 | 17 | ## [0.1.1] 18 | 19 | ### Fixed 20 | 21 | - When 're-registering' an alias/id etc, pref to associate properties with original object 22 | not the alias. This is more consistent with the other operations in the lib. 23 | 24 | ## [0.1.0] 25 | 26 | Initial Release -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor tocontrol, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Objection 2 | 3 | > A dynamic approach to application components 4 | 5 | objection is about objects that acquire resources globally such 6 | as connections, connection pools, threads, thread pools, servers, processes etc. 7 | 8 | It provides a means of registering such objects in a global registry giving you 9 | oversight of what is 'running' in your program. 10 | 11 | ```clojure 12 | (defn jdbc-conn 13 | "Returns a registered jdbc db-spec. Stop with obj/stop!" 14 | [url] 15 | (obj/register (db/pool url) {:name "JDBC Conn" :stopfn db/shutdown})) 16 | 17 | (jdbc-conn some-url) 18 | (obj/status) 19 | ;; => 20 | ;; 1 objects registered. 21 | ;; ------- 22 | ;; objects: 23 | ;; ------- 24 | ;; 81e73f11-dc5f-4576-b706-420fa53856d7 - JDBC Conn 25 | 26 | (obj/stop! "81e") 27 | ``` 28 | 29 | ## Features 30 | 31 | - Provides functions to register 'objects' in your program. 32 | - Objects can be registered at any time and on any thread. 33 | - Registered objects can be stopped, made dependent on one another, 34 | have data associated with them, be named etc. 35 | - Objects that are stopped shutdown their dependent objects first. 36 | - Objects can be anything really, no wrappers or protocol impls required. 37 | 38 | ## Rationale 39 | 40 | Certain objects in most programs have global implications that are not managed by the garbage collector. They often have life cycles, acquire resources or have side-effects just by being 'active' (e.g a thread). They are often dependent on one another, and those dependencies are often implicit and the management of clean shutdowns is often hand-rolled. 41 | 42 | In concurrent scenarios all this becomes even more difficult, particularly in programs where such objects are being spawned/shutdown at runtime 43 | on multiple threads. 44 | 45 | The repl complicates things further, how often have you created a core.async process only to lose the reference to a channel? 46 | 47 | Objection provides a set of tools to manage the complexity inherent in objects of this nature, 48 | helping you write robust programs to have a better time at the repl when your program is changing as you edit it. 49 | 50 | ## Comparison with mount/integrant/component 51 | 52 | > Component/Integrant/Mount already solves this problem, why not use that or make a PR or something 53 | 54 | I am a big fan of the excellent [integrant] and [component] libraries and have been using them for almost as long as I have been using clojure. 55 | 56 | However objection takes a different approach that is rather more dynamic than [component], [integrant] or [mount], after feeling that they bank too hard on a static application whose topology does not change at runtime. 57 | 58 | One thing that is particularily nice about both integrant and component is the declarative wiring of components - I would suggest using either library alongside objection if that has value for your application. 59 | 60 | ## Installation 61 | 62 | `[riverford/objection "0.1.3"]` 63 | 64 | ## Usage 65 | 66 | ### Register an object 67 | Objection manages regular old objects that have been registered with objection. 68 | You can register an object with `register`, it returns the object passed as-is. 69 | 70 | ```clojure 71 | (require 72 | '[objection.core :as obj] 73 | '[ring.adapter.jetty :as jetty] 74 | '[ring.util.response :as resp]) 75 | 76 | (defn start-server 77 | [handler port] 78 | (-> (jetty/run-jetty handler {:port port :join? false}) 79 | (obj/register 80 | { ;; all optional 81 | :name (str "Jetty Server on port " port) 82 | :alias [:jetty-server port] 83 | :data {:handler handler :port port} 84 | ;; optional, but wise! 85 | :stopfn (fn [server] (.stop server))}))) 86 | 87 | (start-server (fn [_] (resp/response "Hello World")) 8080) 88 | ``` 89 | 90 | ### Inspect the registry 91 | 92 | Each registered object is assigned an id, you can get all the currently registered object ids from the `id-seq` function. Alternatively use the function `(status)` to print some useful data. 93 | 94 | ```clojure 95 | (obj/status) 96 | ;; 1 objects registered. 97 | ;; ------- 98 | ;; objects: 99 | ;; ------- 100 | ;; 81e73f11-dc5f-4576-b706-420fa53856d7 - Jetty Server on port 8080 101 | ``` 102 | 103 | ### Inspect an object 104 | 105 | Each registered object can be queried. Each function that takes a registered object 106 | will work on an id (or prefix), alias, as well as the object itself. 107 | 108 | `describe` will return data about the object. 109 | 110 | ```clojure 111 | (obj/describe "81e7") 112 | ;; => 113 | {:registered? true, 114 | :id "81e73f11-dc5f-4576-b706-420fa53856d7", 115 | :name "Jetty Server on port 8080", 116 | :data {:handler #object[user$eval1843$fn__1844 0x45a21de2 "user$eval1843$fn__1844@45a21de2"] :port 8080}, 117 | :aliases #{[:jetty-server 8080]}, 118 | :deps #{}, 119 | :dependents #{}} 120 | ``` 121 | 122 | `object` will return the object instance itself. 123 | 124 | ```clojure 125 | (obj/object "81e7") 126 | ``` 127 | 128 | `id` will return the id of the object or alias if it is registered. 129 | 130 | ```clojure 131 | (obj/id [:jetty-server 8080]) 132 | (obj/id (obj/object "81e7")) 133 | (obj/id "81e7") 134 | 135 | ;; all return the string 136 | ;; => 137 | "81e73f11-dc5f-4576-b706-420fa53856d7" 138 | ``` 139 | 140 | ### Stop an object 141 | 142 | Registered objects can be stopped using the stop! function. Again an alias/id etc can be used interchangeably with the object. 143 | `stop!` will call the `:stopfn` if one was supplied on registry, if not it will look for an implementation of the protocol `obj/IAutoStoppable` or `java.lang.AutoCloseable`. 144 | 145 | ```clojure 146 | (obj/stop! "81e73f11-dc5f-4576-b706-420fa53856d7") 147 | ``` 148 | 149 | You can use `stop-all!` to stop each and every object currently registered. 150 | 151 | ```clojure 152 | (obj/stop-all!) 153 | ``` 154 | 155 | ### Dependencies 156 | 157 | Registered objects can be dependent on one another, manage dependencies through 158 | the `:deps` opt on registry, or using the `depend`/`undepend` functions. 159 | 160 | When constructing an object that is dependent on other objects, it is better to 161 | use the `construct` macro as it protects against dependencies 162 | being stopped on other threads while the construction logic is run. 163 | 164 | `construct` takes the same options as `register`, but takes them before the body containing 165 | the construction code. 166 | 167 | ```clojure 168 | (defn arbitrary-object 169 | [server] 170 | (obj/construct 171 | {:deps [server] 172 | :stopfn (fn [_] (println "stopping object"))} 173 | (Object.))) 174 | 175 | ;; restart the server and construct the object. 176 | (let [server (start-server (fn [_] (resp/response "Hello World")) 8080)] 177 | (arbitrary-object server)) 178 | 179 | ;;b2af4b34-d37a-4f6a-892e-36db94aa95ac 180 | (obj/status) 181 | ;; 2 objects registered. 182 | ;; ------- 183 | ;; objects: 184 | ;; ------- 185 | ;; b2af4b34-d37a-4f6a-892e-36db94aa95ac - Jetty Server on port 8080 186 | ;; f0094e78-e886-4ff0-9e9d-8dd632ea66df - java.lang.Object 187 | 188 | ;; now if we stop the server, objection will first stop the dependent object. 189 | (obj/stop! [:jetty-server 8080]) 190 | ;; stopping object 191 | ;; => nil 192 | ``` 193 | 194 | ### Singletons 195 | 196 | Sometimes global singletons are not so bad if they are used carefully. 197 | For example a good candidate for a singleton is a threadpool that is local to a namespace and used to optimize functions whose api in no way needs to reflect the implementation detail of the thread pool. 198 | e.g the `go` macro in core.async 199 | 200 | Define a singleton with `defsingleton`, defsingleton does not evaluate its body, so they are safe to define in any order. 201 | 202 | Redefinition of the singleton will stop any existing instance for the singleton (and any dependent objects). 203 | 204 | ```clojure 205 | (obj/defsingleton :my-threadpool 206 | ;; the register is optional as singletons will always be registered 207 | ;; but you can use it if you want to supply a name or deps etc 208 | (obj/register 209 | (java.util.concurrent.Executors/newFixedThreadPool 4) 210 | {:name "My Threadpool" 211 | :stopfn (fn [tp] (println "Closing threadpool") (.shutdown tp))})) 212 | ``` 213 | 214 | Grab a singleton with `singleton`, at this point the singleton definition will be evaluated 215 | and a registered object will be returned. Repeatedly calling singleton with the same key will return the same object. 216 | 217 | ```clojure 218 | (obj/singleton :my-threadpool) 219 | ``` 220 | 221 | Singletons are always registered and aliased with the key of the singleton. So you can call any of the normal objection functions with the singleton key 222 | e.g 223 | ```clojure 224 | (obj/describe :my-threadpool) 225 | ;; => 226 | {:registered? true, 227 | :singleton-key :my-threadpool, 228 | :singleton-ns user, 229 | :id "adb8b07b-959d-4327-8442-722d813e17e0", 230 | :aliases #{:my-threadpool}, 231 | :deps #{}, 232 | :dependents #{}} 233 | ``` 234 | 235 | ### Data 236 | 237 | You can associate arbitrary data with an object on registry via a `:data` key. 238 | Later you can retrieve it with `obj/data`, or alter it via `alter-data!`. 239 | 240 | ```clojure 241 | (obj/register foo {:data {:fred 42}}) 242 | 243 | (obj/data foo) ;; => {:fred 42} 244 | ``` 245 | 246 | ## Todo 247 | 248 | Pull requests wecome! 249 | 250 | - Clojurescript support 251 | - tools.namespace reloaded support 252 | - More documentation, examples, usage guidelines 253 | - More introspection 254 | - Better query based on user data 255 | - Middleware (on-stop/on-start etc) 256 | - Visualization and tools for humans 257 | 258 | ## License 259 | 260 | Copyright © 2017 Riverford Organic Farmers 261 | 262 | Distributed under the Eclipse Public License either version 1.0 or (at 263 | your option) any later version. 264 | 265 | [integrant]: https://github.com/weavejester/integrant 266 | [component]: https://github.com/stuartsierra/component 267 | [mount]: https://github.com/tolitius/mount 268 | -------------------------------------------------------------------------------- /doc/guidelines.md: -------------------------------------------------------------------------------- 1 | # Usage Guidelines 2 | 3 | ## Constructors 4 | 5 | When you need to create an object, have the object be registered as part of constructor with `construct`. 6 | This may require wrapping an existing constructor function. 7 | 8 | e.g 9 | 10 | ```clojure 11 | (defn web-server 12 | [db] 13 | (let [port (util/free-port)] 14 | (obj/construct 15 | {:deps [db] 16 | :name "Web Server" 17 | :data {:db db 18 | :port port} 19 | :stopfn (fn [server] (.stop server))} 20 | (jetty/run-jetty 21 | (handler db) 22 | {:port port 23 | :join? false})))) 24 | ``` 25 | 26 | ## Singletons 27 | 28 | Singletons should be used sparingly, only when they represent something incidental that can be encapsulated well. 29 | 30 | A good example of a singleton is a single thread pool used to parallelize work, but where you may now want to expose the threadpool to callers. 31 | The core.async 'go' thread pool `clojure.core.async.impl.dispatch/executor` is an example. 32 | 33 | Another example of an incidental singleton below: 34 | 35 | ```clojure 36 | 37 | (obj/defsingleton ::executor 38 | {:reload? false} 39 | (-> (Executors/newFixedThreadPool 8) 40 | (obj/register 41 | {:name "HTTP multi-get Executor" 42 | :data {:threads 8} 43 | :stopfn (fn [executor] (.shutdown executor))}))) 44 | 45 | (defn multi-get 46 | "Returns a map of url to the result of calling http/get on the url." 47 | [urls] 48 | (let [executor (obj/singleton ::executor) 49 | futs (mapv (fn [url] (.submit executor ^Callable (fn [] (http/get url)))) url)] 50 | (zipmap urls (map deref futs)))) 51 | 52 | ``` 53 | 54 | In this example the thread pool is an internal optimization that is not exposed to nor injected 55 | by the caller. 56 | 57 | Note: a fixed threadpool is only used to demonstrate the idea, here a custom cached executor pool 58 | with niceties like thread naming, idle timeouts, bounded queue and a back-pressure providing policy like caller runs would be better 59 | for IO work like this. 60 | 61 | 62 | 63 | 64 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject riverford/objection "0.1.4-SNAPSHOT" 2 | :description "Manages global resources." 3 | :url "https://github.com/riverford/objection" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.8.0"] 7 | [com.stuartsierra/dependency "0.2.0"]] 8 | :profiles {:dev {:plugins [[lein-codox "0.10.3"]] 9 | :dependencies [[org.clojure/clojurescript "1.9.908"]] 10 | :source-paths ["scripts"] 11 | :codox {:source-uri "https://github.com/riverford/objection/blob/{version}/{filepath}#L{line}" 12 | :output-path "doc" 13 | :metadata {:doc/format :markdown}}}}) 14 | -------------------------------------------------------------------------------- /scripts/cljs_repl.clj: -------------------------------------------------------------------------------- 1 | (require '[cljs.repl :as repl] 2 | '[cljs.repl.nashorn :as nashorn]) 3 | 4 | (repl/repl (nashorn/repl-env)) -------------------------------------------------------------------------------- /src/objection/core.cljc: -------------------------------------------------------------------------------- 1 | (ns objection.core 2 | "Objection helps you manage graphs of stateful objects that acquire resources that are not 3 | managed by the garbage collector. 4 | 5 | It is good for things like, connection pools, threads, thread pools, queues, channels etc. 6 | 7 | Register objects and dependencies via `register`, `construct`. 8 | 9 | Inspect objects with `describe`, `id`, `data`, `id-seq`, `status`. 10 | 11 | Define singletons with `defsingleton` and resolve them with `singleton`." 12 | (:require [com.stuartsierra.dependency :as dep] 13 | [objection.util :as util] 14 | [clojure.string :as str]) 15 | (:refer-clojure :exclude [alias with-open]) 16 | #?(:clj 17 | (:import (java.util UUID) 18 | (java.lang AutoCloseable) 19 | (java.util.concurrent.locks ReentrantLock Lock)))) 20 | 21 | ;; Used sparingly when granular locks would be problematic, such as on depend calls. 22 | #?(:clj 23 | (defonce ^:private global-lock 24 | (Object.))) 25 | 26 | (defonce ^:private reg 27 | (atom {:g (dep/graph) 28 | :idhash {} 29 | :id (sorted-map) 30 | :meta {} 31 | :obj {} 32 | :lock {} 33 | :alias {}})) 34 | 35 | (defn- get-id 36 | [st x] 37 | (let [{:keys [id obj singletons alias]} st] 38 | (or 39 | (when (string? x) 40 | (if (contains? id x) 41 | x 42 | (let [gt (subseq id > x) 43 | kseq (->> gt seq (map key))] 44 | (when (and (seq kseq) 45 | (str/starts-with? (first kseq) x)) 46 | (if (and (next kseq) 47 | (str/starts-with? (second kseq) x)) 48 | nil 49 | (first kseq)))))) 50 | (when-some [a (alias x)] 51 | (get-id st a)) 52 | (obj (util/identity-box x))))) 53 | 54 | #?(:clj 55 | (defn- ^Lock lock-for-object 56 | [x] 57 | (let [st @reg 58 | id (get-id st x)] 59 | (-> st :lock (get id))))) 60 | 61 | (defn id 62 | "Returns the id of the object if the object is registered. 63 | 64 | You can pass the object instance, or an alias of the object." 65 | [x] 66 | (get-id @reg x)) 67 | 68 | (defn object 69 | "Returns a registered object, can pass either an id, id-prefix, alias or object instance." 70 | [x] 71 | (let [st @reg 72 | id (get-id st x)] 73 | (when (some? id) 74 | (-> st :id (get id))))) 75 | 76 | (defn- do-alias 77 | [st x name] 78 | (let [id (get-id st x)] 79 | (if (nil? id) 80 | (throw (ex-info "Not a registered object..." {:error-type :unregistered-object 81 | :op :alias})) 82 | (let [existing-id (-> st :alias (get name))] 83 | (if (or (nil? existing-id) (= id existing-id)) 84 | (-> (assoc-in st [:alias name] id) 85 | (update-in [:meta id :aliases] (fnil conj #{}) name)) 86 | (throw (ex-info "Not allowed to reuse existing alias for different object." {:error-type :alias-reuse 87 | :alias name 88 | :assigned-to existing-id 89 | :target id}))))))) 90 | 91 | (declare do-depend) 92 | 93 | (defn- do-register 94 | [st id obj opts] 95 | (let [existing-id (get-id st obj) 96 | id (or existing-id id) 97 | obj (or (-> st :id (get id)) 98 | obj)] 99 | (as-> 100 | st st 101 | (assoc-in st [:id id] obj) 102 | (assoc-in st [:obj (util/identity-box obj)] id) 103 | (assoc-in st [:alias id] id) 104 | #?(:clj (assoc-in st [:lock id] (ReentrantLock.))) 105 | (update-in st [:meta id] merge {:id id} (select-keys opts [:name :stopfn :data])) 106 | (reduce #(do-alias %1 id %2) st (if (contains? opts :alias) 107 | (cons (:alias opts) (:aliases opts)) 108 | (:aliases opts))) 109 | (reduce #(do-depend %1 id %2) st (:deps opts))))) 110 | 111 | (defprotocol IAutoStoppable 112 | "A protocol that can be extended to types in order to tell objection how to stop! them if a :stopfn is not provided 113 | on registry." 114 | (-stop! [this] "Extend to types to provide a stop behaviour for objects of that type.")) 115 | 116 | (extend-protocol IAutoStoppable 117 | nil 118 | (-stop! [this] 119 | nil) 120 | #?(:clj Object 121 | :cljs default) 122 | (-stop! [this] 123 | nil) 124 | #?@(:clj [AutoCloseable 125 | (-stop! [this] 126 | (.close this))])) 127 | 128 | (defn register 129 | "Registers the object with objection and returns it, will assign it an id automatically. 130 | 131 | An object can be practically anything, but would be expected to be something like a connection pool or a thread etc. 132 | 133 | A registered object is kept alive by objection. Stop the object using the (stop! obj) function. 134 | Almost all objection functions can use the object itself, an id, id prefix or alias. 135 | 136 | See-also: construct 137 | 138 | Opts: 139 | 140 | `:name` - a human friendly name to use for the object in display functions, doesn't have to be unique. 141 | 142 | `:aliases` - a sequence of aliases to apply to the object, each alias can be used interchangeably with the object 143 | in objection functions. 144 | 145 | `:data` - user supplied metadata about the object, retrieve later with (data obj). 146 | 147 | `:deps` - a sequence of dependencies, supports passing objection ids, aliases or registered objects. 148 | 149 | `:stopfn` - a function of the object that performs any shutdown logic. Alternatively implement IAutoStoppable 150 | for the type of the object." 151 | ([obj] (register obj {})) 152 | ([obj opts] 153 | 154 | (assert (some? obj)) 155 | (assert (not (false? obj))) 156 | 157 | (swap! reg do-register (str #?(:clj (UUID/randomUUID) 158 | :cljs (random-uuid))) obj opts) 159 | obj)) 160 | 161 | (declare singleton need) 162 | 163 | (defn construct-call 164 | [opts f] 165 | #?(:cljs 166 | (do 167 | (run! need (:deps opts)) 168 | (register (f) opts)) 169 | :clj 170 | (let [deps (:deps opts) 171 | locks (mapv (fn [dep] 172 | (or (lock-for-object dep) 173 | (throw (ex-info "Dependency is not a registered object..." {:error-type :unregistered-dependency})))) 174 | deps)] 175 | (doseq [lock locks] 176 | (.lock lock)) 177 | (try 178 | (register (f) opts) 179 | (finally 180 | (doseq [lock locks] 181 | (.unlock lock))))))) 182 | 183 | (defmacro construct 184 | "Takes same opts as `register`, takes a body that constructs an object and returns it. 185 | 186 | locks dependencies before running the body, so they cannot be stopped while 187 | this object is being constructed. 188 | 189 | See-also: register" 190 | [opts & body] 191 | `(construct-call ~opts (fn [] ~@body))) 192 | 193 | (defn alias 194 | "Aliases an object under the provided key, each alias can only be assigned to one object, so 195 | make sure it is unique. 196 | 197 | Onced aliased the alias can be used interchangably with the object in objection functions on the object." 198 | [x k] 199 | (swap! reg do-alias x k) 200 | nil) 201 | 202 | (defn alter-data! 203 | "Applies `f` to the data for the object (i.e supplied under :data key on registry/construct). 204 | Saves and returns the new data." 205 | ([x f] 206 | (let [newdata (volatile! nil)] 207 | (swap! reg (fn [st] 208 | (if-some [id (get-id st x)] 209 | (update-in st [:meta id :data] (fn [data] (vreset! newdata (f data)))) 210 | st))) 211 | @newdata)) 212 | ([x f & args] 213 | (alter-data! x #(apply f % args)))) 214 | 215 | (defn id-seq 216 | "Returns the seq of registered object ids." 217 | [] 218 | (keys (:id @reg))) 219 | 220 | (defn- do-depend 221 | [st x dependency] 222 | (if-some [id (get-id st x)] 223 | (if-some [id2 (get-id st dependency)] 224 | (update st :g dep/depend id id2) 225 | (throw (ex-info "Dependency is not a registered object..." {:error-type :unregistered-dependency}))) 226 | (throw (ex-info "Not a registered object..." {:error-type :unregistered-object 227 | :op :depend})))) 228 | 229 | (defn- do-undepend 230 | [st x dependency] 231 | (if-some [id (get-id st x)] 232 | (if-some [id2 (get-id st dependency)] 233 | (update st :g dep/remove-edge id id2) 234 | st) 235 | st)) 236 | 237 | (defn dependencies 238 | "Returns the ids of dependencies of `x`." 239 | [x] 240 | (let [st @reg] 241 | (dep/immediate-dependencies (:g st) (get-id st x)))) 242 | 243 | (defn dependents 244 | "Returns the ids of the dependents of `x`." 245 | [x] 246 | (let [st @reg] 247 | (dep/immediate-dependents (:g st) (get-id st x)))) 248 | 249 | (defn depends? 250 | "Is `x` dependent on dependency?" 251 | [x dependency] 252 | (boolean 253 | (let [st @reg] 254 | (when-some [id1 (get-id st x)] 255 | (when-some [id2 (get-id st dependency)] 256 | (dep/depends? (:g st) id1 id2)))))) 257 | 258 | (defn depend 259 | "Makes `x` dependent on `dependency`, both can be registered object instances, aliases or ids. 260 | When you `(stop! dependency)` objection will make sure that `x` is stopped first." 261 | [x dependency] 262 | #?(:cljs 263 | (if (or (not (object dependency)) 264 | (not (object x))) 265 | (throw (ex-info "Not a registered object..." {:error-type :unregistered-object 266 | :op :depend})) 267 | (if (depends? dependency x) 268 | (throw (ex-info "Dependency cycle detected" {:error-type :dependency-cycle})) 269 | (swap! reg do-depend x dependency))) 270 | :clj 271 | ;; makes sure you cannot possible cause a deadlock 272 | ;; by accident depend a -> b , depend b -> a on different threads. 273 | (locking global-lock 274 | (if-some [dep-lock (lock-for-object dependency)] 275 | (try 276 | (.lock dep-lock) 277 | (if (depends? dependency x) 278 | (throw (ex-info "Dependency cycle detected" {:error-type :dependency-cycle})) 279 | (if-some [lock (lock-for-object x)] 280 | (try 281 | (.lock lock) 282 | (swap! reg do-depend x dependency) 283 | (finally 284 | (.unlock lock))) 285 | (throw (ex-info "Not a registered object..." {:error-type :unregistered-object 286 | :op :depend})))) 287 | (finally 288 | (.unlock dep-lock))) 289 | (throw (ex-info "Dependency is not a registered object..." {:error-type :unregistered-dependency}))))) 290 | nil) 291 | 292 | (defn undepend 293 | "Removes a dependency relationship between `x` and `dependency`, both of which can be registered object instances, aliases or ids. " 294 | [x dependency] 295 | (swap! reg do-undepend x dependency) 296 | nil) 297 | 298 | (declare #?(:clj lock-for-singleton) describe) 299 | 300 | (defn stop! 301 | "Runs the stopfn of `x` or the type specific AutoStoppable impl. e.g on AutoCloseable objects .close will be called. 302 | 303 | Removes the object from the registry. 304 | 305 | If an exception is thrown when stopping the object, it will remain in the registry, use the :force? option to unregister 306 | on error." 307 | ([x] (stop! x {})) 308 | ([x opts] 309 | #?(:cljs 310 | (when x 311 | (let [err-box (volatile! nil)] 312 | (run! stop! (dependents x)) 313 | (let [st @reg 314 | id (get-id st x) 315 | stopfn (-> st :meta (get id) :stopfn) 316 | obj (-> st :id (get id))] 317 | (if (:force? true) 318 | (try 319 | (if (some? stopfn) 320 | (stopfn obj) 321 | (-stop! obj)) 322 | (catch :default e 323 | (vreset! err-box e))) 324 | (if (some? stopfn) 325 | (stopfn obj) 326 | (-stop! obj))) 327 | (swap! reg (fn [st] 328 | (if-some [id (get-id st x)] 329 | (let [obj (-> st :id (get id)) 330 | meta (-> st :meta (get id)) 331 | aliases (:aliases meta)] 332 | (as-> 333 | st st 334 | (update st :id dissoc id) 335 | (update st :obj dissoc (util/identity-box obj)) 336 | (update st :meta dissoc id) 337 | (update st :g dep/remove-all id) 338 | (reduce #(update %1 :alias dissoc %2) st (cons id aliases)))) 339 | st))) 340 | (when-some [exc @err-box] 341 | (throw exc)) 342 | nil))) 343 | :clj 344 | (when x 345 | (when-some [lock (lock-for-object x)] 346 | (try 347 | (.lock lock) 348 | (if-some [singleton-key (when-not (::singleton-locked? opts) 349 | (:singleton-key (describe x)))] 350 | (let [slock (lock-for-singleton singleton-key)] 351 | (try 352 | (.lock ^Lock slock) 353 | (stop! x (assoc opts ::singleton-locked? true)) 354 | (finally 355 | (.unlock ^Lock slock)))) 356 | (let [err-box (volatile! nil)] 357 | (run! stop! (dependents x)) 358 | (let [st @reg 359 | id (get-id st x) 360 | stopfn (-> st :meta (get id) :stopfn) 361 | obj (-> st :id (get id))] 362 | (if (:force? opts) 363 | (try 364 | (if (some? stopfn) 365 | (stopfn obj) 366 | (-stop! obj)) 367 | (catch InterruptedException e 368 | (throw e)) 369 | (catch Throwable e 370 | (vreset! err-box e))) 371 | (if (some? stopfn) 372 | (stopfn obj) 373 | (-stop! obj))) 374 | (swap! reg (fn [st] 375 | (if-some [id (get-id st x)] 376 | (let [obj (-> st :id (get id)) 377 | meta (-> st :meta (get id)) 378 | aliases (:aliases meta)] 379 | (as-> 380 | st st 381 | (update st :id dissoc id) 382 | (update st :obj dissoc (util/identity-box obj)) 383 | (update st :meta dissoc id) 384 | (update st :lock dissoc id) 385 | (update st :g dep/remove-all id) 386 | (reduce #(update %1 :alias dissoc %2) st (cons id aliases)))) 387 | st))) 388 | nil) 389 | (when-some [exc @err-box] 390 | (throw exc)))) 391 | (finally 392 | (.unlock lock)))))))) 393 | 394 | (defn stop-all! 395 | "Stops all current registered objects. 396 | Options are the same as those accepted by 'stop!'." 397 | ([] 398 | (run! stop! (id-seq))) 399 | ([opts] 400 | (run! #(stop! % opts) (id-seq)))) 401 | 402 | (defn rename! 403 | "Changes the :name of `x` to `s`. Then name is intended for display purposes only." 404 | [x s] 405 | (swap! reg (fn [st] (if-some [id (get-id st x)] 406 | (assoc-in st [:meta id :name] (str s)) 407 | st))) 408 | nil) 409 | 410 | (defonce ^:private singleton-registry (atom {})) 411 | 412 | #?(:clj 413 | (defn- lock-for-singleton 414 | [k] 415 | (-> @singleton-registry (get k) :lock))) 416 | 417 | (defn singleton 418 | "Like (object `k`) but if a singleton is registered under the key `k`, it will be constructed if necessary 419 | in order to return the instance. 420 | 421 | Singleton will always return an instance if one has been defined." 422 | [k] 423 | (or (object k) 424 | (when-some [{:keys [f lock]} (get @singleton-registry k)] 425 | #?(:clj (.lock ^Lock lock)) 426 | (try 427 | (or (object k) 428 | (let [ret (f)] 429 | ;; object may already be registered 430 | ;; but thats ok 431 | (register ret {:aliases [k]}) 432 | (alias ret k) 433 | ret)) 434 | (finally 435 | #?(:clj (.unlock ^Lock lock))))))) 436 | 437 | (defn need 438 | "Tries to resolve `x` to a registered object, or singleton - throws an exception with the message if not possible." 439 | ([x] (need x nil)) 440 | ([x error-message] 441 | (assert (some? x)) 442 | (assert (not (false? x))) 443 | (or (object x) 444 | (singleton x) 445 | #?(:clj (throw (IllegalArgumentException. (str (or error-message "Not a registered object.")))) 446 | :cljs (throw (ex-info (str (or error-message "Not a registered object.")) 447 | {:error-type :unregistered-object 448 | :op :need})))))) 449 | 450 | (defn put-singleton* 451 | [k f meta] 452 | (when (:reload? meta) 453 | (stop! k)) 454 | 455 | (swap! singleton-registry (fn [m] (assoc m k {:f f 456 | :k k 457 | :meta meta 458 | #?@(:clj [:lock (or (:lock (get m k)) 459 | (ReentrantLock.))])}))) 460 | nil) 461 | 462 | (defn singleton-keys 463 | "Returns the keys of each registered singleton." 464 | [] 465 | (keys @singleton-registry)) 466 | 467 | (defmacro defsingleton 468 | "Defines a singleton named `k` that whose constructor can be called via (singleton k), if an instance already exists, it is returned - else the body is run 469 | to construct the instance. 470 | 471 | Define a singleton and its constructor 472 | 473 | (defsingleton ::db (create-db)) 474 | 475 | Return with: 476 | 477 | (singleton ::db) 478 | 479 | Redefinition of a singleton will stop any existing instances. 480 | 481 | Singletons are always implicitly registered after construction 482 | and they also receive an alias of the key used in the definition. 483 | 484 | To introduce dependencies, stopfn, additional aliases etc, you can register or construct the object in the body 485 | of the singleton in the normal way. 486 | 487 | Options: 488 | 489 | :reload? (default true) 490 | If true will cause the singleton to restart on redefinition, otherwise a restart will require you to stop! 491 | any existing instance in order for it to restart." 492 | [k opts? & body] 493 | (let [[opts body] (if (map? opts?) 494 | [opts? body] 495 | [nil (cons opts? body)]) 496 | {:keys [reload?] :or {reload? true}} opts] 497 | `(do 498 | (put-singleton* ~k (fn [] 499 | (register 500 | (do ~@body) 501 | {:aliases [~k]})) 502 | {:reload? ~reload? 503 | :ns (quote ~(symbol (str *ns*)))})))) 504 | 505 | (defn describe 506 | "Returns information about `x`, which can be a registered object, alias or id." 507 | [x] 508 | (let [st @reg 509 | sreg @singleton-registry 510 | id (get-id st x) 511 | meta (-> st :meta (get id)) 512 | aliases (get meta :aliases) 513 | singleton-key (or (some (fn [a] (when (contains? sreg a) a)) aliases) 514 | (when (contains? sreg x) x))] 515 | (merge 516 | {:registered? (some? id)} 517 | (when singleton-key 518 | {:singleton-key singleton-key 519 | :singleton-ns (:ns (:meta (get sreg singleton-key)))}) 520 | (select-keys meta [:id :name :data :aliases]) 521 | {:deps (dep/immediate-dependencies (:g st) id) 522 | :dependents (dep/immediate-dependents (:g st) id)}))) 523 | 524 | (defn data 525 | "Returns the data associated with `x`, which can be a registered object, alias or id." 526 | [x] 527 | (let [st @reg 528 | id (get-id st x) 529 | meta (-> st :meta (get id))] 530 | (:data meta))) 531 | 532 | (defn status 533 | "Prints information about currently registered objects." 534 | [] 535 | (let [st @reg 536 | ids (sort (keys (:id st)))] 537 | (println (count ids) "objects registered.") 538 | (when (seq ids) 539 | (println "-------") 540 | (println "objects:") 541 | (println "-------") 542 | (doseq [id ids 543 | :let [meta (get (:meta st) id)]] 544 | (println id " - " (or (:name meta) 545 | (first (:aliases meta)) 546 | #?(:clj (class (get (:id st) id)) 547 | :cljs (type (get (:id st) id))))))))) 548 | 549 | (defmacro with-open 550 | "Like clojure.core/with-open but works registered objects, calling their stop functions instead of .close." 551 | [binding & body] 552 | (if (zero? (count binding)) 553 | `(do ~@body) 554 | `(let [~(nth binding 0) ~(nth binding 1)] 555 | (try 556 | (with-open ~(subvec binding 2) 557 | ~@body) 558 | (finally 559 | (stop! ~(nth binding 0))))))) 560 | 561 | (comment 562 | (defsingleton ::db 563 | (println "starting 42") 564 | (register 565 | 42 566 | {:name "Database Connection Pool" 567 | :stopfn (partial println "stopping")})) 568 | 569 | (defsingleton ::thingy 570 | (need ::db) 571 | (println "starting 64") 572 | (register 573 | 64 574 | {:stopfn (partial println "stopping") 575 | :name "A thingy" 576 | :deps [::db]})) 577 | 578 | (defn thing-that-needs-thingy 579 | [thingy] 580 | (need thingy "A registered thingy is required") 581 | 582 | 583 | (println "Starting a thing") 584 | (register #?(:cljs (random-uuid) 585 | :clj (UUID/randomUUID)) {:stopfn (partial println "stopping") :deps [thingy]}))) -------------------------------------------------------------------------------- /src/objection/util.cljc: -------------------------------------------------------------------------------- 1 | (ns objection.util 2 | #?(:clj (:import (clojure.lang IDeref)))) 3 | 4 | #?(:clj 5 | (deftype IdentityBox [x] 6 | IDeref 7 | (deref [this] x) 8 | Object 9 | (equals [this o] 10 | (and (instance? IdentityBox o) 11 | (identical? x (.-x ^IdentityBox o)))) 12 | (hashCode [this] (System/identityHashCode nil))) 13 | :cljs 14 | (deftype IdentityBox [x] 15 | IDeref 16 | (-deref [this] x) 17 | IEquiv 18 | (-equiv [this o] (and (instance? IdentityBox o) (= x (.-x o)))) 19 | IHash 20 | (-hash [this] 21 | (hash x)))) 22 | 23 | (defn identity-box 24 | [x] 25 | (->IdentityBox x)) -------------------------------------------------------------------------------- /test/objection/core_test.clj: -------------------------------------------------------------------------------- 1 | (ns objection.core-test 2 | (:require [clojure.test :refer :all] 3 | [objection.core :as obj]) 4 | (:import (java.lang AutoCloseable) 5 | (java.util UUID))) 6 | 7 | (deftest test-register 8 | (obj/stop-all!) 9 | 10 | (is (thrown? Throwable (obj/register nil))) 11 | (is (thrown? Throwable (obj/register false))) 12 | 13 | (let [o (Object.)] 14 | (is (identical? o (obj/register o)))) 15 | 16 | (let [a (obj/register (Object.) {:alias ::a}) 17 | b (obj/register (Object.) {:alias ::b 18 | :deps [a] 19 | :aliases [::foo]})] 20 | (is (identical? a (obj/object ::a))) 21 | (is (identical? b (obj/object ::b))) 22 | (is (identical? b (obj/object ::foo))) 23 | 24 | (is (obj/depends? b a)) 25 | (is (obj/depends? ::b ::a))) 26 | 27 | (obj/stop-all!)) 28 | 29 | (deftest test-id 30 | (obj/stop-all!) 31 | (is (nil? (obj/id nil))) 32 | (is (nil? (obj/id (str (UUID/randomUUID))))) 33 | (let [o (Object.)] 34 | (->> "before registry, id returns nil" 35 | (is (nil? (obj/id o)))) 36 | (obj/register o) 37 | (->> "id should be present" 38 | (is (some? (obj/id o)))) 39 | (->> "id should be a string" 40 | (is (string? (obj/id o)))) 41 | (->> "(id (id x)) just returns id" 42 | (is (= (obj/id o) 43 | (obj/id (obj/id o))))) 44 | (->> "id returned by describe and 'id' should be the same" 45 | (is (= (obj/id o) (:id (obj/describe o))))) 46 | 47 | (->> "id should be present in id seq" 48 | (is (contains? (set (obj/id-seq)) (obj/id o)))) 49 | 50 | (->> "can get id by prefix" 51 | (is (= (obj/id o) 52 | (obj/id (subs (obj/id o) 0 5))))) 53 | 54 | (let [oldid (obj/id o)] 55 | (obj/register o) 56 | (->> "reregistering does not change id" 57 | (is (= oldid (obj/id o)))) 58 | 59 | (obj/stop! o) 60 | (->> "id should be nil once an object has been stopped" 61 | (is (nil? (obj/id o)))) 62 | 63 | (->> "oldid should return nil" 64 | (is (nil? (obj/id oldid)))) 65 | 66 | (obj/register o) 67 | (->> "reregistring a stopped obj generates a new id" 68 | (is (not= oldid (obj/id o)))) 69 | (obj/stop-all!)))) 70 | 71 | (deftest test-object 72 | (obj/stop-all!) 73 | (is (nil? (obj/object nil))) 74 | (is (nil? (obj/id (str (UUID/randomUUID))))) 75 | (let [o (Object.)] 76 | (->> "before object is registered, return nil" 77 | (is (nil? (obj/object o)))) 78 | (obj/register o) 79 | (->> "object applied to object is identity" 80 | (is (identical? o (obj/object o)))) 81 | (->> "object applied to id returns the object instance." 82 | (is (identical? o (obj/object (obj/id o))))) 83 | (obj/stop! o) 84 | (->> "after object has been stopped, return nil again" 85 | (is (nil? (obj/object o))))) 86 | (obj/stop-all!)) 87 | 88 | (deftest test-alias 89 | (obj/stop-all!) 90 | (is (nil? (obj/id ::a))) 91 | (is (nil? (obj/object ::a))) 92 | 93 | (let [o (Object.)] 94 | (obj/register o) 95 | (obj/alias o ::a) 96 | 97 | (->> "alias can be used interchangeably with id in obj calls" 98 | (is (identical? o (obj/object ::a)))) 99 | (->> "alias can be used interchangeably with id in id calls" 100 | (is (= (obj/id ::a) (obj/id o)))) 101 | (->> "alias can be used interchangeably with id in describe calls" 102 | (is (= (obj/describe ::a) (obj/describe o)))) 103 | (->> "alias can be used in alter data calls" 104 | (is (= {:foo :bar} 105 | (obj/alter-data! ::a assoc :foo :bar)))) 106 | (is (= {:foo :bar} 107 | (obj/data (obj/id o)) 108 | (obj/data o) 109 | (obj/data ::a))) 110 | (->> "alias can be used interchangeably with id in data calls" 111 | (is (= (obj/data ::a) (obj/data o)))) 112 | 113 | (testing "adding a second alias" 114 | (obj/alias o ::b) 115 | (is (= {:foo :bar} 116 | (obj/data (obj/id o)) 117 | (obj/data o) 118 | (obj/data ::a) 119 | (obj/data ::b)))) 120 | 121 | (testing "realiasing same obj is fine" 122 | (is (nil? (obj/alias o ::a))) 123 | (is (nil? (obj/alias o ::b)))) 124 | 125 | (->> "testing aliases on describe" 126 | (is (= #{::a ::b} 127 | (:aliases (obj/describe o)) 128 | (:aliases (obj/describe ::a)) 129 | (:aliases (obj/describe ::b))))) 130 | 131 | (let [o2 (obj/register (Object.))] 132 | (->> 133 | "duplicating an alias throws" 134 | (is (thrown? Throwable (obj/alias o2 ::a)))))) 135 | 136 | (obj/stop-all!)) 137 | 138 | (deftest test-depend 139 | (obj/stop-all!) 140 | (is (thrown? Throwable (obj/depend nil nil))) 141 | (is (thrown? Throwable (obj/depend (Object.) nil))) 142 | (is (thrown? Throwable (obj/depend nil (Object.)))) 143 | (is (thrown? Throwable (obj/depend (Object.) (Object.)))) 144 | 145 | (let [a (Object.) 146 | b (Object.) 147 | c (Object.) 148 | d (Object.)] 149 | (obj/register a) 150 | (is (thrown? Throwable (obj/depend a b))) 151 | (obj/register b) 152 | (obj/register c) 153 | (obj/register d) 154 | 155 | (is (= #{} (obj/dependents b))) 156 | (is (= #{} (obj/dependencies a))) 157 | 158 | (is (nil? (obj/depend a b))) 159 | (is (nil? (obj/depend b c))) 160 | (is (nil? (obj/depend d c))) 161 | 162 | (->> "redepending is fine" 163 | (is (nil? (obj/depend a b)))) 164 | 165 | (->> "cycles fail" 166 | (is (thrown? Throwable (obj/depend c a)))) 167 | 168 | (is (false? (obj/depends? c a))) 169 | (is (false? (obj/depends? b a))) 170 | (is (false? (obj/depends? nil nil))) 171 | (is (false? (obj/depends? a (Object.)))) 172 | 173 | (is (obj/depends? a b)) 174 | (is (obj/depends? b c)) 175 | (is (obj/depends? a c)) 176 | (is (obj/depends? d c)) 177 | 178 | (obj/alias a ::a) 179 | (obj/alias b ::b) 180 | (obj/alias c ::c) 181 | (obj/alias d ::d) 182 | 183 | (is (obj/depends? ::a ::b)) 184 | (is (obj/depends? ::a ::c)) 185 | (is (obj/depends? ::d ::c)) 186 | 187 | (is (= (obj/dependencies ::a) 188 | (obj/dependencies a) 189 | (obj/dependencies (obj/id a)) 190 | #{(obj/id b)})) 191 | 192 | (is (= (obj/dependents ::b) 193 | (obj/dependents b) 194 | (obj/dependents (obj/id b)) 195 | #{(obj/id a)})) 196 | 197 | (obj/stop! c) 198 | (is (empty? (obj/id-seq)))) 199 | 200 | (obj/stop-all!)) 201 | 202 | (deftest test-undepend 203 | (obj/stop-all!) 204 | 205 | (is (nil? (obj/undepend nil nil))) 206 | (is (nil? (obj/undepend (Object.) nil))) 207 | (is (nil? (obj/undepend nil (Object.)))) 208 | (is (nil? (obj/undepend (Object.) (Object.)))) 209 | 210 | (let [a (obj/register (Object.)) 211 | b (obj/register (Object.)) 212 | c (obj/register (Object.))] 213 | 214 | (obj/depend a b) 215 | (obj/depend b c) 216 | 217 | (is (nil? (obj/undepend b c))) 218 | (is (false? (obj/depends? b c))) 219 | (is (false? (obj/depends? a c))) 220 | (is (obj/depends? a b)) 221 | 222 | (is (= #{} (obj/dependencies b))) 223 | 224 | (obj/stop! c) 225 | (is (= (hash-set 226 | (obj/id a) 227 | (obj/id b)) 228 | (set (obj/id-seq))))) 229 | 230 | (obj/stop-all!)) 231 | 232 | (deftest test-stop 233 | (obj/stop-all!) 234 | 235 | (let [stop-counter (atom 0) 236 | o (obj/register 237 | (Object.) 238 | {:stopfn (fn [_] (swap! stop-counter inc))}) 239 | id (obj/id o)] 240 | 241 | 242 | (is (nil? (obj/stop! o))) 243 | (is (= 1 @stop-counter)) 244 | (is (nil? (obj/stop! o))) 245 | (is (= 1 @stop-counter)) 246 | (is (nil? (obj/stop! id))) 247 | (is (= 1 @stop-counter))) 248 | 249 | (let [stop-counter (atom 0) 250 | o (obj/register 251 | (reify obj/IAutoStoppable 252 | (-stop! [this] 253 | (swap! stop-counter inc)))) 254 | id (obj/id o)] 255 | 256 | 257 | (is (nil? (obj/stop! o))) 258 | (is (= 1 @stop-counter)) 259 | (is (nil? (obj/stop! o))) 260 | (is (= 1 @stop-counter)) 261 | (is (nil? (obj/stop! id))) 262 | (is (= 1 @stop-counter))) 263 | 264 | (let [stop-counter (atom 0) 265 | o (obj/register 266 | (reify AutoCloseable 267 | (close [this] 268 | (swap! stop-counter inc)))) 269 | id (obj/id o)] 270 | 271 | 272 | (is (nil? (obj/stop! o))) 273 | (is (= 1 @stop-counter)) 274 | (is (nil? (obj/stop! o))) 275 | (is (= 1 @stop-counter)) 276 | (is (nil? (obj/stop! id))) 277 | (is (= 1 @stop-counter))) 278 | 279 | (obj/stop-all!)) 280 | 281 | (deftest test-stop-conc 282 | (obj/stop-all!) 283 | 284 | (let [stop-counter (atom 0) 285 | objects (vec (for [i (range 32)] 286 | (obj/register 287 | (Object.) 288 | {:stopfn (fn [_] 289 | (Thread/sleep (min 10 (rand-int 100))) 290 | (swap! stop-counter inc))})))] 291 | (mapv deref (for [o (concat (shuffle (vec objects)) 292 | (shuffle (vec objects)))] 293 | (future 294 | (obj/stop! o)))) 295 | 296 | (->> "each object is stopped exactly once" 297 | (is (= (count objects) @stop-counter)))) 298 | 299 | (let [stop-counter (atom 0) 300 | deps (vec (for [i (range 16)] 301 | (obj/register 302 | (Object.) 303 | {:stopfn (fn [_] 304 | (Thread/sleep (min 10 (rand-int 100))) 305 | (swap! stop-counter inc))}))) 306 | objects (vec (for [i (range 16)] 307 | (obj/register 308 | (Object.) 309 | {:deps (take 3 (shuffle deps)) 310 | :stopfn (fn [_] 311 | (Thread/sleep (min 10 (rand-int 100))) 312 | (swap! stop-counter inc))})))] 313 | 314 | (mapv deref (for [o (shuffle (concat deps objects deps))] 315 | (future 316 | (obj/stop! o)))) 317 | 318 | (->> "each object is stopped exactly once" 319 | (is (= (+ (count objects) 320 | (count deps)) @stop-counter)))) 321 | 322 | (is (empty? (obj/id-seq)))) 323 | 324 | (obj/defsingleton ::test-need-singleton 325 | (Object.)) 326 | 327 | (deftest test-need 328 | (obj/stop-all!) 329 | 330 | (is (thrown? Throwable (obj/need nil))) 331 | (is (thrown? Throwable (obj/need (Object.)))) 332 | 333 | (let [o (obj/register (Object.) {:alias ::o})] 334 | (is (identical? o (obj/need ::o))) 335 | (is (identical? o (obj/need o "foo")))) 336 | 337 | (is (identical? (obj/singleton ::test-need-singleton) 338 | (obj/need ::test-need-singleton))) 339 | 340 | (obj/stop-all!)) 341 | 342 | (obj/defsingleton ::test-singleton 343 | (Thread/sleep (min 10 (rand-int 100))) 344 | (Object.)) 345 | 346 | (deftest test-singleton 347 | (obj/stop-all!) 348 | 349 | (let [o (obj/singleton ::test-singleton)] 350 | (is (some? o)) 351 | (is (identical? o (obj/singleton ::test-singleton))) 352 | (is (identical? o (obj/need ::test-singleton))) 353 | (is (identical? o (obj/object ::test-singleton))) 354 | (is (identical? o (obj/object o))) 355 | (is (identical? (obj/id o) (obj/id ::test-singleton)))) 356 | 357 | (obj/stop! ::test-singleton) 358 | (is (nil? (obj/object ::test-singleton))) 359 | 360 | (let [res-atom (atom [])] 361 | (dotimes [x 100] 362 | (swap! res-atom conj 363 | (future 364 | (Thread/sleep (min 10 (rand-int 100))) 365 | (obj/singleton ::test-singleton)))) 366 | 367 | (->> "singleton always returns the same instance under conc construction" 368 | (is (= 1 (count (set (mapv deref @res-atom))))))) 369 | 370 | (let [res-atom (atom [])] 371 | (dotimes [x 100] 372 | (future 373 | (Thread/sleep (min 10 (rand-int 100))) 374 | (obj/stop! ::test-singleton)) 375 | (swap! res-atom conj 376 | (future 377 | (Thread/sleep (min 10 (rand-int 100))) 378 | (obj/singleton ::test-singleton)))) 379 | 380 | (->> "singleton always returns an instance" 381 | (is (every? some? (mapv deref @res-atom))))) 382 | 383 | (obj/stop-all!)) 384 | 385 | 386 | -------------------------------------------------------------------------------- /test/objection/core_test.cljs: -------------------------------------------------------------------------------- 1 | (ns objection.core-test 2 | (:require [clojure.test :refer [deftest is testing]] 3 | [objection.core :as obj :include-macros true])) 4 | 5 | (deftest test-register 6 | (obj/stop-all!) 7 | 8 | (is (thrown? :default (obj/register nil))) 9 | (is (thrown? :default (obj/register false))) 10 | 11 | (let [o (->Box nil)] 12 | (is (identical? o (obj/register o)))) 13 | 14 | (let [a (obj/register (->Box nil) {:alias ::a}) 15 | b (obj/register (->Box nil) {:alias ::b 16 | :deps [a] 17 | :aliases [::foo]})] 18 | (is (identical? a (obj/object ::a))) 19 | (is (identical? b (obj/object ::b))) 20 | (is (identical? b (obj/object ::foo))) 21 | 22 | (is (obj/depends? b a)) 23 | (is (obj/depends? ::b ::a))) 24 | 25 | (obj/stop-all!)) 26 | 27 | (deftest test-id 28 | (obj/stop-all!) 29 | (is (nil? (obj/id nil))) 30 | (is (nil? (obj/id (str (random-uuid))))) 31 | (let [o (->Box nil)] 32 | (->> "before registry, id returns nil" 33 | (is (nil? (obj/id o)))) 34 | (obj/register o) 35 | (->> "id should be present" 36 | (is (some? (obj/id o)))) 37 | (->> "id should be a string" 38 | (is (string? (obj/id o)))) 39 | (->> "(id (id x)) just returns id" 40 | (is (= (obj/id o) 41 | (obj/id (obj/id o))))) 42 | (->> "id returned by describe and 'id' should be the same" 43 | (is (= (obj/id o) (:id (obj/describe o))))) 44 | 45 | (->> "id should be present in id seq" 46 | (is (contains? (set (obj/id-seq)) (obj/id o)))) 47 | 48 | (->> "can get id by prefix" 49 | (is (= (obj/id o) 50 | (obj/id (subs (obj/id o) 0 5))))) 51 | 52 | (let [oldid (obj/id o)] 53 | (obj/register o) 54 | (->> "reregistering does not change id" 55 | (is (= oldid (obj/id o)))) 56 | 57 | (obj/stop! o) 58 | (->> "id should be nil once an object has been stopped" 59 | (is (nil? (obj/id o)))) 60 | 61 | (->> "oldid should return nil" 62 | (is (nil? (obj/id oldid)))) 63 | 64 | (obj/register o) 65 | (->> "reregistring a stopped obj generates a new id" 66 | (is (not= oldid (obj/id o)))) 67 | (obj/stop-all!)))) 68 | 69 | (deftest test-object 70 | (obj/stop-all!) 71 | (is (nil? (obj/object nil))) 72 | (is (nil? (obj/id (str (random-uuid))))) 73 | (let [o (->Box nil)] 74 | (->> "before object is registered, return nil" 75 | (is (nil? (obj/object o)))) 76 | (obj/register o) 77 | (->> "object applied to object is identity" 78 | (is (identical? o (obj/object o)))) 79 | (->> "object applied to id returns the object instance." 80 | (is (identical? o (obj/object (obj/id o))))) 81 | (obj/stop! o) 82 | (->> "after object has been stopped, return nil again" 83 | (is (nil? (obj/object o))))) 84 | (obj/stop-all!)) 85 | 86 | (deftest test-alias 87 | (obj/stop-all!) 88 | (is (nil? (obj/id ::a))) 89 | (is (nil? (obj/object ::a))) 90 | 91 | (let [o (->Box nil)] 92 | (obj/register o) 93 | (obj/alias o ::a) 94 | 95 | (->> "alias can be used interchangeably with id in obj calls" 96 | (is (identical? o (obj/object ::a)))) 97 | (->> "alias can be used interchangeably with id in id calls" 98 | (is (= (obj/id ::a) (obj/id o)))) 99 | (->> "alias can be used interchangeably with id in describe calls" 100 | (is (= (obj/describe ::a) (obj/describe o)))) 101 | (->> "alias can be used in alter data calls" 102 | (is (= {:foo :bar} 103 | (obj/alter-data! ::a assoc :foo :bar)))) 104 | (is (= {:foo :bar} 105 | (obj/data (obj/id o)) 106 | (obj/data o) 107 | (obj/data ::a))) 108 | (->> "alias can be used interchangeably with id in data calls" 109 | (is (= (obj/data ::a) (obj/data o)))) 110 | 111 | (testing "adding a second alias" 112 | (obj/alias o ::b) 113 | (is (= {:foo :bar} 114 | (obj/data (obj/id o)) 115 | (obj/data o) 116 | (obj/data ::a) 117 | (obj/data ::b)))) 118 | 119 | (testing "realiasing same obj is fine" 120 | (is (nil? (obj/alias o ::a))) 121 | (is (nil? (obj/alias o ::b)))) 122 | 123 | (->> "testing aliases on describe" 124 | (is (= #{::a ::b} 125 | (:aliases (obj/describe o)) 126 | (:aliases (obj/describe ::a)) 127 | (:aliases (obj/describe ::b))))) 128 | 129 | (let [o2 (obj/register (->Box nil))] 130 | (->> 131 | "duplicating an alias throws" 132 | (is (thrown? :default (obj/alias o2 ::a)))))) 133 | 134 | (obj/stop-all!)) 135 | 136 | (deftest test-depend 137 | (obj/stop-all!) 138 | (is (thrown? :default (obj/depend nil nil))) 139 | (is (thrown? :default (obj/depend (->Box nil) nil))) 140 | (is (thrown? :default (obj/depend nil (->Box nil)))) 141 | (is (thrown? :default (obj/depend (->Box nil) (->Box nil)))) 142 | 143 | (let [a (->Box nil) 144 | b (->Box nil) 145 | c (->Box nil) 146 | d (->Box nil)] 147 | (obj/register a) 148 | (is (thrown? :default (obj/depend a b))) 149 | (obj/register b) 150 | (obj/register c) 151 | (obj/register d) 152 | 153 | (is (= #{} (obj/dependents b))) 154 | (is (= #{} (obj/dependencies a))) 155 | 156 | (is (nil? (obj/depend a b))) 157 | (is (nil? (obj/depend b c))) 158 | (is (nil? (obj/depend d c))) 159 | 160 | (->> "redepending is fine" 161 | (is (nil? (obj/depend a b)))) 162 | 163 | (->> "cycles fail" 164 | (is (thrown? :default (obj/depend c a)))) 165 | 166 | (is (false? (obj/depends? c a))) 167 | (is (false? (obj/depends? b a))) 168 | (is (false? (obj/depends? nil nil))) 169 | (is (false? (obj/depends? a (->Box nil)))) 170 | 171 | (is (obj/depends? a b)) 172 | (is (obj/depends? b c)) 173 | (is (obj/depends? a c)) 174 | (is (obj/depends? d c)) 175 | 176 | (obj/alias a ::a) 177 | (obj/alias b ::b) 178 | (obj/alias c ::c) 179 | (obj/alias d ::d) 180 | 181 | (is (obj/depends? ::a ::b)) 182 | (is (obj/depends? ::a ::c)) 183 | (is (obj/depends? ::d ::c)) 184 | 185 | (is (= (obj/dependencies ::a) 186 | (obj/dependencies a) 187 | (obj/dependencies (obj/id a)) 188 | #{(obj/id b)})) 189 | 190 | (is (= (obj/dependents ::b) 191 | (obj/dependents b) 192 | (obj/dependents (obj/id b)) 193 | #{(obj/id a)})) 194 | 195 | (obj/stop! c) 196 | (is (empty? (obj/id-seq)))) 197 | 198 | (obj/stop-all!)) 199 | 200 | (deftest test-undepend 201 | (obj/stop-all!) 202 | 203 | (is (nil? (obj/undepend nil nil))) 204 | (is (nil? (obj/undepend (->Box nil) nil))) 205 | (is (nil? (obj/undepend nil (->Box nil)))) 206 | (is (nil? (obj/undepend (->Box nil) (->Box nil)))) 207 | 208 | (let [a (obj/register (->Box nil)) 209 | b (obj/register (->Box nil)) 210 | c (obj/register (->Box nil))] 211 | 212 | (obj/depend a b) 213 | (obj/depend b c) 214 | 215 | (is (nil? (obj/undepend b c))) 216 | (is (false? (obj/depends? b c))) 217 | (is (false? (obj/depends? a c))) 218 | (is (obj/depends? a b)) 219 | 220 | (is (= #{} (obj/dependencies b))) 221 | 222 | (obj/stop! c) 223 | (is (= (hash-set 224 | (obj/id a) 225 | (obj/id b)) 226 | (set (obj/id-seq))))) 227 | 228 | (obj/stop-all!)) 229 | 230 | (deftest test-stop 231 | (obj/stop-all!) 232 | 233 | (let [stop-counter (atom 0) 234 | o (obj/register 235 | (->Box nil) 236 | {:stopfn (fn [_] (swap! stop-counter inc))}) 237 | id (obj/id o)] 238 | 239 | 240 | (is (nil? (obj/stop! o))) 241 | (is (= 1 @stop-counter)) 242 | (is (nil? (obj/stop! o))) 243 | (is (= 1 @stop-counter)) 244 | (is (nil? (obj/stop! id))) 245 | (is (= 1 @stop-counter))) 246 | 247 | (let [stop-counter (atom 0) 248 | o (obj/register 249 | (reify obj/IAutoStoppable 250 | (-stop! [this] 251 | (swap! stop-counter inc)))) 252 | id (obj/id o)] 253 | 254 | 255 | (is (nil? (obj/stop! o))) 256 | (is (= 1 @stop-counter)) 257 | (is (nil? (obj/stop! o))) 258 | (is (= 1 @stop-counter)) 259 | (is (nil? (obj/stop! id))) 260 | (is (= 1 @stop-counter))) 261 | 262 | (obj/stop-all!)) 263 | 264 | (obj/defsingleton ::test-need-singleton 265 | (->Box nil)) 266 | 267 | (deftest test-need 268 | (obj/stop-all!) 269 | 270 | (is (thrown? :default (obj/need nil))) 271 | (is (thrown? :default (obj/need (->Box nil)))) 272 | 273 | (let [o (obj/register (->Box nil) {:alias ::o})] 274 | (is (identical? o (obj/need ::o))) 275 | (is (identical? o (obj/need o "foo")))) 276 | 277 | (is (identical? (obj/singleton ::test-need-singleton) 278 | (obj/need ::test-need-singleton))) 279 | 280 | (obj/stop-all!)) 281 | 282 | (obj/defsingleton ::test-singleton 283 | (->Box nil)) 284 | 285 | (deftest test-singleton 286 | (obj/stop-all!) 287 | 288 | (let [o (obj/singleton ::test-singleton)] 289 | (is (some? o)) 290 | (is (identical? o (obj/singleton ::test-singleton))) 291 | (is (identical? o (obj/need ::test-singleton))) 292 | (is (identical? o (obj/object ::test-singleton))) 293 | (is (identical? o (obj/object o))) 294 | (is (identical? (obj/id o) (obj/id ::test-singleton)))) 295 | 296 | (obj/stop! ::test-singleton) 297 | (is (nil? (obj/object ::test-singleton))) 298 | 299 | (obj/stop-all!)) --------------------------------------------------------------------------------