EventM.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ConstraintKinds #-}
module Language.Javascript.JSaddle.DOM.EventM
(
  EventM(..)
, SaferEventListener(..)
, EventName
, newListener
, newListenerSync
, newListenerAsync
, addListener
, removeListener
, releaseListener
, on
, event
, eventTarget
, target
, eventCurrentTarget
, eventPhase
, bubbles
, cancelable
, timeStamp
, stopPropagation
, preventDefault
, defaultPrevented
, stopImmediatePropagation
, srcElement
, getCancelBubble
, cancelBubble
, getReturnValue
, returnValue
, uiView
, uiDetail
, uiKeyCode
, uiCharCode
, uiLayerX
, uiLayerY
, uiLayerXY
, uiPageX
, uiPageY
, uiPageXY
, uiWhich
, 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.Class (MonadTrans(..))
import           Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)
import           Control.Monad.IO.Class (MonadIO(..))
import           Language.Javascript.JSaddle.DOM.Types
import qualified Language.Javascript.JSaddle.DOM.Event as Event
import qualified Language.Javascript.JSaddle.DOM.UIEvent as UIEvent
import qualified Language.Javascript.JSaddle.DOM.MouseEvent as MouseEvent
import           Language.Javascript.JSaddle.DOM.EventTarget
import           Language.Javascript.JSaddle.DOM.EventTargetClosures
import           Data.Word (Word)
import           Language.Javascript.JSaddle (JSM)

type EventM t e = ReaderT e JSM

instance MonadDOM (ReaderT e JSM) where
    liftDOM = lift

newListener :: (IsEvent e) => EventM t e () -> JSM (SaferEventListener t e)
newListener f = eventListenerNew (runReaderT f)

newListenerSync :: (IsEvent e) => EventM t e () -> JSM (SaferEventListener t e)
newListenerSync f = eventListenerNewSync (runReaderT f)

newListenerAsync :: (IsEvent e) => EventM t e () -> JSM (SaferEventListener t e)
newListenerAsync f = eventListenerNewAsync (runReaderT f)

addListener :: (IsEventTarget t, IsEvent e) => t -> EventName t e -> SaferEventListener t e -> Bool -> JSM ()
addListener target (EventName eventName) l useCapture = do
    raw <- EventListener <$> toJSVal l
    addEventListener target eventName (Just raw) useCapture

removeListener :: (IsEventTarget t, IsEvent e) => t -> EventName t e -> SaferEventListener t e -> Bool -> JSM ()
removeListener target (EventName eventName) l useCapture = do
    raw <- EventListener <$> toJSVal l
    removeEventListener target eventName (Just raw) useCapture

releaseListener :: (IsEventTarget t, IsEvent e) => SaferEventListener t e -> JSM ()
releaseListener = eventListenerRelease

on :: (IsEventTarget t, IsEvent e) => t -> EventName t e -> EventM t e () -> JSM (JSM ())
on target eventName callback = do
    l <- newListener callback
    addListener target eventName l False
    return $ do
        removeListener target eventName l False
        releaseListener l

event :: EventM t e e
event = ask

eventTarget :: IsEvent e => EventM t e (Maybe EventTarget)
eventTarget = event >>= (lift . Event.getTarget)

target :: (IsEvent e, IsGObject t) => EventM t e (Maybe t)
target = fmap (unsafeCastGObject . toGObject) <$> eventTarget

eventCurrentTarget :: IsEvent e => EventM t e (Maybe EventTarget)
eventCurrentTarget = event >>= (lift . Event.getCurrentTarget)

eventPhase :: IsEvent e => EventM t e Word
eventPhase = event >>= (lift . Event.getEventPhase)

bubbles :: IsEvent e => EventM t e Bool
bubbles = event >>= (lift . Event.getBubbles)

cancelable :: IsEvent e => EventM t e Bool
cancelable = event >>= (lift . Event.getCancelable)

timeStamp :: IsEvent e => EventM t e Word
timeStamp = event >>= (lift . Event.getTimeStamp)

stopPropagation :: IsEvent e => EventM t e ()
stopPropagation = event >>= (lift . Event.stopPropagation)

preventDefault :: IsEvent e => EventM t e ()
preventDefault = event >>= (lift . Event.preventDefault)

defaultPrevented :: IsEvent e => EventM t e Bool
defaultPrevented = event >>= (lift . Event.getDefaultPrevented)

stopImmediatePropagation :: IsEvent e => EventM t e ()
stopImmediatePropagation = event >>= (lift . Event.stopImmediatePropagation)

srcElement :: IsEvent e => EventM t e (Maybe EventTarget)
srcElement = event >>= (lift . Event.getSrcElement)

getCancelBubble :: IsEvent e => EventM t e Bool
getCancelBubble = event >>= (lift . Event.getCancelBubble)

cancelBubble :: IsEvent e => Bool -> EventM t e ()
cancelBubble f = event >>= (lift . flip Event.setCancelBubble f)

getReturnValue :: IsEvent e => EventM t e Bool
getReturnValue = event >>= (lift . Event.getReturnValue)

returnValue :: IsEvent e => Bool -> EventM t e ()
returnValue f = event >>= (lift . flip Event.setReturnValue f)

uiView :: IsUIEvent e => EventM t e (Maybe Window)
uiView = event >>= (lift . UIEvent.getView)

