{-# LANGUAGE CPP, OverloadedStrings, PatternSynonyms #-}
#ifndef ghcjs_HOST_OS
{-# LANGUAGE RecursiveDo #-}
#endif
module JSDOM (
globalThis
, globalThisUnchecked
, currentWindow
, currentWindowUnchecked
, currentDocument
, currentDocumentUnchecked
, syncPoint
, syncAfter
, waitForAnimationFrame
, nextAnimationFrame
, AnimationFrameHandle
, inAnimationFrame
, inAnimationFrame'
, catch
, bracket
) where
#ifdef ghcjs_HOST_OS
import JSDOM.Types
(FromJSVal(..), MonadDOM, liftDOM, GlobalThis(..), Document(..), Window(..), JSM)
import Language.Javascript.JSaddle.Object (jsg)
import JavaScript.Web.AnimationFrame (AnimationFrameHandle, inAnimationFrame)
#else
import Control.Monad (void, forM_, when)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Concurrent.MVar (putMVar, takeMVar)
import Language.Javascript.JSaddle.Types (JSContextRef(..))
import Language.Javascript.JSaddle.Object (freeFunction, jsg)
import Language.Javascript.JSaddle.Monad (askJSM)
import JSDOM.Types
(Callback(..), RequestAnimationFrameCallback(..), FromJSVal(..),
MonadDOM, liftDOM, GlobalThis(..), Document(..), Window(..), JSM, JSContextRef(..))
import JSDOM.Generated.RequestAnimationFrameCallback
(newRequestAnimationFrameCallbackSync)
import JSDOM.Generated.Window (requestAnimationFrame)
#endif
import GHCJS.Concurrent (OnBlocked(..))
import Language.Javascript.JSaddle
(syncPoint, syncAfter, waitForAnimationFrame,
nextAnimationFrame, catch, bracket)
globalThis :: MonadDOM m => m (Maybe GlobalThis)
globalThis :: m (Maybe GlobalThis)
globalThis = DOM (Maybe GlobalThis) -> m (Maybe GlobalThis)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (DOM (Maybe GlobalThis) -> m (Maybe GlobalThis))
-> DOM (Maybe GlobalThis) -> m (Maybe GlobalThis)
forall a b. (a -> b) -> a -> b
$ String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg (String
"globalThis" :: String) JSM JSVal
-> (JSVal -> DOM (Maybe GlobalThis)) -> DOM (Maybe GlobalThis)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe GlobalThis)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal
globalThisUnchecked :: MonadDOM m => m GlobalThis
globalThisUnchecked :: m GlobalThis
globalThisUnchecked = DOM GlobalThis -> m GlobalThis
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (DOM GlobalThis -> m GlobalThis) -> DOM GlobalThis -> m GlobalThis
forall a b. (a -> b) -> a -> b
$ String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg (String
"globalThis" :: String) JSM JSVal -> (JSVal -> DOM GlobalThis) -> DOM GlobalThis
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM GlobalThis
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked
currentWindow :: MonadDOM m => m (Maybe Window)
currentWindow :: m (Maybe Window)
currentWindow = DOM (Maybe Window) -> m (Maybe Window)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (DOM (Maybe Window) -> m (Maybe Window))
-> DOM (Maybe Window) -> m (Maybe Window)
forall a b. (a -> b) -> a -> b
$ String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg (String
"window" :: String) JSM JSVal -> (JSVal -> DOM (Maybe Window)) -> DOM (Maybe Window)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Window)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal
currentWindowUnchecked :: MonadDOM m => m Window
currentWindowUnchecked :: m Window
currentWindowUnchecked = DOM Window -> m Window
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (DOM Window -> m Window) -> DOM Window -> m Window
forall a b. (a -> b) -> a -> b
$ String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg (String
"window" :: String) JSM JSVal -> (JSVal -> DOM Window) -> DOM Window
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Window
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked
currentDocument :: MonadDOM m => m (Maybe Document)
currentDocument :: m (Maybe Document)
currentDocument = DOM (Maybe Document) -> m (Maybe Document)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (DOM (Maybe Document) -> m (Maybe Document))
-> DOM (Maybe Document) -> m (Maybe Document)
forall a b. (a -> b) -> a -> b
$ String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg (String
"document" :: String) JSM JSVal
-> (JSVal -> DOM (Maybe Document)) -> DOM (Maybe Document)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Document)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal
currentDocumentUnchecked :: MonadDOM m => m Document
currentDocumentUnchecked :: m Document
currentDocumentUnchecked = DOM Document -> m Document
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (DOM Document -> m Document) -> DOM Document -> m Document
forall a b. (a -> b) -> a -> b
$ String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg (String
"document" :: String) JSM JSVal -> (JSVal -> DOM Document) -> DOM Document
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Document
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked
#ifndef ghcjs_HOST_OS
data AnimationFrameHandle = AnimationFrameHandle
inAnimationFrame :: OnBlocked
-> (Double -> JSM ())
-> JSM AnimationFrameHandle
inAnimationFrame :: OnBlocked -> (Double -> JSM ()) -> JSM AnimationFrameHandle
inAnimationFrame OnBlocked
_ Double -> JSM ()
f = do
MVar [Double -> JSM ()]
handlersMVar <- JSContextRef -> MVar [Double -> JSM ()]
animationFrameHandlers (JSContextRef -> MVar [Double -> JSM ()])
-> JSM JSContextRef -> JSM (MVar [Double -> JSM ()])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
[Double -> JSM ()]
handlers <- IO [Double -> JSM ()] -> JSM [Double -> JSM ()]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Double -> JSM ()] -> JSM [Double -> JSM ()])
-> IO [Double -> JSM ()] -> JSM [Double -> JSM ()]
forall a b. (a -> b) -> a -> b
$ MVar [Double -> JSM ()] -> IO [Double -> JSM ()]
forall a. MVar a -> IO a
takeMVar MVar [Double -> JSM ()]
handlersMVar
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ MVar [Double -> JSM ()] -> [Double -> JSM ()] -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar [Double -> JSM ()]
handlersMVar (Double -> JSM ()
f (Double -> JSM ()) -> [Double -> JSM ()] -> [Double -> JSM ()]
forall a. a -> [a] -> [a]
: [Double -> JSM ()]
handlers)
Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Double -> JSM ()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double -> JSM ()]
handlers) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
Window
win <- DOM Window
forall (m :: * -> *). MonadDOM m => m Window
currentWindowUnchecked
rec cb :: RequestAnimationFrameCallback
cb@(RequestAnimationFrameCallback (Callback Function
fCb)) <- (Double -> JSM ()) -> JSM RequestAnimationFrameCallback
forall (m :: * -> *).
MonadDOM m =>
(Double -> JSM ()) -> m RequestAnimationFrameCallback
newRequestAnimationFrameCallbackSync ((Double -> JSM ()) -> JSM RequestAnimationFrameCallback)
-> (Double -> JSM ()) -> JSM RequestAnimationFrameCallback
forall a b. (a -> b) -> a -> b
$ \Double
t -> do
Function -> JSM ()
freeFunction Function
fCb
[Double -> JSM ()]
handlersToRun <- IO [Double -> JSM ()] -> JSM [Double -> JSM ()]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Double -> JSM ()] -> JSM [Double -> JSM ()])
-> IO [Double -> JSM ()] -> JSM [Double -> JSM ()]
forall a b. (a -> b) -> a -> b
$ MVar [Double -> JSM ()] -> IO [Double -> JSM ()]
forall a. MVar a -> IO a
takeMVar MVar [Double -> JSM ()]
handlersMVar
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ MVar [Double -> JSM ()] -> [Double -> JSM ()] -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar [Double -> JSM ()]
handlersMVar []
[Double -> JSM ()] -> ((Double -> JSM ()) -> JSM ()) -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Double -> JSM ()] -> [Double -> JSM ()]
forall a. [a] -> [a]
reverse [Double -> JSM ()]
handlersToRun) (\Double -> JSM ()
handler -> Double -> JSM ()
handler Double
t)
JSM Int -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM Int -> JSM ()) -> JSM Int -> JSM ()
forall a b. (a -> b) -> a -> b
$ Window -> RequestAnimationFrameCallback -> JSM Int
forall (m :: * -> *).
MonadDOM m =>
Window -> RequestAnimationFrameCallback -> m Int
requestAnimationFrame Window
win RequestAnimationFrameCallback
cb
AnimationFrameHandle -> JSM AnimationFrameHandle
forall (m :: * -> *) a. Monad m => a -> m a
return AnimationFrameHandle
AnimationFrameHandle
#endif
inAnimationFrame' :: (Double -> JSM ())
-> JSM AnimationFrameHandle
inAnimationFrame' :: (Double -> JSM ()) -> JSM AnimationFrameHandle
inAnimationFrame' = OnBlocked -> (Double -> JSM ()) -> JSM AnimationFrameHandle
inAnimationFrame OnBlocked
ContinueAsync