ghcjs-dom-jsffi 0.7.0.4 → 0.7.1.0
raw patch · 4 files changed
+69/−6 lines, 4 files
Files
- ghcjs-dom-jsffi.cabal +1/−1
- src/GHCJS/DOM/EventM.hs +36/−1
- src/GHCJS/DOM/EventTargetClosures.hs +29/−1
- src/GHCJS/DOM/JSFFI/RTCPeerConnection.hs +3/−3
ghcjs-dom-jsffi.cabal view
@@ -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
src/GHCJS/DOM/EventM.hs view
@@ -1,6 +1,12 @@ {-# LANGUAGE ConstraintKinds #-}+{- | 'EventM' provides a convenient monadic interface for handling DOM events.++The <https://developer.mozilla.org/en-US/docs/Web/API/Event DOM Event interface>+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
src/GHCJS/DOM/EventTargetClosures.hs view
@@ -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)
src/GHCJS/DOM/JSFFI/RTCPeerConnection.hs view
@@ -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# #) -- | <https://developer.mozilla.org/en-US/docs/Web/API/RTCPeerConnection#createAnswer Mozilla webkitRTCPeerConnection.createAnswer documentation> 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 )) #)