example.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Foreign.C.String
import Foreign.Ptr

import Control.Monad (forM_)
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import Text.Blaze.Html.Renderer.Pretty

import Data.IORef

foreign import javascript "((html) => document.documentElement.innerHTML = h$decodeUtf8z(html,0))"
  setInnerHtml :: CString -> IO ()

foreign import javascript "((txt) => console.log(h$decodeUtf8z(txt,0)))"
  logConsole :: CString -> IO ()

foreign import javascript "((fun) => document.body.onclick = (() => fun()))"
  setBodyOnClick :: FunPtr (IO ()) -> IO ()

foreign import ccall "wrapper" createFunPtr :: (IO ()) -> IO (FunPtr (IO ()))


numbers :: Int -> Html
numbers n = docTypeHtml $ do
  H.head $ do
    H.title "Natural numbers"
  body $ do
    p "A list of natural numbers:"
    ul $ forM_ [1 .. n] (li . toHtml)

main :: IO ()
main = do
  withCString "Hello, JS!" logConsole
  ref <- newIORef 1
  withCString (renderHtml $ numbers 1) setInnerHtml
  callback <- createFunPtr $ do
    val <- atomicModifyIORef' ref (\v -> (v+1, v+1))
    withCString (show val) logConsole
    withCString (renderHtml $ numbers val) setInnerHtml

  setBodyOnClick callback