-
Notifications
You must be signed in to change notification settings - Fork 0
/
IncrementalDom.purs
58 lines (52 loc) · 1.87 KB
/
IncrementalDom.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
module Text.Smolder.Renderer.IncrementalDom (render) where
import Prelude
import Control.Monad.Eff (Eff)
import DOM (DOM)
import DOM.Event.Event (Event)
import DOM.Event.EventTarget (addEventListener, dispatchEvent, eventListener)
import DOM.Event.Types (EventType(..))
import DOM.HTML.Types (HTMLElement, htmlElementToEventTarget)
import Data.Foreign (Foreign, toForeign)
import Data.StrMap (StrMap, delete, lookup, toUnfoldable)
import Data.Traversable (traverse, traverse_)
import Data.Tuple (Tuple)
import Text.Smolder.Markup (EventHandler(..), Markup)
import Text.Smolder.Renderer.Util (Node(..), renderMarkup)
import Unsafe.Coerce (unsafeCoerce)
import Web.IncrementalDOM (IDOM, elementClose, elementOpen, text)
foreign import createEvent :: String -> Foreign -> Event
renderAttributes :: StrMap String -> Array (Tuple String Foreign)
renderAttributes = map toForeign >>> toUnfoldable
attachHandler ::
forall e.
HTMLElement ->
EventHandler (Event -> Eff e Unit) ->
Eff (dom :: DOM | e ) Unit
attachHandler el (EventHandler eventName callback) =
addEventListener
(EventType eventName)
(eventListener $ unsafeCoerce callback)
false
(htmlElementToEventTarget el)
renderNode :: forall e. Node (Event -> Eff e Unit) -> Eff (idom :: IDOM | e) Unit
renderNode (Text t) = text t *> pure unit
renderNode (Element name props handlers children) = do
let
key = lookup "key" props
props' = delete "key" $ props
el <-
elementOpen name key []
(renderAttributes props')
traverse_ (unsafeCoerce <<< attachHandler el) handlers
traverse_ renderNode children
_ <- elementClose name
_ <-
unsafeCoerce $
dispatchEvent
(createEvent "render" $ toForeign {})
(htmlElementToEventTarget el)
pure unit
render :: forall e. Markup (Event -> Eff e Unit) -> Eff (idom :: IDOM | e) Unit
render markup = do
_ <- traverse renderNode $ renderMarkup markup
pure unit