{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.XSLTProcessor
       (newXSLTProcessor, importStylesheet, transformToFragment,
        transformToFragment_, transformToDocument, transformToDocument_,
        setParameter, getParameter, getParameter_, getParameterUnsafe,
        getParameterUnchecked, removeParameter, clearParameters, reset,
        XSLTProcessor(..), gTypeXSLTProcessor)
       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/XSLTProcessor Mozilla XSLTProcessor documentation> 
newXSLTProcessor :: (MonadDOM m) => m XSLTProcessor
newXSLTProcessor :: m XSLTProcessor
newXSLTProcessor
  = DOM XSLTProcessor -> m XSLTProcessor
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSVal -> XSLTProcessor
XSLTProcessor (JSVal -> XSLTProcessor) -> JSM JSVal -> DOM XSLTProcessor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSM JSVal -> () -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new ([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"XSLTProcessor") ())

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/XSLTProcessor.transformToFragment Mozilla XSLTProcessor.transformToFragment documentation> 
transformToFragment ::
                    (MonadDOM m, IsNode source, IsDocument docVal) =>
                      XSLTProcessor -> Maybe source -> Maybe docVal -> m DocumentFragment
transformToFragment :: XSLTProcessor -> Maybe source -> Maybe docVal -> m DocumentFragment
transformToFragment XSLTProcessor
self Maybe source
source Maybe docVal
docVal
  = DOM DocumentFragment -> m DocumentFragment
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((XSLTProcessor
self XSLTProcessor
-> Getting (JSM JSVal) XSLTProcessor (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]
"transformToFragment"
          [Maybe source -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe source
source, Maybe docVal -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe docVal
docVal])
         JSM JSVal
-> (JSVal -> DOM DocumentFragment) -> DOM DocumentFragment
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM DocumentFragment
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/XSLTProcessor.transformToDocument Mozilla XSLTProcessor.transformToDocument documentation> 
transformToDocument ::
                    (MonadDOM m, IsNode source) =>
                      XSLTProcessor -> Maybe source -> m Document
transformToDocument :: XSLTProcessor -> Maybe source -> m Document
transformToDocument XSLTProcessor
self Maybe source
source
  = DOM Document -> m Document
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((XSLTProcessor
self XSLTProcessor
-> Getting (JSM JSVal) XSLTProcessor (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]
"transformToDocument" [Maybe source -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe source
source]) JSM JSVal -> (JSVal -> DOM Document) -> DOM Document
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM Document
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

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

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

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/XSLTProcessor.getParameter Mozilla XSLTProcessor.getParameter documentation> 
getParameterUnsafe ::
                   (MonadDOM m, ToJSString namespaceURI, ToJSString localName,
                    HasCallStack, FromJSString result) =>
                     XSLTProcessor -> Maybe namespaceURI -> Maybe localName -> m result
getParameterUnsafe :: XSLTProcessor -> Maybe namespaceURI -> Maybe localName -> m result
getParameterUnsafe XSLTProcessor
self Maybe namespaceURI
namespaceURI Maybe localName
localName
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((XSLTProcessor
self XSLTProcessor
-> Getting (JSM JSVal) XSLTProcessor (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]
"getParameter"
           [Maybe namespaceURI -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe namespaceURI
namespaceURI, Maybe localName -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe localName
localName])
          JSM JSVal -> (JSVal -> JSM (Maybe result)) -> JSM (Maybe result)
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 (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 ([Char] -> DOM result
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") result -> DOM result
forall (m :: * -> *) a. Monad m => a -> m a
return)

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/XSLTProcessor.clearParameters Mozilla XSLTProcessor.clearParameters documentation> 
clearParameters :: (MonadDOM m) => XSLTProcessor -> m ()
clearParameters :: XSLTProcessor -> m ()
clearParameters XSLTProcessor
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 (XSLTProcessor
self XSLTProcessor
-> Getting (JSM JSVal) XSLTProcessor (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"clearParameters" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/XSLTProcessor.reset Mozilla XSLTProcessor.reset documentation> 
reset :: (MonadDOM m) => XSLTProcessor -> m ()
reset :: XSLTProcessor -> m ()
reset XSLTProcessor
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 (XSLTProcessor
self XSLTProcessor
-> Getting (JSM JSVal) XSLTProcessor (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> () -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf [Char]
"reset" ()))