{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.Document
       (getAnimations, getAnimations_, newDocument, getElementsByTagName,
        getElementsByTagName_, getElementsByTagNameNS,
        getElementsByTagNameNS_, getElementsByClassName,
        getElementsByClassName_, createElement, createElement_,
        createElementNS, createElementNS_, createDocumentFragment,
        createDocumentFragment_, createTextNode, createTextNode_,
        createCDATASection, createCDATASection_, createComment,
        createComment_, createProcessingInstruction,
        createProcessingInstruction_, importNode, importNode_, adoptNode,
        adoptNode_, createAttribute, createAttribute_, createAttributeNS,
        createAttributeNS_, createEvent, createEvent_, createRange,
        createRange_, createNodeIterator, createNodeIterator_,
        createTreeWalker, createTreeWalker_, getElementsByName,
        getElementsByName_, hasFocus, hasFocus_, execCommand, execCommand_,
        queryCommandEnabled, queryCommandEnabled_, queryCommandIndeterm,
        queryCommandIndeterm_, queryCommandState, queryCommandState_,
        queryCommandSupported, queryCommandSupported_, queryCommandValue,
        queryCommandValue_, getSelection, getSelection_,
        getSelectionUnsafe, getSelectionUnchecked, createExpression,
        createExpression_, createNSResolver, createNSResolver_, evaluate,
        evaluate_, webkitExitFullscreen, webkitCancelFullScreen,
        exitPointerLock, getOverrideStyle, getOverrideStyle_,
        caretRangeFromPoint, caretRangeFromPoint_, getCSSCanvasContext,
        getCSSCanvasContext_, webkitGetNamedFlows, webkitGetNamedFlows_,
        createTouch, createTouch_, createTouchList, createTouchList_,
        getTimeline, getImplementation, getURL, getDocumentURI, getOrigin,
        getCompatMode, getCharacterSet, getCharset, getInputEncoding,
        getContentType, getDoctype, getDoctypeUnsafe, getDoctypeUnchecked,
        getDocumentElement, getDocumentElementUnsafe,
        getDocumentElementUnchecked, getLocation, getLocationUnsafe,
        getLocationUnchecked, setDomain, getDomain, getReferrer, setCookie,
        getCookie, getLastModified, getReadyState, setTitle, getTitle,
        setDir, getDir, setBody, getBody, getBodyUnsafe, getBodyUnchecked,
        getHead, getHeadUnsafe, getHeadUnchecked, getImages, getEmbeds,
        getPlugins, getLinks, getForms, getScripts, getCurrentScript,
        getCurrentScriptUnsafe, getCurrentScriptUnchecked, getDefaultView,
        getDefaultViewUnsafe, getDefaultViewUnchecked, setDesignMode,
        getDesignMode, readyStateChange, getStyleSheets,
        getScrollingElement, getScrollingElementUnsafe,
        getScrollingElementUnchecked, getWebkitFullscreenEnabled,
        getWebkitFullscreenElement, getWebkitFullscreenElementUnsafe,
        getWebkitFullscreenElementUnchecked, getWebkitIsFullScreen,
        getWebkitFullScreenKeyboardInputAllowed,
        getWebkitCurrentFullScreenElement, webKitFullscreenChange,
        webKitFullscreenError, pointerlockchange, pointerlockerror,
        getFonts, getHidden, getVisibilityState, visibilitychange,
        getApplets, getAnchors, getPreferredStylesheetSet,
        getPreferredStylesheetSetUnsafe,
        getPreferredStylesheetSetUnchecked, setSelectedStylesheetSet,
        getSelectedStylesheetSet, getSelectedStylesheetSetUnsafe,
        getSelectedStylesheetSetUnchecked, getXmlEncoding,
        getXmlEncodingUnsafe, getXmlEncodingUnchecked, setXmlVersion,
        getXmlVersion, getXmlVersionUnsafe, getXmlVersionUnchecked,
        setXmlStandalone, getXmlStandalone, selectStart, selectionchange,
        getRootElement, getRootElementUnsafe, getRootElementUnchecked,
        Document(..), gTypeDocument, IsDocument, toDocument)
       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 Data.Traversable (mapM)
import Language.Javascript.JSaddle (JSM(..), JSVal(..), JSString, strictEqual, toJSVal, valToStr, valToNumber, valToBool, js, jss, jsf, jsg, function, asyncFunction, new, array, jsUndefined, (!), (!!))
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, unsafeEventNameAsync)
import JSDOM.Enums

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getAnimations Mozilla Document.getAnimations documentation> 
getAnimations ::
              (MonadDOM m, IsDocument self) => self -> m [Animation]
getAnimations :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m [Animation]
getAnimations self
self
  = DOM [Animation] -> m [Animation]
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getAnimations" ()) JSM JSVal -> (JSVal -> DOM [Animation]) -> DOM [Animation]
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM [Animation]
forall o. FromJSVal o => JSVal -> JSM [o]
fromJSArrayUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getAnimations Mozilla Document.getAnimations documentation> 
getAnimations_ :: (MonadDOM m, IsDocument self) => self -> m ()
getAnimations_ :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m ()
getAnimations_ self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getAnimations" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document Mozilla Document documentation> 
newDocument :: (MonadDOM m) => m Document
newDocument :: forall (m :: * -> *). MonadDOM m => m Document
newDocument = DOM Document -> m Document
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSVal -> Document
Document (JSVal -> Document) -> JSM JSVal -> DOM Document
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JSVal -> () -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new (String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"Document") ())

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getElementsByTagName Mozilla Document.getElementsByTagName documentation> 
getElementsByTagName ::
                     (MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
                       self -> qualifiedName -> m HTMLCollection
getElementsByTagName :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m HTMLCollection
getElementsByTagName self
self qualifiedName
qualifiedName
  = DOM HTMLCollection -> m HTMLCollection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getElementsByTagName"
          [qualifiedName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal qualifiedName
qualifiedName])
         JSM JSVal -> (JSVal -> DOM HTMLCollection) -> DOM HTMLCollection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLCollection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getElementsByTagName Mozilla Document.getElementsByTagName documentation> 
getElementsByTagName_ ::
                      (MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
                        self -> qualifiedName -> m ()
getElementsByTagName_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
getElementsByTagName_ self
self qualifiedName
qualifiedName
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getElementsByTagName"
            [qualifiedName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal qualifiedName
qualifiedName]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getElementsByTagNameNS Mozilla Document.getElementsByTagNameNS documentation> 
getElementsByTagNameNS ::
                       (MonadDOM m, IsDocument self, ToJSString namespaceURI,
                        ToJSString localName) =>
                         self -> Maybe namespaceURI -> localName -> m HTMLCollection
getElementsByTagNameNS :: forall (m :: * -> *) self namespaceURI localName.
(MonadDOM m, IsDocument self, ToJSString namespaceURI,
 ToJSString localName) =>
self -> Maybe namespaceURI -> localName -> m HTMLCollection
getElementsByTagNameNS self
self Maybe namespaceURI
namespaceURI localName
localName
  = DOM HTMLCollection -> m HTMLCollection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getElementsByTagNameNS"
          [Maybe namespaceURI -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe namespaceURI
namespaceURI, localName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal localName
localName])
         JSM JSVal -> (JSVal -> DOM HTMLCollection) -> DOM HTMLCollection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLCollection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getElementsByTagNameNS Mozilla Document.getElementsByTagNameNS documentation> 
getElementsByTagNameNS_ ::
                        (MonadDOM m, IsDocument self, ToJSString namespaceURI,
                         ToJSString localName) =>
                          self -> Maybe namespaceURI -> localName -> m ()
getElementsByTagNameNS_ :: forall (m :: * -> *) self namespaceURI localName.
(MonadDOM m, IsDocument self, ToJSString namespaceURI,
 ToJSString localName) =>
self -> Maybe namespaceURI -> localName -> m ()
getElementsByTagNameNS_ self
self Maybe namespaceURI
namespaceURI localName
localName
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getElementsByTagNameNS"
            [Maybe namespaceURI -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe namespaceURI
namespaceURI, localName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal localName
localName]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getElementsByClassName Mozilla Document.getElementsByClassName documentation> 
getElementsByClassName ::
                       (MonadDOM m, IsDocument self, ToJSString classNames) =>
                         self -> classNames -> m HTMLCollection
getElementsByClassName :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m HTMLCollection
getElementsByClassName self
self classNames
classNames
  = DOM HTMLCollection -> m HTMLCollection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getElementsByClassName"
          [classNames -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal classNames
classNames])
         JSM JSVal -> (JSVal -> DOM HTMLCollection) -> DOM HTMLCollection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLCollection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getElementsByClassName Mozilla Document.getElementsByClassName documentation> 
getElementsByClassName_ ::
                        (MonadDOM m, IsDocument self, ToJSString classNames) =>
                          self -> classNames -> m ()
getElementsByClassName_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
getElementsByClassName_ self
self classNames
classNames
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getElementsByClassName"
            [classNames -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal classNames
classNames]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createElement Mozilla Document.createElement documentation> 
createElement ::
              (MonadDOM m, IsDocument self, ToJSString localName) =>
                self -> localName -> m Element
createElement :: forall (m :: * -> *) self localName.
(MonadDOM m, IsDocument self, ToJSString localName) =>
self -> localName -> m Element
createElement self
self localName
localName
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createElement" [localName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal localName
localName]) JSM JSVal -> (JSVal -> DOM Element) -> DOM Element
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Element
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createElement Mozilla Document.createElement documentation> 
createElement_ ::
               (MonadDOM m, IsDocument self, ToJSString localName) =>
                 self -> localName -> m ()
createElement_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
createElement_ self
self localName
localName
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createElement" [localName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal localName
localName]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createElementNS Mozilla Document.createElementNS documentation> 
createElementNS ::
                (MonadDOM m, IsDocument self, ToJSString namespaceURI,
                 ToJSString qualifiedName) =>
                  self -> Maybe namespaceURI -> qualifiedName -> m Element
createElementNS :: forall (m :: * -> *) self namespaceURI qualifiedName.
(MonadDOM m, IsDocument self, ToJSString namespaceURI,
 ToJSString qualifiedName) =>
self -> Maybe namespaceURI -> qualifiedName -> m Element
createElementNS self
self Maybe namespaceURI
namespaceURI qualifiedName
qualifiedName
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createElementNS"
          [Maybe namespaceURI -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe namespaceURI
namespaceURI, qualifiedName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal qualifiedName
qualifiedName])
         JSM JSVal -> (JSVal -> DOM Element) -> DOM Element
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Element
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createElementNS Mozilla Document.createElementNS documentation> 
createElementNS_ ::
                 (MonadDOM m, IsDocument self, ToJSString namespaceURI,
                  ToJSString qualifiedName) =>
                   self -> Maybe namespaceURI -> qualifiedName -> m ()
createElementNS_ :: forall (m :: * -> *) self namespaceURI localName.
(MonadDOM m, IsDocument self, ToJSString namespaceURI,
 ToJSString localName) =>
