pair programming

src/cljs/emptyhead/thought/extend.cljs

@@ -0,0 +1,61 @@
+(ns emptyhead.thought.extend
+  (:require [emptyhead.contract.eval :as contract]
+            [emptyhead.idea.property :as prop]
+            [emptyhead.idea.protocol :as prtc]
+            [emptyhead.thought.crud :as thought]
+            [emptyhead.util.magic :as magic]
+            [clojure.set :refer [union]]))
+
+(defn register-extension
+  "Register `thought` as extension for one or more `stages`."
+  [thought & stages]
+  (doseq [stage stages]
+    (prop/register-property! thought (magic/extension-prop stage)))
+  thought)
+
+(defn remove-extension!
+  "Remove `thought` as extension for one or more `stages`."
+  [thought & stages]
+  (doseq [stage stages]
+    (prop/remove-property! thought (magic/extension-prop stage)))
+  thought)
+
+(defn- get-extensions
+  "Get extensions for `stage`;
+  e.g. for `stage` of [:foo :bar :baz], get extensions for [:foo :bar :baz], [:foo :bar], [:foo]"
+  [stage]
+  (loop [property-segment stage
+         acc []]
+    (if (empty? property-segment)
+      acc
+      (recur (butlast property-segment)
+             (union acc (prop/with-property (magic/extension-prop property-segment)))))))
+
+(defn extensions
+  "Get extensions of `thought`.
+  Returns a map of {stage => #{thought}}."
+  [thought]
+  (let [stages (thought/stages thought)
+        filter-fn #(contract/evaluate (thought/contract thought) %)
+        aspects (map
+                 #(->> % get-extensions (filter filter-fn))
+                 stages)]
+    (zipmap stages aspects)))
+
+(defn pop-stage
+  "Get aspects of next stage of thought execution.
+  Returns a tuple of (#{extension-dhammas},
+  a copy of `thought` with its first extension-stage removed)."
+  [thought]
+  (let [stages (thought/stages thought)
+        aspects (filter #(contract/evaluate (thought/contract thought) %)
+                        (get-extensions (first stages)))
+        modified (prtc/copy-fn #(assoc % :ext-stages (rest stages))
+                          thought)]
+    (list aspects modified)))
+
+(defn has-stage?
+  "Return true if `thought` has extension stage `stage`.
+  Also works if e.g. `stage` is [:foo] and `thought` has [:foo :bar]."
+  [thought stage]
+  (some #(= stage (take (count stage) %)) (thought/stages thought)))