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.Generated.Event as Event
import qualified Language.Javascript.JSaddle.DOM.Generated.UIEvent as UIEvent
import qualified Language.Javascript.JSaddle.DOM.Generated.MouseEvent as MouseEvent
import           Language.Javascript.JSaddle.DOM.Generated.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)