self -> Maybe namespaceURI -> localName -> m ()
createElementNS_ self
self Maybe namespaceURI
namespaceURI qualifiedName
qualifiedName
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createElementNS"
            [Maybe namespaceURI -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe namespaceURI
namespaceURI, qualifiedName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal qualifiedName
qualifiedName]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createDocumentFragment Mozilla Document.createDocumentFragment documentation> 
createDocumentFragment ::
                       (MonadDOM m, IsDocument self) => self -> m DocumentFragment
createDocumentFragment :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment self
self
  = DOM DocumentFragment -> m DocumentFragment
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createDocumentFragment" ()) JSM JSVal
-> (JSVal -> DOM DocumentFragment) -> DOM DocumentFragment
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM DocumentFragment
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createDocumentFragment Mozilla Document.createDocumentFragment documentation> 
createDocumentFragment_ ::
                        (MonadDOM m, IsDocument self) => self -> m ()
createDocumentFragment_ :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m ()
createDocumentFragment_ self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createDocumentFragment" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createTextNode Mozilla Document.createTextNode documentation> 
createTextNode ::
               (MonadDOM m, IsDocument self, ToJSString data') =>
                 self -> data' -> m Text
createTextNode :: forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode self
self data'
data'
  = DOM Text -> m Text
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createTextNode" [data' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal data'
data']) JSM JSVal -> (JSVal -> DOM Text) -> DOM Text
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Text
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createTextNode Mozilla Document.createTextNode documentation> 
createTextNode_ ::
                (MonadDOM m, IsDocument self, ToJSString data') =>
                  self -> data' -> m ()
createTextNode_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
createTextNode_ self
self data'
data'
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createTextNode" [data' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal data'
data']))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createCDATASection Mozilla Document.createCDATASection documentation> 
createCDATASection ::
                   (MonadDOM m, IsDocument self, ToJSString data') =>
                     self -> data' -> m CDATASection
createCDATASection :: forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m CDATASection
createCDATASection self
self data'
data'
  = DOM CDATASection -> m CDATASection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createCDATASection" [data' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal data'
data'])
         JSM JSVal -> (JSVal -> DOM CDATASection) -> DOM CDATASection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM CDATASection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createCDATASection Mozilla Document.createCDATASection documentation> 
createCDATASection_ ::
                    (MonadDOM m, IsDocument self, ToJSString data') =>
                      self -> data' -> m ()
createCDATASection_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
createCDATASection_ self
self data'
data'
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createCDATASection" [data' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal data'
data']))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createComment Mozilla Document.createComment documentation> 
createComment ::
              (MonadDOM m, IsDocument self, ToJSString data') =>
                self -> data' -> m Comment
createComment :: forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Comment
createComment self
self data'
data'
  = DOM Comment -> m Comment
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createComment" [data' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal data'
data']) JSM JSVal -> (JSVal -> DOM Comment) -> DOM Comment
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Comment
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createComment Mozilla Document.createComment documentation> 
createComment_ ::
               (MonadDOM m, IsDocument self, ToJSString data') =>
                 self -> data' -> m ()
createComment_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
createComment_ self
self data'
data'
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createComment" [data' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal data'
data']))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createProcessingInstruction Mozilla Document.createProcessingInstruction documentation> 
createProcessingInstruction ::
                            (MonadDOM m, IsDocument self, ToJSString target,
                             ToJSString data') =>
                              self -> target -> data' -> m ProcessingInstruction
createProcessingInstruction :: forall (m :: * -> *) self target data'.
(MonadDOM m, IsDocument self, ToJSString target,
 ToJSString data') =>
self -> target -> data' -> m ProcessingInstruction
createProcessingInstruction self
self target
target data'
data'
  = DOM ProcessingInstruction -> m ProcessingInstruction
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createProcessingInstruction"
          [target -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal target
target, data' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal data'
data'])
         JSM JSVal
-> (JSVal -> DOM ProcessingInstruction)
-> DOM ProcessingInstruction
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM ProcessingInstruction
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createProcessingInstruction Mozilla Document.createProcessingInstruction documentation> 
createProcessingInstruction_ ::
                             (MonadDOM m, IsDocument self, ToJSString target,
                              ToJSString data') =>
                               self -> target -> data' -> m ()
createProcessingInstruction_ :: forall (m :: * -> *) self target data'.
(MonadDOM m, IsDocument self, ToJSString target,
 ToJSString data') =>
self -> target -> data' -> m ()
createProcessingInstruction_ self
self target
target data'
data'
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createProcessingInstruction"
            [target -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal target
target, data' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal data'
data']))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.importNode Mozilla Document.importNode documentation> 
importNode ::
           (MonadDOM m, IsDocument self, IsNode node) =>
             self -> node -> Bool -> m Node
importNode :: forall (m :: * -> *) self node.
(MonadDOM m, IsDocument self, IsNode node) =>
self -> node -> Bool -> m Node
importNode self
self node
node Bool
deep
  = DOM Node -> m Node
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"importNode"
          [node -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal node
node, Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
deep])
         JSM JSVal -> (JSVal -> DOM Node) -> DOM Node
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Node
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.importNode Mozilla Document.importNode documentation> 
importNode_ ::
            (MonadDOM m, IsDocument self, IsNode node) =>
              self -> node -> Bool -> m ()
importNode_ :: forall (m :: * -> *) self node.
(MonadDOM m, IsDocument self, IsNode node) =>
self -> node -> Bool -> m ()
importNode_ self
self node
node Bool
deep
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"importNode"
            [node -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal node
node, Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
deep]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.adoptNode Mozilla Document.adoptNode documentation> 
adoptNode ::
          (MonadDOM m, IsDocument self, IsNode node) =>
            self -> node -> m Node
adoptNode :: forall (m :: * -> *) self node.
(MonadDOM m, IsDocument self, IsNode node) =>
self -> node -> m Node
adoptNode self
self node
node
  = DOM Node -> m Node
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"adoptNode" [node -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal node
node]) JSM JSVal -> (JSVal -> DOM Node) -> DOM Node
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Node
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.adoptNode Mozilla Document.adoptNode documentation> 
adoptNode_ ::
           (MonadDOM m, IsDocument self, IsNode node) => self -> node -> m ()
adoptNode_ :: forall (m :: * -> *) self node.
(MonadDOM m, IsDocument self, IsNode node) =>
self -> node -> m ()
adoptNode_ self
self node
node
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"adoptNode" [node -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal node
node]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createAttribute Mozilla Document.createAttribute documentation> 
createAttribute ::
                (MonadDOM m, IsDocument self, ToJSString localName) =>
                  self -> localName -> m Attr
createAttribute :: forall (m :: * -> *) self localName.
(MonadDOM m, IsDocument self, ToJSString localName) =>
self -> localName -> m Attr
createAttribute self
self localName
localName
  = DOM Attr -> m Attr
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createAttribute" [localName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal localName
localName])
         JSM JSVal -> (JSVal -> DOM Attr) -> DOM Attr
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Attr
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createAttribute Mozilla Document.createAttribute documentation> 
createAttribute_ ::
                 (MonadDOM m, IsDocument self, ToJSString localName) =>
                   self -> localName -> m ()
createAttribute_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
createAttribute_ self
self localName
localName
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createAttribute" [localName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal localName
localName]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createAttributeNS Mozilla Document.createAttributeNS documentation> 
createAttributeNS ::
                  (MonadDOM m, IsDocument self, ToJSString namespaceURI,
                   ToJSString qualifiedName) =>
                    self -> Maybe namespaceURI -> qualifiedName -> m Attr
createAttributeNS :: forall (m :: * -> *) self namespaceURI qualifiedName.
(MonadDOM m, IsDocument self, ToJSString namespaceURI,
 ToJSString qualifiedName) =>
self -> Maybe namespaceURI -> qualifiedName -> m Attr
createAttributeNS self
self Maybe namespaceURI
namespaceURI qualifiedName
qualifiedName
  = DOM Attr -> m Attr
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createAttributeNS"
          [Maybe namespaceURI -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe namespaceURI
namespaceURI, qualifiedName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal qualifiedName
qualifiedName])
         JSM JSVal -> (JSVal -> DOM Attr) -> DOM Attr
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Attr
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createAttributeNS Mozilla Document.createAttributeNS documentation> 
createAttributeNS_ ::
                   (MonadDOM m, IsDocument self, ToJSString namespaceURI,
                    ToJSString qualifiedName) =>
                     self -> Maybe namespaceURI -> qualifiedName -> m ()
createAttributeNS_ :: forall (m :: * -> *) self namespaceURI localName.
(MonadDOM m, IsDocument self, ToJSString namespaceURI,
 ToJSString localName) =>
self -> Maybe namespaceURI -> localName -> m ()
createAttributeNS_ self
self Maybe namespaceURI
namespaceURI qualifiedName
qualifiedName
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createAttributeNS"
            [Maybe namespaceURI -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe namespaceURI
namespaceURI, qualifiedName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal qualifiedName
qualifiedName]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createEvent Mozilla Document.createEvent documentation> 
createEvent ::
            (MonadDOM m, IsDocument self, ToJSString type') =>
              self -> type' -> m Event
createEvent :: forall (m :: * -> *) self type'.
(MonadDOM m, IsDocument self, ToJSString type') =>
self -> type' -> m Event
createEvent self
self type'
type'
  = DOM Event -> m Event
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createEvent" [type' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal type'
type']) JSM JSVal -> (JSVal -> DOM Event) -> DOM Event
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Event
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createEvent Mozilla Document.createEvent documentation> 
createEvent_ ::
             (MonadDOM m, IsDocument self, ToJSString type') =>
               self -> type' -> m ()
createEvent_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
createEvent_ self
self type'
type'
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createEvent" [type' -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal type'
type']))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createRange Mozilla Document.createRange documentation> 
createRange :: (MonadDOM m, IsDocument self) => self -> m Range
createRange :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Range
createRange self
self
  = DOM Range -> m Range
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createRange" ()) JSM JSVal -> (JSVal -> DOM Range) -> DOM Range
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Range
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createRange Mozilla Document.createRange documentation> 
createRange_ :: (MonadDOM m, IsDocument self) => self -> m ()
createRange_ :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m ()
createRange_ self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createRange" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createNodeIterator Mozilla Document.createNodeIterator documentation> 
createNodeIterator ::
                   (MonadDOM m, IsDocument self, IsNode root) =>
                     self -> root -> Maybe Word -> Maybe NodeFilter -> m NodeIterator
createNodeIterator :: forall (m :: * -> *) self root.
(MonadDOM m, IsDocument self, IsNode root) =>
self -> root -> Maybe Word -> Maybe NodeFilter -> m NodeIterator
createNodeIterator self
self root
root Maybe Word
whatToShow Maybe NodeFilter
filter
  = DOM NodeIterator -> m NodeIterator
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createNodeIterator"
          [root -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal root
root, Maybe Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Word
whatToShow, Maybe NodeFilter -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe NodeFilter
filter])
         JSM JSVal -> (JSVal -> DOM NodeIterator) -> DOM NodeIterator
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM NodeIterator
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createNodeIterator Mozilla Document.createNodeIterator documentation> 
createNodeIterator_ ::
                    (MonadDOM m, IsDocument self, IsNode root) =>
                      self -> root -> Maybe Word -> Maybe NodeFilter -> m ()
createNodeIterator_ :: forall (m :: * -> *) self root.
(MonadDOM m, IsDocument self, IsNode root) =>
self -> root -> Maybe Word -> Maybe NodeFilter -> m ()
createNodeIterator_ self
self root
root Maybe Word
whatToShow Maybe NodeFilter
filter
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createNodeIterator"
            [root -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal root
root, Maybe Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Word
whatToShow, Maybe NodeFilter -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe NodeFilter
filter]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createTreeWalker Mozilla Document.createTreeWalker documentation> 
createTreeWalker ::
                 (MonadDOM m, IsDocument self, IsNode root) =>
                   self -> root -> Maybe Word -> Maybe NodeFilter -> m TreeWalker
createTreeWalker :: forall (m :: * -> *) self root.
(MonadDOM m, IsDocument self, IsNode root) =>
self -> root -> Maybe Word -> Maybe NodeFilter -> m TreeWalker
createTreeWalker self
self root
root Maybe Word
whatToShow Maybe NodeFilter
filter
  = DOM TreeWalker -> m TreeWalker
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createTreeWalker"
          [root -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal root
root, Maybe Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Word
whatToShow, Maybe NodeFilter -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe NodeFilter
filter])
         JSM JSVal -> (JSVal -> DOM TreeWalker) -> DOM TreeWalker
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM TreeWalker
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createTreeWalker Mozilla Document.createTreeWalker documentation> 
createTreeWalker_ ::
                  (MonadDOM m, IsDocument self, IsNode root) =>
                    self -> root -> Maybe Word -> Maybe NodeFilter -> m ()
createTreeWalker_ :: forall (m :: * -> *) self root.
(MonadDOM m, IsDocument self, IsNode root) =>
self -> root -> Maybe Word -> Maybe NodeFilter -> m ()
createTreeWalker_ self
self root
root Maybe Word
whatToShow Maybe NodeFilter
filter
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createTreeWalker"
            [root -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal root
root, Maybe Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Word
whatToShow, Maybe NodeFilter -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe NodeFilter
filter]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getElementsByName Mozilla Document.getElementsByName documentation> 
getElementsByName ::
                  (MonadDOM m, IsDocument self, ToJSString elementName) =>
                    self -> elementName -> m NodeList
getElementsByName :: forall (m :: * -> *) self elementName.
(MonadDOM m, IsDocument self, ToJSString elementName) =>
self -> elementName -> m NodeList
getElementsByName self
self elementName
elementName
  = DOM NodeList -> m NodeList
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getElementsByName"
          [elementName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal elementName
elementName])
         JSM JSVal -> (JSVal -> DOM NodeList) -> DOM NodeList
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM NodeList
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getElementsByName Mozilla Document.getElementsByName documentation> 
getElementsByName_ ::
                   (MonadDOM m, IsDocument self, ToJSString elementName) =>
                     self -> elementName -> m ()
getElementsByName_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
getElementsByName_ self
self elementName
elementName
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getElementsByName"
            [elementName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal elementName
elementName]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.hasFocus Mozilla Document.hasFocus documentation> 
hasFocus :: (MonadDOM m, IsDocument self) => self -> m Bool
hasFocus :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Bool
hasFocus self
self
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"hasFocus" ()) JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.hasFocus Mozilla Document.hasFocus documentation> 
hasFocus_ :: (MonadDOM m, IsDocument self) => self -> m ()
hasFocus_ :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m ()
hasFocus_ self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"hasFocus" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.execCommand Mozilla Document.execCommand documentation> 
execCommand ::
            (MonadDOM m, IsDocument self, ToJSString commandId,
             ToJSString value) =>
              self -> commandId -> Bool -> Maybe value -> m Bool
execCommand :: forall (m :: * -> *) self commandId value.
(MonadDOM m, IsDocument self, ToJSString commandId,
 ToJSString value) =>
self -> commandId -> Bool -> Maybe value -> m Bool
execCommand self
self commandId
commandId Bool
showUI Maybe value
value
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"execCommand"
          [commandId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal commandId
commandId, Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
showUI, Maybe value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe value
value])
         JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.execCommand Mozilla Document.execCommand documentation> 
execCommand_ ::
             (MonadDOM m, IsDocument self, ToJSString commandId,
              ToJSString value) =>
               self -> commandId -> Bool -> Maybe value -> m ()
execCommand_ :: forall (m :: * -> *) self commandId value.
(MonadDOM m, IsDocument self, ToJSString commandId,
 ToJSString value) =>
self -> commandId -> Bool -> Maybe value -> m ()
execCommand_ self
self commandId
commandId Bool
showUI Maybe value
value
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"execCommand"
            [commandId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal commandId
commandId, Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
showUI, Maybe value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe value
value]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.queryCommandEnabled Mozilla Document.queryCommandEnabled documentation> 
queryCommandEnabled ::
                    (MonadDOM m, IsDocument self, ToJSString commandId) =>
                      self -> commandId -> m Bool
queryCommandEnabled :: forall (m :: * -> *) self commandId.
(MonadDOM m, IsDocument self, ToJSString commandId) =>
self -> commandId -> m Bool
queryCommandEnabled self
self commandId
commandId
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"queryCommandEnabled"
          [commandId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal commandId
commandId])
         JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.queryCommandEnabled Mozilla Document.queryCommandEnabled documentation> 
queryCommandEnabled_ ::
                     (MonadDOM m, IsDocument self, ToJSString commandId) =>
                       self -> commandId -> m ()
queryCommandEnabled_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
queryCommandEnabled_ self
self commandId
commandId
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"queryCommandEnabled"
            [commandId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal commandId
commandId]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.queryCommandIndeterm Mozilla Document.queryCommandIndeterm documentation> 
queryCommandIndeterm ::
                     (MonadDOM m, IsDocument self, ToJSString commandId) =>
                       self -> commandId -> m Bool
queryCommandIndeterm :: forall (m :: * -> *) self commandId.
(MonadDOM m, IsDocument self, ToJSString commandId) =>
self -> commandId -> m Bool
queryCommandIndeterm self
self commandId
commandId
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"queryCommandIndeterm"
          [commandId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal commandId
commandId])
         JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.queryCommandIndeterm Mozilla Document.queryCommandIndeterm documentation> 
queryCommandIndeterm_ ::
                      (MonadDOM m, IsDocument self, ToJSString commandId) =>
                        self -> commandId -> m ()
queryCommandIndeterm_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
queryCommandIndeterm_ self
self commandId
commandId
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"queryCommandIndeterm"
            [commandId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal commandId
commandId]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.queryCommandState Mozilla Document.queryCommandState documentation> 
queryCommandState ::
                  (MonadDOM m, IsDocument self, ToJSString commandId) =>
                    self -> commandId -> m Bool
queryCommandState :: forall (m :: * -> *) self commandId.
(MonadDOM m, IsDocument self, ToJSString commandId) =>
self -> commandId -> m Bool
queryCommandState self
self commandId
commandId
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"queryCommandState" [commandId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal commandId
commandId])
         JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.queryCommandState Mozilla Document.queryCommandState documentation> 
queryCommandState_ ::
                   (MonadDOM m, IsDocument self, ToJSString commandId) =>
                     self -> commandId -> m ()
queryCommandState_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
queryCommandState_ self
self commandId
commandId
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"queryCommandState" [commandId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal commandId
commandId]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.queryCommandSupported Mozilla Document.queryCommandSupported documentation> 
queryCommandSupported ::
                      (MonadDOM m, IsDocument self, ToJSString commandId) =>
                        self -> commandId -> m Bool
queryCommandSupported :: forall (m :: * -> *) self commandId.
(MonadDOM m, IsDocument self, ToJSString commandId) =>
self -> commandId -> m Bool
queryCommandSupported self
self commandId
commandId
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"queryCommandSupported"
          [commandId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal commandId
commandId])
         JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.queryCommandSupported Mozilla Document.queryCommandSupported documentation> 
