diff --git a/ghcjs-dom-jsffi.cabal b/ghcjs-dom-jsffi.cabal --- a/ghcjs-dom-jsffi.cabal +++ b/ghcjs-dom-jsffi.cabal @@ -1,5 +1,5 @@ name: ghcjs-dom-jsffi -version: 0.7.0.4 +version: 0.7.1.0 cabal-version: >=1.24 build-type: Simple license: MIT diff --git a/src/GHCJS/DOM/EventM.hs b/src/GHCJS/DOM/EventM.hs --- a/src/GHCJS/DOM/EventM.hs +++ b/src/GHCJS/DOM/EventM.hs @@ -1,6 +1,12 @@ {-# LANGUAGE ConstraintKinds #-} +{- | 'EventM' provides a convenient monadic interface for handling DOM events. + +The +is exposed, as well as functions for accessing UIEvents and MouseEvents. +-} module GHCJS.DOM.EventM ( +-- $doc EventM(..) , SaferEventListener(..) , EventName @@ -11,6 +17,7 @@ , removeListener , releaseListener , on +-- * DOM Event interface , event , eventTarget , target @@ -28,6 +35,7 @@ , cancelBubble , getReturnValue , returnValue +-- * UIEvent helpers , uiView , uiDetail , uiKeyCode @@ -39,6 +47,7 @@ , uiPageY , uiPageXY , uiWhich +-- * MouseEvent helpers , mouseScreenX , mouseScreenY , mouseScreenXY @@ -78,34 +87,60 @@ import Data.Traversable (mapM) import Data.Coerce (coerce) +-- $doc +-- TODO: small tutorial w/ example function + +-- | @IO@ with the current @Event@ in scope (read with 'event'). type EventM t e = ReaderT e IO +-- | See 'eventListenerNew'. newListener :: (IsEvent e) => EventM t e () -> IO (SaferEventListener t e) newListener f = SaferEventListener <$> eventListenerNew (runReaderT f) +-- | See 'eventListenerNewSync'. newListenerSync :: (IsEvent e) => EventM t e () -> IO (SaferEventListener t e) newListenerSync f = SaferEventListener <$> eventListenerNewSync (runReaderT f) +-- | See 'eventListenerNewAsync'. newListenerAsync :: (IsEvent e) => EventM t e () -> IO (SaferEventListener t e) newListenerAsync f = SaferEventListener <$> eventListenerNewAsync (runReaderT f) +-- | Add an EventListener to an EventTarget. addListener :: (IsEventTarget t, IsEvent e) => t -> EventName t e -> SaferEventListener t e -> Bool -> IO () addListener target (EventName eventName) (SaferEventListener l) useCapture = addEventListener target eventName (Just l) useCapture +-- | Remove an EventListener from an EventTarget. removeListener :: (IsEventTarget t, IsEvent e) => t -> EventName t e -> SaferEventListener t e -> Bool -> IO () removeListener target (EventName eventName) (SaferEventListener l) useCapture = removeEventListener target eventName (Just l) useCapture +-- | Release the listener (deallocates callbacks). releaseListener :: (IsEventTarget t, IsEvent e) => SaferEventListener t e -> IO () releaseListener (SaferEventListener l) = eventListenerRelease l -on :: (IsEventTarget t, IsEvent e) => t -> EventName t e -> EventM t e () -> IO (IO ()) +-- | Shortcut for create, add and release: +-- +-- @ +-- releaseAction <- on element 'GHCJS.DOM.JSFFI.Generated.Document.click' $ do +-- Just w <- 'GHCJS.DOM.currentWindow' +-- 'GHCJS.DOM.JSFFI.Generated.Window.alert' w "I was clicked!" +-- -- remove click handler again +-- releaseAction +-- @ +on :: (IsEventTarget t, IsEvent e) + => t -- ^ target + -> EventName t e -- ^ event + -> EventM t e () -- ^ action + -> IO (IO ()) -- ^ @IO@ action that removes the listener from the element on target eventName callback = do l <- newListener callback addListener target eventName l False return (removeListener target eventName l False >> releaseListener l) +-- | 'on' for multiple targets & events. +-- +-- The returned @IO@ action removes them all at once. onThese :: (IsEventTarget t, IsEvent e) => [(t, EventName t e)] -> EventM t e () -> IO (IO ()) onThese targetsAndEventNames callback = do l <- newListener callback diff --git a/src/GHCJS/DOM/EventTargetClosures.hs b/src/GHCJS/DOM/EventTargetClosures.hs --- a/src/GHCJS/DOM/EventTargetClosures.hs +++ b/src/GHCJS/DOM/EventTargetClosures.hs @@ -1,6 +1,19 @@ {-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface #-} module GHCJS.DOM.EventTargetClosures - (EventName(..), SaferEventListener(..), unsafeEventName, eventListenerNew, eventListenerNewSync, eventListenerNewAsync, eventListenerRelease) where + ( + -- | __Note on Naming:__ 'SaferEventListener' is to 'EventListener' what + -- 'EventName' is to 'DOMString'. If @SaferEventListener@ did not have + -- a prefix we would have two types called @EventListener@. That might + -- lead to confusion. + EventName(..) + , SaferEventListener(..) + , unsafeEventName + -- * Creation and Destruction + -- | __Note:__ Don’t forget to release your event listeners, or you will leak memory. + , eventListenerNew + , eventListenerNewSync + , eventListenerNewAsync + , eventListenerRelease ) where import Control.Applicative ((<$>)) import Control.Monad ((>=>)) @@ -11,7 +24,16 @@ import GHCJS.DOM.Types import GHCJS.Foreign.Callback.Internal +-- | Plain JS 'DOMString' that carries two phantom types: +-- +-- * @t@: type of the event’s target +-- * @e@: type of the event +-- +-- Many @GHCJS.DOM@ modules export @EventName@s, for example +-- "GHCJS.DOM.JSFFI.Generated.Window". newtype EventName t e = EventName DOMString + +-- | Plain JS 'EventListener' that carries the same phantom types as 'EventName'. newtype SaferEventListener t e = SaferEventListener EventListener instance PToJSVal (SaferEventListener t e) where @@ -22,17 +44,23 @@ pFromJSVal = SaferEventListener . pFromJSVal {-# INLINE pFromJSVal #-} +-- | Forces the phantom parameters. unsafeEventName :: DOMString -> EventName t e unsafeEventName = EventName +-- | Create an EventListener that will try to run the callback synchronously, +-- but fork a thread if it takes too long to execute ('ContinueAsync'). eventListenerNew :: IsEvent event => (event -> IO ()) -> IO EventListener eventListenerNew callback = (EventListener . jsval) <$> syncCallback1 ContinueAsync (fromJSValUnchecked >=> callback) +-- | Create an sync EventListener, throw 'ThrowWouldBlock' if it takes too long. eventListenerNewSync :: IsEvent event => (event -> IO ()) -> IO EventListener eventListenerNewSync callback = (EventListener . jsval) <$> syncCallback1 ThrowWouldBlock (fromJSValUnchecked >=> callback) +-- | Create an async EventListener. eventListenerNewAsync :: IsEvent event => (event -> IO ()) -> IO EventListener eventListenerNewAsync callback = (EventListener . jsval) <$> asyncCallback1 (fromJSValUnchecked >=> callback) +-- | Release the event listener (deallocate callback). eventListenerRelease :: EventListener -> IO () eventListenerRelease (EventListener ref) = releaseCallback (Callback ref) diff --git a/src/GHCJS/DOM/JSFFI/RTCPeerConnection.hs b/src/GHCJS/DOM/JSFFI/RTCPeerConnection.hs --- a/src/GHCJS/DOM/JSFFI/RTCPeerConnection.hs +++ b/src/GHCJS/DOM/JSFFI/RTCPeerConnection.hs @@ -31,7 +31,7 @@ import GHCJS.DOM.Types import GHCJS.DOM.JSFFI.DOMError (throwDOMErrorException) -import qualified GHCJS.DOM.JSFFI.Generated.RTCPeerConnection as Generated hiding ( +import GHCJS.DOM.JSFFI.Generated.RTCPeerConnection as Generated hiding ( js_createOffer, createOffer , js_createAnswer, createAnswer , js_setLocalDescription, setLocalDescription @@ -55,12 +55,12 @@ foreign import javascript interruptible "$1[\"createAnswer\"](function(d) { $c(true, d); }, function(e) { $c(false, e); }, $2);" js_createAnswer :: - RTCPeerConnection -> Dictionary -> Dictionary -> State# RealWorld -> (# State# RealWorld, Bool, ByteArray# #) + RTCPeerConnection -> Nullable Dictionary -> State# RealWorld -> (# State# RealWorld, Bool, ByteArray# #) -- | createAnswer' :: MonadIO m => RTCPeerConnection -> Maybe Dictionary -> m (Either DOMError RTCSessionDescription) createAnswer' self answerOptions = liftIO . IO $ \s# -> - case js_createOffer self (maybeToNullable answerOptions) s# of + case js_createAnswer self (maybeToNullable answerOptions) s# of (# s2#, False, error #) -> (# s2#, Left (DOMError (JSVal error)) #) (# s2#, True, d #) -> (# s2#, Right (RTCSessionDescription (JSVal d )) #)