{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.MutationRecord
       (getType, getTarget, getAddedNodes, getRemovedNodes,
        getPreviousSibling, getPreviousSiblingUnsafe,
        getPreviousSiblingUnchecked, getNextSibling, getNextSiblingUnsafe,
        getNextSiblingUnchecked, getAttributeName, getAttributeNameUnsafe,
        getAttributeNameUnchecked, getAttributeNamespace,
        getAttributeNamespaceUnsafe, getAttributeNamespaceUnchecked,
        getOldValue, getOldValueUnsafe, getOldValueUnchecked,
        MutationRecord(..), gTypeMutationRecord)
       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/MutationRecord.type Mozilla MutationRecord.type documentation> 
getType ::
        (MonadDOM m, FromJSString result) => MutationRecord -> m result
getType :: forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
MutationRecord -> m result
getType MutationRecord
self = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"type") 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/MutationRecord.target Mozilla MutationRecord.target documentation> 
getTarget :: (MonadDOM m) => MutationRecord -> m Node
getTarget :: forall (m :: * -> *). MonadDOM m => MutationRecord -> m Node
getTarget MutationRecord
self
  = DOM Node -> m Node
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"target") 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/MutationRecord.addedNodes Mozilla MutationRecord.addedNodes documentation> 
getAddedNodes :: (MonadDOM m) => MutationRecord -> m NodeList
getAddedNodes :: forall (m :: * -> *). MonadDOM m => MutationRecord -> m NodeList
getAddedNodes MutationRecord
self
  = DOM NodeList -> m NodeList
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"addedNodes") 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/MutationRecord.removedNodes Mozilla MutationRecord.removedNodes documentation> 
getRemovedNodes :: (MonadDOM m) => MutationRecord -> m NodeList
getRemovedNodes :: forall (m :: * -> *). MonadDOM m => MutationRecord -> m NodeList
getRemovedNodes MutationRecord
self
  = DOM NodeList -> m NodeList
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"removedNodes") 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/MutationRecord.previousSibling Mozilla MutationRecord.previousSibling documentation> 
getPreviousSibling ::
                   (MonadDOM m) => MutationRecord -> m (Maybe Node)
getPreviousSibling :: forall (m :: * -> *).
MonadDOM m =>
MutationRecord -> m (Maybe Node)
getPreviousSibling MutationRecord
self
  = DOM (Maybe Node) -> m (Maybe Node)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"previousSibling") JSM JSVal -> (JSVal -> DOM (Maybe Node)) -> DOM (Maybe 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 (Maybe Node)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/MutationRecord.previousSibling Mozilla MutationRecord.previousSibling documentation> 
getPreviousSiblingUnsafe ::
                         (MonadDOM m, HasCallStack) => MutationRecord -> m Node
getPreviousSiblingUnsafe :: forall (m :: * -> *).
(MonadDOM m, HasCallStack) =>
MutationRecord -> m Node
getPreviousSiblingUnsafe MutationRecord
self
  = DOM Node -> m Node
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"previousSibling") JSM JSVal -> (JSVal -> DOM (Maybe Node)) -> DOM (Maybe 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 (Maybe Node)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe Node) -> (Maybe Node -> 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
>>=
         DOM Node -> (Node -> DOM Node) -> Maybe Node -> DOM Node
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM Node
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") Node -> DOM Node
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/MutationRecord.previousSibling Mozilla MutationRecord.previousSibling documentation> 
getPreviousSiblingUnchecked ::
                            (MonadDOM m) => MutationRecord -> m Node
getPreviousSiblingUnchecked :: forall (m :: * -> *). MonadDOM m => MutationRecord -> m Node
getPreviousSiblingUnchecked MutationRecord
self
  = DOM Node -> m Node
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"previousSibling") 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/MutationRecord.nextSibling Mozilla MutationRecord.nextSibling documentation> 
getNextSibling :: (MonadDOM m) => MutationRecord -> m (Maybe Node)
getNextSibling :: forall (m :: * -> *).
MonadDOM m =>
MutationRecord -> m (Maybe Node)
getNextSibling MutationRecord
self
  = DOM (Maybe Node) -> m (Maybe Node)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"nextSibling") JSM JSVal -> (JSVal -> DOM (Maybe Node)) -> DOM (Maybe 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 (Maybe Node)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/MutationRecord.nextSibling Mozilla MutationRecord.nextSibling documentation> 
getNextSiblingUnsafe ::
                     (MonadDOM m, HasCallStack) => MutationRecord -> m Node
getNextSiblingUnsafe :: forall (m :: * -> *).
(MonadDOM m, HasCallStack) =>
MutationRecord -> m Node
getNextSiblingUnsafe MutationRecord
self
  = DOM Node -> m Node
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"nextSibling") JSM JSVal -> (JSVal -> DOM (Maybe Node)) -> DOM (Maybe 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 (Maybe Node)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
fromJSVal) DOM (Maybe Node) -> (Maybe Node -> 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
>>=
         DOM Node -> (Node -> DOM Node) -> Maybe Node -> DOM Node
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> DOM Node
forall a. HasCallStack => String -> a
Prelude.error String
"Nothing to return") Node -> DOM Node
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/MutationRecord.nextSibling Mozilla MutationRecord.nextSibling documentation> 
getNextSiblingUnchecked :: (MonadDOM m) => MutationRecord -> m Node
getNextSiblingUnchecked :: forall (m :: * -> *). MonadDOM m => MutationRecord -> m Node
getNextSiblingUnchecked MutationRecord
self
  = DOM Node -> m Node
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"nextSibling") 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/MutationRecord.attributeName Mozilla MutationRecord.attributeName documentation> 
getAttributeName ::
                 (MonadDOM m, FromJSString result) =>
                   MutationRecord -> m (Maybe result)