queryCommandSupported_ ::
                       (MonadDOM m, IsDocument self, ToJSString commandId) =>
                         self -> commandId -> m ()
queryCommandSupported_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
queryCommandSupported_ self
self commandId
commandId
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"queryCommandSupported"
            [commandId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal commandId
commandId]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.queryCommandValue Mozilla Document.queryCommandValue documentation> 
queryCommandValue ::
                  (MonadDOM m, IsDocument self, ToJSString commandId,
                   FromJSString result) =>
                    self -> commandId -> m result
queryCommandValue :: forall (m :: * -> *) self commandId result.
(MonadDOM m, IsDocument self, ToJSString commandId,
 FromJSString result) =>
self -> commandId -> m result
queryCommandValue self
self commandId
commandId
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"queryCommandValue" [commandId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal commandId
commandId])
         JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.queryCommandValue Mozilla Document.queryCommandValue documentation> 
queryCommandValue_ ::
                   (MonadDOM m, IsDocument self, ToJSString commandId) =>
                     self -> commandId -> m ()
queryCommandValue_ :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
queryCommandValue_ self
self commandId
commandId
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"queryCommandValue" [commandId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal commandId
commandId]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getSelection Mozilla Document.getSelection documentation> 
getSelection ::
             (MonadDOM m, IsDocument self) => self -> m (Maybe Selection)
getSelection :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m (Maybe Selection)
getSelection self
self
  = DOM (Maybe Selection) -> m (Maybe Selection)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getSelection" ()) JSM JSVal
-> (JSVal -> DOM (Maybe Selection)) -> DOM (Maybe Selection)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Selection)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getSelection Mozilla Document.getSelection documentation> 
getSelection_ :: (MonadDOM m, IsDocument self) => self -> m ()
getSelection_ :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m ()
getSelection_ self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getSelection" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getSelection Mozilla Document.getSelection documentation> 
getSelectionUnsafe ::
                   (MonadDOM m, IsDocument self, HasCallStack) => self -> m Selection
getSelectionUnsafe :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self, HasCallStack) =>
self -> m Selection
getSelectionUnsafe self
self
  = DOM Selection -> m Selection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getSelection" ()) JSM JSVal
-> (JSVal -> DOM (Maybe Selection)) -> DOM (Maybe Selection)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Selection)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe Selection)
-> (Maybe Selection -> DOM Selection) -> DOM Selection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM Selection
-> (Selection -> DOM Selection) -> Maybe Selection -> DOM Selection
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM Selection
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") Selection -> DOM Selection
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getSelection Mozilla Document.getSelection documentation> 
getSelectionUnchecked ::
                      (MonadDOM m, IsDocument self) => self -> m Selection
getSelectionUnchecked :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Selection
getSelectionUnchecked self
self
  = DOM Selection -> m Selection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getSelection" ()) JSM JSVal -> (JSVal -> DOM Selection) -> DOM Selection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Selection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createExpression Mozilla Document.createExpression documentation> 
createExpression ::
                 (MonadDOM m, IsDocument self, ToJSString expression) =>
                   self ->
                     Maybe expression -> Maybe XPathNSResolver -> m XPathExpression
createExpression :: forall (m :: * -> *) self expression.
(MonadDOM m, IsDocument self, ToJSString expression) =>
self
-> Maybe expression -> Maybe XPathNSResolver -> m XPathExpression
createExpression self
self Maybe expression
expression Maybe XPathNSResolver
resolver
  = DOM XPathExpression -> m XPathExpression
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createExpression"
          [Maybe expression -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe expression
expression, Maybe XPathNSResolver -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe XPathNSResolver
resolver])
         JSM JSVal -> (JSVal -> DOM XPathExpression) -> DOM XPathExpression
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM XPathExpression
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createExpression Mozilla Document.createExpression documentation> 
createExpression_ ::
                  (MonadDOM m, IsDocument self, ToJSString expression) =>
                    self -> Maybe expression -> Maybe XPathNSResolver -> m ()
