{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.HTMLAppletElement
       (setAlign, getAlign, setAlt, getAlt, setArchive, getArchive,
        setCode, getCode, setCodeBase, getCodeBase, setHeight, getHeight,
        setHspace, getHspace, setName, getName, setObject, getObject,
        setVspace, getVspace, setWidth, getWidth, HTMLAppletElement(..),
        gTypeHTMLAppletElement)
       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/HTMLAppletElement.align Mozilla HTMLAppletElement.align documentation> 
setAlign ::
         (MonadDOM m, ToJSString val) => HTMLAppletElement -> val -> m ()
setAlign :: HTMLAppletElement -> val -> m ()
setAlign HTMLAppletElement
self val
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLAppletElement
self HTMLAppletElement
-> Getting (DOM ()) HTMLAppletElement (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. [Char]
-> 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 [Char]
"align" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAppletElement.align Mozilla HTMLAppletElement.align documentation> 
getAlign ::
         (MonadDOM m, FromJSString result) => HTMLAppletElement -> m result
getAlign :: HTMLAppletElement -> m result
getAlign HTMLAppletElement
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLAppletElement
self HTMLAppletElement
-> Getting (JSM JSVal) HTMLAppletElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter HTMLAppletElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"align") JSM JSVal -> (JSVal -> DOM result) -> DOM result
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/HTMLAppletElement.alt Mozilla HTMLAppletElement.alt documentation> 
setAlt ::
       (MonadDOM m, ToJSString val) => HTMLAppletElement -> val -> m ()
setAlt :: HTMLAppletElement -> val -> m ()
setAlt HTMLAppletElement
self val
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLAppletElement
self HTMLAppletElement
-> Getting (DOM ()) HTMLAppletElement (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. [Char]
-> 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 [Char]
"alt" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAppletElement.alt Mozilla HTMLAppletElement.alt documentation> 
getAlt ::
       (MonadDOM m, FromJSString result) => HTMLAppletElement -> m result
getAlt :: HTMLAppletElement -> m result
getAlt HTMLAppletElement
self = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLAppletElement
self HTMLAppletElement
-> Getting (JSM JSVal) HTMLAppletElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter HTMLAppletElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"alt") JSM JSVal -> (JSVal -> DOM result) -> DOM result
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/HTMLAppletElement.archive Mozilla HTMLAppletElement.archive documentation> 
setArchive ::
           (MonadDOM m, ToJSString val) => HTMLAppletElement -> val -> m ()
setArchive :: HTMLAppletElement -> val -> m ()
setArchive HTMLAppletElement
self val
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLAppletElement
self HTMLAppletElement
-> Getting (DOM ()) HTMLAppletElement (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. [Char]
-> 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 [Char]
"archive" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAppletElement.archive Mozilla HTMLAppletElement.archive documentation> 
getArchive ::
           (MonadDOM m, FromJSString result) => HTMLAppletElement -> m result
getArchive :: HTMLAppletElement -> m result
getArchive HTMLAppletElement
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLAppletElement
self HTMLAppletElement
-> Getting (JSM JSVal) HTMLAppletElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter HTMLAppletElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"archive") JSM JSVal -> (JSVal -> DOM result) -> DOM result
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/HTMLAppletElement.code Mozilla HTMLAppletElement.code documentation> 
setCode ::
        (MonadDOM m, ToJSString val) => HTMLAppletElement -> val -> m ()
setCode :: HTMLAppletElement -> val -> m ()
setCode HTMLAppletElement
self val
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLAppletElement
self HTMLAppletElement
-> Getting (DOM ()) HTMLAppletElement (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. [Char]
-> 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 [Char]
"code" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAppletElement.code Mozilla HTMLAppletElement.code documentation> 
getCode ::
        (MonadDOM m, FromJSString result) => HTMLAppletElement -> m result
getCode :: HTMLAppletElement -> m result
getCode HTMLAppletElement
self = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLAppletElement
self HTMLAppletElement
-> Getting (JSM JSVal) HTMLAppletElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter HTMLAppletElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"code") JSM JSVal -> (JSVal -> DOM result) -> DOM result
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/HTMLAppletElement.codeBase Mozilla HTMLAppletElement.codeBase documentation> 
setCodeBase ::
            (MonadDOM m, ToJSString val) => HTMLAppletElement -> val -> m ()
setCodeBase :: HTMLAppletElement -> val -> m ()
setCodeBase HTMLAppletElement
self val
val
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLAppletElement
self HTMLAppletElement
-> Getting (DOM ()) HTMLAppletElement (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. [Char]
-> 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 [Char]
"codeBase" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAppletElement.codeBase Mozilla HTMLAppletElement.codeBase documentation> 
getCodeBase ::
            (MonadDOM m, FromJSString result) => HTMLAppletElement -> m result
getCodeBase :: HTMLAppletElement -> m result
getCodeBase HTMLAppletElement
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLAppletElement
self HTMLAppletElement
-> Getting (JSM JSVal) HTMLAppletElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter HTMLAppletElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"codeBase") JSM JSVal -> (JSVal -> DOM result) -> DOM result
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/HTMLAppletElement.height Mozilla HTMLAppletElement.height documentation> 
setHeight ::
          (MonadDOM m, ToJSString val) => HTMLAppletElement -> val -> m ()
setHeight :: HTMLAppletElement -> val -> m ()
setHeight HTMLAppletElement
self val
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLAppletElement
self HTMLAppletElement
-> Getting (DOM ()) HTMLAppletElement (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. [Char]
-> 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 [Char]
"height" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAppletElement.height Mozilla HTMLAppletElement.height documentation> 
getHeight ::
          (MonadDOM m, FromJSString result) => HTMLAppletElement -> m result
getHeight :: HTMLAppletElement -> m result
getHeight HTMLAppletElement
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLAppletElement
self HTMLAppletElement
-> Getting (JSM JSVal) HTMLAppletElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter HTMLAppletElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"height") JSM JSVal -> (JSVal -> DOM result) -> DOM result
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/HTMLAppletElement.hspace Mozilla HTMLAppletElement.hspace documentation> 
setHspace :: (MonadDOM m) => HTMLAppletElement -> Word -> m ()
setHspace :: HTMLAppletElement -> Word -> m ()
setHspace HTMLAppletElement
self Word
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLAppletElement
self HTMLAppletElement
-> Getting (DOM ()) HTMLAppletElement (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. [Char]
-> 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 [Char]
"hspace" (Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAppletElement.hspace Mozilla HTMLAppletElement.hspace documentation> 
getHspace :: (MonadDOM m) => HTMLAppletElement -> m Word
getHspace :: HTMLAppletElement -> m Word
getHspace HTMLAppletElement
self
  = DOM Word -> m Word
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (Double -> Word
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Word) -> JSM Double -> DOM Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((HTMLAppletElement
self HTMLAppletElement
-> Getting (JSM JSVal) HTMLAppletElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter HTMLAppletElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"hspace") JSM JSVal -> (JSVal -> JSM Double) -> JSM Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM Double
forall value. ToJSVal value => value -> JSM Double
valToNumber))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAppletElement.name Mozilla HTMLAppletElement.name documentation> 
setName ::
        (MonadDOM m, ToJSString val) => HTMLAppletElement -> val -> m ()
setName :: HTMLAppletElement -> val -> m ()
setName HTMLAppletElement
self val
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLAppletElement
self HTMLAppletElement
-> Getting (DOM ()) HTMLAppletElement (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. [Char]
-> 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 [Char]
"name" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAppletElement.name Mozilla HTMLAppletElement.name documentation> 
getName ::
        (MonadDOM m, FromJSString result) => HTMLAppletElement -> m result
getName :: HTMLAppletElement -> m result
getName HTMLAppletElement
self = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLAppletElement
self HTMLAppletElement
-> Getting (JSM JSVal) HTMLAppletElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter HTMLAppletElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"name") JSM JSVal -> (JSVal -> DOM result) -> DOM result
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/HTMLAppletElement.object Mozilla HTMLAppletElement.object documentation> 
setObject ::
          (MonadDOM m, ToJSString val) => HTMLAppletElement -> val -> m ()
setObject :: HTMLAppletElement -> val -> m ()
setObject HTMLAppletElement
self val
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLAppletElement
self HTMLAppletElement
-> Getting (DOM ()) HTMLAppletElement (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. [Char]
-> 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 [Char]
"object" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAppletElement.object Mozilla HTMLAppletElement.object documentation> 
getObject ::
          (MonadDOM m, FromJSString result) => HTMLAppletElement -> m result
getObject :: HTMLAppletElement -> m result
getObject HTMLAppletElement
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLAppletElement
self HTMLAppletElement
-> Getting (JSM JSVal) HTMLAppletElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter HTMLAppletElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"object") JSM JSVal -> (JSVal -> DOM result) -> DOM result
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/HTMLAppletElement.vspace Mozilla HTMLAppletElement.vspace documentation> 
setVspace :: (MonadDOM m) => HTMLAppletElement -> Word -> m ()
setVspace :: HTMLAppletElement -> Word -> m ()
setVspace HTMLAppletElement
self Word
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLAppletElement
self HTMLAppletElement
-> Getting (DOM ()) HTMLAppletElement (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. [Char]
-> 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 [Char]
"vspace" (Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAppletElement.vspace Mozilla HTMLAppletElement.vspace documentation> 
getVspace :: (MonadDOM m) => HTMLAppletElement -> m Word
getVspace :: HTMLAppletElement -> m Word
getVspace HTMLAppletElement
self
  = DOM Word -> m Word
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (Double -> Word
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Word) -> JSM Double -> DOM Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((HTMLAppletElement
self HTMLAppletElement
-> Getting (JSM JSVal) HTMLAppletElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter HTMLAppletElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"vspace") JSM JSVal -> (JSVal -> JSM Double) -> JSM Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM Double
forall value. ToJSVal value => value -> JSM Double
valToNumber))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAppletElement.width Mozilla HTMLAppletElement.width documentation> 
setWidth ::
         (MonadDOM m, ToJSString val) => HTMLAppletElement -> val -> m ()
setWidth :: HTMLAppletElement -> val -> m ()
setWidth HTMLAppletElement
self val
val = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (HTMLAppletElement
self HTMLAppletElement
-> Getting (DOM ()) HTMLAppletElement (DOM ()) -> DOM ()
forall s a. s -> Getting a s a -> a
^. [Char]
-> 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 [Char]
"width" (val -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal val
val))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAppletElement.width Mozilla HTMLAppletElement.width documentation> 
getWidth ::
         (MonadDOM m, FromJSString result) => HTMLAppletElement -> m result
getWidth :: HTMLAppletElement -> m result
getWidth HTMLAppletElement
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLAppletElement
self HTMLAppletElement
-> Getting (JSM JSVal) HTMLAppletElement (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter HTMLAppletElement (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"width") JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM result
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)