-
Notifications
You must be signed in to change notification settings - Fork 0
/
attach.cljs
202 lines (179 loc) · 7.3 KB
/
attach.cljs
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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
(ns mayu.attach
(:require [clojure.string :as str]
[allpa.core :as a
:refer [curry defprotomethod]]
[mayu.dom :as dom]
[mayu.frp.event :as e]
[mayu.frp.signal :as s]
[mayu.mdom :as mdom]
["snabbdom" :refer [init h]]
["snabbdom/modules/attributes" :as attrs]
["snabbdom/modules/class" :as class]
["snabbdom/modules/eventlisteners" :as el]
["snabbdom/modules/style" :as style]))
(def mutable-keys [:value :checked :selected])
(defn update-mutable [prev curr]
(let [elm (aget curr "elm")
data (or (aget curr "data") #js {})
mutable (or (aget data "mutable") #js {})]
(doseq [kw-key mutable-keys]
(let [key (name kw-key)
val (aget mutable key)
mkey (str "_mayu_mutable_" key)]
(when (and val (not= val (aget elm key)))
(aset elm key val))
(when (and val (not= val (aget elm mkey)))
(aset elm mkey val))))))
(defrecord TText [s])
(defrecord TCreateElement [tag key path attrs children])
(def ^:dynamic g-render-info (atom {}))
(def on-input
#(let [target (aget %1 "target")]
(js/setTimeout
(fn []
(doseq [kw-key mutable-keys]
(let [key (name kw-key)
mkey (str "_mayu_mutable_" key)
mval (aget target mkey)
val (get target key)]
(when (and mval
(not= val mval))
(aset target key mval)))))
0)))
(defn push-el [vnode]
(let [el (aget vnode "elm")
data (or (aget vnode "data") #js{})
path (aget data "path")]
(swap! g-render-info #(assoc-in %1 [:els path] el))))
(defn push-el-mount [vnode]
(let [el (aget vnode "elm")
data (or (aget vnode "data") #js{})
path (aget data "path")]
(swap! g-render-info #(-> %1
(assoc-in [:mounted path] el)
(assoc-in [:els path] el)))))
(declare thunk)
(defprotomethod to-vdoms [tdom]
TText
(:s tdom)
TCreateElement
(let [{:keys [tag key path attrs children]} tdom
mutable (reduce #(if (contains? attrs %2)
(assoc %1 %2 (get attrs %2))
%1)
{}
mutable-keys)
fixed-attrs (reduce #(dissoc %1 %2)
(dissoc attrs :style)
mutable-keys)
fix-keys
(fn [styles]
(a/map-keys (fn [_ k]
(->> (name k)
(reduce (fn [{:keys [up? s]} c]
(cond
up? {:up? false
:s (str s (str/upper-case c))}
(= \- c) {:up? true :s s}
:else {:up? false :s (str s c)}))
{:up? false :s ""})
:s))
styles))
data (-> {:attrs fixed-attrs
:mutable mutable
:path path
:on {:input on-input}
:hook {:insert push-el-mount
:postpatch push-el}}
(#(if (nil? key) %1 (assoc %1 :key (str (hash key)))))
((fn [data]
(if (empty? (:style attrs))
data
(assoc data :style
(->> (:style attrs)
fix-keys
(a/map-values (fn [v _]
(if (map? v)
(fix-keys v)
v)))))))))]
(thunk path tag data children)))
(defn build-thunk [thunk]
(let [data (or (aget thunk "data") #js {})
[tag data children] (or (aget data "args") [])
jsdata (clj->js data)]
(aset jsdata "path" (:path data))
(h tag jsdata (clj->js (map to-vdoms children)))))
(defn copy-to-thunk [vnode thunk]
(let [thunk-data (or (aget thunk "data") #js {})
vnode-data (or (aget vnode "data") #js {})]
(aset vnode-data "args" (aget thunk-data "args"))
(aset vnode "data" vnode-data)
(aset thunk "data" (aget vnode "data"))
(aset thunk "children" (aget vnode "children"))
(aset thunk "text" (aget vnode "text"))
(aset thunk "elm" (aget vnode "elm"))))
(defn thunk-init [thunk]
(let [vnode (build-thunk thunk)]
(copy-to-thunk vnode thunk)))
(defn thunk-prepatch [prev curr]
(let [prev-data (or (aget prev "data") #js {})
curr-data (or (aget curr "data") #js {})
prev-args (or (aget prev-data "args") [])
curr-args (or (aget curr-data "args") [])
[_ _ _ path] curr-args]
(swap! g-render-info #(assoc-in %1 [:els path] (aget prev "elm")))
(copy-to-thunk (if (= prev-args curr-args) prev (build-thunk curr)) curr)))
(defn thunk [path tag data children]
(let [jsdata #js {:hook #js {:init thunk-init
:prepatch thunk-prepatch
:insert push-el-mount
:postpatch push-el}
:args [tag data children path]}]
(when (not (nil? (:key data)))
(aset jsdata "key" (:key data)))
(h tag jsdata)))
(defprotomethod to-tdoms [mdom]
!mdom/MText
[(->TText (:s mdom))]
!mdom/MCreateElement
(let [{:keys [tag key path attrs children]} mdom]
(swap! g-render-info #(assoc-in %1 [:used path] true))
[(->TCreateElement tag key path attrs (mapcat to-tdoms children))])
!mdom/MBind
(mapcat to-tdoms (s/inst! (:signal mdom)))
!mdom/MSSRAwait
(mapcat to-tdoms (:children mdom)))
(defn post-render [e-render-info render-info]
(fn []
(swap! g-render-info #(assoc %1 :els (select-keys (:els %1) (keys (:used %1)))))
(e/push! e-render-info @render-info)))
(defn attach [element env ui]
(let [attrs? (.hasAttributes element)
raw-attrs (if attrs?
(aget element "attributes")
#js[])
attrs-map (->> (range (aget raw-attrs "length"))
(reduce #(assoc %1
(aget (aget raw-attrs %2) "name")
(aget (aget raw-attrs %2) "value"))
{}))
render-info (atom {})
e-render-info (e/on! (e/Event))
a-prev (atom element)
patch (init #js [(.-default attrs)
(.-default class)
(.-default el)
#js {:create update-mutable
:update update-mutable
:post (post-render e-render-info render-info)}
(.-default style)])]
(dom/run e-render-info false env ui
#(binding [g-render-info render-info]
(swap! g-render-info (curry merge {:mounted {} :used {}}))
(let [vdom (h (aget element "tagName")
(clj->js {:attrs attrs-map})
(clj->js (->> %1
(mapcat to-tdoms)
(map to-vdoms))))]
(patch @a-prev vdom)
(reset! a-prev vdom))))))