createExpression_ :: forall (m :: * -> *) self expression.
(MonadDOM m, IsDocument self, ToJSString expression) =>
self -> Maybe expression -> Maybe XPathNSResolver -> m ()
createExpression_ self
self Maybe expression
expression Maybe XPathNSResolver
resolver
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createExpression"
            [Maybe expression -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe expression
expression, Maybe XPathNSResolver -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe XPathNSResolver
resolver]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createNSResolver Mozilla Document.createNSResolver documentation> 
createNSResolver ::
                 (MonadDOM m, IsDocument self, IsNode nodeResolver) =>
                   self -> Maybe nodeResolver -> m XPathNSResolver
createNSResolver :: forall (m :: * -> *) self nodeResolver.
(MonadDOM m, IsDocument self, IsNode nodeResolver) =>
self -> Maybe nodeResolver -> m XPathNSResolver
createNSResolver self
self Maybe nodeResolver
nodeResolver
  = DOM XPathNSResolver -> m XPathNSResolver
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createNSResolver"
          [Maybe nodeResolver -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe nodeResolver
nodeResolver])
         JSM JSVal -> (JSVal -> DOM XPathNSResolver) -> DOM XPathNSResolver
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM XPathNSResolver
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createNSResolver Mozilla Document.createNSResolver documentation> 
createNSResolver_ ::
                  (MonadDOM m, IsDocument self, IsNode nodeResolver) =>
                    self -> Maybe nodeResolver -> m ()
createNSResolver_ :: forall (m :: * -> *) self nodeResolver.
(MonadDOM m, IsDocument self, IsNode nodeResolver) =>
self -> Maybe nodeResolver -> m ()
createNSResolver_ self
self Maybe nodeResolver
nodeResolver
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createNSResolver"
            [Maybe nodeResolver -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe nodeResolver
nodeResolver]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.evaluate Mozilla Document.evaluate documentation> 
evaluate ::
         (MonadDOM m, IsDocument self, ToJSString expression,
          IsNode contextNode) =>
           self ->
             Maybe expression ->
               Maybe contextNode ->
                 Maybe XPathNSResolver ->
                   Maybe Word -> Maybe XPathResult -> m XPathResult
evaluate :: forall (m :: * -> *) self expression contextNode.
(MonadDOM m, IsDocument self, ToJSString expression,
 IsNode contextNode) =>
self
-> Maybe expression
-> Maybe contextNode
-> Maybe XPathNSResolver
-> Maybe Word
-> Maybe XPathResult
-> m XPathResult
evaluate self
self Maybe expression
expression Maybe contextNode
contextNode Maybe XPathNSResolver
resolver Maybe Word
type' Maybe XPathResult
inResult
  = DOM XPathResult -> m XPathResult
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"evaluate"
          [Maybe expression -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe expression
expression, Maybe contextNode -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe contextNode
contextNode, Maybe XPathNSResolver -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe XPathNSResolver
resolver,
           Maybe Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Word
type', Maybe XPathResult -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe XPathResult
inResult])
         JSM JSVal -> (JSVal -> DOM XPathResult) -> DOM XPathResult
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM XPathResult
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.evaluate Mozilla Document.evaluate documentation> 
evaluate_ ::
          (MonadDOM m, IsDocument self, ToJSString expression,
           IsNode contextNode) =>
            self ->
              Maybe expression ->
                Maybe contextNode ->
                  Maybe XPathNSResolver -> Maybe Word -> Maybe XPathResult -> m ()
evaluate_ :: forall (m :: * -> *) self expression contextNode.
(MonadDOM m, IsDocument self, ToJSString expression,
 IsNode contextNode) =>
self
-> Maybe expression
-> Maybe contextNode
-> Maybe XPathNSResolver
-> Maybe Word
-> Maybe XPathResult
-> m ()
evaluate_ self
self Maybe expression
expression Maybe contextNode
contextNode Maybe XPathNSResolver
resolver Maybe Word
type' Maybe XPathResult
inResult
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"evaluate"
            [Maybe expression -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe expression
expression, Maybe contextNode -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe contextNode
contextNode, Maybe XPathNSResolver -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe XPathNSResolver
resolver,
             Maybe Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Word
type', Maybe XPathResult -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe XPathResult
inResult]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.webkitExitFullscreen Mozilla Document.webkitExitFullscreen documentation> 
webkitExitFullscreen ::
                     (MonadDOM m, IsDocument self) => self -> m ()
webkitExitFullscreen :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m ()
webkitExitFullscreen self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"webkitExitFullscreen" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.webkitCancelFullScreen Mozilla Document.webkitCancelFullScreen documentation> 
webkitCancelFullScreen ::
                       (MonadDOM m, IsDocument self) => self -> m ()
webkitCancelFullScreen :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m ()
webkitCancelFullScreen self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"webkitCancelFullScreen" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.exitPointerLock Mozilla Document.exitPointerLock documentation> 
exitPointerLock :: (MonadDOM m, IsDocument self) => self -> m ()
exitPointerLock :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m ()
exitPointerLock self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"exitPointerLock" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getOverrideStyle Mozilla Document.getOverrideStyle documentation> 
getOverrideStyle ::
                 (MonadDOM m, IsDocument self, IsElement element,
                  ToJSString pseudoElement) =>
                   self ->
                     Maybe element -> Maybe pseudoElement -> m CSSStyleDeclaration
getOverrideStyle :: forall (m :: * -> *) self element pseudoElement.
(MonadDOM m, IsDocument self, IsElement element,
 ToJSString pseudoElement) =>
self
-> Maybe element -> Maybe pseudoElement -> m CSSStyleDeclaration
getOverrideStyle self
self Maybe element
element Maybe pseudoElement
pseudoElement
  = DOM CSSStyleDeclaration -> m CSSStyleDeclaration
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getOverrideStyle"
          [Maybe element -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe element
element, Maybe pseudoElement -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe pseudoElement
pseudoElement])
         JSM JSVal
-> (JSVal -> DOM CSSStyleDeclaration) -> DOM CSSStyleDeclaration
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM CSSStyleDeclaration
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getOverrideStyle Mozilla Document.getOverrideStyle documentation> 
getOverrideStyle_ ::
                  (MonadDOM m, IsDocument self, IsElement element,
                   ToJSString pseudoElement) =>
                    self -> Maybe element -> Maybe pseudoElement -> m ()
getOverrideStyle_ :: forall (m :: * -> *) self element pseudoElement.
(MonadDOM m, IsDocument self, IsElement element,
 ToJSString pseudoElement) =>
self -> Maybe element -> Maybe pseudoElement -> m ()
getOverrideStyle_ self
self Maybe element
element Maybe pseudoElement
pseudoElement
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getOverrideStyle"
            [Maybe element -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe element
element, Maybe pseudoElement -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe pseudoElement
pseudoElement]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.caretRangeFromPoint Mozilla Document.caretRangeFromPoint documentation> 
caretRangeFromPoint ::
                    (MonadDOM m, IsDocument self) =>
                      self -> Maybe Int -> Maybe Int -> m Range
caretRangeFromPoint :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> Maybe Int -> Maybe Int -> m Range
caretRangeFromPoint self
self Maybe Int
x Maybe Int
y
  = DOM Range -> m Range
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"caretRangeFromPoint"
          [Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
x, Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
y])
         JSM JSVal -> (JSVal -> DOM Range) -> DOM Range
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Range
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.caretRangeFromPoint Mozilla Document.caretRangeFromPoint documentation> 
caretRangeFromPoint_ ::
                     (MonadDOM m, IsDocument self) =>
                       self -> Maybe Int -> Maybe Int -> m ()
caretRangeFromPoint_ :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> Maybe Int -> Maybe Int -> m ()
caretRangeFromPoint_ self
self Maybe Int
x Maybe Int
y
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"caretRangeFromPoint"
            [Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
x, Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
y]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getCSSCanvasContext Mozilla Document.getCSSCanvasContext documentation> 
getCSSCanvasContext ::
                    (MonadDOM m, IsDocument self, ToJSString contextId,
                     ToJSString name) =>
                      self -> contextId -> name -> Int -> Int -> m RenderingContext
getCSSCanvasContext :: forall (m :: * -> *) self contextId name.
(MonadDOM m, IsDocument self, ToJSString contextId,
 ToJSString name) =>
self -> contextId -> name -> Int -> Int -> m RenderingContext
getCSSCanvasContext self
self contextId
contextId name
name Int
width Int
height
  = DOM RenderingContext -> m RenderingContext
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getCSSCanvasContext"
          [contextId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal contextId
contextId, name -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal name
name, Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Int
width, Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Int
height])
         JSM JSVal
-> (JSVal -> DOM RenderingContext) -> DOM RenderingContext
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM RenderingContext
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.getCSSCanvasContext Mozilla Document.getCSSCanvasContext documentation> 
getCSSCanvasContext_ ::
                     (MonadDOM m, IsDocument self, ToJSString contextId,
                      ToJSString name) =>
                       self -> contextId -> name -> Int -> Int -> m ()
getCSSCanvasContext_ :: forall (m :: * -> *) self contextId name.
(MonadDOM m, IsDocument self, ToJSString contextId,
 ToJSString name) =>
self -> contextId -> name -> Int -> Int -> m ()
getCSSCanvasContext_ self
self contextId
contextId name
name Int
width Int
height
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"getCSSCanvasContext"
            [contextId -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal contextId
contextId, name -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal name
name, Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Int
width, Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Int
height]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.webkitGetNamedFlows Mozilla Document.webkitGetNamedFlows documentation> 
webkitGetNamedFlows ::
                    (MonadDOM m, IsDocument self) => self -> m DOMNamedFlowCollection
webkitGetNamedFlows :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DOMNamedFlowCollection
webkitGetNamedFlows self
self
  = DOM DOMNamedFlowCollection -> m DOMNamedFlowCollection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"webkitGetNamedFlows" ()) JSM JSVal
-> (JSVal -> DOM DOMNamedFlowCollection)
-> DOM DOMNamedFlowCollection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM DOMNamedFlowCollection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.webkitGetNamedFlows Mozilla Document.webkitGetNamedFlows documentation> 
webkitGetNamedFlows_ ::
                     (MonadDOM m, IsDocument self) => self -> m ()
webkitGetNamedFlows_ :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m ()
webkitGetNamedFlows_ self
self
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"webkitGetNamedFlows" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createTouch Mozilla Document.createTouch documentation> 
createTouch ::
            (MonadDOM m, IsDocument self, IsEventTarget target) =>
              self ->
                Maybe Window ->
                  Maybe target ->
                    Maybe Int ->
                      Maybe Int ->
                        Maybe Int ->
                          Maybe Int ->
                            Maybe Int ->
                              Maybe Int -> Maybe Int -> Maybe Float -> Maybe Float -> m Touch
