{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.HTMLDocument
       (open, close, write, writeln, clear, captureEvents, releaseEvents,
        getAll, setBgColor, getBgColor, setFgColor, getFgColor,
        setAlinkColor, getAlinkColor, setLinkColor, getLinkColor,
        setVlinkColor, getVlinkColor, HTMLDocument(..), gTypeHTMLDocument)
       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/HTMLDocument.open Mozilla HTMLDocument.open documentation> 
open :: (MonadDOM m) => HTMLDocument -> m ()
open :: forall (m :: * -> *). MonadDOM m => HTMLDocument -> m ()
open HTMLDocument
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 (HTMLDocument
self HTMLDocument
-> Getting (JSM JSVal) HTMLDocument (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
"open" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLDocument.close Mozilla HTMLDocument.close documentation> 
close :: (MonadDOM m) => HTMLDocument -> m ()
close :: forall (m :: * -> *). MonadDOM m => HTMLDocument -> m ()
close HTMLDocument
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 (HTMLDocument
self HTMLDocument
-> Getting (JSM JSVal) HTMLDocument (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
"close" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLDocument.write Mozilla HTMLDocument.write documentation> 
write ::
      (MonadDOM m, ToJSString text) => HTMLDocument -> Maybe text -> m ()
write :: forall (m :: * -> *) text.
(MonadDOM m, ToJSString text) =>
HTMLDocument -> Maybe text -> m ()
write HTMLDocument
self Maybe text
text
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (HTMLDocument
self HTMLDocument
-> Getting (JSM JSVal) HTMLDocument (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
"write" [Maybe text -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe text
text]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLDocument.writeln Mozilla HTMLDocument.writeln documentation> 
writeln ::
        (MonadDOM m, ToJSString text) => HTMLDocument -> Maybe text -> m ()
writeln :: forall (m :: * -> *) text.
(MonadDOM m, ToJSString text) =>
HTMLDocument -> Maybe text -> m ()
writeln HTMLDocument
self Maybe text
text
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (HTMLDocument
self HTMLDocument
-> Getting (JSM JSVal) HTMLDocument (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
"writeln" [Maybe text -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe text
text]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLDocument.clear Mozilla HTMLDocument.clear documentation> 
clear :: (MonadDOM m) => HTMLDocument -> m ()
clear :: forall (m :: * -> *). MonadDOM m => HTMLDocument -> m ()
clear HTMLDocument
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 (HTMLDocument
self HTMLDocument
-> Getting (JSM JSVal) HTMLDocument (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
"clear" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLDocument.captureEvents Mozilla HTMLDocument.captureEvents documentation> 
captureEvents :: (MonadDOM m) => HTMLDocument -> m ()
captureEvents :: forall (m :: * -> *). MonadDOM m => HTMLDocument -> m ()
captureEvents HTMLDocument
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 (HTMLDocument
self HTMLDocument
-> Getting (JSM JSVal) HTMLDocument (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
"captureEvents" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLDocument.releaseEvents Mozilla HTMLDocument.releaseEvents documentation> 
releaseEvents :: (MonadDOM m) => HTMLDocument -> m ()
releaseEvents :: forall (m :: * -> *). MonadDOM m => HTMLDocument -> m ()
releaseEvents HTMLDocument
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 (HTMLDocument
self HTMLDocument
-> Getting (JSM JSVal) HTMLDocument (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
"releaseEvents" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLDocument.all Mozilla HTMLDocument.all documentation> 
getAll :: (MonadDOM m) => HTMLDocument -> m HTMLAllCollection
getAll :: forall (m :: * -> *).
MonadDOM m =>
HTMLDocument -> m HTMLAllCollection
getAll HTMLDocument
self = DOM HTMLAllCollection -> m HTMLAllCollection
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLDocument
self HTMLDocument
-> Getting (JSM JSVal) HTMLDocument (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter HTMLDocument (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"all") JSM JSVal
-> (JSVal -> DOM HTMLAllCollection) -> DOM HTMLAllCollection
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 HTMLAllCollection
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLDocument.bgColor Mozilla HTMLDocument.bgColor documentation> 
setBgColor ::
           (MonadDOM m, ToJSString val) => HTMLDocument -> val -> m ()
setBgColor :: forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLDocument -> val -> m ()
setBgColor HTMLDocument
self val
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLDocument
self HTMLDocument -> Getting (DOM ()) HTMLDocument (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
"bgColor" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLDocument.bgColor Mozilla HTMLDocument.bgColor documentation> 
getBgColor ::
           (MonadDOM m, FromJSString result) => HTMLDocument -> m result
getBgColor :: forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLDocument -> m result
getBgColor HTMLDocument
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLDocument
self HTMLDocument
-> Getting (JSM JSVal) HTMLDocument (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter HTMLDocument (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"bgColor") 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/HTMLDocument.fgColor Mozilla HTMLDocument.fgColor documentation> 
setFgColor ::
           (MonadDOM m, ToJSString val) => HTMLDocument -> val -> m ()
setFgColor :: forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLDocument -> val -> m ()
setFgColor HTMLDocument
self val
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLDocument
self HTMLDocument -> Getting (DOM ()) HTMLDocument (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
"fgColor" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLDocument.fgColor Mozilla HTMLDocument.fgColor documentation> 
getFgColor ::
           (MonadDOM m, FromJSString result) => HTMLDocument -> m result
getFgColor :: forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLDocument -> m result
getFgColor HTMLDocument
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLDocument
self HTMLDocument
-> Getting (JSM JSVal) HTMLDocument (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter HTMLDocument (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"fgColor") 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/HTMLDocument.alinkColor Mozilla HTMLDocument.alinkColor documentation> 
setAlinkColor ::
              (MonadDOM m, ToJSString val) => HTMLDocument -> val -> m ()
setAlinkColor :: forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLDocument -> val -> m ()
setAlinkColor HTMLDocument
self val
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLDocument
self HTMLDocument -> Getting (DOM ()) HTMLDocument (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
"alinkColor" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLDocument.alinkColor Mozilla HTMLDocument.alinkColor documentation> 
getAlinkColor ::
              (MonadDOM m, FromJSString result) => HTMLDocument -> m result
getAlinkColor :: forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLDocument -> m result
getAlinkColor HTMLDocument
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLDocument
self HTMLDocument
-> Getting (JSM JSVal) HTMLDocument (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter HTMLDocument (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"alinkColor") 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/HTMLDocument.linkColor Mozilla HTMLDocument.linkColor documentation> 
setLinkColor ::
             (MonadDOM m, ToJSString val) => HTMLDocument -> val -> m ()
setLinkColor :: forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLDocument -> val -> m ()
setLinkColor HTMLDocument
self val
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLDocument
self HTMLDocument -> Getting (DOM ()) HTMLDocument (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
"linkColor" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLDocument.linkColor Mozilla HTMLDocument.linkColor documentation> 
getLinkColor ::
             (MonadDOM m, FromJSString result) => HTMLDocument -> m result
getLinkColor :: forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLDocument -> m result
getLinkColor HTMLDocument
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLDocument
self HTMLDocument
-> Getting (JSM JSVal) HTMLDocument (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter HTMLDocument (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"linkColor") 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/HTMLDocument.vlinkColor Mozilla HTMLDocument.vlinkColor documentation> 
setVlinkColor ::
              (MonadDOM m, ToJSString val) => HTMLDocument -> val -> m ()
setVlinkColor :: forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLDocument -> val -> m ()
setVlinkColor HTMLDocument
self val
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLDocument
self HTMLDocument -> Getting (DOM ()) HTMLDocument (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
"vlinkColor" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLDocument.vlinkColor Mozilla HTMLDocument.vlinkColor documentation> 
getVlinkColor ::
              (MonadDOM m, FromJSString result) => HTMLDocument -> m result
getVlinkColor :: forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLDocument -> m result
getVlinkColor HTMLDocument
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLDocument
self HTMLDocument
-> Getting (JSM JSVal) HTMLDocument (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter HTMLDocument (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"vlinkColor") 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)