diff --git a/jsaddle-dom.cabal b/jsaddle-dom.cabal --- a/jsaddle-dom.cabal +++ b/jsaddle-dom.cabal @@ -1,5 +1,5 @@ name: jsaddle-dom -version: 0.9.1.0 +version: 0.9.2.0 cabal-version: >=1.22 build-type: Simple license: MIT @@ -31,7 +31,6 @@ JSDOM.Custom.Navigator JSDOM.Custom.NavigatorUserMediaError JSDOM.Custom.PositionError - JSDOM.Custom.RTCPeerConnection JSDOM.Custom.RTCPeerConnectionError JSDOM.Custom.SQLError JSDOM.Custom.SQLTransaction @@ -632,7 +631,6 @@ JSDOM.Custom.Navigator as JSDOM.Navigator, JSDOM.Custom.NavigatorUserMediaError as JSDOM.NavigatorUserMediaError, JSDOM.Custom.PositionError as JSDOM.PositionError, - JSDOM.Custom.RTCPeerConnection as JSDOM.RTCPeerConnection, JSDOM.Custom.RTCPeerConnectionError as JSDOM.RTCPeerConnectionError, JSDOM.Custom.SQLError as JSDOM.SQLError, JSDOM.Custom.SQLTransaction as JSDOM.SQLTransaction, @@ -952,6 +950,7 @@ JSDOM.Generated.RTCIceCandidate as JSDOM.RTCIceCandidate, JSDOM.Generated.RTCIceCandidateEvent as JSDOM.RTCIceCandidateEvent, JSDOM.Generated.RTCIceTransport as JSDOM.RTCIceTransport, + JSDOM.Generated.RTCPeerConnection as JSDOM.RTCPeerConnection, JSDOM.Generated.RTCPeerConnectionIceEvent as JSDOM.RTCPeerConnectionIceEvent, JSDOM.Generated.RTCRtpReceiver as JSDOM.RTCRtpReceiver, JSDOM.Generated.RTCRtpSender as JSDOM.RTCRtpSender, diff --git a/src/JSDOM.hs b/src/JSDOM.hs --- a/src/JSDOM.hs +++ b/src/JSDOM.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE OverloadedStrings, PatternSynonyms, RecursiveDo #-} +{-# LANGUAGE CPP, OverloadedStrings, PatternSynonyms #-} +#ifndef ghcjs_HOST_OS +{-# LANGUAGE RecursiveDo #-} +#endif module JSDOM ( currentWindow , currentWindowUnchecked @@ -15,13 +18,15 @@ , bracket ) where +#ifdef ghcjs_HOST_OS +import JSDOM.Types + (FromJSVal(..), MonadDOM, liftDOM, 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 GHCJS.Concurrent (OnBlocked(..)) -import Language.Javascript.JSaddle - (syncPoint, syncAfter, waitForAnimationFrame, - nextAnimationFrame, catch, bracket) import Language.Javascript.JSaddle.Types (JSContextRef(..)) import Language.Javascript.JSaddle.Object (freeFunction, jsg) import Language.Javascript.JSaddle.Monad (askJSM) @@ -31,6 +36,11 @@ 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) currentWindow :: MonadDOM m => m (Maybe Window) currentWindow = liftDOM $ jsg ("window" :: String) >>= fromJSVal @@ -44,6 +54,8 @@ currentDocumentUnchecked :: MonadDOM m => m Document currentDocumentUnchecked = liftDOM $ jsg ("document" :: String) >>= fromJSValUnchecked +#ifndef ghcjs_HOST_OS + data AnimationFrameHandle = AnimationFrameHandle {- | @@ -67,6 +79,8 @@ void $ requestAnimationFrame win cb liftIO $ putMVar handlersMVar (f : handlers) return AnimationFrameHandle + +#endif {- | Run the action in an animationframe callback. The action runs in a diff --git a/src/JSDOM/Custom/RTCPeerConnection.hs b/src/JSDOM/Custom/RTCPeerConnection.hs deleted file mode 100644 --- a/src/JSDOM/Custom/RTCPeerConnection.hs +++ /dev/null @@ -1,101 +0,0 @@ -module JSDOM.Custom.RTCPeerConnection ( - module GeneratedExport - , createOffer - , createAnswer -) where - -import Data.Maybe (fromJust) - -import Control.Concurrent.MVar (takeMVar, putMVar, newEmptyMVar) -import Control.Monad.IO.Class (MonadIO(..)) - -import JSDOM.Types - (RTCIceCandidate(..), - withCallback, Callback(..), RTCSessionDescription(..), DOMError(..), - Dictionary(..), RTCPeerConnection(..), MonadDOM, - RTCSessionDescriptionCallback(..), - RTCPeerConnectionErrorCallback(..), - RTCStatsCallback(..), VoidCallback(..), RTCOfferOptions, RTCAnswerOptions) - -import JSDOM.Custom.DOMError (throwDOMErrorException) - ---import JSDOM.Generated.RTCSessionDescriptionCallback --- (newRTCSessionDescriptionCallback) ---import JSDOM.Generated.RTCPeerConnectionErrorCallback --- (newRTCPeerConnectionErrorCallback) ---import JSDOM.Generated.VoidCallback --- (newVoidCallback) ---import JSDOM.Generated.RTCStatsCallback --- (newRTCStatsCallback) - -import JSDOM.Generated.RTCSessionDescription - (newRTCSessionDescription) -import qualified - JSDOM.Generated.RTCPeerConnection - as Generated - (createAnswer, createOffer) -import JSDOM.Generated.RTCPeerConnection - as GeneratedExport hiding - (createAnswer, createOffer) - ----- | ---createOffer' :: MonadDOM m => RTCPeerConnection -> Maybe Dictionary -> m (Either DOMError RTCSessionDescription) ---createOffer' self offerOptions = do --- result <- liftIO newEmptyMVar --- withCallback (newRTCSessionDescriptionCallback (liftIO . putMVar result . Right . fromJust)) $ \success -> --- withCallback (newRTCPeerConnectionErrorCallback (liftIO . putMVar result . Left . fromJust)) $ \error -> do --- Generated.createOffer self (Just success) (Just error) offerOptions --- liftIO $ takeMVar result - -createOffer :: MonadDOM m => RTCPeerConnection -> Maybe RTCOfferOptions -> m RTCSessionDescription -createOffer self offerOptions = Generated.createOffer self offerOptions >>= newRTCSessionDescription - ----- | ---createAnswer' :: MonadDOM m => RTCPeerConnection -> Maybe Dictionary -> m (Either DOMError RTCSessionDescription) ---createAnswer' self answerOptions = do --- result <- liftIO newEmptyMVar --- withCallback (newRTCSessionDescriptionCallback (liftIO . putMVar result . Right . fromJust)) $ \success -> --- withCallback (newRTCPeerConnectionErrorCallback (liftIO . putMVar result . Left . fromJust)) $ \error -> do --- Generated.createAnswer self (Just success) (Just error) answerOptions --- liftIO $ takeMVar result - -createAnswer :: MonadDOM m => RTCPeerConnection -> Maybe RTCAnswerOptions -> m RTCSessionDescription -createAnswer self answerOptions = Generated.createAnswer self answerOptions >>= newRTCSessionDescription - ----- | ---setLocalDescription' :: MonadDOM m => RTCPeerConnection -> RTCSessionDescription -> m (Maybe DOMError) ---setLocalDescription' self description = do --- result <- liftIO newEmptyMVar --- withCallback (newVoidCallback (liftIO $ putMVar result Nothing)) $ \success -> --- withCallback (newRTCPeerConnectionErrorCallback (liftIO . putMVar result)) $ \error -> do --- Generated.setLocalDescription self (Just description) (Just success) (Just error) --- liftIO $ takeMVar result --- ---setLocalDescription :: MonadDOM m => RTCPeerConnection -> RTCSessionDescription -> m () ---setLocalDescription self description = setLocalDescription' self description >>= maybe (return ()) throwDOMErrorException --- ----- | ---setRemoteDescription' :: MonadDOM m => RTCPeerConnection -> RTCSessionDescription -> m (Maybe DOMError) ---setRemoteDescription' self description = do --- result <- liftIO newEmptyMVar --- withCallback (newVoidCallback (liftIO $ putMVar result Nothing)) $ \success -> --- withCallback (newRTCPeerConnectionErrorCallback (liftIO . putMVar result)) $ \error -> do --- Generated.setRemoteDescription self (Just description) (Just success) (Just error) --- liftIO $ takeMVar result --- ---setRemoteDescription :: MonadDOM m => RTCPeerConnection -> RTCSessionDescription -> m () ---setRemoteDescription self description = setRemoteDescription' self description >>= maybe (return ()) throwDOMErrorException --- ----- | ---addIceCandidate' :: MonadDOM m => RTCPeerConnection -> RTCIceCandidate -> m (Maybe DOMError) ---addIceCandidate' self candidate = do --- result <- liftIO newEmptyMVar --- withCallback (newVoidCallback (liftIO $ putMVar result Nothing)) $ \success -> --- withCallback (newRTCPeerConnectionErrorCallback (liftIO . putMVar result)) $ \error -> do --- Generated.addIceCandidate self (Just candidate) (Just success) (Just error) --- liftIO $ takeMVar result --- ---addIceCandidate :: MonadDOM m => RTCPeerConnection -> RTCIceCandidate -> m () ---addIceCandidate self candidate = addIceCandidate' self candidate >>= maybe (return ()) throwDOMErrorException --- - diff --git a/src/JSDOM/Types.hs b/src/JSDOM/Types.hs --- a/src/JSDOM/Types.hs +++ b/src/JSDOM/Types.hs @@ -52,7 +52,7 @@ , Function(Function), unFunction, IsFunction, toFunction, noFunction -- * Promise - , readPromise + , PromiseRejected(..), noPromiseRejected, readPromise -- * Callbacks , Callback(..)