{-# LANGUAGE PatternSynonyms #-} -- For HasCallStack compatibility {-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} module JSDOM.Generated.Window (openDatabase, openDatabase_, openDatabaseUnsafe, openDatabaseUnchecked, getSelection, getSelection_, getSelectionUnsafe, getSelectionUnchecked, focus, blur, close, print, stop, open, open_, openUnsafe, openUnchecked, showModalDialog, showModalDialog_, alert, confirm, confirm_, prompt, prompt_, promptUnsafe, promptUnchecked, find, find_, scrollBy, scrollTo, scroll, moveBy, moveTo, resizeBy, resizeTo, matchMedia, matchMedia_, matchMediaUnsafe, matchMediaUnchecked, getComputedStyle, getComputedStyle_, getComputedStyleUnsafe, getComputedStyleUnchecked, getMatchedCSSRules, getMatchedCSSRules_, getMatchedCSSRulesUnsafe, getMatchedCSSRulesUnchecked, webkitConvertPointFromPageToNode, webkitConvertPointFromPageToNode_, webkitConvertPointFromPageToNodeUnsafe, webkitConvertPointFromPageToNodeUnchecked, webkitConvertPointFromNodeToPage, webkitConvertPointFromNodeToPage_, webkitConvertPointFromNodeToPageUnsafe, webkitConvertPointFromNodeToPageUnchecked, postMessage, requestAnimationFrame, requestAnimationFrame_, cancelAnimationFrame, webkitRequestAnimationFrame, webkitRequestAnimationFrame_, webkitCancelAnimationFrame, webkitCancelRequestAnimationFrame, captureEvents, releaseEvents, getWebkitIndexedDB, getWebkitIndexedDBUnsafe, getWebkitIndexedDBUnchecked, getIndexedDB, getIndexedDBUnsafe, getIndexedDBUnchecked, getWebkitStorageInfo, getWebkitStorageInfoUnsafe, getWebkitStorageInfoUnchecked, getSpeechSynthesis, getSpeechSynthesisUnsafe, getSpeechSynthesisUnchecked, getScreen, getScreenUnsafe, getScreenUnchecked, getHistory, getHistoryUnsafe, getHistoryUnchecked, getLocationbar, getLocationbarUnsafe, getLocationbarUnchecked, getMenubar, getMenubarUnsafe, getMenubarUnchecked, getPersonalbar, getPersonalbarUnsafe, getPersonalbarUnchecked, getScrollbars, getScrollbarsUnsafe, getScrollbarsUnchecked, getStatusbar, getStatusbarUnsafe, getStatusbarUnchecked, getToolbar, getToolbarUnsafe, getToolbarUnchecked, getNavigator, getNavigatorUnsafe, getNavigatorUnchecked, getClientInformation, getClientInformationUnsafe, getClientInformationUnchecked, getCrypto, getCryptoUnsafe, getCryptoUnchecked, setLocation, getLocation, getLocationUnsafe, getLocationUnchecked, getEvent, getEventUnsafe, getEventUnchecked, getFrameElement, getFrameElementUnsafe, getFrameElementUnchecked, getOffscreenBuffering, getOuterHeight, getOuterWidth, getInnerHeight, getInnerWidth, getScreenX, getScreenY, getScreenLeft, getScreenTop, getScrollX, getScrollY, getPageXOffset, getPageYOffset, getClosed, getLength, setName, getName, setStatus, getStatus, setDefaultStatus, getDefaultStatus, setDefaultstatus, getDefaultstatus, getSelf, getSelfUnsafe, getSelfUnchecked, getWindow, getWindowUnsafe, getWindowUnchecked, getFrames, getFramesUnsafe, getFramesUnchecked, getOpener, getOpenerUnsafe, getOpenerUnchecked, getParent, getParentUnsafe, getParentUnchecked, getTop, getTopUnsafe, getTopUnchecked, getDocument, getDocumentUnsafe, getDocumentUnchecked, getStyleMedia, getStyleMediaUnsafe, getStyleMediaUnchecked, getDevicePixelRatio, getApplicationCache, getApplicationCacheUnsafe, getApplicationCacheUnchecked, getSessionStorage, getSessionStorageUnsafe, getSessionStorageUnchecked, getLocalStorage, getLocalStorageUnsafe, getLocalStorageUnchecked, getOrientation, getPerformance, getPerformanceUnsafe, getPerformanceUnchecked, getCSS, getCSSUnsafe, getCSSUnchecked, abort, beforeUnload, blurEvent, canPlay, canPlayThrough, change, click, contextMenu, dblClick, drag, dragEnd, dragEnter, dragLeave, dragOver, dragStart, drop, durationChange, emptied, ended, error, focusEvent, hashChange, input, invalid, keyDown, keyPress, keyUp, load, loadedData, loadedMetadata, loadStart, message, mouseDown, mouseEnter, mouseLeave, mouseMove, mouseOut, mouseOver, mouseUp, mouseWheel, offline, online, pageHide, pageShow, pause, play, playing, popState, progress, rateChange, resize, scrollEvent, seeked, seeking, select, stalled, storage, submit, suspend, timeUpdate, unload, volumeChange, waiting, wheel, reset, search, webKitAnimationEnd, webKitAnimationIteration, webKitAnimationStart, animationEnd, animationIteration, animationStart, webKitTransitionEnd, transitionEnd, orientationChange, touchStart, touchMove, touchEnd, touchCancel, gestureStart, gestureChange, gestureEnd, deviceMotion, deviceOrientation, webKitDeviceProximity, webKitWillRevealBottom, webKitWillRevealLeft, webKitWillRevealRight, webKitWillRevealTop, Window(..), gTypeWindow) where import Prelude ((.), (==), (>>=), return, IO, Int, Float, Double, Bool(..), Maybe, maybe, fromIntegral, round, realToFrac, fmap, Show, Read, Eq, Ord, Maybe(..)) import qualified Prelude (error) import Data.Typeable (Typeable) import Language.Javascript.JSaddle (JSM(..), JSVal(..), JSString, strictEqual, toJSVal, valToStr, valToNumber, valToBool, js, jss, jsf, jsg, function, new, array) import Data.Int (Int64) import Data.Word (Word, Word64) import JSDOM.Types import Control.Applicative ((<$>)) import Control.Monad (void) import Control.Lens.Operators ((^.)) import JSDOM.EventTargetClosures (EventName, unsafeEventName) import JSDOM.Enums -- | openDatabase :: (MonadDOM m, ToJSString name, ToJSString version, ToJSString displayName) => Window -> name -> version -> displayName -> Word -> Maybe DatabaseCallback -> m (Maybe Database) openDatabase self name version displayName estimatedSize creationCallback = liftDOM ((self ^. jsf "openDatabase" [toJSVal name, toJSVal version, toJSVal displayName, toJSVal estimatedSize, toJSVal creationCallback]) >>= fromJSVal) -- | openDatabase_ :: (MonadDOM m, ToJSString name, ToJSString version, ToJSString displayName) => Window -> name -> version -> displayName -> Word -> Maybe DatabaseCallback -> m () openDatabase_ self name version displayName estimatedSize creationCallback = liftDOM (void (self ^. jsf "openDatabase" [toJSVal name, toJSVal version, toJSVal displayName, toJSVal estimatedSize, toJSVal creationCallback])) -- | openDatabaseUnsafe :: (MonadDOM m, ToJSString name, ToJSString version, ToJSString displayName, HasCallStack) => Window -> name -> version -> displayName -> Word -> Maybe DatabaseCallback -> m Database openDatabaseUnsafe self name version displayName estimatedSize creationCallback = liftDOM (((self ^. jsf "openDatabase" [toJSVal name, toJSVal version, toJSVal displayName, toJSVal estimatedSize, toJSVal creationCallback]) >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | openDatabaseUnchecked :: (MonadDOM m, ToJSString name, ToJSString version, ToJSString displayName) => Window -> name -> version -> displayName -> Word -> Maybe DatabaseCallback -> m Database openDatabaseUnchecked self name version displayName estimatedSize creationCallback = liftDOM ((self ^. jsf "openDatabase" [toJSVal name, toJSVal version, toJSVal displayName, toJSVal estimatedSize, toJSVal creationCallback]) >>= fromJSValUnchecked) -- | getSelection :: (MonadDOM m) => Window -> m (Maybe Selection) getSelection self = liftDOM ((self ^. jsf "getSelection" ()) >>= fromJSVal) -- | getSelection_ :: (MonadDOM m) => Window -> m () getSelection_ self = liftDOM (void (self ^. jsf "getSelection" ())) -- | getSelectionUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Selection getSelectionUnsafe self = liftDOM (((self ^. jsf "getSelection" ()) >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getSelectionUnchecked :: (MonadDOM m) => Window -> m Selection getSelectionUnchecked self = liftDOM ((self ^. jsf "getSelection" ()) >>= fromJSValUnchecked) -- | focus :: (MonadDOM m) => Window -> m () focus self = liftDOM (void (self ^. jsf "focus" ())) -- | blur :: (MonadDOM m) => Window -> m () blur self = liftDOM (void (self ^. jsf "blur" ())) -- | close :: (MonadDOM m) => Window -> m () close self = liftDOM (void (self ^. jsf "close" ())) -- | print :: (MonadDOM m) => Window -> m () print self = liftDOM (void (self ^. jsf "print" ())) -- | stop :: (MonadDOM m) => Window -> m () stop self = liftDOM (void (self ^. jsf "stop" ())) -- | open :: (MonadDOM m, ToJSString url, ToJSString name, ToJSString options) => Window -> url -> name -> options -> m (Maybe Window) open self url name options = liftDOM ((self ^. jsf "open" [toJSVal url, toJSVal name, toJSVal options]) >>= fromJSVal) -- | open_ :: (MonadDOM m, ToJSString url, ToJSString name, ToJSString options) => Window -> url -> name -> options -> m () open_ self url name options = liftDOM (void (self ^. jsf "open" [toJSVal url, toJSVal name, toJSVal options])) -- | openUnsafe :: (MonadDOM m, ToJSString url, ToJSString name, ToJSString options, HasCallStack) => Window -> url -> name -> options -> m Window openUnsafe self url name options = liftDOM (((self ^. jsf "open" [toJSVal url, toJSVal name, toJSVal options]) >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | openUnchecked :: (MonadDOM m, ToJSString url, ToJSString name, ToJSString options) => Window -> url -> name -> options -> m Window openUnchecked self url name options = liftDOM ((self ^. jsf "open" [toJSVal url, toJSVal name, toJSVal options]) >>= fromJSValUnchecked) -- | showModalDialog :: (MonadDOM m, ToJSString url, ToJSString featureArgs) => Window -> url -> JSVal -> featureArgs -> m JSVal showModalDialog self url dialogArgs featureArgs = liftDOM ((self ^. jsf "showModalDialog" [toJSVal url, toJSVal dialogArgs, toJSVal featureArgs]) >>= toJSVal) -- | showModalDialog_ :: (MonadDOM m, ToJSString url, ToJSString featureArgs) => Window -> url -> JSVal -> featureArgs -> m () showModalDialog_ self url dialogArgs featureArgs = liftDOM (void (self ^. jsf "showModalDialog" [toJSVal url, toJSVal dialogArgs, toJSVal featureArgs])) -- | alert :: (MonadDOM m, ToJSString message) => Window -> message -> m () alert self message = liftDOM (void (self ^. jsf "alert" [toJSVal message])) -- | confirm :: (MonadDOM m, ToJSString message) => Window -> message -> m Bool confirm self message = liftDOM ((self ^. jsf "confirm" [toJSVal message]) >>= valToBool) -- | confirm_ :: (MonadDOM m, ToJSString message) => Window -> message -> m () confirm_ self message = liftDOM (void (self ^. jsf "confirm" [toJSVal message])) -- | prompt :: (MonadDOM m, ToJSString message, ToJSString defaultValue, FromJSString result) => Window -> message -> Maybe defaultValue -> m (Maybe result) prompt self message defaultValue = liftDOM ((self ^. jsf "prompt" [toJSVal message, toJSVal defaultValue]) >>= fromMaybeJSString) -- | prompt_ :: (MonadDOM m, ToJSString message, ToJSString defaultValue) => Window -> message -> Maybe defaultValue -> m () prompt_ self message defaultValue = liftDOM (void (self ^. jsf "prompt" [toJSVal message, toJSVal defaultValue])) -- | promptUnsafe :: (MonadDOM m, ToJSString message, ToJSString defaultValue, HasCallStack, FromJSString result) => Window -> message -> Maybe defaultValue -> m result promptUnsafe self message defaultValue = liftDOM (((self ^. jsf "prompt" [toJSVal message, toJSVal defaultValue]) >>= fromMaybeJSString) >>= maybe (Prelude.error "Nothing to return") return) -- | promptUnchecked :: (MonadDOM m, ToJSString message, ToJSString defaultValue, FromJSString result) => Window -> message -> Maybe defaultValue -> m result promptUnchecked self message defaultValue = liftDOM ((self ^. jsf "prompt" [toJSVal message, toJSVal defaultValue]) >>= fromJSValUnchecked) -- | find :: (MonadDOM m, ToJSString string) => Window -> string -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> m Bool find self string caseSensitive backwards wrap wholeWord searchInFrames showDialog = liftDOM ((self ^. jsf "find" [toJSVal string, toJSVal caseSensitive, toJSVal backwards, toJSVal wrap, toJSVal wholeWord, toJSVal searchInFrames, toJSVal showDialog]) >>= valToBool) -- | find_ :: (MonadDOM m, ToJSString string) => Window -> string -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> m () find_ self string caseSensitive backwards wrap wholeWord searchInFrames showDialog = liftDOM (void (self ^. jsf "find" [toJSVal string, toJSVal caseSensitive, toJSVal backwards, toJSVal wrap, toJSVal wholeWord, toJSVal searchInFrames, toJSVal showDialog])) -- | scrollBy :: (MonadDOM m) => Window -> Int -> Int -> m () scrollBy self x y = liftDOM (void (self ^. jsf "scrollBy" [toJSVal x, toJSVal y])) -- | scrollTo :: (MonadDOM m) => Window -> Int -> Int -> m () scrollTo self x y = liftDOM (void (self ^. jsf "scrollTo" [toJSVal x, toJSVal y])) -- | scroll :: (MonadDOM m) => Window -> Int -> Int -> m () scroll self x y = liftDOM (void (self ^. jsf "scroll" [toJSVal x, toJSVal y])) -- | moveBy :: (MonadDOM m) => Window -> Float -> Float -> m () moveBy self x y = liftDOM (void (self ^. jsf "moveBy" [toJSVal x, toJSVal y])) -- | moveTo :: (MonadDOM m) => Window -> Float -> Float -> m () moveTo self x y = liftDOM (void (self ^. jsf "moveTo" [toJSVal x, toJSVal y])) -- | resizeBy :: (MonadDOM m) => Window -> Float -> Float -> m () resizeBy self x y = liftDOM (void (self ^. jsf "resizeBy" [toJSVal x, toJSVal y])) -- | resizeTo :: (MonadDOM m) => Window -> Float -> Float -> m () resizeTo self width height = liftDOM (void (self ^. jsf "resizeTo" [toJSVal width, toJSVal height])) -- | matchMedia :: (MonadDOM m, ToJSString query) => Window -> query -> m (Maybe MediaQueryList) matchMedia self query = liftDOM ((self ^. jsf "matchMedia" [toJSVal query]) >>= fromJSVal) -- | matchMedia_ :: (MonadDOM m, ToJSString query) => Window -> query -> m () matchMedia_ self query = liftDOM (void (self ^. jsf "matchMedia" [toJSVal query])) -- | matchMediaUnsafe :: (MonadDOM m, ToJSString query, HasCallStack) => Window -> query -> m MediaQueryList matchMediaUnsafe self query = liftDOM (((self ^. jsf "matchMedia" [toJSVal query]) >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | matchMediaUnchecked :: (MonadDOM m, ToJSString query) => Window -> query -> m MediaQueryList matchMediaUnchecked self query = liftDOM ((self ^. jsf "matchMedia" [toJSVal query]) >>= fromJSValUnchecked) -- | getComputedStyle :: (MonadDOM m, IsElement element, ToJSString pseudoElement) => Window -> Maybe element -> Maybe pseudoElement -> m (Maybe CSSStyleDeclaration) getComputedStyle self element pseudoElement = liftDOM ((self ^. jsf "getComputedStyle" [toJSVal element, toJSVal pseudoElement]) >>= fromJSVal) -- | getComputedStyle_ :: (MonadDOM m, IsElement element, ToJSString pseudoElement) => Window -> Maybe element -> Maybe pseudoElement -> m () getComputedStyle_ self element pseudoElement = liftDOM (void (self ^. jsf "getComputedStyle" [toJSVal element, toJSVal pseudoElement])) -- | getComputedStyleUnsafe :: (MonadDOM m, IsElement element, ToJSString pseudoElement, HasCallStack) => Window -> Maybe element -> Maybe pseudoElement -> m CSSStyleDeclaration getComputedStyleUnsafe self element pseudoElement = liftDOM (((self ^. jsf "getComputedStyle" [toJSVal element, toJSVal pseudoElement]) >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getComputedStyleUnchecked :: (MonadDOM m, IsElement element, ToJSString pseudoElement) => Window -> Maybe element -> Maybe pseudoElement -> m CSSStyleDeclaration getComputedStyleUnchecked self element pseudoElement = liftDOM ((self ^. jsf "getComputedStyle" [toJSVal element, toJSVal pseudoElement]) >>= fromJSValUnchecked) -- | getMatchedCSSRules :: (MonadDOM m, IsElement element, ToJSString pseudoElement) => Window -> Maybe element -> Maybe pseudoElement -> m (Maybe CSSRuleList) getMatchedCSSRules self element pseudoElement = liftDOM ((self ^. jsf "getMatchedCSSRules" [toJSVal element, toJSVal pseudoElement]) >>= fromJSVal) -- | getMatchedCSSRules_ :: (MonadDOM m, IsElement element, ToJSString pseudoElement) => Window -> Maybe element -> Maybe pseudoElement -> m () getMatchedCSSRules_ self element pseudoElement = liftDOM (void (self ^. jsf "getMatchedCSSRules" [toJSVal element, toJSVal pseudoElement])) -- | getMatchedCSSRulesUnsafe :: (MonadDOM m, IsElement element, ToJSString pseudoElement, HasCallStack) => Window -> Maybe element -> Maybe pseudoElement -> m CSSRuleList getMatchedCSSRulesUnsafe self element pseudoElement = liftDOM (((self ^. jsf "getMatchedCSSRules" [toJSVal element, toJSVal pseudoElement]) >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getMatchedCSSRulesUnchecked :: (MonadDOM m, IsElement element, ToJSString pseudoElement) => Window -> Maybe element -> Maybe pseudoElement -> m CSSRuleList getMatchedCSSRulesUnchecked self element pseudoElement = liftDOM ((self ^. jsf "getMatchedCSSRules" [toJSVal element, toJSVal pseudoElement]) >>= fromJSValUnchecked) -- | webkitConvertPointFromPageToNode :: (MonadDOM m, IsNode node) => Window -> Maybe node -> Maybe WebKitPoint -> m (Maybe WebKitPoint) webkitConvertPointFromPageToNode self node p = liftDOM ((self ^. jsf "webkitConvertPointFromPageToNode" [toJSVal node, toJSVal p]) >>= fromJSVal) -- | webkitConvertPointFromPageToNode_ :: (MonadDOM m, IsNode node) => Window -> Maybe node -> Maybe WebKitPoint -> m () webkitConvertPointFromPageToNode_ self node p = liftDOM (void (self ^. jsf "webkitConvertPointFromPageToNode" [toJSVal node, toJSVal p])) -- | webkitConvertPointFromPageToNodeUnsafe :: (MonadDOM m, IsNode node, HasCallStack) => Window -> Maybe node -> Maybe WebKitPoint -> m WebKitPoint webkitConvertPointFromPageToNodeUnsafe self node p = liftDOM (((self ^. jsf "webkitConvertPointFromPageToNode" [toJSVal node, toJSVal p]) >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | webkitConvertPointFromPageToNodeUnchecked :: (MonadDOM m, IsNode node) => Window -> Maybe node -> Maybe WebKitPoint -> m WebKitPoint webkitConvertPointFromPageToNodeUnchecked self node p = liftDOM ((self ^. jsf "webkitConvertPointFromPageToNode" [toJSVal node, toJSVal p]) >>= fromJSValUnchecked) -- | webkitConvertPointFromNodeToPage :: (MonadDOM m, IsNode node) => Window -> Maybe node -> Maybe WebKitPoint -> m (Maybe WebKitPoint) webkitConvertPointFromNodeToPage self node p = liftDOM ((self ^. jsf "webkitConvertPointFromNodeToPage" [toJSVal node, toJSVal p]) >>= fromJSVal) -- | webkitConvertPointFromNodeToPage_ :: (MonadDOM m, IsNode node) => Window -> Maybe node -> Maybe WebKitPoint -> m () webkitConvertPointFromNodeToPage_ self node p = liftDOM (void (self ^. jsf "webkitConvertPointFromNodeToPage" [toJSVal node, toJSVal p])) -- | webkitConvertPointFromNodeToPageUnsafe :: (MonadDOM m, IsNode node, HasCallStack) => Window -> Maybe node -> Maybe WebKitPoint -> m WebKitPoint webkitConvertPointFromNodeToPageUnsafe self node p = liftDOM (((self ^. jsf "webkitConvertPointFromNodeToPage" [toJSVal node, toJSVal p]) >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | webkitConvertPointFromNodeToPageUnchecked :: (MonadDOM m, IsNode node) => Window -> Maybe node -> Maybe WebKitPoint -> m WebKitPoint webkitConvertPointFromNodeToPageUnchecked self node p = liftDOM ((self ^. jsf "webkitConvertPointFromNodeToPage" [toJSVal node, toJSVal p]) >>= fromJSValUnchecked) -- | postMessage :: (MonadDOM m, IsSerializedScriptValue message, ToJSString targetOrigin, IsArray messagePorts) => Window -> Maybe message -> targetOrigin -> Maybe messagePorts -> m () postMessage self message targetOrigin messagePorts = liftDOM (void (self ^. jsf "postMessage" [toJSVal message, toJSVal targetOrigin, toJSVal messagePorts])) -- | requestAnimationFrame :: (MonadDOM m) => Window -> Maybe RequestAnimationFrameCallback -> m Int requestAnimationFrame self callback = liftDOM (round <$> ((self ^. jsf "requestAnimationFrame" [toJSVal callback]) >>= valToNumber)) -- | requestAnimationFrame_ :: (MonadDOM m) => Window -> Maybe RequestAnimationFrameCallback -> m () requestAnimationFrame_ self callback = liftDOM (void (self ^. jsf "requestAnimationFrame" [toJSVal callback])) -- | cancelAnimationFrame :: (MonadDOM m) => Window -> Int -> m () cancelAnimationFrame self id = liftDOM (void (self ^. jsf "cancelAnimationFrame" [toJSVal id])) -- | webkitRequestAnimationFrame :: (MonadDOM m) => Window -> Maybe RequestAnimationFrameCallback -> m Int webkitRequestAnimationFrame self callback = liftDOM (round <$> ((self ^. jsf "webkitRequestAnimationFrame" [toJSVal callback]) >>= valToNumber)) -- | webkitRequestAnimationFrame_ :: (MonadDOM m) => Window -> Maybe RequestAnimationFrameCallback -> m () webkitRequestAnimationFrame_ self callback = liftDOM (void (self ^. jsf "webkitRequestAnimationFrame" [toJSVal callback])) -- | webkitCancelAnimationFrame :: (MonadDOM m) => Window -> Int -> m () webkitCancelAnimationFrame self id = liftDOM (void (self ^. jsf "webkitCancelAnimationFrame" [toJSVal id])) -- | webkitCancelRequestAnimationFrame :: (MonadDOM m) => Window -> Int -> m () webkitCancelRequestAnimationFrame self id = liftDOM (void (self ^. jsf "webkitCancelRequestAnimationFrame" [toJSVal id])) -- | captureEvents :: (MonadDOM m) => Window -> m () captureEvents self = liftDOM (void (self ^. jsf "captureEvents" ())) -- | releaseEvents :: (MonadDOM m) => Window -> m () releaseEvents self = liftDOM (void (self ^. jsf "releaseEvents" ())) -- | getWebkitIndexedDB :: (MonadDOM m) => Window -> m (Maybe IDBFactory) getWebkitIndexedDB self = liftDOM ((self ^. js "webkitIndexedDB") >>= fromJSVal) -- | getWebkitIndexedDBUnsafe :: (MonadDOM m, HasCallStack) => Window -> m IDBFactory getWebkitIndexedDBUnsafe self = liftDOM (((self ^. js "webkitIndexedDB") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getWebkitIndexedDBUnchecked :: (MonadDOM m) => Window -> m IDBFactory getWebkitIndexedDBUnchecked self = liftDOM ((self ^. js "webkitIndexedDB") >>= fromJSValUnchecked) -- | getIndexedDB :: (MonadDOM m) => Window -> m (Maybe IDBFactory) getIndexedDB self = liftDOM ((self ^. js "indexedDB") >>= fromJSVal) -- | getIndexedDBUnsafe :: (MonadDOM m, HasCallStack) => Window -> m IDBFactory getIndexedDBUnsafe self = liftDOM (((self ^. js "indexedDB") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getIndexedDBUnchecked :: (MonadDOM m) => Window -> m IDBFactory getIndexedDBUnchecked self = liftDOM ((self ^. js "indexedDB") >>= fromJSValUnchecked) -- | getWebkitStorageInfo :: (MonadDOM m) => Window -> m (Maybe StorageInfo) getWebkitStorageInfo self = liftDOM ((self ^. js "webkitStorageInfo") >>= fromJSVal) -- | getWebkitStorageInfoUnsafe :: (MonadDOM m, HasCallStack) => Window -> m StorageInfo getWebkitStorageInfoUnsafe self = liftDOM (((self ^. js "webkitStorageInfo") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getWebkitStorageInfoUnchecked :: (MonadDOM m) => Window -> m StorageInfo getWebkitStorageInfoUnchecked self = liftDOM ((self ^. js "webkitStorageInfo") >>= fromJSValUnchecked) -- | getSpeechSynthesis :: (MonadDOM m) => Window -> m (Maybe SpeechSynthesis) getSpeechSynthesis self = liftDOM ((self ^. js "speechSynthesis") >>= fromJSVal) -- | getSpeechSynthesisUnsafe :: (MonadDOM m, HasCallStack) => Window -> m SpeechSynthesis getSpeechSynthesisUnsafe self = liftDOM (((self ^. js "speechSynthesis") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getSpeechSynthesisUnchecked :: (MonadDOM m) => Window -> m SpeechSynthesis getSpeechSynthesisUnchecked self = liftDOM ((self ^. js "speechSynthesis") >>= fromJSValUnchecked) -- | getScreen :: (MonadDOM m) => Window -> m (Maybe Screen) getScreen self = liftDOM ((self ^. js "screen") >>= fromJSVal) -- | getScreenUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Screen getScreenUnsafe self = liftDOM (((self ^. js "screen") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getScreenUnchecked :: (MonadDOM m) => Window -> m Screen getScreenUnchecked self = liftDOM ((self ^. js "screen") >>= fromJSValUnchecked) -- | getHistory :: (MonadDOM m) => Window -> m (Maybe History) getHistory self = liftDOM ((self ^. js "history") >>= fromJSVal) -- | getHistoryUnsafe :: (MonadDOM m, HasCallStack) => Window -> m History getHistoryUnsafe self = liftDOM (((self ^. js "history") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getHistoryUnchecked :: (MonadDOM m) => Window -> m History getHistoryUnchecked self = liftDOM ((self ^. js "history") >>= fromJSValUnchecked) -- | getLocationbar :: (MonadDOM m) => Window -> m (Maybe BarProp) getLocationbar self = liftDOM ((self ^. js "locationbar") >>= fromJSVal) -- | getLocationbarUnsafe :: (MonadDOM m, HasCallStack) => Window -> m BarProp getLocationbarUnsafe self = liftDOM (((self ^. js "locationbar") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getLocationbarUnchecked :: (MonadDOM m) => Window -> m BarProp getLocationbarUnchecked self = liftDOM ((self ^. js "locationbar") >>= fromJSValUnchecked) -- | getMenubar :: (MonadDOM m) => Window -> m (Maybe BarProp) getMenubar self = liftDOM ((self ^. js "menubar") >>= fromJSVal) -- | getMenubarUnsafe :: (MonadDOM m, HasCallStack) => Window -> m BarProp getMenubarUnsafe self = liftDOM (((self ^. js "menubar") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getMenubarUnchecked :: (MonadDOM m) => Window -> m BarProp getMenubarUnchecked self = liftDOM ((self ^. js "menubar") >>= fromJSValUnchecked) -- | getPersonalbar :: (MonadDOM m) => Window -> m (Maybe BarProp) getPersonalbar self = liftDOM ((self ^. js "personalbar") >>= fromJSVal) -- | getPersonalbarUnsafe :: (MonadDOM m, HasCallStack) => Window -> m BarProp getPersonalbarUnsafe self = liftDOM (((self ^. js "personalbar") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getPersonalbarUnchecked :: (MonadDOM m) => Window -> m BarProp getPersonalbarUnchecked self = liftDOM ((self ^. js "personalbar") >>= fromJSValUnchecked) -- | getScrollbars :: (MonadDOM m) => Window -> m (Maybe BarProp) getScrollbars self = liftDOM ((self ^. js "scrollbars") >>= fromJSVal) -- | getScrollbarsUnsafe :: (MonadDOM m, HasCallStack) => Window -> m BarProp getScrollbarsUnsafe self = liftDOM (((self ^. js "scrollbars") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getScrollbarsUnchecked :: (MonadDOM m) => Window -> m BarProp getScrollbarsUnchecked self = liftDOM ((self ^. js "scrollbars") >>= fromJSValUnchecked) -- | getStatusbar :: (MonadDOM m) => Window -> m (Maybe BarProp) getStatusbar self = liftDOM ((self ^. js "statusbar") >>= fromJSVal) -- | getStatusbarUnsafe :: (MonadDOM m, HasCallStack) => Window -> m BarProp getStatusbarUnsafe self = liftDOM (((self ^. js "statusbar") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getStatusbarUnchecked :: (MonadDOM m) => Window -> m BarProp getStatusbarUnchecked self = liftDOM ((self ^. js "statusbar") >>= fromJSValUnchecked) -- | getToolbar :: (MonadDOM m) => Window -> m (Maybe BarProp) getToolbar self = liftDOM ((self ^. js "toolbar") >>= fromJSVal) -- | getToolbarUnsafe :: (MonadDOM m, HasCallStack) => Window -> m BarProp getToolbarUnsafe self = liftDOM (((self ^. js "toolbar") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getToolbarUnchecked :: (MonadDOM m) => Window -> m BarProp getToolbarUnchecked self = liftDOM ((self ^. js "toolbar") >>= fromJSValUnchecked) -- | getNavigator :: (MonadDOM m) => Window -> m (Maybe Navigator) getNavigator self = liftDOM ((self ^. js "navigator") >>= fromJSVal) -- | getNavigatorUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Navigator getNavigatorUnsafe self = liftDOM (((self ^. js "navigator") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getNavigatorUnchecked :: (MonadDOM m) => Window -> m Navigator getNavigatorUnchecked self = liftDOM ((self ^. js "navigator") >>= fromJSValUnchecked) -- | getClientInformation :: (MonadDOM m) => Window -> m (Maybe Navigator) getClientInformation self = liftDOM ((self ^. js "clientInformation") >>= fromJSVal) -- | getClientInformationUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Navigator getClientInformationUnsafe self = liftDOM (((self ^. js "clientInformation") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getClientInformationUnchecked :: (MonadDOM m) => Window -> m Navigator getClientInformationUnchecked self = liftDOM ((self ^. js "clientInformation") >>= fromJSValUnchecked) -- | getCrypto :: (MonadDOM m) => Window -> m (Maybe Crypto) getCrypto self = liftDOM ((self ^. js "crypto") >>= fromJSVal) -- | getCryptoUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Crypto getCryptoUnsafe self = liftDOM (((self ^. js "crypto") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getCryptoUnchecked :: (MonadDOM m) => Window -> m Crypto getCryptoUnchecked self = liftDOM ((self ^. js "crypto") >>= fromJSValUnchecked) -- | setLocation :: (MonadDOM m) => Window -> Maybe Location -> m () setLocation self val = liftDOM (self ^. jss "location" (toJSVal val)) -- | getLocation :: (MonadDOM m) => Window -> m (Maybe Location) getLocation self = liftDOM ((self ^. js "location") >>= fromJSVal) -- | getLocationUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Location getLocationUnsafe self = liftDOM (((self ^. js "location") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getLocationUnchecked :: (MonadDOM m) => Window -> m Location getLocationUnchecked self = liftDOM ((self ^. js "location") >>= fromJSValUnchecked) -- | getEvent :: (MonadDOM m) => Window -> m (Maybe Event) getEvent self = liftDOM ((self ^. js "event") >>= fromJSVal) -- | getEventUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Event getEventUnsafe self = liftDOM (((self ^. js "event") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getEventUnchecked :: (MonadDOM m) => Window -> m Event getEventUnchecked self = liftDOM ((self ^. js "event") >>= fromJSValUnchecked) -- | getFrameElement :: (MonadDOM m) => Window -> m (Maybe Element) getFrameElement self = liftDOM ((self ^. js "frameElement") >>= fromJSVal) -- | getFrameElementUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Element getFrameElementUnsafe self = liftDOM (((self ^. js "frameElement") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getFrameElementUnchecked :: (MonadDOM m) => Window -> m Element getFrameElementUnchecked self = liftDOM ((self ^. js "frameElement") >>= fromJSValUnchecked) -- | getOffscreenBuffering :: (MonadDOM m) => Window -> m Bool getOffscreenBuffering self = liftDOM ((self ^. js "offscreenBuffering") >>= valToBool) -- | getOuterHeight :: (MonadDOM m) => Window -> m Int getOuterHeight self = liftDOM (round <$> ((self ^. js "outerHeight") >>= valToNumber)) -- | getOuterWidth :: (MonadDOM m) => Window -> m Int getOuterWidth self = liftDOM (round <$> ((self ^. js "outerWidth") >>= valToNumber)) -- | getInnerHeight :: (MonadDOM m) => Window -> m Int getInnerHeight self = liftDOM (round <$> ((self ^. js "innerHeight") >>= valToNumber)) -- | getInnerWidth :: (MonadDOM m) => Window -> m Int getInnerWidth self = liftDOM (round <$> ((self ^. js "innerWidth") >>= valToNumber)) -- | getScreenX :: (MonadDOM m) => Window -> m Int getScreenX self = liftDOM (round <$> ((self ^. js "screenX") >>= valToNumber)) -- | getScreenY :: (MonadDOM m) => Window -> m Int getScreenY self = liftDOM (round <$> ((self ^. js "screenY") >>= valToNumber)) -- | getScreenLeft :: (MonadDOM m) => Window -> m Int getScreenLeft self = liftDOM (round <$> ((self ^. js "screenLeft") >>= valToNumber)) -- | getScreenTop :: (MonadDOM m) => Window -> m Int getScreenTop self = liftDOM (round <$> ((self ^. js "screenTop") >>= valToNumber)) -- | getScrollX :: (MonadDOM m) => Window -> m Int getScrollX self = liftDOM (round <$> ((self ^. js "scrollX") >>= valToNumber)) -- | getScrollY :: (MonadDOM m) => Window -> m Int getScrollY self = liftDOM (round <$> ((self ^. js "scrollY") >>= valToNumber)) -- | getPageXOffset :: (MonadDOM m) => Window -> m Int getPageXOffset self = liftDOM (round <$> ((self ^. js "pageXOffset") >>= valToNumber)) -- | getPageYOffset :: (MonadDOM m) => Window -> m Int getPageYOffset self = liftDOM (round <$> ((self ^. js "pageYOffset") >>= valToNumber)) -- | getClosed :: (MonadDOM m) => Window -> m Bool getClosed self = liftDOM ((self ^. js "closed") >>= valToBool) -- | getLength :: (MonadDOM m) => Window -> m Word getLength self = liftDOM (round <$> ((self ^. js "length") >>= valToNumber)) -- | setName :: (MonadDOM m, ToJSString val) => Window -> val -> m () setName self val = liftDOM (self ^. jss "name" (toJSVal val)) -- | getName :: (MonadDOM m, FromJSString result) => Window -> m result getName self = liftDOM ((self ^. js "name") >>= fromJSValUnchecked) -- | setStatus :: (MonadDOM m, ToJSString val) => Window -> val -> m () setStatus self val = liftDOM (self ^. jss "status" (toJSVal val)) -- | getStatus :: (MonadDOM m, FromJSString result) => Window -> m result getStatus self = liftDOM ((self ^. js "status") >>= fromJSValUnchecked) -- | setDefaultStatus :: (MonadDOM m, ToJSString val) => Window -> val -> m () setDefaultStatus self val = liftDOM (self ^. jss "defaultStatus" (toJSVal val)) -- | getDefaultStatus :: (MonadDOM m, FromJSString result) => Window -> m result getDefaultStatus self = liftDOM ((self ^. js "defaultStatus") >>= fromJSValUnchecked) -- | setDefaultstatus :: (MonadDOM m, ToJSString val) => Window -> val -> m () setDefaultstatus self val = liftDOM (self ^. jss "defaultstatus" (toJSVal val)) -- | getDefaultstatus :: (MonadDOM m, FromJSString result) => Window -> m result getDefaultstatus self = liftDOM ((self ^. js "defaultstatus") >>= fromJSValUnchecked) -- | getSelf :: (MonadDOM m) => Window -> m (Maybe Window) getSelf self = liftDOM ((self ^. js "self") >>= fromJSVal) -- | getSelfUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Window getSelfUnsafe self = liftDOM (((self ^. js "self") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getSelfUnchecked :: (MonadDOM m) => Window -> m Window getSelfUnchecked self = liftDOM ((self ^. js "self") >>= fromJSValUnchecked) -- | getWindow :: (MonadDOM m) => Window -> m (Maybe Window) getWindow self = liftDOM ((self ^. js "window") >>= fromJSVal) -- | getWindowUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Window getWindowUnsafe self = liftDOM (((self ^. js "window") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getWindowUnchecked :: (MonadDOM m) => Window -> m Window getWindowUnchecked self = liftDOM ((self ^. js "window") >>= fromJSValUnchecked) -- | getFrames :: (MonadDOM m) => Window -> m (Maybe Window) getFrames self = liftDOM ((self ^. js "frames") >>= fromJSVal) -- | getFramesUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Window getFramesUnsafe self = liftDOM (((self ^. js "frames") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getFramesUnchecked :: (MonadDOM m) => Window -> m Window getFramesUnchecked self = liftDOM ((self ^. js "frames") >>= fromJSValUnchecked) -- | getOpener :: (MonadDOM m) => Window -> m (Maybe Window) getOpener self = liftDOM ((self ^. js "opener") >>= fromJSVal) -- | getOpenerUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Window getOpenerUnsafe self = liftDOM (((self ^. js "opener") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getOpenerUnchecked :: (MonadDOM m) => Window -> m Window getOpenerUnchecked self = liftDOM ((self ^. js "opener") >>= fromJSValUnchecked) -- | getParent :: (MonadDOM m) => Window -> m (Maybe Window) getParent self = liftDOM ((self ^. js "parent") >>= fromJSVal) -- | getParentUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Window getParentUnsafe self = liftDOM (((self ^. js "parent") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getParentUnchecked :: (MonadDOM m) => Window -> m Window getParentUnchecked self = liftDOM ((self ^. js "parent") >>= fromJSValUnchecked) -- | getTop :: (MonadDOM m) => Window -> m (Maybe Window) getTop self = liftDOM ((self ^. js "top") >>= fromJSVal) -- | getTopUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Window getTopUnsafe self = liftDOM (((self ^. js "top") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getTopUnchecked :: (MonadDOM m) => Window -> m Window getTopUnchecked self = liftDOM ((self ^. js "top") >>= fromJSValUnchecked) -- | getDocument :: (MonadDOM m) => Window -> m (Maybe Document) getDocument self = liftDOM ((self ^. js "document") >>= fromJSVal) -- | getDocumentUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Document getDocumentUnsafe self = liftDOM (((self ^. js "document") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getDocumentUnchecked :: (MonadDOM m) => Window -> m Document getDocumentUnchecked self = liftDOM ((self ^. js "document") >>= fromJSValUnchecked) -- | getStyleMedia :: (MonadDOM m) => Window -> m (Maybe StyleMedia) getStyleMedia self = liftDOM ((self ^. js "styleMedia") >>= fromJSVal) -- | getStyleMediaUnsafe :: (MonadDOM m, HasCallStack) => Window -> m StyleMedia getStyleMediaUnsafe self = liftDOM (((self ^. js "styleMedia") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getStyleMediaUnchecked :: (MonadDOM m) => Window -> m StyleMedia getStyleMediaUnchecked self = liftDOM ((self ^. js "styleMedia") >>= fromJSValUnchecked) -- | getDevicePixelRatio :: (MonadDOM m) => Window -> m Double getDevicePixelRatio self = liftDOM ((self ^. js "devicePixelRatio") >>= valToNumber) -- | getApplicationCache :: (MonadDOM m) => Window -> m (Maybe ApplicationCache) getApplicationCache self = liftDOM ((self ^. js "applicationCache") >>= fromJSVal) -- | getApplicationCacheUnsafe :: (MonadDOM m, HasCallStack) => Window -> m ApplicationCache getApplicationCacheUnsafe self = liftDOM (((self ^. js "applicationCache") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getApplicationCacheUnchecked :: (MonadDOM m) => Window -> m ApplicationCache getApplicationCacheUnchecked self = liftDOM ((self ^. js "applicationCache") >>= fromJSValUnchecked) -- | getSessionStorage :: (MonadDOM m) => Window -> m (Maybe Storage) getSessionStorage self = liftDOM ((self ^. js "sessionStorage") >>= fromJSVal) -- | getSessionStorageUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Storage getSessionStorageUnsafe self = liftDOM (((self ^. js "sessionStorage") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getSessionStorageUnchecked :: (MonadDOM m) => Window -> m Storage getSessionStorageUnchecked self = liftDOM ((self ^. js "sessionStorage") >>= fromJSValUnchecked) -- | getLocalStorage :: (MonadDOM m) => Window -> m (Maybe Storage) getLocalStorage self = liftDOM ((self ^. js "localStorage") >>= fromJSVal) -- | getLocalStorageUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Storage getLocalStorageUnsafe self = liftDOM (((self ^. js "localStorage") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getLocalStorageUnchecked :: (MonadDOM m) => Window -> m Storage getLocalStorageUnchecked self = liftDOM ((self ^. js "localStorage") >>= fromJSValUnchecked) -- | getOrientation :: (MonadDOM m) => Window -> m Int getOrientation self = liftDOM (round <$> ((self ^. js "orientation") >>= valToNumber)) -- | getPerformance :: (MonadDOM m) => Window -> m (Maybe Performance) getPerformance self = liftDOM ((self ^. js "performance") >>= fromJSVal) -- | getPerformanceUnsafe :: (MonadDOM m, HasCallStack) => Window -> m Performance getPerformanceUnsafe self = liftDOM (((self ^. js "performance") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getPerformanceUnchecked :: (MonadDOM m) => Window -> m Performance getPerformanceUnchecked self = liftDOM ((self ^. js "performance") >>= fromJSValUnchecked) -- | getCSS :: (MonadDOM m) => Window -> m (Maybe CSS) getCSS self = liftDOM ((self ^. js "CSS") >>= fromJSVal) -- | getCSSUnsafe :: (MonadDOM m, HasCallStack) => Window -> m CSS getCSSUnsafe self = liftDOM (((self ^. js "CSS") >>= fromJSVal) >>= maybe (Prelude.error "Nothing to return") return) -- | getCSSUnchecked :: (MonadDOM m) => Window -> m CSS getCSSUnchecked self = liftDOM ((self ^. js "CSS") >>= fromJSValUnchecked) -- | abort :: EventName Window UIEvent abort = unsafeEventName (toJSString "abort") -- | beforeUnload :: EventName Window BeforeUnloadEvent beforeUnload = unsafeEventName (toJSString "beforeunload") -- | blurEvent :: EventName Window FocusEvent blurEvent = unsafeEventName (toJSString "blur") -- | canPlay :: EventName Window Event canPlay = unsafeEventName (toJSString "canplay") -- | canPlayThrough :: EventName Window Event canPlayThrough = unsafeEventName (toJSString "canplaythrough") -- | change :: EventName Window Event change = unsafeEventName (toJSString "change") -- | click :: EventName Window MouseEvent click = unsafeEventName (toJSString "click") -- | contextMenu :: EventName Window MouseEvent contextMenu = unsafeEventName (toJSString "contextmenu") -- | dblClick :: EventName Window MouseEvent dblClick = unsafeEventName (toJSString "dblclick") -- | drag :: EventName Window MouseEvent drag = unsafeEventName (toJSString "drag") -- | dragEnd :: EventName Window MouseEvent dragEnd = unsafeEventName (toJSString "dragend") -- | dragEnter :: EventName Window MouseEvent dragEnter = unsafeEventName (toJSString "dragenter") -- | dragLeave :: EventName Window MouseEvent dragLeave = unsafeEventName (toJSString "dragleave") -- | dragOver :: EventName Window MouseEvent dragOver = unsafeEventName (toJSString "dragover") -- | dragStart :: EventName Window MouseEvent dragStart = unsafeEventName (toJSString "dragstart") -- | drop :: EventName Window MouseEvent drop = unsafeEventName (toJSString "drop") -- | durationChange :: EventName Window Event durationChange = unsafeEventName (toJSString "durationchange") -- | emptied :: EventName Window Event emptied = unsafeEventName (toJSString "emptied") -- | ended :: EventName Window Event ended = unsafeEventName (toJSString "ended") -- | error :: EventName Window UIEvent error = unsafeEventName (toJSString "error") -- | focusEvent :: EventName Window FocusEvent focusEvent = unsafeEventName (toJSString "focus") -- | hashChange :: EventName Window HashChangeEvent hashChange = unsafeEventName (toJSString "hashchange") -- | input :: EventName Window Event input = unsafeEventName (toJSString "input") -- | invalid :: EventName Window Event invalid = unsafeEventName (toJSString "invalid") -- | keyDown :: EventName Window KeyboardEvent keyDown = unsafeEventName (toJSString "keydown") -- | keyPress :: EventName Window KeyboardEvent keyPress = unsafeEventName (toJSString "keypress") -- | keyUp :: EventName Window KeyboardEvent keyUp = unsafeEventName (toJSString "keyup") -- | load :: EventName Window UIEvent load = unsafeEventName (toJSString "load") -- | loadedData :: EventName Window Event loadedData = unsafeEventName (toJSString "loadeddata") -- | loadedMetadata :: EventName Window Event loadedMetadata = unsafeEventName (toJSString "loadedmetadata") -- | loadStart :: EventName Window ProgressEvent loadStart = unsafeEventName (toJSString "loadstart") -- | message :: EventName Window MessageEvent message = unsafeEventName (toJSString "message") -- | mouseDown :: EventName Window MouseEvent mouseDown = unsafeEventName (toJSString "mousedown") -- | mouseEnter :: EventName Window MouseEvent mouseEnter = unsafeEventName (toJSString "mouseenter") -- | mouseLeave :: EventName Window MouseEvent mouseLeave = unsafeEventName (toJSString "mouseleave") -- | mouseMove :: EventName Window MouseEvent mouseMove = unsafeEventName (toJSString "mousemove") -- | mouseOut :: EventName Window MouseEvent mouseOut = unsafeEventName (toJSString "mouseout") -- | mouseOver :: EventName Window MouseEvent mouseOver = unsafeEventName (toJSString "mouseover") -- | mouseUp :: EventName Window MouseEvent mouseUp = unsafeEventName (toJSString "mouseup") -- | mouseWheel :: EventName Window MouseEvent mouseWheel = unsafeEventName (toJSString "mousewheel") -- | offline :: EventName Window Event offline = unsafeEventName (toJSString "offline") -- | online :: EventName Window Event online = unsafeEventName (toJSString "online") -- | pageHide :: EventName Window PageTransitionEvent pageHide = unsafeEventName (toJSString "pagehide") -- | pageShow :: EventName Window PageTransitionEvent pageShow = unsafeEventName (toJSString "pageshow") -- | pause :: EventName Window Event pause = unsafeEventName (toJSString "pause") -- | play :: EventName Window Event play = unsafeEventName (toJSString "play") -- | playing :: EventName Window Event playing = unsafeEventName (toJSString "playing") -- | popState :: EventName Window PopStateEvent popState = unsafeEventName (toJSString "popstate") -- | progress :: EventName Window ProgressEvent progress = unsafeEventName (toJSString "progress") -- | rateChange :: EventName Window Event rateChange = unsafeEventName (toJSString "ratechange") -- | resize :: EventName Window UIEvent resize = unsafeEventName (toJSString "resize") -- | scrollEvent :: EventName Window UIEvent scrollEvent = unsafeEventName (toJSString "scroll") -- | seeked :: EventName Window Event seeked = unsafeEventName (toJSString "seeked") -- | seeking :: EventName Window Event seeking = unsafeEventName (toJSString "seeking") -- | select :: EventName Window UIEvent select = unsafeEventName (toJSString "select") -- | stalled :: EventName Window Event stalled = unsafeEventName (toJSString "stalled") -- | storage :: EventName Window StorageEvent storage = unsafeEventName (toJSString "storage") -- | submit :: EventName Window Event submit = unsafeEventName (toJSString "submit") -- | suspend :: EventName Window Event suspend = unsafeEventName (toJSString "suspend") -- | timeUpdate :: EventName Window Event timeUpdate = unsafeEventName (toJSString "timeupdate") -- | unload :: EventName Window UIEvent unload = unsafeEventName (toJSString "unload") -- | volumeChange :: EventName Window Event volumeChange = unsafeEventName (toJSString "volumechange") -- | waiting :: EventName Window Event waiting = unsafeEventName (toJSString "waiting") -- | wheel :: EventName Window WheelEvent wheel = unsafeEventName (toJSString "wheel") -- | reset :: EventName Window Event reset = unsafeEventName (toJSString "reset") -- | search :: EventName Window Event search = unsafeEventName (toJSString "search") -- | webKitAnimationEnd :: EventName Window AnimationEvent webKitAnimationEnd = unsafeEventName (toJSString "webkitanimationend") -- | webKitAnimationIteration :: EventName Window AnimationEvent webKitAnimationIteration = unsafeEventName (toJSString "webkitanimationiteration") -- | webKitAnimationStart :: EventName Window AnimationEvent webKitAnimationStart = unsafeEventName (toJSString "webkitanimationstart") -- | animationEnd :: EventName Window AnimationEvent animationEnd = unsafeEventName (toJSString "animationend") -- | animationIteration :: EventName Window AnimationEvent animationIteration = unsafeEventName (toJSString "animationiteration") -- | animationStart :: EventName Window AnimationEvent animationStart = unsafeEventName (toJSString "animationstart") -- | webKitTransitionEnd :: EventName Window TransitionEvent webKitTransitionEnd = unsafeEventName (toJSString "webkittransitionend") -- | transitionEnd :: EventName Window TransitionEvent transitionEnd = unsafeEventName (toJSString "transitionend") -- | orientationChange :: EventName Window Event orientationChange = unsafeEventName (toJSString "orientationchange") -- | touchStart :: EventName Window TouchEvent touchStart = unsafeEventName (toJSString "touchstart") -- | touchMove :: EventName Window TouchEvent touchMove = unsafeEventName (toJSString "touchmove") -- | touchEnd :: EventName Window TouchEvent touchEnd = unsafeEventName (toJSString "touchend") -- | touchCancel :: EventName Window TouchEvent touchCancel = unsafeEventName (toJSString "touchcancel") -- | gestureStart :: EventName Window UIEvent gestureStart = unsafeEventName (toJSString "gesturestart") -- | gestureChange :: EventName Window UIEvent gestureChange = unsafeEventName (toJSString "gesturechange") -- | gestureEnd :: EventName Window UIEvent gestureEnd = unsafeEventName (toJSString "gestureend") -- | deviceMotion :: EventName Window DeviceMotionEvent deviceMotion = unsafeEventName (toJSString "devicemotion") -- | deviceOrientation :: EventName Window DeviceOrientationEvent deviceOrientation = unsafeEventName (toJSString "deviceorientation") -- | webKitDeviceProximity :: EventName Window DeviceProximityEvent webKitDeviceProximity = unsafeEventName (toJSString "webkitdeviceproximity") -- | webKitWillRevealBottom :: EventName Window Event webKitWillRevealBottom = unsafeEventName (toJSString "webkitwillrevealbottom") -- | webKitWillRevealLeft :: EventName Window Event webKitWillRevealLeft = unsafeEventName (toJSString "webkitwillrevealleft") -- | webKitWillRevealRight :: EventName Window Event webKitWillRevealRight = unsafeEventName (toJSString "webkitwillrevealright") -- | webKitWillRevealTop :: EventName Window Event webKitWillRevealTop = unsafeEventName (toJSString "webkitwillrevealtop")