Created
January 25, 2020 06:18
-
-
Save lgessler/3d9705a49813e2274b42f28a1dcb794b to your computer and use it in GitHub Desktop.
defnode macro
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defmacro defnode | |
"This macro defines a new node type. To do this, it does several things: | |
(1) Defines specs for a new node type. Specifically, it creates a new spec for: | |
- each additional attribute | |
- the entire attribute map with the built-in ::id, ::type, and ::labels keys | |
- the id-attribute vector pair used to add a node to ubergraph | |
(2) Defines a function make-name-symbol-pair (e.g. make-text-source-pair) that | |
takes an id argument and any additional arguments and returns an id-attr pair for | |
use with ubergraph. | |
`name-symbol`: a symbol that will be used for the node's type | |
`addtl-attrs`: a map from unqualified keywords to predicates" | |
[name-symbol addtl-attrs] | |
;; example: expanded call to (defnode text-source {:text string?}): | |
;; (do | |
;; (clojure.spec.alpha/def :halite.node.text-source.attrs/text string?) | |
;; (clojure.spec.alpha/def | |
;; :halite.node.text-source/attrs | |
;; (clojure.spec.alpha/keys | |
;; :req-un | |
;; [:halite.core-alt/id | |
;; :halite.core-alt/type | |
;; :halite.core-alt/labels | |
;; :halite.node.text-source.attrs/text])) | |
;; (clojure.spec.alpha/def | |
;; :halite.node/text-source | |
;; (clojure.spec.alpha/cat | |
;; :id | |
;; :halite.core-alt/id | |
;; :attrs | |
;; :halite.node.text-source/attrs)) | |
;; (clojure.core/defn | |
;; make-text-source-pair | |
;; [id text] | |
;; [id {:id id, :type :text-source, :labels {}, :text text}])) | |
;; this does a LOT of things! Throughout these comments, I'll suppose our example input is | |
;; as if we had invoked the macro this way: `(defnode text-source {:text string?})` | |
(let [node-base-namespace (str BASE_NAMESPACE ".node") ;; "halite.node" | |
node-namespace (str node-base-namespace "." name-symbol) ;; "halite.node.text-source" | |
attr-namespace (str node-namespace ".attrs") ;; "halite.node.text-source.attrs" | |
;; function for taking a keyword and namespacing it against attr-namespace | |
;; ex: `(attr-keyword :text)` => `:halite.node.text-source.attrs/text` | |
attr-keyword #(keyword attr-namespace (name %)) | |
;; a spec def for each additional attribute | |
;; ex: `(s/def :halite.node.text-source.attrs/text string?) | |
attr-defs (for [[k pred] addtl-attrs] | |
`(s/def ~(attr-keyword k) ~pred)) | |
;; namespaced versions of the additional attr keys--we'll need these to register | |
;; specs with them | |
;; ex: `'(:halite.node.text-source.attrs/text)` | |
nsed-addtl-attr-keys (->> addtl-attrs keys (map attr-keyword)) | |
;; properly namespaced spec keywords for every attribute | |
;; ex: `[::id ::type ::labels :halite.node.text-source.attrs/text]` | |
all-attr-keys (into [::id ::type ::labels] nsed-addtl-attr-keys) | |
;; args: the argument vector (of symbols) for the `make-` function | |
;; ex: `'[id text]` | |
addtl-args (->> addtl-attrs | |
keys | |
(map name) | |
(map symbol)) | |
args (into ['id] addtl-args)] | |
`(do | |
;; spec all the additional attributes using the map | |
;; (need to define attr-keyword# since attr-keyword is not available at runtime) | |
;; ex: `(s/def :halite.node.text-source.attrs/text string?)` | |
~@attr-defs | |
;; spec the attrs map containing all the attributes | |
;; ex: `(s/def | |
;; :halite.node.text-source/attrs | |
;; (s/keys :req-un [::id ::type ::labels :halite.node.text-source.attrs/text]))` | |
(s/def | |
~(keyword node-namespace "attrs") | |
(s/keys :req-un ~all-attr-keys)) | |
;; spec the [id, attrs] vector we'll use with ubergraph | |
;; ex: `(s/def | |
;; :halite.node/text-source | |
;; (s/cat :id ::id :attrs :halite.node.text-source/attrs))` | |
(s/def | |
~(keyword node-base-namespace (str name-symbol)) | |
(s/cat :id ::id | |
:attrs ~(keyword node-namespace "attrs"))) | |
(defn ~(symbol (str "make-" (str name-symbol) "-pair")) | |
~args | |
[~'id | |
~(into {:id 'id | |
:type (keyword name-symbol) | |
:labels {}} | |
(for [s addtl-args] | |
[(keyword s) s]))]) | |
))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment