Initial Commit

src/cljs/emptyhead/idea/crud.cljs

@@ -0,0 +1,59 @@
+(ns emptyhead.idea.crud
+  "Functions for Creating, Updating and Deleting ideas.
+  The 'R' in 'CRUD' is implemented by [[emptyhead.idea.protocol/value]]."
+  (:require [emptyhead.idea.state :refer [state]]
+            [emptyhead.idea.property :as prop]
+            [emptyhead.idea.protocol :as prtc]))
+
+(defn- register-idea!
+  "Helper function to scaffold an 'empty' idea."
+  [ref]
+  (swap! state assoc-in [ref :_meta :_properties] #{})
+  (swap! state assoc-in [ref :_meta :_reference] ref)
+  ref)
+
+(defn swap-idea!
+  "Swap data inside `idea` with given `data`.
+  Returns a reference to `idea`."
+  [idea data]
+  (swap! state assoc
+         (prtc/reference idea)
+         (merge data {:_meta (prtc/val-fn :_meta idea)}))
+  (prtc/reference idea))
+
+(defn extend-idea!
+  "Merge `data` into state of `idea`.
+  Returns a reference to `idea`."
+  [idea data]
+  (swap! state assoc (prtc/reference idea) (prtc/val-fn merge idea data))
+  (prtc/reference idea))
+
+(defn mutate-idea!
+  "Evaluate `fun` on `idea` with optional extra `args`, then replace `idea` by the result.
+  Returns a reference to `idea`."
+  [fun idea & args]
+  (swap-idea! idea (prtc/val-fn fun idea args))
+  (prtc/reference idea))
+
+(defn forget-idea!
+  "Delete `idea` from the state.
+  Returns a copy of the `idea`."
+  [idea]
+  (let [val (prtc/value idea)]
+    (apply prop/remove-property! idea (prop/properties idea))
+    (prtc/ref-fn #(swap! state dissoc %) idea)
+    (prtc/copy val)))
+
+(defn have-idea!
+  "Instantiate up to `count` new ideas, optionally prefixing reference symbol with `prefix`.
+  Additionally allows you to immediately attach `properties` and `data`.
+  Returns a single idea or a list of ideas depending on whether `count` was given."
+  [& {:keys [prefix count properties data]
+      :or {count 1 prefix "idea_" properties []}}]
+  (let [fun #(register-idea! (gensym prefix))
+        ideas (take count (repeatedly fun))]
+    (run! #(apply prop/register-property! % properties) ideas)
+    (when data (run! #(extend-idea! % data) ideas))
+    (if (= count 1)
+      (first ideas)
+      ideas)))

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))

src/cljs/emptyhead/idea/protocol.cljs

@@ -0,0 +1,78 @@
+(ns emptyhead.idea.protocol
+  "Implements transparent conversions between the _value_ of an idea, i.e. a map containing its data,
+  and the _reference_ of an idea, i.e. a symbol that identifies it in the state;
+  i.e., state looks like {reference_1 value_1 ...}"
+  (:require [emptyhead.util.logging :as log]
+            [emptyhead.idea.state :refer [state]]))
+
+(defn- to-reference [val]
+  (let [ref (get-in val [:_meta :_reference])]
+    (cond
+      (get-in val [:_meta :_stale-reference])
+      (log/error (str "Attempt to find stale reference `" ref "` -- this is a copy.")
+                 {:value val :type :stale-reference})
+
+      (not (symbol? ref))
+      (log/error (str "Attempt to find invalid reference `" ref "` --  invalid idea?")
+                 {:value val :type :invalid-reference})
+
+      :else ref)))
+
+(defprotocol Idea
+  (reference [idea] "Reference, i.e. symbol, for `idea`.")
+  (value [idea] "Value, i.e. map, of `idea`."))
+
+(extend-protocol Idea
+  cljs.core/PersistentHashMap
+  (reference [idea] (to-reference idea))
+  (value [idea] idea)
+
+  cljs.core/PersistentArrayMap
+  (reference [idea] (to-reference idea))
+  (value [idea] idea)
+
+  Symbol
+  (reference [idea] idea)
+  (value [idea] (get @state idea)))
+
+(defn copy
+  "Make a copy of `idea`.
+  Returns an object that is identical to the value of `idea`,
+  but marked as not containing a reference to anything in the state."
+  [idea]
+  (assoc-in (value idea) [:_meta :_stale-reference] true))
+
+(defn- non-copy [idea] (assoc-in (value idea) [:_meta :_stale-reference] false))
+
+(defn uncopy!
+  "Takes a copied idea and 'uncopies' it, making its reference active again
+  and updating what is in the game state."
+  [copy-obj]
+  (let [idea (non-copy copy-obj)]
+    (swap! state assoc (to-reference idea) idea)))
+
+(defn force-reference
+  "Get the (now stale!) reference of a copied idea."
+  [copy-obj]
+  (to-reference (non-copy copy-obj)))
+
+(defn copy-fn
+  "Execute `fun` on a copy of `idea` with optional additional `args`."
+  [fun idea & args]
+  (apply fun (copy idea) args))
+
+(defn val-fn
+  "Execute `fun` on the value of `idea` with optional additional `args`."
+  [fun idea & args]
+  (apply fun (value idea) args))
+
+(defn ref-fn
+  "Execute `fun` on a reference to `idea` with optional additional `args`."
+  [fun idea & args]
+  (apply fun (reference idea) args))
+
+(defn force-reference-fn
+  "Execute `fun` on a reference to `idea` with optional additional `args`.
+  Unlike [[reference-fn]], this will work on a copy."
+  [fun idea & args]
+  (apply fun (force-reference idea) args))

src/cljs/emptyhead/idea/state.cljs

@@ -0,0 +1,16 @@
+(ns emptyhead.idea.state
+  "Implements the state object.")
+
+(def empty-state
+  {:_properties {}
+
+   :_descriptions
+   {:_properties "Property-to-idea mapping."
+    :property {}
+    :property_fns {}}})
+
+(defonce state
+  (atom empty-state))
+
+(defn reset-state! []
+  (reset! state empty-state))