Skip to content

Instantly share code, notes, and snippets.

@bamboo
Created June 12, 2015 15:17
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save bamboo/48cfa2fc585cf22e18a7 to your computer and use it in GitHub Desktop.
Save bamboo/48cfa2fc585cf22e18a7 to your computer and use it in GitHub Desktop.
system-composition in clojure
(ns composition.core
(:require [com.stuartsierra.dependency :as dep]))
#_(defprotocol Component ; an interesting thought
(dependencies [component])
(constructor [component configuration]))
(defn using [dependencies constructor]
{::dependencies dependencies
::constructor constructor})
(defn dependencies [component]
(::dependencies component))
(defn instantiate [component system]
(->> (::dependencies component)
(map (partial get system))
(apply (::constructor component))))
(defn dependency-graph [system-map]
(reduce-kv
(fn [g k v]
(reduce
(fn [g d] (dep/depend g k d))
g
(dependencies v)))
(dep/graph)
system-map))
(defn compose [system-map]
(->> system-map
dependency-graph
dep/topo-sort
(reduce
(fn [system component-id]
(assoc system component-id (instantiate (system-map component-id) system)))
{})))
(defmacro component [dependencies & body]
`(using ~(mapv keyword dependencies)
(fn ~dependencies (do ~@body))))
(defmacro defcomponent [name dependencies & body]
`(def ~name (component ~dependencies ~@body)))
(defn singleton [value]
(using [] (constantly value)))
(defn create-sneer-admin [network tuple-space]
{:type :admin :network network :tuple-space tuple-space})
(defcomponent tuple-space [tuple-base]
{:type :ts :tuple-base tuple-base})
(defcomponent tuple-base [db network]
{:type :tb :db db :network network})
; main
(compose {:sneer-admin (using [:network :tuple-space] create-sneer-admin)
:network (singleton :the-network)
:db (singleton :the-db)
:tuple-base tuple-base
:tuple-space tuple-space})
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment