From e403bd9f9383686fb7b681532386b009f2ee853b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Thu, 27 Mar 2025 20:14:41 +0100 Subject: Generate sample interactive page --- src/Main.hs | 51 +++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 49 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Main.hs b/src/Main.hs index 65ae4a0..69276ac 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,51 @@ -module Main where +module Main (main, setup) where + +import GHC.Wasm.Prim main :: IO () -main = putStrLn "Hello, Haskell!" +main = error "unused" + +foreign export javascript setup :: IO () +setup :: IO () +setup = do + body <- js_document_getElementById (toJSString "body") + js_set_innerHTML body (toJSString "
") + + 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 -- cgit v1.2.3