createTouch :: forall (m :: * -> *) self target.
(MonadDOM m, IsDocument self, IsEventTarget target) =>
self
-> Maybe Window
-> Maybe target
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Float
-> Maybe Float
-> m Touch
createTouch self
self Maybe Window
window Maybe target
target Maybe Int
identifier Maybe Int
pageX Maybe Int
pageY Maybe Int
screenX
  Maybe Int
screenY Maybe Int
webkitRadiusX Maybe Int
webkitRadiusY Maybe Float
webkitRotationAngle Maybe Float
webkitForce
  = DOM Touch -> m Touch
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createTouch"
          [Maybe Window -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Window
window, Maybe target -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe target
target, Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
identifier, Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
pageX,
           Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
pageY, Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
screenX, Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
screenY,
           Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
webkitRadiusX, Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
webkitRadiusY,
           Maybe Float -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Float
webkitRotationAngle, Maybe Float -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Float
webkitForce])
         JSM JSVal -> (JSVal -> DOM Touch) -> DOM Touch
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Touch
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createTouch Mozilla Document.createTouch documentation> 
createTouch_ ::
             (MonadDOM m, IsDocument self, IsEventTarget target) =>
               self ->
                 Maybe Window ->
                   Maybe target ->
                     Maybe Int ->
                       Maybe Int ->
                         Maybe Int ->
                           Maybe Int ->
                             Maybe Int ->
                               Maybe Int -> Maybe Int -> Maybe Float -> Maybe Float -> m ()
createTouch_ :: forall (m :: * -> *) self target.
(MonadDOM m, IsDocument self, IsEventTarget target) =>
self
-> Maybe Window
-> Maybe target
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Float
-> Maybe Float
-> m ()
createTouch_ self
self Maybe Window
window Maybe target
target Maybe Int
identifier Maybe Int
pageX Maybe Int
pageY Maybe Int
screenX
  Maybe Int
screenY Maybe Int
webkitRadiusX Maybe Int
webkitRadiusY Maybe Float
webkitRotationAngle Maybe Float
webkitForce
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createTouch"
            [Maybe Window -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Window
window, Maybe target -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe target
target, Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
identifier, Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
pageX,
             Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
pageY, Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
screenX, Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
screenY,
             Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
webkitRadiusX, Maybe Int -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Int
webkitRadiusY,
             Maybe Float -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Float
webkitRotationAngle, Maybe Float -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe Float
webkitForce]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createTouchList Mozilla Document.createTouchList documentation> 
createTouchList ::
                (MonadDOM m, IsDocument self) => self -> [Touch] -> m TouchList
createTouchList :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> [Touch] -> m TouchList
createTouchList self
self [Touch]
touches
  = DOM TouchList -> m TouchList
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createTouchList"
          [JSM Object -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ([Touch] -> JSM Object
forall args. MakeArgs args => args -> JSM Object
array [Touch]
touches)])
         JSM JSVal -> (JSVal -> DOM TouchList) -> DOM TouchList
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM TouchList
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.createTouchList Mozilla Document.createTouchList documentation> 
createTouchList_ ::
                 (MonadDOM m, IsDocument self) => self -> [Touch] -> m ()
createTouchList_ :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> [Touch] -> m ()
createTouchList_ self
self [Touch]
touches
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"createTouchList"
            [JSM Object -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ([Touch] -> JSM Object
forall args. MakeArgs args => args -> JSM Object
array [Touch]
touches)]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.timeline Mozilla Document.timeline documentation> 
getTimeline ::
            (MonadDOM m, IsDocument self) => self -> m DocumentTimeline
getTimeline :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentTimeline
getTimeline self
self
  = DOM DocumentTimeline -> m DocumentTimeline
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"timeline") JSM JSVal
-> (JSVal -> DOM DocumentTimeline) -> DOM DocumentTimeline
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM DocumentTimeline
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.implementation Mozilla Document.implementation documentation> 
getImplementation ::
                  (MonadDOM m, IsDocument self) => self -> m DOMImplementation
getImplementation :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DOMImplementation
getImplementation self
self
  = DOM DOMImplementation -> m DOMImplementation
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"implementation") JSM JSVal
-> (JSVal -> DOM DOMImplementation) -> DOM DOMImplementation
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM DOMImplementation
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.URL Mozilla Document.URL documentation> 
getURL ::
       (MonadDOM m, IsDocument self, FromJSString result) =>
         self -> m result
getURL :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getURL self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"URL") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.documentURI Mozilla Document.documentURI documentation> 
getDocumentURI ::
               (MonadDOM m, IsDocument self, FromJSString result) =>
                 self -> m result
getDocumentURI :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getDocumentURI self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"documentURI") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.origin Mozilla Document.origin documentation> 
getOrigin ::
          (MonadDOM m, IsDocument self, FromJSString result) =>
            self -> m result
getOrigin :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getOrigin self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"origin") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.compatMode Mozilla Document.compatMode documentation> 
getCompatMode ::
              (MonadDOM m, IsDocument self, FromJSString result) =>
                self -> m result
getCompatMode :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getCompatMode self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"compatMode") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.characterSet Mozilla Document.characterSet documentation> 
getCharacterSet ::
                (MonadDOM m, IsDocument self, FromJSString result) =>
                  self -> m result
getCharacterSet :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getCharacterSet self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"characterSet") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.charset Mozilla Document.charset documentation> 
getCharset ::
           (MonadDOM m, IsDocument self, FromJSString result) =>
             self -> m result
getCharset :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getCharset self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"charset") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.inputEncoding Mozilla Document.inputEncoding documentation> 
getInputEncoding ::
                 (MonadDOM m, IsDocument self, FromJSString result) =>
                   self -> m result
getInputEncoding :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getInputEncoding self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"inputEncoding") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.contentType Mozilla Document.contentType documentation> 
getContentType ::
               (MonadDOM m, IsDocument self, FromJSString result) =>
                 self -> m result
getContentType :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getContentType self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"contentType") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.doctype Mozilla Document.doctype documentation> 
getDoctype ::
           (MonadDOM m, IsDocument self) => self -> m (Maybe DocumentType)
getDoctype :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m (Maybe DocumentType)
getDoctype self
self
  = DOM (Maybe DocumentType) -> m (Maybe DocumentType)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"doctype") JSM JSVal
-> (JSVal -> DOM (Maybe DocumentType)) -> DOM (Maybe DocumentType)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe DocumentType)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.doctype Mozilla Document.doctype documentation> 
getDoctypeUnsafe ::
                 (MonadDOM m, IsDocument self, HasCallStack) =>
                   self -> m DocumentType
getDoctypeUnsafe :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self, HasCallStack) =>
self -> m DocumentType
getDoctypeUnsafe self
self
  = DOM DocumentType -> m DocumentType
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"doctype") JSM JSVal
-> (JSVal -> DOM (Maybe DocumentType)) -> DOM (Maybe DocumentType)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe DocumentType)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe DocumentType)
-> (Maybe DocumentType -> DOM DocumentType) -> DOM DocumentType
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM DocumentType
-> (DocumentType -> DOM DocumentType)
-> Maybe DocumentType
-> DOM DocumentType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM DocumentType
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") DocumentType -> DOM DocumentType
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.doctype Mozilla Document.doctype documentation> 
getDoctypeUnchecked ::
                    (MonadDOM m, IsDocument self) => self -> m DocumentType
getDoctypeUnchecked :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentType
getDoctypeUnchecked self
self
  = DOM DocumentType -> m DocumentType
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"doctype") JSM JSVal -> (JSVal -> DOM DocumentType) -> DOM DocumentType
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM DocumentType
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.documentElement Mozilla Document.documentElement documentation> 
getDocumentElement ::
                   (MonadDOM m, IsDocument self) => self -> m (Maybe Element)
getDocumentElement :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m (Maybe Element)
getDocumentElement self
self
  = DOM (Maybe Element) -> m (Maybe Element)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"documentElement") JSM JSVal -> (JSVal -> DOM (Maybe Element)) -> DOM (Maybe Element)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Element)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.documentElement Mozilla Document.documentElement documentation> 
getDocumentElementUnsafe ::
                         (MonadDOM m, IsDocument self, HasCallStack) => self -> m Element
getDocumentElementUnsafe :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self, HasCallStack) =>
self -> m Element
getDocumentElementUnsafe self
self
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"documentElement") JSM JSVal -> (JSVal -> DOM (Maybe Element)) -> DOM (Maybe Element)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Element)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe Element)
-> (Maybe Element -> DOM Element) -> DOM Element
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM Element
-> (Element -> DOM Element) -> Maybe Element -> DOM Element
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM Element
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") Element -> DOM Element
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.documentElement Mozilla Document.documentElement documentation> 
getDocumentElementUnchecked ::
                            (MonadDOM m, IsDocument self) => self -> m Element
getDocumentElementUnchecked :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Element
getDocumentElementUnchecked self
self
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"documentElement") JSM JSVal -> (JSVal -> DOM Element) -> DOM Element
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Element
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.location Mozilla Document.location documentation> 
getLocation ::
            (MonadDOM m, IsDocument self) => self -> m (Maybe Location)
getLocation :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m (Maybe Location)
getLocation self
self
  = DOM (Maybe Location) -> m (Maybe Location)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"location") JSM JSVal
-> (JSVal -> DOM (Maybe Location)) -> DOM (Maybe Location)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Location)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.location Mozilla Document.location documentation> 
getLocationUnsafe ::
                  (MonadDOM m, IsDocument self, HasCallStack) => self -> m Location
getLocationUnsafe :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self, HasCallStack) =>
self -> m Location
getLocationUnsafe self
self
  = DOM Location -> m Location
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"location") JSM JSVal
-> (JSVal -> DOM (Maybe Location)) -> DOM (Maybe Location)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Location)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe Location)
-> (Maybe Location -> DOM Location) -> DOM Location
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM Location
-> (Location -> DOM Location) -> Maybe Location -> DOM Location
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM Location
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") Location -> DOM Location
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.location Mozilla Document.location documentation> 
getLocationUnchecked ::
                     (MonadDOM m, IsDocument self) => self -> m Location
getLocationUnchecked :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Location
getLocationUnchecked self
self
  = DOM Location -> m Location
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"location") JSM JSVal -> (JSVal -> DOM Location) -> DOM Location
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Location
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.domain Mozilla Document.domain documentation> 
setDomain ::
          (MonadDOM m, IsDocument self, ToJSString val) =>
            self -> val -> m ()
setDomain :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
setDomain self
self val
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (DOM ()) Document (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. String
-> JSM JSVal
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
forall name val.
(ToJSString name, ToJSVal val) =>
name
-> val
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
jss String
"domain" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.domain Mozilla Document.domain documentation> 
getDomain ::
          (MonadDOM m, IsDocument self, FromJSString result) =>
            self -> m result
getDomain :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getDomain self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"domain") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.referrer Mozilla Document.referrer documentation> 
getReferrer ::
            (MonadDOM m, IsDocument self, FromJSString result) =>
              self -> m result
getReferrer :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getReferrer self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"referrer") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.cookie Mozilla Document.cookie documentation> 
setCookie ::
          (MonadDOM m, IsDocument self, ToJSString val) =>
            self -> val -> m ()
