{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.WorkerGlobalScope
       (fetch, fetch_, close, importScripts, getIndexedDB, getSelf,
        getLocation, error, offline, online, getNavigator,
        WorkerGlobalScope(..), gTypeWorkerGlobalScope, IsWorkerGlobalScope,
        toWorkerGlobalScope)
       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/WorkerGlobalScope.fetch Mozilla WorkerGlobalScope.fetch documentation> 
fetch ::
      (MonadDOM m, IsWorkerGlobalScope self, ToJSVal input) =>
        self -> input -> Maybe RequestInit -> m Response
fetch :: self -> input -> Maybe RequestInit -> m Response
fetch self
self input
input Maybe RequestInit
init
  = DOM Response -> m Response
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((((self -> WorkerGlobalScope
forall o. IsWorkerGlobalScope o => o -> WorkerGlobalScope
toWorkerGlobalScope self
self) WorkerGlobalScope
-> Getting (JSM JSVal) WorkerGlobalScope (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]
"fetch"
           [input -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal input
input, Maybe RequestInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe RequestInit
init])
          JSM JSVal -> (JSVal -> JSM JSVal) -> JSM JSVal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> JSM JSVal
readPromise)
         JSM JSVal -> (JSVal -> DOM Response) -> DOM Response
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Response
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WorkerGlobalScope.fetch Mozilla WorkerGlobalScope.fetch documentation> 
fetch_ ::
       (MonadDOM m, IsWorkerGlobalScope self, ToJSVal input) =>
         self -> input -> Maybe RequestInit -> m ()
fetch_ :: self -> input -> Maybe RequestInit -> m ()
fetch_ self
self input
input Maybe RequestInit
init
  = 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 -> WorkerGlobalScope
forall o. IsWorkerGlobalScope o => o -> WorkerGlobalScope
toWorkerGlobalScope self
self) WorkerGlobalScope
-> Getting (JSM JSVal) WorkerGlobalScope (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]
"fetch"
            [input -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal input
input, Maybe RequestInit -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe RequestInit
init]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WorkerGlobalScope.close Mozilla WorkerGlobalScope.close documentation> 
close :: (MonadDOM m, IsWorkerGlobalScope self) => self -> m ()
close :: self -> m ()
close self
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 ((self -> WorkerGlobalScope
forall o. IsWorkerGlobalScope o => o -> WorkerGlobalScope
toWorkerGlobalScope self
self) WorkerGlobalScope
-> Getting (JSM JSVal) WorkerGlobalScope (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]
"close" ()))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WorkerGlobalScope.importScripts Mozilla WorkerGlobalScope.importScripts documentation> 
importScripts ::
              (MonadDOM m, IsWorkerGlobalScope self, ToJSString urls) =>
                self -> [urls] -> m ()
importScripts :: self -> [urls] -> m ()
importScripts self
self [urls]
urls
  = 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 -> WorkerGlobalScope
forall o. IsWorkerGlobalScope o => o -> WorkerGlobalScope
toWorkerGlobalScope self
self) WorkerGlobalScope
-> Getting (JSM JSVal) WorkerGlobalScope (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]
"importScripts"
            [JSM Object -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ([urls] -> JSM Object
forall args. MakeArgs args => args -> JSM Object
array [urls]
urls)]))

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

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

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WorkerGlobalScope.onerror Mozilla WorkerGlobalScope.onerror documentation> 
error ::
      (IsWorkerGlobalScope self, IsEventTarget self) =>
        EventName self UIEvent
error :: EventName self UIEvent
error = DOMString -> EventName self UIEvent
forall t e. DOMString -> EventName t e
unsafeEventNameAsync ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"error")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WorkerGlobalScope.onoffline Mozilla WorkerGlobalScope.onoffline documentation> 
offline ::
        (IsWorkerGlobalScope self, IsEventTarget self) =>
          EventName self Event
offline :: EventName self Event
offline = DOMString -> EventName self Event
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"offline")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WorkerGlobalScope.ononline Mozilla WorkerGlobalScope.ononline documentation> 
online ::
       (IsWorkerGlobalScope self, IsEventTarget self) =>
         EventName self Event
online :: EventName self Event
online = DOMString -> EventName self Event
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"online")

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