{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.IDBDatabase
       (createObjectStore, createObjectStore_, deleteObjectStore,
        transaction, transaction_, close, getName, getVersion,
        getObjectStoreNames, abort, closeEvent, error, versionChange,
        IDBDatabase(..), gTypeIDBDatabase)
       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/IDBDatabase.createObjectStore Mozilla IDBDatabase.createObjectStore documentation> 
createObjectStore ::
                  (MonadDOM m, ToJSString name) =>
                    IDBDatabase ->
                      name -> Maybe IDBObjectStoreParameters -> m IDBObjectStore
createObjectStore :: IDBDatabase
-> name -> Maybe IDBObjectStoreParameters -> m IDBObjectStore
createObjectStore IDBDatabase
self name
name Maybe IDBObjectStoreParameters
parameters
  = DOM IDBObjectStore -> m IDBObjectStore
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((IDBDatabase
self IDBDatabase
-> Getting (JSM JSVal) IDBDatabase (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]
"createObjectStore"
          [name -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal name
name, Maybe IDBObjectStoreParameters -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe IDBObjectStoreParameters
parameters])
         JSM JSVal -> (JSVal -> DOM IDBObjectStore) -> DOM IDBObjectStore
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM IDBObjectStore
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBDatabase.deleteObjectStore Mozilla IDBDatabase.deleteObjectStore documentation> 
deleteObjectStore ::
                  (MonadDOM m, ToJSString name) => IDBDatabase -> name -> m ()
deleteObjectStore :: IDBDatabase -> name -> m ()
deleteObjectStore IDBDatabase
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 (IDBDatabase
self IDBDatabase
-> Getting (JSM JSVal) IDBDatabase (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]
"deleteObjectStore" [name -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal name
name]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBDatabase.transaction Mozilla IDBDatabase.transaction documentation> 
transaction ::
            (MonadDOM m, IsStringOrStrings storeNames) =>
              IDBDatabase ->
                storeNames -> Maybe IDBTransactionMode -> m IDBTransaction
transaction :: IDBDatabase
-> storeNames -> Maybe IDBTransactionMode -> m IDBTransaction
transaction IDBDatabase
self storeNames
storeNames Maybe IDBTransactionMode
mode
  = DOM IDBTransaction -> m IDBTransaction
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((IDBDatabase
self IDBDatabase
-> Getting (JSM JSVal) IDBDatabase (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]
"transaction" [storeNames -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal storeNames
storeNames, Maybe IDBTransactionMode -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe IDBTransactionMode
mode]) JSM JSVal -> (JSVal -> DOM IDBTransaction) -> DOM IDBTransaction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM IDBTransaction
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBDatabase.close Mozilla IDBDatabase.close documentation> 
close :: (MonadDOM m) => IDBDatabase -> m ()
close :: IDBDatabase -> m ()
close IDBDatabase
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 (IDBDatabase
self IDBDatabase
-> Getting (JSM JSVal) IDBDatabase (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/IDBDatabase.name Mozilla IDBDatabase.name documentation> 
getName ::
        (MonadDOM m, FromJSString result) => IDBDatabase -> m result
getName :: IDBDatabase -> m result
getName IDBDatabase
self = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((IDBDatabase
self IDBDatabase
-> Getting (JSM JSVal) IDBDatabase (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter IDBDatabase (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"name") 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/IDBDatabase.version Mozilla IDBDatabase.version documentation> 
getVersion :: (MonadDOM m) => IDBDatabase -> m Word64
getVersion :: IDBDatabase -> m Word64
getVersion IDBDatabase
self
  = DOM Word64 -> m Word64
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (Double -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Word64) -> JSM Double -> DOM Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((IDBDatabase
self IDBDatabase
-> Getting (JSM JSVal) IDBDatabase (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter IDBDatabase (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"version") 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))

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBDatabase.onabort Mozilla IDBDatabase.onabort documentation> 
abort :: EventName IDBDatabase Event
abort :: EventName IDBDatabase Event
abort = DOMString -> EventName IDBDatabase Event
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"abort")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBDatabase.onclose Mozilla IDBDatabase.onclose documentation> 
closeEvent :: EventName IDBDatabase CloseEvent
closeEvent :: EventName IDBDatabase CloseEvent
closeEvent = DOMString -> EventName IDBDatabase CloseEvent
forall t e. DOMString -> EventName t e
unsafeEventNameAsync ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"close")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBDatabase.onerror Mozilla IDBDatabase.onerror documentation> 
error :: EventName IDBDatabase Event
error :: EventName IDBDatabase Event
error = DOMString -> EventName IDBDatabase Event
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"error")

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBDatabase.onversionchange Mozilla IDBDatabase.onversionchange documentation> 
versionChange :: EventName IDBDatabase IDBVersionChangeEvent
versionChange :: EventName IDBDatabase IDBVersionChangeEvent
versionChange = DOMString -> EventName IDBDatabase IDBVersionChangeEvent
forall t e. DOMString -> EventName t e
unsafeEventName ([Char] -> DOMString
forall a. ToJSString a => a -> DOMString
toJSString [Char]
"versionchange")