60 lines
2.0 KiB
Clojure
60 lines
2.0 KiB
Clojure
(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)))))))
|
|
|
|
;; XXX contains references to scrapped "contract" subsys
|
|
(defn extensions
|
|
"Get extensions of `thought`.
|
|
Returns a map of {stage => #{thought}}."
|
|
[thought]
|
|
(let [stages (thought/stages thought)
|
|
aspects (map get-extensions stages)]
|
|
(zipmap stages aspects)))
|
|
|
|
(defn pop-stage
|
|
"Get aspects of next stage of thought execution.
|
|
Returns a tuple of (#{extensions},
|
|
a copy of `thought` with its first extension-stage removed)."
|
|
[thought]
|
|
(let [stages (thought/stages thought)
|
|
aspects (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)))
|