uiDetail :: IsUIEvent e => EventM t e Int
uiDetail = event >>= (lift . UIEvent.getDetail)

uiKeyCode :: IsUIEvent e => EventM t e Int
uiKeyCode = event >>= (lift . UIEvent.getKeyCode)

uiCharCode :: IsUIEvent e => EventM t e Int
uiCharCode = event >>= (lift . UIEvent.getCharCode)

uiLayerX :: IsUIEvent e => EventM t e Int
uiLayerX = event >>= (lift . UIEvent.getLayerX)

uiLayerY :: IsUIEvent e => EventM t e Int
uiLayerY = event >>= (lift . UIEvent.getLayerY)

uiLayerXY :: IsUIEvent e => EventM t e (Int, Int)
uiLayerXY = do
    e <- event
    x <- lift $ UIEvent.getLayerX e
    y <- lift $ UIEvent.getLayerY e
    return (x, y)

uiPageX :: IsUIEvent e => EventM t e Int
uiPageX = event >>= (lift . UIEvent.getPageX)

uiPageY :: IsUIEvent e => EventM t e Int
uiPageY = event >>= (lift . UIEvent.getPageY)

uiPageXY :: IsUIEvent e => EventM t e (Int, Int)
uiPageXY = do
    e <- event
    x <- lift $ UIEvent.getPageX e
    y <- lift $ UIEvent.getPageY e
    return (x, y)

uiWhich :: IsUIEvent e => EventM t e Int
uiWhich = event >>= (lift . UIEvent.getWhich)

mouseScreenX :: IsMouseEvent e => EventM t e Int
mouseScreenX = event >>= (lift . MouseEvent.getScreenX)

mouseScreenY :: IsMouseEvent e => EventM t e Int
mouseScreenY = event >>= (lift . MouseEvent.getScreenY)

mouseScreenXY :: IsMouseEvent e => EventM t e (Int, Int)
mouseScreenXY = do
    e <- event
    x <- lift $ MouseEvent.getScreenX e
    y <- lift $ MouseEvent.getScreenY e
    return (x, y)

mouseClientX :: IsMouseEvent e => EventM t e Int
mouseClientX = event >>= (lift . MouseEvent.getClientX)

mouseClientY :: IsMouseEvent e => EventM t e Int
mouseClientY = event >>= (lift . MouseEvent.getClientY)

mouseClientXY :: IsMouseEvent e => EventM t e (Int, Int)
mouseClientXY = do
    e <- event
    x <- lift $ MouseEvent.getClientX e
    y <- lift $ MouseEvent.getClientY e
    return (x, y)

mouseMovementX :: IsMouseEvent e => EventM t e Int
mouseMovementX = event >>= (lift . MouseEvent.getMovementX)

mouseMovementY :: IsMouseEvent e => EventM t e Int
mouseMovementY = event >>= (lift . MouseEvent.getMovementY)

mouseMovementXY :: IsMouseEvent e => EventM t e (Int, Int)
mouseMovementXY = do
    e <- event
    x <- lift $ MouseEvent.getMovementX e
    y <- lift $ MouseEvent.getMovementY e
    return (x, y)

mouseCtrlKey :: IsMouseEvent e => EventM t e Bool
mouseCtrlKey = event >>= (lift . MouseEvent.getCtrlKey)

mouseShiftKey :: IsMouseEvent e => EventM t e Bool
mouseShiftKey = event >>= (lift . MouseEvent.getShiftKey)

mouseAltKey :: IsMouseEvent e => EventM t e Bool
mouseAltKey = event >>= (lift . MouseEvent.getAltKey)

mouseMetaKey :: IsMouseEvent e => EventM t e Bool
mouseMetaKey = event >>= (lift . MouseEvent.getMetaKey)

mouseButton :: IsMouseEvent e => EventM t e Word
mouseButton = event >>= (lift . MouseEvent.getButton)

mouseRelatedTarget :: IsMouseEvent e => EventM t e (Maybe EventTarget)
mouseRelatedTarget = event >>= (lift . MouseEvent.getRelatedTarget)

mouseOffsetX :: IsMouseEvent e => EventM t e Int
mouseOffsetX = event >>= (lift . MouseEvent.getOffsetX)

mouseOffsetY :: IsMouseEvent e => EventM t e Int
mouseOffsetY = event >>= (lift . MouseEvent.getOffsetY)

mouseOffsetXY :: IsMouseEvent e => EventM t e (Int, Int)
mouseOffsetXY = do
    e <- event
    x <- lift $ MouseEvent.getOffsetX e
    y <- lift $ MouseEvent.getOffsetY e
    return (x, y)

mouseX :: IsMouseEvent e => EventM t e Int
mouseX = event >>= (lift . MouseEvent.getX)

mouseY :: IsMouseEvent e => EventM t e Int
mouseY = event >>= (lift . MouseEvent.getY)

mouseXY :: IsMouseEvent e => EventM t e (Int, Int)
mouseXY = do
    e <- event
    x <- lift $ MouseEvent.getX e
    y <- lift $ MouseEvent.getY e
    return (x, y)

mouseFromElement :: IsMouseEvent e => EventM t e (Maybe Node)
mouseFromElement = event >>= (lift . MouseEvent.getFromElement)

mouseToElement :: IsMouseEvent e => EventM t e (Maybe Node)
mouseToElement = event >>= (lift . MouseEvent.getToElement)