summaryrefslogtreecommitdiff
path: root/src/Main.hs
blob: 69276ac463818bbaea0fe6f46e25947b6591999d (plain)
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
module Main (main, setup) where

import GHC.Wasm.Prim

main :: IO ()
main = error "unused"

foreign export javascript setup :: IO ()
setup :: IO ()
setup = do
    body <- js_document_getElementById (toJSString "body")
    js_set_innerHTML body (toJSString "<input id=\"some_input\" type=\"text\" value=\"xyz\" /><button id=\"some_button\">add</button></div><div><ul id=\"some_list\"></ul></div>")

    buttonElem <- js_document_getElementById (toJSString "some_button")
    buttonCallback <- asEventListener onButtonClick

    js_addEventListener buttonElem (toJSString "click") buttonCallback

onButtonClick :: JSVal -> IO ()
onButtonClick _event = do
    inputElem <- js_document_getElementById (toJSString "some_input")
    listElem <- js_document_getElementById (toJSString "some_list")

    li <- js_document_createElement (toJSString "li")
    content <- js_document_createTextNode =<< js_get_value inputElem
    js_appendChild li content
    js_appendChild listElem li

foreign import javascript unsafe "document.getElementById($1)"
    js_document_getElementById :: JSString -> IO JSVal

foreign import javascript unsafe "$1.innerHTML = $2"
    js_set_innerHTML :: JSVal -> JSString -> IO ()

foreign import javascript unsafe "$1.appendChild($2)"
    js_appendChild :: JSVal -> JSVal -> IO ()

foreign import javascript unsafe "document.createElement($1)"
    js_document_createElement :: JSString -> IO JSVal

foreign import javascript unsafe "document.createTextNode($1)"
    js_document_createTextNode :: JSString -> IO JSVal

foreign import javascript unsafe "$1.value"
    js_get_value :: JSVal -> IO JSString

foreign import javascript unsafe "$1.addEventListener($2, $3)"
    js_addEventListener :: JSVal -> JSString -> JSVal -> IO ()

foreign import javascript "wrapper"
    asEventListener :: (JSVal -> IO ()) -> IO JSVal