{-# 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
, newListener
, newListenerSync
, newListenerAsync
, addListener
, removeListener
, releaseListener
, on
, onSync
, onAsync
, onTheseSync
, onTheseAsync
-- * Event interface
, event
, eventTarget
, target
, eventCurrentTarget
, eventPhase
, bubbles
, cancelable
, timeStamp
, stopPropagation
, preventDefault
, defaultPrevented
, stopImmediatePropagation
, srcElement
, getCancelBubble
, cancelBubble
, getReturnValue
, returnValue
-- * UIEvent helpers
, uiView
, uiDetail
, uiKeyCode
, uiCharCode
, uiLayerX
, uiLayerY
, uiLayerXY
, uiPageX
, uiPageY
, uiPageXY
, uiWhich
-- * MouseEvent helpers
, mouseScreenX
, mouseScreenY
, mouseScreenXY
, mouseClientX
, mouseClientY
, mouseClientXY
, mouseMovementX
, mouseMovementY
, mouseMovementXY
, mouseCtrlKey
, mouseShiftKey
, mouseAltKey
, mouseMetaKey
, mouseButton
, mouseRelatedTarget
, mouseOffsetX
, mouseOffsetY
, mouseOffsetXY
, mouseX
, mouseY
, mouseXY
, mouseFromElement
, mouseToElement
)
where
import Control.Applicative ((<$>))
import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)
import Control.Monad.IO.Class (MonadIO(..))
import GHCJS.DOM.Types
import qualified GHCJS.DOM.JSFFI.Generated.Event as Event
import qualified GHCJS.DOM.JSFFI.Generated.UIEvent as UIEvent
import qualified GHCJS.DOM.JSFFI.Generated.KeyboardEvent as KeyboardEvent
import qualified GHCJS.DOM.JSFFI.Generated.MouseEvent as MouseEvent
import GHCJS.DOM.JSFFI.Generated.EventTarget
import GHCJS.DOM.EventTargetClosures
import Data.Word (Word)
import Data.Foldable (forM_)
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 (SaferEventListener l) useCapture =
addEventListener target (eventNameString 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 (SaferEventListener l) useCapture =
removeEventListener target (eventNameString eventName) (Just l) useCapture
-- | Release the listener (deallocates callbacks).
releaseListener :: (IsEventTarget t, IsEvent e) => SaferEventListener t e -> IO ()
releaseListener (SaferEventListener l) = eventListenerRelease l
-- | Shortcut for create, add and release:
--
-- @
-- releaseAction <- on element 'GHCJS.DOM.Document.click' $ do
-- w <- 'GHCJS.DOM.currentWindowUnchecked'
-- 'GHCJS.DOM.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@(EventNameSyncDefault _) = onSync target eventName
on target eventName@(EventNameAsyncDefault _) = onAsync target eventName
-- | Like 'on' but always uses 'newListenerSync'
onSync :: (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
onSync target eventName callback = do
l <- newListenerSync callback
addListener target eventName l False
return (removeListener target eventName l False >> releaseListener l)
-- | Like 'on' but uses 'newListenerAsync'
onAsync :: (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
onAsync target eventName callback = do
l <- newListenerAsync callback
addListener target eventName l False
return (removeListener target eventName l False >> releaseListener l)
-- | 'onSync' for multiple targets & events.
--
-- The returned @IO@ action removes them all at once.
onTheseSync :: (IsEventTarget t, IsEvent e) => [(t, EventName t e)] -> EventM t e () -> IO (IO ())
onTheseSync targetsAndEventNames callback = do
l <- newListenerSync callback
forM_ targetsAndEventNames $ \(target, eventName) ->
addListener target eventName l False
return (do
forM_ targetsAndEventNames (\(target, eventName) ->
removeListener target eventName l False)
releaseListener l)
-- | 'onAsync' for multiple targets & events.
--
-- The returned @IO@ action removes them all at once.
onTheseAsync :: (IsEventTarget t, IsEvent e) => [(t, EventName t e)] -> EventM t e () -> IO (IO ())
onTheseAsync targetsAndEventNames callback = do
l <- newListenerAsync callback
forM_ targetsAndEventNames $ \(target, eventName) ->
addListener target eventName l False
return (do
forM_ targetsAndEventNames (\(target, eventName) ->
removeListener target eventName l False)
releaseListener l)
event :: EventM t e e
event = ask
eventTarget :: IsEvent e => EventM t e (Maybe EventTarget)
eventTarget = event >>= Event.getTarget
eventTargetUnsafe :: IsEvent e => EventM t e EventTarget
eventTargetUnsafe = event >>= Event.getTargetUnsafe
eventTargetUnchecked :: IsEvent e => EventM t e EventTarget
eventTargetUnchecked = event >>= Event.getTargetUnchecked
target :: (IsEvent e, IsGObject t) => EventM t e (Maybe t)
target = eventTarget >>= mapM (liftJSM . fromJSValUnchecked . coerce)
targetUnsafe :: (IsEvent e, IsGObject t) => EventM t e t
targetUnsafe = eventTargetUnsafe >>= (liftJSM . fromJSValUnchecked . coerce)
targetUnchecked :: (IsEvent e, IsGObject t) => EventM t e t
targetUnchecked = eventTargetUnchecked >>= (liftJSM . fromJSValUnchecked . coerce)
eventCurrentTarget :: IsEvent e => EventM t e (Maybe EventTarget)
eventCurrentTarget = event >>= Event.getCurrentTarget
eventCurrentTargetUnsafe :: IsEvent e => EventM t e EventTarget
eventCurrentTargetUnsafe = event >>= Event.getCurrentTargetUnsafe
eventCurrentTargetUnchecked :: IsEvent e => EventM t e EventTarget
eventCurrentTargetUnchecked = event >>= Event.getCurrentTargetUnchecked
eventPhase :: IsEvent e => EventM t e Word
eventPhase = event >>= Event.getEventPhase
bubbles :: IsEvent e => EventM t e Bool
bubbles = event >>= Event.getBubbles
cancelable :: IsEvent e => EventM t e Bool
cancelable = event >>= Event.getCancelable
timeStamp :: IsEvent e => EventM t e Word
timeStamp = event >>= Event.getTimeStamp
stopPropagation :: IsEvent e => EventM t e ()
stopPropagation = event >>= Event.stopPropagation
preventDefault :: IsEvent e => EventM t e ()
preventDefault = event >>= Event.preventDefault
defaultPrevented :: IsEvent e => EventM t e Bool
defaultPrevented = event >>= Event.getDefaultPrevented
stopImmediatePropagation :: IsEvent e => EventM t e ()
stopImmediatePropagation = event >>= Event.stopImmediatePropagation
srcElement :: IsEvent e => EventM t e EventTarget
srcElement = event >>= Event.getSrcElement
getCancelBubble :: IsEvent e => EventM t e Bool
getCancelBubble = event >>= Event.getCancelBubble
cancelBubble :: IsEvent e => Bool -> EventM t e ()
cancelBubble f = event >>= flip Event.setCancelBubble f
getReturnValue :: IsEvent e => EventM t e Bool
getReturnValue = event >>= Event.getReturnValue
returnValue :: IsEvent e => Bool -> EventM t e ()
returnValue f = event >>= flip Event.setReturnValue f
uiView :: IsUIEvent e => EventM t e Window
uiView = event >>= UIEvent.getView
uiDetail :: IsUIEvent e => EventM t e Int
uiDetail = event >>= UIEvent.getDetail
uiKeyCode :: EventM t KeyboardEvent Word
uiKeyCode = event >>= KeyboardEvent.getKeyCode
uiCharCode :: EventM t KeyboardEvent Word
uiCharCode = event >>= KeyboardEvent.getCharCode
uiLayerX :: IsUIEvent e => EventM t e Int
uiLayerX = event >>= UIEvent.getLayerX
uiLayerY :: IsUIEvent e => EventM t e Int
uiLayerY = event >>= UIEvent.getLayerY
uiLayerXY :: IsUIEvent e => EventM t e (Int, Int)
uiLayerXY = do
e <- event
x <- UIEvent.getLayerX e
y <- UIEvent.getLayerY e
return (x, y)
uiPageX :: IsUIEvent e => EventM t e Int
uiPageX = event >>= UIEvent.getPageX
uiPageY :: IsUIEvent e => EventM t e Int
uiPageY = event >>= UIEvent.getPageY
uiPageXY :: IsUIEvent e => EventM t e (Int, Int)
uiPageXY = do
e <- event
x <- UIEvent.getPageX e
y <- UIEvent.getPageY e
return (x, y)
uiWhich :: IsUIEvent e => EventM t e Int
uiWhich = event >>= UIEvent.getWhich
mouseScreenX :: IsMouseEvent e => EventM t e Int
mouseScreenX = event >>= MouseEvent.getScreenX
mouseScreenY :: IsMouseEvent e => EventM t e Int
mouseScreenY = event >>= MouseEvent.getScreenY
mouseScreenXY :: IsMouseEvent e => EventM t e (Int, Int)
mouseScreenXY = do
e <- event
x <- MouseEvent.getScreenX e
y <- MouseEvent.getScreenY e
return (x, y)
mouseClientX :: IsMouseEvent e => EventM t e Int
mouseClientX = event >>= MouseEvent.getClientX
mouseClientY :: IsMouseEvent e => EventM t e Int
mouseClientY = event >>= MouseEvent.getClientY
mouseClientXY :: IsMouseEvent e => EventM t e (Int, Int)
mouseClientXY = do
e <- event
x <- MouseEvent.getClientX e
y <- MouseEvent.getClientY e
return (x, y)
mouseMovementX :: IsMouseEvent e => EventM t e Int
mouseMovementX = event >>= MouseEvent.getMovementX
mouseMovementY :: IsMouseEvent e => EventM t e Int
mouseMovementY = event >>= MouseEvent.getMovementY
mouseMovementXY :: IsMouseEvent e => EventM t e (Int, Int)
mouseMovementXY = do
e <- event
x <- MouseEvent.getMovementX e
y <- MouseEvent.getMovementY e
return (x, y)
mouseCtrlKey :: IsMouseEvent e => EventM t e Bool
mouseCtrlKey = event >>= MouseEvent.getCtrlKey
mouseShiftKey :: IsMouseEvent e => EventM t e Bool
mouseShiftKey = event >>= MouseEvent.getShiftKey
mouseAltKey :: IsMouseEvent e => EventM t e Bool
mouseAltKey = event >>= MouseEvent.getAltKey
mouseMetaKey :: IsMouseEvent e => EventM t e Bool
mouseMetaKey = event >>= MouseEvent.getMetaKey
mouseButton :: IsMouseEvent e => EventM t e Word
mouseButton = event >>= MouseEvent.getButton
mouseRelatedTarget :: IsMouseEvent e => EventM t e (Maybe EventTarget)
mouseRelatedTarget = event >>= MouseEvent.getRelatedTarget
mouseOffsetX :: IsMouseEvent e => EventM t e Int
mouseOffsetX = event >>= MouseEvent.getOffsetX
mouseOffsetY :: IsMouseEvent e => EventM t e Int
mouseOffsetY = event >>= MouseEvent.getOffsetY
mouseOffsetXY :: IsMouseEvent e => EventM t e (Int, Int)
mouseOffsetXY = do
e <- event
x <- MouseEvent.getOffsetX e
y <- MouseEvent.getOffsetY e
return (x, y)
mouseX :: IsMouseEvent e => EventM t e Int
mouseX = event >>= MouseEvent.getX
mouseY :: IsMouseEvent e => EventM t e Int
mouseY = event >>= MouseEvent.getY
mouseXY :: IsMouseEvent e => EventM t e (Int, Int)
mouseXY = do
e <- event
x <- MouseEvent.getX e
y <- MouseEvent.getY e
return (x, y)
mouseFromElement :: IsMouseEvent e => EventM t e (Maybe Node)
mouseFromElement = event >>= MouseEvent.getFromElement
mouseToElement :: IsMouseEvent e => EventM t e (Maybe Node)
mouseToElement = event >>= MouseEvent.getToElement