setCookie :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
setCookie self
self val
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (DOM ()) Document (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. String
-> JSM JSVal
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
forall name val.
(ToJSString name, ToJSVal val) =>
name
-> val
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
jss String
"cookie" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.cookie Mozilla Document.cookie documentation> 
getCookie ::
          (MonadDOM m, IsDocument self, FromJSString result) =>
            self -> m result
getCookie :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getCookie self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"cookie") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.lastModified Mozilla Document.lastModified documentation> 
getLastModified ::
                (MonadDOM m, IsDocument self, FromJSString result) =>
                  self -> m result
getLastModified :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getLastModified self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"lastModified") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.readyState Mozilla Document.readyState documentation> 
getReadyState ::
              (MonadDOM m, IsDocument self) => self -> m DocumentReadyState
getReadyState :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentReadyState
getReadyState self
self
  = DOM DocumentReadyState -> m DocumentReadyState
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"readyState") JSM JSVal
-> (JSVal -> DOM DocumentReadyState) -> DOM DocumentReadyState
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM DocumentReadyState
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.title Mozilla Document.title documentation> 
setTitle ::
         (MonadDOM m, IsDocument self, ToJSString val) =>
           self -> val -> m ()
setTitle :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
setTitle self
self val
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (DOM ()) Document (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. String
-> JSM JSVal
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
forall name val.
(ToJSString name, ToJSVal val) =>
name
-> val
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
jss String
"title" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.title Mozilla Document.title documentation> 
getTitle ::
         (MonadDOM m, IsDocument self, FromJSString result) =>
           self -> m result
getTitle :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getTitle self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"title") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.dir Mozilla Document.dir documentation> 
setDir ::
       (MonadDOM m, IsDocument self, ToJSString val) =>
         self -> val -> m ()
setDir :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
setDir self
self val
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (DOM ()) Document (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. String
-> JSM JSVal
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
forall name val.
(ToJSString name, ToJSVal val) =>
name
-> val
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
jss String
"dir" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.dir Mozilla Document.dir documentation> 
getDir ::
       (MonadDOM m, IsDocument self, FromJSString result) =>
         self -> m result
getDir :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getDir self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"dir") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.body Mozilla Document.body documentation> 
setBody ::
        (MonadDOM m, IsDocument self, IsHTMLElement val) =>
          self -> Maybe val -> m ()
setBody :: forall (m :: * -> *) self val.
(MonadDOM m, IsDocument self, IsHTMLElement val) =>
self -> Maybe val -> m ()
setBody self
self Maybe val
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (DOM ()) Document (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. String
-> JSM JSVal
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
forall name val.
(ToJSString name, ToJSVal val) =>
name
-> val
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
jss String
"body" (Maybe val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.body Mozilla Document.body documentation> 
getBody ::
        (MonadDOM m, IsDocument self) => self -> m (Maybe HTMLElement)
getBody :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m (Maybe HTMLElement)
getBody self
self
  = DOM (Maybe HTMLElement) -> m (Maybe HTMLElement)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"body") JSM JSVal
-> (JSVal -> DOM (Maybe HTMLElement)) -> DOM (Maybe HTMLElement)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe HTMLElement)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.body Mozilla Document.body documentation> 
getBodyUnsafe ::
              (MonadDOM m, IsDocument self, HasCallStack) =>
                self -> m HTMLElement
getBodyUnsafe :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self, HasCallStack) =>
self -> m HTMLElement
getBodyUnsafe self
self
  = DOM HTMLElement -> m HTMLElement
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"body") JSM JSVal
-> (JSVal -> DOM (Maybe HTMLElement)) -> DOM (Maybe HTMLElement)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe HTMLElement)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe HTMLElement)
-> (Maybe HTMLElement -> DOM HTMLElement) -> DOM HTMLElement
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM HTMLElement
-> (HTMLElement -> DOM HTMLElement)
-> Maybe HTMLElement
-> DOM HTMLElement
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM HTMLElement
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") HTMLElement -> DOM HTMLElement
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.body Mozilla Document.body documentation> 
getBodyUnchecked ::
                 (MonadDOM m, IsDocument self) => self -> m HTMLElement
getBodyUnchecked :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLElement
getBodyUnchecked self
self
  = DOM HTMLElement -> m HTMLElement
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"body") JSM JSVal -> (JSVal -> DOM HTMLElement) -> DOM HTMLElement
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLElement
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.head Mozilla Document.head documentation> 
getHead ::
        (MonadDOM m, IsDocument self) => self -> m (Maybe HTMLHeadElement)
getHead :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m (Maybe HTMLHeadElement)
getHead self
self
  = DOM (Maybe HTMLHeadElement) -> m (Maybe HTMLHeadElement)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"head") JSM JSVal
-> (JSVal -> DOM (Maybe HTMLHeadElement))
-> DOM (Maybe HTMLHeadElement)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe HTMLHeadElement)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.head Mozilla Document.head documentation> 
getHeadUnsafe ::
              (MonadDOM m, IsDocument self, HasCallStack) =>
                self -> m HTMLHeadElement
getHeadUnsafe :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self, HasCallStack) =>
self -> m HTMLHeadElement
getHeadUnsafe self
self
  = DOM HTMLHeadElement -> m HTMLHeadElement
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"head") JSM JSVal
-> (JSVal -> DOM (Maybe HTMLHeadElement))
-> DOM (Maybe HTMLHeadElement)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe HTMLHeadElement)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe HTMLHeadElement)
-> (Maybe HTMLHeadElement -> DOM HTMLHeadElement)
-> DOM HTMLHeadElement
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM HTMLHeadElement
-> (HTMLHeadElement -> DOM HTMLHeadElement)
-> Maybe HTMLHeadElement
-> DOM HTMLHeadElement
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM HTMLHeadElement
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") HTMLHeadElement -> DOM HTMLHeadElement
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.head Mozilla Document.head documentation> 
getHeadUnchecked ::
                 (MonadDOM m, IsDocument self) => self -> m HTMLHeadElement
getHeadUnchecked :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLHeadElement
getHeadUnchecked self
self
  = DOM HTMLHeadElement -> m HTMLHeadElement
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"head") JSM JSVal -> (JSVal -> DOM HTMLHeadElement) -> DOM HTMLHeadElement
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLHeadElement
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.images Mozilla Document.images documentation> 
getImages ::
          (MonadDOM m, IsDocument self) => self -> m HTMLCollection
getImages :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLCollection
getImages self
self
  = DOM HTMLCollection -> m HTMLCollection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"images") JSM JSVal -> (JSVal -> DOM HTMLCollection) -> DOM HTMLCollection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLCollection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.embeds Mozilla Document.embeds documentation> 
getEmbeds ::
          (MonadDOM m, IsDocument self) => self -> m HTMLCollection
getEmbeds :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLCollection
getEmbeds self
self
  = DOM HTMLCollection -> m HTMLCollection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"embeds") JSM JSVal -> (JSVal -> DOM HTMLCollection) -> DOM HTMLCollection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLCollection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.plugins Mozilla Document.plugins documentation> 
getPlugins ::
           (MonadDOM m, IsDocument self) => self -> m HTMLCollection
getPlugins :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLCollection
getPlugins self
self
  = DOM HTMLCollection -> m HTMLCollection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"plugins") JSM JSVal -> (JSVal -> DOM HTMLCollection) -> DOM HTMLCollection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLCollection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.links Mozilla Document.links documentation> 
getLinks ::
         (MonadDOM m, IsDocument self) => self -> m HTMLCollection
getLinks :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLCollection
getLinks self
self
  = DOM HTMLCollection -> m HTMLCollection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"links") JSM JSVal -> (JSVal -> DOM HTMLCollection) -> DOM HTMLCollection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLCollection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.forms Mozilla Document.forms documentation> 
getForms ::
         (MonadDOM m, IsDocument self) => self -> m HTMLCollection
getForms :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLCollection
getForms self
self
  = DOM HTMLCollection -> m HTMLCollection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"forms") JSM JSVal -> (JSVal -> DOM HTMLCollection) -> DOM HTMLCollection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLCollection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.scripts Mozilla Document.scripts documentation> 
getScripts ::
           (MonadDOM m, IsDocument self) => self -> m HTMLCollection
getScripts :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLCollection
getScripts self
self
  = DOM HTMLCollection -> m HTMLCollection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"scripts") JSM JSVal -> (JSVal -> DOM HTMLCollection) -> DOM HTMLCollection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLCollection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.currentScript Mozilla Document.currentScript documentation> 
getCurrentScript ::
                 (MonadDOM m, IsDocument self) =>
                   self -> m (Maybe HTMLScriptElement)
getCurrentScript :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m (Maybe HTMLScriptElement)
getCurrentScript self
self
  = DOM (Maybe HTMLScriptElement) -> m (Maybe HTMLScriptElement)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"currentScript") JSM JSVal
-> (JSVal -> DOM (Maybe HTMLScriptElement))
-> DOM (Maybe HTMLScriptElement)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe HTMLScriptElement)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.currentScript Mozilla Document.currentScript documentation> 
getCurrentScriptUnsafe ::
                       (MonadDOM m, IsDocument self, HasCallStack) =>
                         self -> m HTMLScriptElement
getCurrentScriptUnsafe :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self, HasCallStack) =>
self -> m HTMLScriptElement
getCurrentScriptUnsafe self
self
  = DOM HTMLScriptElement -> m HTMLScriptElement
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"currentScript") JSM JSVal
-> (JSVal -> DOM (Maybe HTMLScriptElement))
-> DOM (Maybe HTMLScriptElement)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe HTMLScriptElement)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe HTMLScriptElement)
-> (Maybe HTMLScriptElement -> DOM HTMLScriptElement)
-> DOM HTMLScriptElement
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM HTMLScriptElement
-> (HTMLScriptElement -> DOM HTMLScriptElement)
-> Maybe HTMLScriptElement
-> DOM HTMLScriptElement
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM HTMLScriptElement
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") HTMLScriptElement -> DOM HTMLScriptElement
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.currentScript Mozilla Document.currentScript documentation> 
getCurrentScriptUnchecked ::
                          (MonadDOM m, IsDocument self) => self -> m HTMLScriptElement
getCurrentScriptUnchecked :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLScriptElement
getCurrentScriptUnchecked self
self
  = DOM HTMLScriptElement -> m HTMLScriptElement
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"currentScript") JSM JSVal
-> (JSVal -> DOM HTMLScriptElement) -> DOM HTMLScriptElement
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLScriptElement
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.defaultView Mozilla Document.defaultView documentation> 
getDefaultView ::
               (MonadDOM m, IsDocument self) => self -> m (Maybe Window)
getDefaultView :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m (Maybe Window)
getDefaultView self
self
  = DOM (Maybe Window) -> m (Maybe Window)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"defaultView") JSM JSVal -> (JSVal -> DOM (Maybe Window)) -> DOM (Maybe Window)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Window)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.defaultView Mozilla Document.defaultView documentation> 
getDefaultViewUnsafe ::
                     (MonadDOM m, IsDocument self, HasCallStack) => self -> m Window
