{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.HTMLCollection
       (item, item_, itemUnsafe, itemUnchecked, namedItem, namedItem_,
        namedItemUnsafe, namedItemUnchecked, getLength, HTMLCollection(..),
        gTypeHTMLCollection, IsHTMLCollection, toHTMLCollection)
       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/HTMLCollection.item Mozilla HTMLCollection.item documentation> 
item ::
     (MonadDOM m, IsHTMLCollection self) =>
       self -> Word -> m (Maybe Element)
item :: self -> Word -> m (Maybe Element)
item self
self Word
index
  = DOM (Maybe Element) -> m (Maybe Element)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> HTMLCollection
forall o. IsHTMLCollection o => o -> HTMLCollection
toHTMLCollection self
self) HTMLCollection
-> Getting (JSM JSVal) HTMLCollection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"item" [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
index]) JSM JSVal -> (JSVal -> DOM (Maybe Element)) -> DOM (Maybe Element)
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/HTMLCollection.item Mozilla HTMLCollection.item documentation> 
item_ ::
      (MonadDOM m, IsHTMLCollection self) => self -> Word -> m ()
item_ :: self -> Word -> m ()
item_ self
self Word
index
  = 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 -> HTMLCollection
forall o. IsHTMLCollection o => o -> HTMLCollection
toHTMLCollection self
self) HTMLCollection
-> Getting (JSM JSVal) HTMLCollection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"item" [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
index]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLCollection.item Mozilla HTMLCollection.item documentation> 
itemUnsafe ::
           (MonadDOM m, IsHTMLCollection self, HasCallStack) =>
             self -> Word -> m Element
itemUnsafe :: self -> Word -> m Element
itemUnsafe self
self Word
index
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> HTMLCollection
forall o. IsHTMLCollection o => o -> HTMLCollection
toHTMLCollection self
self) HTMLCollection
-> Getting (JSM JSVal) HTMLCollection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"item" [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
index]) JSM JSVal -> (JSVal -> DOM (Maybe Element)) -> DOM (Maybe Element)
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 (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 ([Char] -> DOM Element
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") Element -> DOM Element
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLCollection.item Mozilla HTMLCollection.item documentation> 
itemUnchecked ::
              (MonadDOM m, IsHTMLCollection self) => self -> Word -> m Element
itemUnchecked :: self -> Word -> m Element
itemUnchecked self
self Word
index
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((self -> HTMLCollection
forall o. IsHTMLCollection o => o -> HTMLCollection
toHTMLCollection self
self) HTMLCollection
-> Getting (JSM JSVal) HTMLCollection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"item" [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
index]) JSM JSVal -> (JSVal -> DOM Element) -> DOM Element
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/HTMLCollection.namedItem Mozilla HTMLCollection.namedItem documentation> 
namedItem ::
          (MonadDOM m, IsHTMLCollection self, ToJSString name) =>
            self -> name -> m (Maybe Element)
namedItem :: self -> name -> m (Maybe Element)
namedItem self
self name
name
  = DOM (Maybe Element) -> m (Maybe Element)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> HTMLCollection
forall o. IsHTMLCollection o => o -> HTMLCollection
toHTMLCollection self
self) HTMLCollection -> name -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! name
name) JSM JSVal -> (JSVal -> DOM (Maybe Element)) -> DOM (Maybe Element)
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/HTMLCollection.namedItem Mozilla HTMLCollection.namedItem documentation> 
namedItem_ ::
           (MonadDOM m, IsHTMLCollection self, ToJSString name) =>
             self -> name -> m ()
namedItem_ :: self -> name -> m ()
namedItem_ self
self name
name
  = 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 -> HTMLCollection
forall o. IsHTMLCollection o => o -> HTMLCollection
toHTMLCollection self
self) HTMLCollection -> name -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! name
name))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLCollection.namedItem Mozilla HTMLCollection.namedItem documentation> 
namedItemUnsafe ::
                (MonadDOM m, IsHTMLCollection self, ToJSString name,
                 HasCallStack) =>
                  self -> name -> m Element
namedItemUnsafe :: self -> name -> m Element
namedItemUnsafe self
self name
name
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> HTMLCollection
forall o. IsHTMLCollection o => o -> HTMLCollection
toHTMLCollection self
self) HTMLCollection -> name -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! name
name) JSM JSVal -> (JSVal -> DOM (Maybe Element)) -> DOM (Maybe Element)
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 (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 ([Char] -> DOM Element
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") Element -> DOM Element
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLCollection.namedItem Mozilla HTMLCollection.namedItem documentation> 
namedItemUnchecked ::
                   (MonadDOM m, IsHTMLCollection self, ToJSString name) =>
                     self -> name -> m Element
namedItemUnchecked :: self -> name -> m Element
namedItemUnchecked self
self name
name
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (((self -> HTMLCollection
forall o. IsHTMLCollection o => o -> HTMLCollection
toHTMLCollection self
self) HTMLCollection -> name -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! name
name) JSM JSVal -> (JSVal -> DOM Element) -> DOM Element
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/HTMLCollection.length Mozilla HTMLCollection.length documentation> 
getLength :: (MonadDOM m, IsHTMLCollection self) => self -> m Word
getLength :: self -> m Word
getLength self
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
<$>
         (((self -> HTMLCollection
forall o. IsHTMLCollection o => o -> HTMLCollection
toHTMLCollection self
self) HTMLCollection
-> Getting (JSM JSVal) HTMLCollection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter HTMLCollection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"length") 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))