Skip to content

next-id #20

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

Merged
darkleaf merged 4 commits into from
Oct 23, 2024
Merged

next-id #20

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
e297853
wip
darkleaf Oct 22, 2024
cba5eaf
wip2
darkleaf Oct 23, 2024
fbdef3f
atomicinteger -> atom+inc
darkleaf Oct 23, 2024
fe7d8de
wip
darkleaf Oct 23, 2024
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
237 changes: 125 additions & 112 deletions src/darkleaf/di/core.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,9 @@
(defn- seq-contains? [xs x]
(not (neg? (index-of xs x))))

(defn ^:dynamic *next-id* []
(throw (IllegalStateException. "Attempting to call unbound `di/*next-id*`")))

(def ^:private dependency-type-priority
{:required 1
:optional 2})
Expand Down Expand Up @@ -120,8 +123,9 @@
built-map))

:else
(let [obj (build-obj built-map factory)]
(vswap! *stop-list conj #(p/demolish factory obj))
(let [obj (build-obj built-map factory)
stop (bound-fn* #(p/demolish factory obj))]
(vswap! *stop-list conj stop)
(case [obj dep-type]
[nil :optional] (recur tail built-map)
[nil :required] (missing-dependency! stack)
Expand Down Expand Up @@ -205,6 +209,11 @@
(map? key) [::implicit-root {::implicit-root (-> key (update-vals ref) template)}]
true [key nil]))

(defn- ->next-id []
(let [id (atom -1)]
(fn next-id []
(swap! id inc))))

(defn ^AutoCloseable start
"Starts a system of dependent objects.

Expand Down Expand Up @@ -255,86 +264,90 @@
See the tests for use cases.
See `update-key`."
[key & middlewares]
(let [[key root-registry] (key->key&registry key)

middlewares (concat [with-env with-ns root-registry] middlewares)
registry (apply-middleware nil-registry middlewares)
ctx {:registry registry
:*stop-list (volatile! '())}
obj (try-build ctx key)]
^{:type ::root
::print obj}
(reify
AutoCloseable
(close [_]
(->> (try-stop-started ctx)
(throw-many!)))
IDeref
(deref [_]
obj)
Indexed
(nth [_ i]
(nth obj i))
(nth [_ i not-found]
(nth obj i not-found))
(count [_]
(count obj))
ILookup
(valAt [_ key]
(get obj key))
(valAt [_ key not-found]
(get obj key not-found))
IFn
(call [_]
(.call ^IFn obj))
(run [_]
(.run ^IFn obj))
(invoke [this]
(.invoke ^IFn obj))
(invoke [_ a1]
(.invoke ^IFn obj a1))
(invoke [_ a1 a2]
(.invoke ^IFn obj a1 a2))
(invoke [_ a1 a2 a3]
(.invoke ^IFn obj a1 a2 a3))
(invoke [_ a1 a2 a3 a4]
(.invoke ^IFn obj a1 a2 a3 a4))
(invoke [_ a1 a2 a3 a4 a5]
(.invoke ^IFn obj a1 a2 a3 a4 a5))
(invoke [_ a1 a2 a3 a4 a5 a6]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6))
(invoke [_ a1 a2 a3 a4 a5 a6 a7]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 args]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 args))
(applyTo [_ args]
(.applyTo ^IFn obj args)))))
(binding [*next-id* (->next-id)]
(let [[key root-registry] (key->key&registry key)

middlewares (concat [with-env
with-ns
root-registry]
middlewares)
registry (apply-middleware nil-registry middlewares)
ctx {:registry registry
:*stop-list (volatile! '())}
obj (try-build ctx key)]
^{:type ::root
::print obj}
(reify
AutoCloseable
(close [_]
(->> (try-stop-started ctx)
(throw-many!)))
IDeref
(deref [_]
obj)
Indexed
(nth [_ i]
(nth obj i))
(nth [_ i not-found]
(nth obj i not-found))
(count [_]
(count obj))
ILookup
(valAt [_ key]
(get obj key))
(valAt [_ key not-found]
(get obj key not-found))
IFn
(call [_]
(.call ^IFn obj))
(run [_]
(.run ^IFn obj))
(invoke [this]
(.invoke ^IFn obj))
(invoke [_ a1]
(.invoke ^IFn obj a1))
(invoke [_ a1 a2]
(.invoke ^IFn obj a1 a2))
(invoke [_ a1 a2 a3]
(.invoke ^IFn obj a1 a2 a3))
(invoke [_ a1 a2 a3 a4]
(.invoke ^IFn obj a1 a2 a3 a4))
(invoke [_ a1 a2 a3 a4 a5]
(.invoke ^IFn obj a1 a2 a3 a4 a5))
(invoke [_ a1 a2 a3 a4 a5 a6]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6))
(invoke [_ a1 a2 a3 a4 a5 a6 a7]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20))
(invoke [_ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 args]
(.invoke ^IFn obj a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 args))
(applyTo [_ args]
(.applyTo ^IFn obj args))))))

(defn stop
"Stops the root of a system"
Expand Down Expand Up @@ -493,24 +506,24 @@
See `start`, `derive`."
[target f & args]
{:pre [(key? target)]}
(let [prefix (gensym (str (symbol target) "+di-update-key#"))
new-key (symbol (str prefix "-target"))
f-key (symbol (str prefix "-f"))
arg-keys (for [i (-> args count range)]
(symbol (str prefix "-arg#" i)))
new-factory (reify p/Factory
(dependencies [_]
(zipmap (concat [new-key f-key] arg-keys)
(repeat :optional)))
(build [_ deps]
(let [t (deps new-key)
f (deps f-key)
args (map deps arg-keys)]
(apply f t args)))
(demolish [_ _]))
own-registry (zipmap (cons f-key arg-keys)
(cons f args))]
(fn [registry]
(fn [registry]
(let [prefix (str (symbol target) "+di-update-key#" (*next-id*))
new-key (symbol (str prefix "-target"))
f-key (symbol (str prefix "-f"))
arg-keys (for [i (-> args count range)]
(symbol (str prefix "-arg#" i)))
new-factory (reify p/Factory
(dependencies [_]
(zipmap (concat [new-key f-key] arg-keys)
(repeat :optional)))
(build [_ deps]
(let [t (deps new-key)
f (deps f-key)
args (map deps arg-keys)]
(apply f t args)))
(demolish [_ _]))
own-registry (zipmap (cons f-key arg-keys)
(cons f args))]
(fn [key]
(cond
(= new-key key)
Expand All @@ -536,18 +549,18 @@
(di/start ::root (di/add-side-dependency `flyway))
```"
[dep-key]
(let [*orig-key (volatile! nil)
*orig-factory (volatile! nil)
new-key (gensym "darkleaf.di.core/new-key#")
new-factory (reify p/Factory
(dependencies [_]
;; array-map preserves order of keys
{new-key :required
dep-key :required})
(build [_ deps]
(new-key deps))
(demolish [_ _]))]
(fn [registry]
(fn [registry]
(let [*orig-key (volatile! nil)
*orig-factory (volatile! nil)
new-key (symbol (str "darkleaf.di.generated/new-key#" (*next-id*)))
new-factory (reify p/Factory
(dependencies [_]
;; array-map preserves order of keys
{new-key :required
dep-key :required})
(build [_ deps]
(new-key deps))
(demolish [_ _]))]
(fn [key]
(when (nil? @*orig-key)
(vreset! *orig-key key))
Expand Down
14 changes: 14 additions & 0 deletions test/darkleaf/di/next_id_test.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
(ns darkleaf.di.next-id-test
(:require
[clojure.test :as t]
[darkleaf.di.core :as di]))

(defn a
{::di/stop #(swap! % assoc :stop-id (di/*next-id*))}
[]
(atom {:start-id (di/*next-id*)}))

(t/deftest a-test
(let [root (di/start `a)]
(di/stop root)
(t/is (= {:start-id 0 :stop-id 1} @@root))))