getDefaultViewUnsafe :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self, HasCallStack) =>
self -> m Window
getDefaultViewUnsafe self
self
  = DOM Window -> m Window
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"defaultView") JSM JSVal -> (JSVal -> DOM (Maybe Window)) -> DOM (Maybe Window)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Window)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe Window) -> (Maybe Window -> DOM Window) -> DOM Window
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM Window -> (Window -> DOM Window) -> Maybe Window -> DOM Window
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM Window
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") Window -> DOM Window
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.defaultView Mozilla Document.defaultView documentation> 
getDefaultViewUnchecked ::
                        (MonadDOM m, IsDocument self) => self -> m Window
getDefaultViewUnchecked :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Window
getDefaultViewUnchecked self
self
  = DOM Window -> m Window
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"defaultView") JSM JSVal -> (JSVal -> DOM Window) -> DOM Window
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Window
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.designMode Mozilla Document.designMode documentation> 
setDesignMode ::
              (MonadDOM m, IsDocument self, ToJSString val) =>
                self -> val -> m ()
setDesignMode :: forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsDocument self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
setDesignMode self
self val
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (DOM ()) Document (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. String
-> JSM JSVal
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
forall name val.
(ToJSString name, ToJSVal val) =>
name
-> val
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
jss String
"designMode" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.designMode Mozilla Document.designMode documentation> 
getDesignMode ::
              (MonadDOM m, IsDocument self, FromJSString result) =>
                self -> m result
getDesignMode :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getDesignMode self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"designMode") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.onreadystatechange Mozilla Document.onreadystatechange documentation> 
readyStateChange ::
                 (IsDocument self, IsEventTarget self) => EventName self Event
readyStateChange :: forall self.
(IsDocument self, IsEventTarget self) =>
EventName self Event
readyStateChange
  = DOMString -> EventName self Event
forall t e. DOMString -> EventName t e
unsafeEventNameAsync (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"readystatechange")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.styleSheets Mozilla Document.styleSheets documentation> 
getStyleSheets ::
               (MonadDOM m, IsDocument self) => self -> m StyleSheetList
getStyleSheets :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m StyleSheetList
getStyleSheets self
self
  = DOM StyleSheetList -> m StyleSheetList
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"styleSheets") JSM JSVal -> (JSVal -> DOM StyleSheetList) -> DOM StyleSheetList
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM StyleSheetList
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.scrollingElement Mozilla Document.scrollingElement documentation> 
getScrollingElement ::
                    (MonadDOM m, IsDocument self) => self -> m (Maybe Element)
getScrollingElement :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m (Maybe Element)
getScrollingElement self
self
  = DOM (Maybe Element) -> m (Maybe Element)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"scrollingElement") JSM JSVal -> (JSVal -> DOM (Maybe Element)) -> DOM (Maybe Element)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Element)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.scrollingElement Mozilla Document.scrollingElement documentation> 
getScrollingElementUnsafe ::
                          (MonadDOM m, IsDocument self, HasCallStack) => self -> m Element
getScrollingElementUnsafe :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self, HasCallStack) =>
self -> m Element
getScrollingElementUnsafe self
self
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"scrollingElement") JSM JSVal -> (JSVal -> DOM (Maybe Element)) -> DOM (Maybe Element)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Element)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe Element)
-> (Maybe Element -> DOM Element) -> DOM Element
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM Element
-> (Element -> DOM Element) -> Maybe Element -> DOM Element
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM Element
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") Element -> DOM Element
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.scrollingElement Mozilla Document.scrollingElement documentation> 
getScrollingElementUnchecked ::
                             (MonadDOM m, IsDocument self) => self -> m Element
getScrollingElementUnchecked :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Element
getScrollingElementUnchecked self
self
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"scrollingElement") JSM JSVal -> (JSVal -> DOM Element) -> DOM Element
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Element
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.webkitFullscreenEnabled Mozilla Document.webkitFullscreenEnabled documentation> 
getWebkitFullscreenEnabled ::
                           (MonadDOM m, IsDocument self) => self -> m Bool
getWebkitFullscreenEnabled :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Bool
getWebkitFullscreenEnabled self
self
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"webkitFullscreenEnabled") JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.webkitFullscreenElement Mozilla Document.webkitFullscreenElement documentation> 
getWebkitFullscreenElement ::
                           (MonadDOM m, IsDocument self) => self -> m (Maybe Element)
getWebkitFullscreenElement :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m (Maybe Element)
getWebkitFullscreenElement self
self
  = DOM (Maybe Element) -> m (Maybe Element)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"webkitFullscreenElement") JSM JSVal -> (JSVal -> DOM (Maybe Element)) -> DOM (Maybe Element)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe Element)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.webkitFullscreenElement Mozilla Document.webkitFullscreenElement documentation> 
getWebkitFullscreenElementUnsafe ::
                                 (MonadDOM m, IsDocument self, HasCallStack) => self -> m Element
getWebkitFullscreenElementUnsafe :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self, HasCallStack) =>
self -> m Element
getWebkitFullscreenElementUnsafe self
self
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"webkitFullscreenElement") JSM JSVal -> (JSVal -> DOM (Maybe Element)) -> DOM (Maybe Element)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          JSVal -> DOM (Maybe Element)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)
         DOM (Maybe Element)
-> (Maybe Element -> DOM Element) -> DOM Element
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DOM Element
-> (Element -> DOM Element) -> Maybe Element -> DOM Element
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM Element
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") Element -> DOM Element
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.webkitFullscreenElement Mozilla Document.webkitFullscreenElement documentation> 
getWebkitFullscreenElementUnchecked ::
                                    (MonadDOM m, IsDocument self) => self -> m Element
getWebkitFullscreenElementUnchecked :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Element
getWebkitFullscreenElementUnchecked self
self
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"webkitFullscreenElement") JSM JSVal -> (JSVal -> DOM Element) -> DOM Element
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Element
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.webkitIsFullScreen Mozilla Document.webkitIsFullScreen documentation> 
getWebkitIsFullScreen ::
                      (MonadDOM m, IsDocument self) => self -> m Bool
getWebkitIsFullScreen :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Bool
getWebkitIsFullScreen self
self
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"webkitIsFullScreen") JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.webkitFullScreenKeyboardInputAllowed Mozilla Document.webkitFullScreenKeyboardInputAllowed documentation> 
getWebkitFullScreenKeyboardInputAllowed ::
                                        (MonadDOM m, IsDocument self) => self -> m Bool
getWebkitFullScreenKeyboardInputAllowed :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Bool
getWebkitFullScreenKeyboardInputAllowed self
self
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"webkitFullScreenKeyboardInputAllowed")
         JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.webkitCurrentFullScreenElement Mozilla Document.webkitCurrentFullScreenElement documentation> 
getWebkitCurrentFullScreenElement ::
                                  (MonadDOM m, IsDocument self) => self -> m Element
getWebkitCurrentFullScreenElement :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Element
getWebkitCurrentFullScreenElement self
self
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"webkitCurrentFullScreenElement") JSM JSVal -> (JSVal -> DOM Element) -> DOM Element
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Element
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.onwebkitfullscreenchange Mozilla Document.onwebkitfullscreenchange documentation> 
webKitFullscreenChange ::
                       (IsDocument self, IsEventTarget self) => EventName self Event
webKitFullscreenChange :: forall self.
(IsDocument self, IsEventTarget self) =>
EventName self Event
webKitFullscreenChange
  = DOMString -> EventName self Event
forall t e. DOMString -> EventName t e
unsafeEventName (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"webkitfullscreenchange")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.onwebkitfullscreenerror Mozilla Document.onwebkitfullscreenerror documentation> 
webKitFullscreenError ::
                      (IsDocument self, IsEventTarget self) => EventName self Event
webKitFullscreenError :: forall self.
(IsDocument self, IsEventTarget self) =>
EventName self Event
webKitFullscreenError
  = DOMString -> EventName self Event
forall t e. DOMString -> EventName t e
unsafeEventName (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"webkitfullscreenerror")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.onpointerlockchange Mozilla Document.onpointerlockchange documentation> 
pointerlockchange ::
                  (IsDocument self, IsEventTarget self) => EventName self Event
pointerlockchange :: forall self.
(IsDocument self, IsEventTarget self) =>
EventName self Event
pointerlockchange
  = DOMString -> EventName self Event
forall t e. DOMString -> EventName t e
unsafeEventName (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"pointerlockchange")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.onpointerlockerror Mozilla Document.onpointerlockerror documentation> 
pointerlockerror ::
                 (IsDocument self, IsEventTarget self) => EventName self Event
pointerlockerror :: forall self.
(IsDocument self, IsEventTarget self) =>
EventName self Event
pointerlockerror = DOMString -> EventName self Event
forall t e. DOMString -> EventName t e
unsafeEventName (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"pointerlockerror")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.fonts Mozilla Document.fonts documentation> 
getFonts :: (MonadDOM m, IsDocument self) => self -> m FontFaceSet
getFonts :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m FontFaceSet
getFonts self
self
  = DOM FontFaceSet -> m FontFaceSet
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"fonts") JSM JSVal -> (JSVal -> DOM FontFaceSet) -> DOM FontFaceSet
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM FontFaceSet
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.hidden Mozilla Document.hidden documentation> 
getHidden :: (MonadDOM m, IsDocument self) => self -> m Bool
getHidden :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Bool
getHidden self
self
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"hidden") JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.visibilityState Mozilla Document.visibilityState documentation> 
getVisibilityState ::
                   (MonadDOM m, IsDocument self) => self -> m VisibilityState
getVisibilityState :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m VisibilityState
getVisibilityState self
self
  = DOM VisibilityState -> m VisibilityState
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"visibilityState") JSM JSVal -> (JSVal -> DOM VisibilityState) -> DOM VisibilityState
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM VisibilityState
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.onvisibilitychange Mozilla Document.onvisibilitychange documentation> 
visibilitychange ::
                 (IsDocument self, IsEventTarget self) => EventName self Event
visibilitychange :: forall self.
(IsDocument self, IsEventTarget self) =>
EventName self Event
visibilitychange = DOMString -> EventName self Event
forall t e. DOMString -> EventName t e
unsafeEventName (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"visibilitychange")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.applets Mozilla Document.applets documentation> 
getApplets ::
           (MonadDOM m, IsDocument self) => self -> m HTMLCollection
getApplets :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLCollection
getApplets self
self
  = DOM HTMLCollection -> m HTMLCollection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"applets") JSM JSVal -> (JSVal -> DOM HTMLCollection) -> DOM HTMLCollection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLCollection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.anchors Mozilla Document.anchors documentation> 
getAnchors ::
           (MonadDOM m, IsDocument self) => self -> m HTMLCollection
getAnchors :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLCollection
getAnchors self
self
  = DOM HTMLCollection -> m HTMLCollection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"anchors") JSM JSVal -> (JSVal -> DOM HTMLCollection) -> DOM HTMLCollection
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM HTMLCollection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.preferredStylesheetSet Mozilla Document.preferredStylesheetSet documentation> 
getPreferredStylesheetSet ::
                          (MonadDOM m, IsDocument self, FromJSString result) =>
                            self -> m (Maybe result)
getPreferredStylesheetSet :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m (Maybe result)
getPreferredStylesheetSet self
self
  = DOM (Maybe result) -> m (Maybe result)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"preferredStylesheetSet") JSM JSVal -> (JSVal -> DOM (Maybe result)) -> DOM (Maybe result)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM (Maybe result)
forall a. FromJSString a => JSVal -> JSM (Maybe a)
fromMaybeJSString)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.preferredStylesheetSet Mozilla Document.preferredStylesheetSet documentation> 
getPreferredStylesheetSetUnsafe ::
                                (MonadDOM m, IsDocument self, HasCallStack, FromJSString result) =>
                                  self -> m result
getPreferredStylesheetSetUnsafe :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, HasCallStack, FromJSString result) =>
self -> m result
getPreferredStylesheetSetUnsafe self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"preferredStylesheetSet") JSM JSVal -> (JSVal -> JSM (Maybe result)) -> JSM (Maybe result)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          JSVal -> JSM (Maybe result)
forall a. FromJSString a => JSVal -> JSM (Maybe a)
fromMaybeJSString)
         JSM (Maybe result) -> (Maybe result -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DOM result -> (result -> DOM result) -> Maybe result -> DOM result
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM result
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") result -> DOM result
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.preferredStylesheetSet Mozilla Document.preferredStylesheetSet documentation> 
getPreferredStylesheetSetUnchecked ::
                                   (MonadDOM m, IsDocument self, FromJSString result) =>
                                     self -> m result
getPreferredStylesheetSetUnchecked :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getPreferredStylesheetSetUnchecked self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"preferredStylesheetSet") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.selectedStylesheetSet Mozilla Document.selectedStylesheetSet documentation> 
setSelectedStylesheetSet ::
                         (MonadDOM m, IsDocument self, ToJSString val) =>
                           self -> Maybe val -> m ()
setSelectedStylesheetSet :: forall (m :: * -> *) self val.
(MonadDOM m, IsDocument self, ToJSString val) =>
self -> Maybe val -> m ()
setSelectedStylesheetSet self
self Maybe val
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (DOM ()) Document (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. String
-> JSM JSVal
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
forall name val.
(ToJSString name, ToJSVal val) =>
name
-> val
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
jss String
"selectedStylesheetSet" (Maybe val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.selectedStylesheetSet Mozilla Document.selectedStylesheetSet documentation> 
getSelectedStylesheetSet ::
                         (MonadDOM m, IsDocument self, FromJSString result) =>
                           self -> m (Maybe result)
getSelectedStylesheetSet :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m (Maybe result)
getSelectedStylesheetSet self
self
  = DOM (Maybe result) -> m (Maybe result)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"selectedStylesheetSet") JSM JSVal -> (JSVal -> DOM (Maybe result)) -> DOM (Maybe result)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM (Maybe result)
forall a. FromJSString a => JSVal -> JSM (Maybe a)
fromMaybeJSString)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.selectedStylesheetSet Mozilla Document.selectedStylesheetSet documentation> 
getSelectedStylesheetSetUnsafe ::
                               (MonadDOM m, IsDocument self, HasCallStack, FromJSString result) =>
                                 self -> m result
getSelectedStylesheetSetUnsafe :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, HasCallStack, FromJSString result) =>
self -> m result
getSelectedStylesheetSetUnsafe self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"selectedStylesheetSet") JSM JSVal -> (JSVal -> JSM (Maybe result)) -> JSM (Maybe result)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          JSVal -> JSM (Maybe result)
forall a. FromJSString a => JSVal -> JSM (Maybe a)
fromMaybeJSString)
         JSM (Maybe result) -> (Maybe result -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DOM result -> (result -> DOM result) -> Maybe result -> DOM result
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM result
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") result -> DOM result
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.selectedStylesheetSet Mozilla Document.selectedStylesheetSet documentation> 
getSelectedStylesheetSetUnchecked ::
                                  (MonadDOM m, IsDocument self, FromJSString result) =>
                                    self -> m result
getSelectedStylesheetSetUnchecked :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getSelectedStylesheetSetUnchecked self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"selectedStylesheetSet") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.xmlEncoding Mozilla Document.xmlEncoding documentation> 
getXmlEncoding ::
               (MonadDOM m, IsDocument self, FromJSString result) =>
                 self -> m (Maybe result)
getXmlEncoding :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m (Maybe result)
getXmlEncoding self
self
  = DOM (Maybe result) -> m (Maybe result)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"xmlEncoding") JSM JSVal -> (JSVal -> DOM (Maybe result)) -> DOM (Maybe result)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe result)
forall a. FromJSString a => JSVal -> JSM (Maybe a)
fromMaybeJSString)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.xmlEncoding Mozilla Document.xmlEncoding documentation> 
getXmlEncodingUnsafe ::
                     (MonadDOM m, IsDocument self, HasCallStack, FromJSString result) =>
                       self -> m result
getXmlEncodingUnsafe :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, HasCallStack, FromJSString result) =>
self -> m result
getXmlEncodingUnsafe self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"xmlEncoding") JSM JSVal -> (JSVal -> JSM (Maybe result)) -> JSM (Maybe result)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM (Maybe result)
forall a. FromJSString a => JSVal -> JSM (Maybe a)
fromMaybeJSString)
         JSM (Maybe result) -> (Maybe result -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DOM result -> (result -> DOM result) -> Maybe result -> DOM result
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM result
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") result -> DOM result
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.xmlEncoding Mozilla Document.xmlEncoding documentation> 
getXmlEncodingUnchecked ::
                        (MonadDOM m, IsDocument self, FromJSString result) =>
                          self -> m result
getXmlEncodingUnchecked :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getXmlEncodingUnchecked self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"xmlEncoding") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.xmlVersion Mozilla Document.xmlVersion documentation> 
setXmlVersion ::
              (MonadDOM m, IsDocument self, ToJSString val) =>
                self -> Maybe val -> m ()
setXmlVersion :: forall (m :: * -> *) self val.
(MonadDOM m, IsDocument self, ToJSString val) =>
self -> Maybe val -> m ()
setXmlVersion self
self Maybe val
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (DOM ()) Document (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. String
-> JSM JSVal
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
forall name val.
(ToJSString name, ToJSVal val) =>
name
-> val
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
jss String
"xmlVersion" (Maybe val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.xmlVersion Mozilla Document.xmlVersion documentation> 
getXmlVersion ::
              (MonadDOM m, IsDocument self, FromJSString result) =>
                self -> m (Maybe result)
getXmlVersion :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m (Maybe result)
getXmlVersion self
self
  = DOM (Maybe result) -> m (Maybe result)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"xmlVersion") JSM JSVal -> (JSVal -> DOM (Maybe result)) -> DOM (Maybe result)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe result)
forall a. FromJSString a => JSVal -> JSM (Maybe a)
fromMaybeJSString)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.xmlVersion Mozilla Document.xmlVersion documentation> 
getXmlVersionUnsafe ::
                    (MonadDOM m, IsDocument self, HasCallStack, FromJSString result) =>
                      self -> m result
getXmlVersionUnsafe :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, HasCallStack, FromJSString result) =>
self -> m result
getXmlVersionUnsafe self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"xmlVersion") JSM JSVal -> (JSVal -> JSM (Maybe result)) -> JSM (Maybe result)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM (Maybe result)
forall a. FromJSString a => JSVal -> JSM (Maybe a)
fromMaybeJSString) JSM (Maybe result) -> (Maybe result -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM result -> (result -> DOM result) -> Maybe result -> DOM result
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM result
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") result -> DOM result
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.xmlVersion Mozilla Document.xmlVersion documentation> 
getXmlVersionUnchecked ::
                       (MonadDOM m, IsDocument self, FromJSString result) =>
                         self -> m result
getXmlVersionUnchecked :: forall (m :: * -> *) self result.
(MonadDOM m, IsDocument self, FromJSString result) =>
self -> m result
getXmlVersionUnchecked self
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"xmlVersion") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.xmlStandalone Mozilla Document.xmlStandalone documentation> 
setXmlStandalone ::
                 (MonadDOM m, IsDocument self) => self -> Bool -> m ()
setXmlStandalone :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> Bool -> m ()
setXmlStandalone self
self Bool
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (DOM ()) Document (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. String
-> JSM JSVal
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
forall name val.
(ToJSString name, ToJSVal val) =>
name
-> val
-> forall o. MakeObject o => IndexPreservingGetter o (DOM ())
jss String
"xmlStandalone" (Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.xmlStandalone Mozilla Document.xmlStandalone documentation> 
getXmlStandalone :: (MonadDOM m, IsDocument self) => self -> m Bool
getXmlStandalone :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Bool
getXmlStandalone self
self
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"xmlStandalone") JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.onselectstart Mozilla Document.onselectstart documentation> 
selectStart ::
            (IsDocument self, IsEventTarget self) => EventName self Event
selectStart :: forall self.
(IsDocument self, IsEventTarget self) =>
EventName self Event
selectStart = DOMString -> EventName self Event
forall t e. DOMString -> EventName t e
unsafeEventName (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"selectstart")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.onselectionchange Mozilla Document.onselectionchange documentation> 
selectionchange ::
                (IsDocument self, IsEventTarget self) =>
                  EventName self onselectionchange
selectionchange :: forall self onselectionchange.
(IsDocument self, IsEventTarget self) =>
EventName self onselectionchange
selectionchange = DOMString -> EventName self onselectionchange
forall t e. DOMString -> EventName t e
unsafeEventName (String -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString String
"selectionchange")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.rootElement Mozilla Document.rootElement documentation> 
getRootElement ::
               (MonadDOM m, IsDocument self) => self -> m (Maybe SVGSVGElement)
getRootElement :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m (Maybe SVGSVGElement)
getRootElement self
self
  = DOM (Maybe SVGSVGElement) -> m (Maybe SVGSVGElement)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"rootElement") JSM JSVal
-> (JSVal -> DOM (Maybe SVGSVGElement))
-> DOM (Maybe SVGSVGElement)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe SVGSVGElement)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.rootElement Mozilla Document.rootElement documentation> 
getRootElementUnsafe ::
                     (MonadDOM m, IsDocument self, HasCallStack) =>
                       self -> m SVGSVGElement
getRootElementUnsafe :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self, HasCallStack) =>
self -> m SVGSVGElement
getRootElementUnsafe self
self
  = DOM SVGSVGElement -> m SVGSVGElement
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"rootElement") JSM JSVal
-> (JSVal -> DOM (Maybe SVGSVGElement))
-> DOM (Maybe SVGSVGElement)
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM (Maybe SVGSVGElement)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe SVGSVGElement)
-> (Maybe SVGSVGElement -> DOM SVGSVGElement) -> DOM SVGSVGElement
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM SVGSVGElement
-> (SVGSVGElement -> DOM SVGSVGElement)
-> Maybe SVGSVGElement
-> DOM SVGSVGElement
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM SVGSVGElement
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") SVGSVGElement -> DOM SVGSVGElement
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/Document.rootElement Mozilla Document.rootElement documentation> 
getRootElementUnchecked ::
                        (MonadDOM m, IsDocument self) => self -> m SVGSVGElement
getRootElementUnchecked :: forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m SVGSVGElement
getRootElementUnchecked self
self
  = DOM SVGSVGElement -> m SVGSVGElement
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> Document
forall o. IsDocument o => o -> Document
toDocument self
self) Document -> Getting (JSM JSVal) Document (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter Document (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"rootElement") JSM JSVal -> (JSVal -> DOM SVGSVGElement) -> DOM SVGSVGElement
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM SVGSVGElement
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)