/
core.clj
71 lines (66 loc) · 3.69 KB
/
core.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
(ns baby-ginfer.core
(:require [baby-sepl.core :refer [baby-sepl baby-step]]
[baby-ginfer.quality-of-life :refer :all]))
;in-mem persistence (default)
(def in-mem-connector
{:load-fn (fn [cache node attribute]
(get-in cache [node attribute]))
:store-fn (fn [cache node attribute value]
(assoc-in cache [node attribute] value))})
;graph persistence side-effects
(defn get! [{:keys [connector nodes] :as state} node attribute]
((:load-fn connector) nodes node attribute))
(defn mutate! [{:keys [connector nodes] :as state} node attribute value]
(update state :nodes (:store-fn connector) node attribute value))
;generic/common graph logic
(defn resolve [state node paths f]
"Walk the graph starting at node,
execute f upon reaching the end point of each path,
and return the sequence of outcomes"
(letfn [(stepper [x path]
(when x
(if (coll? x)
(map #(getter % path) x)
(getter x path))))
(getter [n [step & steps]]
(if steps
(-> (get! state node step)
(stepper steps))
(f n step)))]
(map (partial getter node) paths)))
;graph inference algorithm declaration for baby-sepl (update->notify-eval naive loop)
(def ginfer-flows
{"update-flow" {:side-effect-action (fn get-value [state [node attribute]]
[(get-in state [:blueprints attribute :ref])
(get! state node attribute)])
:pure-action (fn update-fn [[node attribute value] [ref curr-value]]
(when (not= value curr-value)
(cond-> []
:mutate (conj (baby-step "mutate-flow" [node attribute value]))
(some? ref) (conj (baby-step "update-flow" [value ref node]))
:notify (conj (baby-step "notify-flow" [node attribute])))))}
"mutate-flow" {:side-effect-action (fn mutate [state [node attribute value]]
(mutate! state node attribute value))}
"notify-flow" {:side-effect-action (fn get-listeners [state [node attribute]]
(let [listeners (get-in state [:blueprints attribute :listeners])]
(->> (resolve state node listeners #(do [%1 %2]))
(flatten)
(filter some?)
(partition-all 2))))
:pure-action (fn notify [args listeners]
(map #(baby-step "eval-flow" %) listeners))}
"eval-flow" {:side-effect-action (fn get-sources-data [state [node attribute]]
(let [{:keys [eval-fn sources]} (get-in state [:blueprints attribute])]
[eval-fn
(resolve state node sources #(get! state %1 %2))]))
:pure-action (fn eval [[node attribute] [eval-fn sources-data]]
(let [value (apply eval-fn sources-data)]
[(baby-step "update-flow" [node attribute value])]))}})
;main api
(defn infer
([blueprints events] (infer blueprints events in-mem-connector))
([blueprints events connector]
(baby-sepl ginfer-flows
{:blueprints (deduce-listeners (expand-refs blueprints))
:connector connector}
events)))