/
Prop.purs
198 lines (176 loc) · 6.26 KB
/
Prop.purs
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
module Halogen.VDom.DOM.Prop
( Prop(..)
, ElemRef(..)
, PropValue
, propFromString
, propFromBoolean
, propFromInt
, propFromNumber
, buildProp
) where
import Prelude
import Data.Function.Uncurried as Fn
import Data.Maybe (Maybe(..))
import Data.Nullable (toNullable)
import Data.Tuple (Tuple(..), fst, snd)
import Effect (Effect)
import Effect.Ref as Ref
import Effect.Uncurried as EFn
import Foreign (typeOf)
import Foreign.Object as Object
import Halogen.VDom as V
import Halogen.VDom.Types (Namespace(..))
import Halogen.VDom.Util as Util
import Unsafe.Coerce (unsafeCoerce)
import Web.DOM.Element (Element) as DOM
import Web.Event.Event (EventType(..), Event) as DOM
import Web.Event.EventTarget (eventListener) as DOM
-- | Attributes, properties, event handlers, and element lifecycles.
-- | Parameterized by the type of handlers outputs.
data Prop a
= Attribute (Maybe Namespace) String String
| Property String PropValue
| Handler DOM.EventType (DOM.Event → Maybe a)
| Ref (ElemRef DOM.Element → Maybe a)
instance functorProp ∷ Functor Prop where
map f (Handler ty g) = Handler ty (map f <$> g)
map f (Ref g) = Ref (map f <$> g)
map f p = unsafeCoerce p
data ElemRef a
= Created a
| Removed a
instance functorElemRef ∷ Functor ElemRef where
map f (Created a) = Created (f a)
map f (Removed a) = Removed (f a)
foreign import data PropValue ∷ Type
propFromString ∷ String → PropValue
propFromString = unsafeCoerce
propFromBoolean ∷ Boolean → PropValue
propFromBoolean = unsafeCoerce
propFromInt ∷ Int → PropValue
propFromInt = unsafeCoerce
propFromNumber ∷ Number → PropValue
propFromNumber = unsafeCoerce
-- | A `Machine`` for applying attributes, properties, and event handlers.
-- | An emitter effect must be provided to respond to events. For example,
-- | to allow arbitrary effects in event handlers, one could use `id`.
buildProp
∷ ∀ a
. (a → Effect Unit)
→ DOM.Element
→ V.Machine (Array (Prop a)) Unit
buildProp emit el = render
where
render = EFn.mkEffectFn1 \ps1 → do
events ← Util.newMutMap
ps1' ← EFn.runEffectFn3 Util.strMapWithIxE ps1 propToStrKey (applyProp events)
pure
(V.Step unit
(Fn.runFn2 patch (Util.unsafeFreeze events) ps1')
(done ps1'))
patch = Fn.mkFn2 \prevEvents ps1 →
EFn.mkEffectFn1 \ps2 → do
events ← Util.newMutMap
let
onThese = Fn.runFn2 diffProp prevEvents events
onThis = removeProp prevEvents
onThat = applyProp events
ps2' ← EFn.runEffectFn6 Util.diffWithKeyAndIxE ps1 ps2 propToStrKey onThese onThis onThat
pure
(V.Step unit
(Fn.runFn2 patch (Util.unsafeFreeze events) ps2')
(done ps2'))
done ps =
case Object.lookup "ref" ps of
Just (Ref f) →
EFn.runEffectFn1 mbEmit (f (Removed el))
_ →
Util.effectUnit
mbEmit = EFn.mkEffectFn1 case _ of
Just a → emit a
_ → pure unit
applyProp events = EFn.mkEffectFn3 \_ _ v →
case v of
Attribute ns attr val → do
EFn.runEffectFn4 Util.setAttribute (toNullable ns) attr val el
pure v
Property prop val → do
EFn.runEffectFn3 setProperty prop val el
pure v
Handler (DOM.EventType ty) f → do
case Fn.runFn2 Util.unsafeGetAny ty events of
handler | Fn.runFn2 Util.unsafeHasAny ty events → do
Ref.write f (snd handler)
pure v
_ → do
ref ← Ref.new f
listener ← DOM.eventListener \ev → do
f' ← Ref.read ref
EFn.runEffectFn1 mbEmit (f' ev)
EFn.runEffectFn3 Util.pokeMutMap ty (Tuple listener ref) events
EFn.runEffectFn3 Util.addEventListener ty listener el
pure v
Ref f → do
EFn.runEffectFn1 mbEmit (f (Created el))
pure v
diffProp = Fn.mkFn2 \prevEvents events → EFn.mkEffectFn4 \_ _ v1 v2 →
case v1, v2 of
Attribute _ _ val1, Attribute ns2 attr2 val2 →
if val1 == val2
then pure v2
else do
EFn.runEffectFn4 Util.setAttribute (toNullable ns2) attr2 val2 el
pure v2
Property _ val1, Property prop2 val2 →
case Fn.runFn2 Util.refEq val1 val2, prop2 of
true, _ →
pure v2
_, "value" → do
let elVal = Fn.runFn2 unsafeGetProperty "value" el
if Fn.runFn2 Util.refEq elVal val2
then pure v2
else do
EFn.runEffectFn3 setProperty prop2 val2 el
pure v2
_, _ → do
EFn.runEffectFn3 setProperty prop2 val2 el
pure v2
Handler _ _, Handler (DOM.EventType ty) f → do
let
handler = Fn.runFn2 Util.unsafeLookup ty prevEvents
Ref.write f (snd handler)
EFn.runEffectFn3 Util.pokeMutMap ty handler events
pure v2
_, _ →
pure v2
removeProp prevEvents = EFn.mkEffectFn2 \_ v →
case v of
Attribute ns attr _ →
EFn.runEffectFn3 Util.removeAttribute (toNullable ns) attr el
Property prop _ →
EFn.runEffectFn2 removeProperty prop el
Handler (DOM.EventType ty) _ → do
let
handler = Fn.runFn2 Util.unsafeLookup ty prevEvents
EFn.runEffectFn3 Util.removeEventListener ty (fst handler) el
Ref _ →
pure unit
propToStrKey ∷ ∀ i. Prop i → String
propToStrKey = case _ of
Attribute (Just (Namespace ns)) attr _ → "attr/" <> ns <> ":" <> attr
Attribute _ attr _ → "attr/:" <> attr
Property prop _ → "prop/" <> prop
Handler (DOM.EventType ty) _ → "handler/" <> ty
Ref _ → "ref"
setProperty ∷ EFn.EffectFn3 String PropValue DOM.Element Unit
setProperty = Util.unsafeSetAny
unsafeGetProperty ∷ Fn.Fn2 String DOM.Element PropValue
unsafeGetProperty = Util.unsafeGetAny
removeProperty ∷ EFn.EffectFn2 String DOM.Element Unit
removeProperty = EFn.mkEffectFn2 \key el →
case typeOf (Fn.runFn2 Util.unsafeGetAny key el) of
"string" → EFn.runEffectFn3 Util.unsafeSetAny key "" el
_ → case key of
"rowSpan" → EFn.runEffectFn3 Util.unsafeSetAny key 1 el
"colSpan" → EFn.runEffectFn3 Util.unsafeSetAny key 1 el
_ → EFn.runEffectFn3 Util.unsafeSetAny key Util.jsUndefined el