69 lines
2.2 KiB
Clojure
69 lines
2.2 KiB
Clojure
(ns emptyhead.idea.property
|
|
"Implements 'properties' - hierarchical tags for ideas."
|
|
(:require [clojure.set :as stdset]
|
|
[emptyhead.idea.protocol :as prtc]
|
|
[emptyhead.idea.state :as state]))
|
|
|
|
(defn properties
|
|
"Returns a set of all properties associated with `idea`."
|
|
[idea]
|
|
(prtc/val-fn #(get-in % [:_meta :_properties]) idea))
|
|
|
|
(defn with-property
|
|
"Returns a set of all ideas with `property`."
|
|
[property]
|
|
(get-in @state/state (concat [:_properties] property [:_node])))
|
|
|
|
;; XXX should error if multiple are found
|
|
(defn just-property
|
|
"Returns the single idea with `property`."
|
|
[property]
|
|
(first (with-property property)))
|
|
|
|
(defn has-property?
|
|
"Returns true if and only if `property` is associated with `idea`."
|
|
[idea property]
|
|
(contains? (properties idea) property))
|
|
|
|
(defn register-property!
|
|
"Associate one or more `properties` to an `idea`."
|
|
[idea & properties]
|
|
(let [property (first properties)
|
|
tail (rest properties)
|
|
iref (prtc/reference idea)]
|
|
(when property
|
|
(reduce
|
|
(fn [acc property]
|
|
(swap! state/state update-in (conj acc property :_node) (fnil conj #{}) iref)
|
|
(swap! state/state update-in [iref :_meta :_properties] (fnil conj #{}) (conj (vec (rest acc)) property))
|
|
(conj acc property))
|
|
[:_properties] property))
|
|
(when tail
|
|
(run! #(register-property! idea %) tail))
|
|
iref))
|
|
|
|
(defn- remove-property-node! [idea property]
|
|
(swap! state/state update-in
|
|
(concat [:_properties] property [:_node])
|
|
disj (prtc/reference idea))
|
|
(prtc/reference idea))
|
|
|
|
(defn- child-properties [property]
|
|
(map #(conj property %)
|
|
(-> @state/state :_properties (get-in property)
|
|
keys set (disj :_node))))
|
|
|
|
(defn- rm-prop! [idea property]
|
|
(swap! state/state update-in [idea :_meta :_properties] disj property)
|
|
(remove-property-node! idea property)
|
|
(let [children (stdset/intersection
|
|
(set (child-properties property))
|
|
(properties idea))]
|
|
(run! #(rm-prop! idea %) children)))
|
|
|
|
(defn remove-property!
|
|
"Dissociate one or more `properties` from `idea`."
|
|
[idea & properties]
|
|
(run! #(prtc/ref-fn rm-prop! idea %) properties)
|
|
(prtc/reference idea))
|