{-# 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

{- |
     Run the action in an animationframe callback. The action runs in a
     synchronous thread, and is passed the high-performance clock time
     stamp for that frame.
 -}
inAnimationFrame :: OnBlocked       -- ^ what to do when encountering a blocking call
                 -> (Double -> JSM ())  -- ^ the action to run
                 -> 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
    -- Take the list of pending animation fram handlers
    [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
    -- Add this handler to the list to be run by the callback
    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)
    -- If this was the first handler added set up a callback
    -- to run the handlers in the next animation frame.
    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
              -- This is a one off handler so free it when it runs
              Function -> JSM ()
freeFunction Function
fCb
              -- Take the list of handers and empty it
              [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 []
              -- Exectute handlers in the order 
              [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)
        -- Add the callback function
        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

{- |
     Run the action in an animationframe callback. The action runs in a
     synchronous thread, and is passed the high-performance clock time
     stamp for that frame.  On GHCJS this version will continue
     asynchronously if it is not possible to complete the callback
     synchronously.
 -}
inAnimationFrame' :: (Double -> JSM ())  -- ^ the action to run
                 -> JSM AnimationFrameHandle
inAnimationFrame' :: (Double -> JSM ()) -> JSM AnimationFrameHandle
inAnimationFrame' = OnBlocked -> (Double -> JSM ()) -> JSM AnimationFrameHandle
inAnimationFrame OnBlocked
ContinueAsync