73 lines
2.3 KiB
Clojure
73 lines
2.3 KiB
Clojure
(ns emptyhead.thought.crud
|
|
"Implements CRUD operations on thoughts.
|
|
Since thoughts are ideas, 'missing' operations here are implemented in [[emptyhead.idea.crud]]."
|
|
(:require [emptyhead.idea.protocol :as prtc]
|
|
[emptyhead.idea.crud :as idea]
|
|
[emptyhead.idea.property :as prop]
|
|
[emptyhead.contract.eval :as contract]
|
|
[emptyhead.util.magic :as magic]))
|
|
|
|
;; TODO groups
|
|
(defn make-thought
|
|
"Helper function to make thought object.
|
|
You may want `register-thought!` instead."
|
|
[operator & {:keys [data ext-contract ext-stages transient]
|
|
:or {data {} ext-contract {}
|
|
ext-stages [[:thought operator :pre] [:thought operator]
|
|
[:PRE-EXECUTE] [:EXECUTE] [:POST-EXECUTE]
|
|
[:thought operator :post]]
|
|
transient true}}]
|
|
(hash-map :operator operator
|
|
:data data
|
|
:ext-contract ext-contract
|
|
:ext-stages ext-stages
|
|
:return []
|
|
:transient (not (false? transient))))
|
|
|
|
(defn register-thought!
|
|
"Create a thought and register it in the state.
|
|
Returns a reference to the created thought."
|
|
[operator & {:keys [data ext-contract ext-stages transient group]
|
|
:as args}]
|
|
(idea/have-idea!
|
|
:prefix (str "emptyhead.thought#" (magic/symbolize-ns operator))
|
|
:properties [magic/thought-ns]
|
|
:data (make-thought operator args)))
|
|
|
|
(defn contract
|
|
"Get the extension contract of a `thought`.
|
|
Returns the contract."
|
|
[thought]
|
|
(prtc/val-fn :ext-contract thought))
|
|
|
|
(defn stages
|
|
"Get the extension stages of a `thought`.
|
|
Returns the list of stages."
|
|
[thought]
|
|
(prtc/val-fn :ext-stages thought))
|
|
|
|
(defn operator
|
|
"Get the operator id of a `thought`.
|
|
Returns the operator keyword."
|
|
[thought]
|
|
(prtc/val-fn :operator thought))
|
|
|
|
(defn data
|
|
"Get the data field of a `thought`."
|
|
[thought]
|
|
(prtc/val-fn :data thought))
|
|
|
|
(defn stack
|
|
[thought]
|
|
(prtc/val-fn :return thought))
|
|
|
|
(defn pop-stack
|
|
[thought]
|
|
[(assoc thought :return (-> thought prtc/copy stack butlast vec)) (-> thought prtc/copy stack peek)])
|
|
|
|
(def root-thought (make-thought :root))
|
|
|
|
(defn add-ext-stage!
|
|
[thought stage]
|
|
(idea/mutate-idea! #(update % :ext-stages conj stage) thought))
|