ghcjs-vdom-0.2.0.0: examples/Render.hs

{-# LANGUAGE QuasiQuotes, OverloadedStrings, BangPatterns #-}

{-
  ghcjs-vdom example, demonstrating the render queue
 -}

module Main where

import           Control.Concurrent
import           Control.Monad

import           Data.IORef
import           Data.Monoid

import           GHCJS.Foreign.QQ
import           GHCJS.Types

import qualified GHCJS.VDOM.Component    as C
import qualified GHCJS.VDOM.Attribute    as A
import qualified GHCJS.VDOM.Element      as E
import qualified GHCJS.VDOM.Render       as R
import           GHCJS.VDOM

import qualified Data.JSString.Int       as JSS


-- a component with a slowed down rendering function
mkSlow :: JSString -> Int -> IO VComp
mkSlow descr delay = do
  count <- newIORef (0::Int)
  let descr' = E.text (descr <> " " <> JSS.decimal delay <> ": ")
  C.mkComponent $ do
    threadDelay delay
    c <- atomicModifyIORef count (\x -> let x' = x+1 in (x',x'))
    return $ E.div (A.class_ "slow") [descr', E.text (JSS.decimal c)]

main :: IO ()
main = do
  root <- [js| document.createElement('div') |]
  [js_| document.body.appendChild(`root); |]
  slows1 <- mapM (mkSlow "slow1") [10000, 50000, 100000, 300000]
  slows2 <- mapM (mkSlow "slow2") [10000, 50000, 100000]
  void $ mount root (E.div () (map C.toNode (slows1++slows2)))
  r1 <- R.mkRenderer
  r2 <- R.mkRenderer
  forever $ do
    mapM_ (R.render r1) slows1
    mapM_ (R.render r2) slows2
    threadDelay 10000