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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAllCollection.item Mozilla HTMLAllCollection.item documentation> 
itemUnsafe ::
           (MonadDOM m, HasCallStack) =>
             HTMLAllCollection -> Word -> m Element
itemUnsafe :: forall (m :: * -> *).
(MonadDOM m, HasCallStack) =>
HTMLAllCollection -> Word -> m Element
itemUnsafe HTMLAllCollection
self Word
index
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((HTMLAllCollection
self HTMLAllCollection
-> Getting (JSM JSVal) HTMLAllCollection (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
"item" [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
index]) 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/HTMLAllCollection.item Mozilla HTMLAllCollection.item documentation> 
itemUnchecked ::
              (MonadDOM m) => HTMLAllCollection -> Word -> m Element
itemUnchecked :: forall (m :: * -> *).
MonadDOM m =>
HTMLAllCollection -> Word -> m Element
itemUnchecked HTMLAllCollection
self Word
index
  = DOM Element -> m Element
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((HTMLAllCollection
self HTMLAllCollection
-> Getting (JSM JSVal) HTMLAllCollection (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
"item" [Word -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Word
index]) 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/HTMLAllCollection.namedItem Mozilla HTMLAllCollection.namedItem documentation> 
namedItem ::
          (MonadDOM m, ToJSString name) =>
            HTMLAllCollection -> name -> m (Maybe HTMLCollectionOrElement)
namedItem :: forall (m :: * -> *) name.
(MonadDOM m, ToJSString name) =>
HTMLAllCollection -> name -> m (Maybe HTMLCollectionOrElement)
namedItem HTMLAllCollection
self name
name = DOM (Maybe HTMLCollectionOrElement)
-> m (Maybe HTMLCollectionOrElement)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLAllCollection
self HTMLAllCollection -> name -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! name
name) JSM JSVal
-> (JSVal -> DOM (Maybe HTMLCollectionOrElement))
-> DOM (Maybe HTMLCollectionOrElement)
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 HTMLCollectionOrElement)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAllCollection.namedItem Mozilla HTMLAllCollection.namedItem documentation> 
namedItem_ ::
           (MonadDOM m, ToJSString name) => HTMLAllCollection -> name -> m ()
namedItem_ :: forall (m :: * -> *) name.
(MonadDOM m, ToJSString name) =>
HTMLAllCollection -> name -> m ()
namedItem_ HTMLAllCollection
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 (HTMLAllCollection
self HTMLAllCollection -> 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/HTMLAllCollection.namedItem Mozilla HTMLAllCollection.namedItem documentation> 
namedItemUnsafe ::
                (MonadDOM m, ToJSString name, HasCallStack) =>
                  HTMLAllCollection -> name -> m HTMLCollectionOrElement
namedItemUnsafe :: forall (m :: * -> *) name.
(MonadDOM m, ToJSString name, HasCallStack) =>
HTMLAllCollection -> name -> m HTMLCollectionOrElement
namedItemUnsafe HTMLAllCollection
self name
name
  = DOM HTMLCollectionOrElement -> m HTMLCollectionOrElement
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((HTMLAllCollection
self HTMLAllCollection -> name -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! name
name) JSM JSVal
-> (JSVal -> DOM (Maybe HTMLCollectionOrElement))
-> DOM (Maybe HTMLCollectionOrElement)
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 HTMLCollectionOrElement)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe HTMLCollectionOrElement)
-> (Maybe HTMLCollectionOrElement -> DOM HTMLCollectionOrElement)
-> DOM HTMLCollectionOrElement
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         DOM HTMLCollectionOrElement
-> (HTMLCollectionOrElement -> DOM HTMLCollectionOrElement)
-> Maybe HTMLCollectionOrElement
-> DOM HTMLCollectionOrElement
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM HTMLCollectionOrElement
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") HTMLCollectionOrElement -> DOM HTMLCollectionOrElement
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAllCollection.namedItem Mozilla HTMLAllCollection.namedItem documentation> 
namedItemUnchecked ::
                   (MonadDOM m, ToJSString name) =>
                     HTMLAllCollection -> name -> m HTMLCollectionOrElement
namedItemUnchecked :: forall (m :: * -> *) name.
(MonadDOM m, ToJSString name) =>
HTMLAllCollection -> name -> m HTMLCollectionOrElement
namedItemUnchecked HTMLAllCollection
self name
name
  = DOM HTMLCollectionOrElement -> m HTMLCollectionOrElement
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((HTMLAllCollection
self HTMLAllCollection -> name -> JSM JSVal
forall this name.
(MakeObject this, ToJSString name) =>
this -> name -> JSM JSVal
! name
name) JSM JSVal
-> (JSVal -> DOM HTMLCollectionOrElement)
-> DOM HTMLCollectionOrElement
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 HTMLCollectionOrElement
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/HTMLAllCollection.length Mozilla HTMLAllCollection.length documentation> 
getLength :: (MonadDOM m) => HTMLAllCollection -> m Word
getLength :: forall (m :: * -> *). MonadDOM m => HTMLAllCollection -> m Word
getLength HTMLAllCollection
self
  = DOM Word -> m Word
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (Double -> Word
forall b. Integral b => Double -> b
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
<$> ((HTMLAllCollection
self HTMLAllCollection
-> Getting (JSM JSVal) HTMLAllCollection (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter HTMLAllCollection (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"length") JSM JSVal -> (JSVal -> JSM Double) -> JSM Double
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 Double
forall value. ToJSVal value => value -> JSM Double
valToNumber))