module Language.Sunroof.Concurrent
( loop
, forkJS
, threadDelay
, yield
) where
import Language.Sunroof.Types
import Language.Sunroof.Classes ( Sunroof(..) )
import Language.Sunroof.JS.Ref ( newJSRef, readJSRef, writeJSRef, JSRef )
import Language.Sunroof.JS.Number ( JSNumber )
import Language.Sunroof.JS.Browser ( window, setTimeout )
loop :: (Sunroof a) => a -> (a -> JSB a) -> JSB ()
loop start m = do
v :: JSRef (JSContinuation ()) <- newJSRef (cast nullJS)
s <- newJSRef start
f <- continuation $ \ () -> do
a <- readJSRef s
a' <- m a
s # writeJSRef a'
f <- readJSRef v
_ <- liftJS $ window # setTimeout (\x -> goto f x) 0
return ()
v # writeJSRef f
_ <- goto f ()
return ()
forkJS :: (SunroofThread t1) => JS t1 () -> JS t2 ()
forkJS m = do
_ <- window # setTimeout (\() -> blockableJS m) 0
return ()
threadDelay :: JSNumber -> JSB ()
threadDelay n = callcc $ \ o -> do
_ <- window # setTimeout (\x -> goto o x) n
done
yield :: JSB ()
yield = threadDelay 0