Initial Commit

src/cljs/emptyhead/idea/property.cljs

@@ -0,0 +1,68 @@
+(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))