getAttributeName :: forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
MutationRecord -> m (Maybe result)
getAttributeName MutationRecord
self
  = DOM (Maybe result) -> m (Maybe result)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"attributeName") 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/MutationRecord.attributeName Mozilla MutationRecord.attributeName documentation> 
getAttributeNameUnsafe ::
                       (MonadDOM m, HasCallStack, FromJSString result) =>
                         MutationRecord -> m result
getAttributeNameUnsafe :: forall (m :: * -> *) result.
(MonadDOM m, HasCallStack, FromJSString result) =>
MutationRecord -> m result
getAttributeNameUnsafe MutationRecord
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"attributeName") 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/MutationRecord.attributeName Mozilla MutationRecord.attributeName documentation> 
getAttributeNameUnchecked ::
                          (MonadDOM m, FromJSString result) => MutationRecord -> m result
getAttributeNameUnchecked :: forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
MutationRecord -> m result
getAttributeNameUnchecked MutationRecord
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"attributeName") 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/MutationRecord.attributeNamespace Mozilla MutationRecord.attributeNamespace documentation> 
getAttributeNamespace ::
                      (MonadDOM m, FromJSString result) =>
                        MutationRecord -> m (Maybe result)
getAttributeNamespace :: forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
MutationRecord -> m (Maybe result)
getAttributeNamespace MutationRecord
self
  = DOM (Maybe result) -> m (Maybe result)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"attributeNamespace") 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/MutationRecord.attributeNamespace Mozilla MutationRecord.attributeNamespace documentation> 
getAttributeNamespaceUnsafe ::
                            (MonadDOM m, HasCallStack, FromJSString result) =>
                              MutationRecord -> m result
getAttributeNamespaceUnsafe :: forall (m :: * -> *) result.
(MonadDOM m, HasCallStack, FromJSString result) =>
MutationRecord -> m result
getAttributeNamespaceUnsafe MutationRecord
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"attributeNamespace") 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/MutationRecord.attributeNamespace Mozilla MutationRecord.attributeNamespace documentation> 
getAttributeNamespaceUnchecked ::
                               (MonadDOM m, FromJSString result) => MutationRecord -> m result
getAttributeNamespaceUnchecked :: forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
MutationRecord -> m result
getAttributeNamespaceUnchecked MutationRecord
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"attributeNamespace") 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/MutationRecord.oldValue Mozilla MutationRecord.oldValue documentation> 
getOldValue ::
            (MonadDOM m, FromJSString result) =>
              MutationRecord -> m (Maybe result)
getOldValue :: forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
MutationRecord -> m (Maybe result)
getOldValue MutationRecord
self
  = DOM (Maybe result) -> m (Maybe result)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"oldValue") 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/MutationRecord.oldValue Mozilla MutationRecord.oldValue documentation> 
getOldValueUnsafe ::
                  (MonadDOM m, HasCallStack, FromJSString result) =>
                    MutationRecord -> m result
getOldValueUnsafe :: forall (m :: * -> *) result.
(MonadDOM m, HasCallStack, FromJSString result) =>
MutationRecord -> m result
getOldValueUnsafe MutationRecord
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"oldValue") 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/MutationRecord.oldValue Mozilla MutationRecord.oldValue documentation> 
getOldValueUnchecked ::
                     (MonadDOM m, FromJSString result) => MutationRecord -> m result
getOldValueUnchecked :: forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
MutationRecord -> m result
getOldValueUnchecked MutationRecord
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((MutationRecord
self MutationRecord
-> Getting (JSM JSVal) MutationRecord (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> IndexPreservingGetter MutationRecord (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js String
"oldValue") 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)