{-# LANGUAGE PatternSynonyms #-} module Language.Javascript.JSaddle.DOM.Generated.IDBObjectStore (put, add, deleteRange, delete, getRange, get, clear, openCursorRange, openCursor, createIndex', createIndex, index, deleteIndex, countRange, count, getName, getKeyPath, getIndexNames, getTransaction, getAutoIncrement, IDBObjectStore, castToIDBObjectStore, gTypeIDBObjectStore) where import Prelude ((.), (==), (>>=), return, IO, Int, Float, Double, Bool(..), Maybe, maybe, fromIntegral, round, realToFrac, fmap, Show, Read, Eq, Ord, Maybe(..)) import Data.Typeable (Typeable) import Language.Javascript.JSaddle (JSM(..), JSVal(..), JSString, strictEqual, toJSVal, valToStr, valToNumber, valToBool, js, jss, jsf, jsg, function, new, array) import Data.Int (Int64) import Data.Word (Word, Word64) import Language.Javascript.JSaddle.DOM.Types import Control.Applicative ((<$>)) import Control.Monad (void) import Control.Lens.Operators ((^.)) import Language.Javascript.JSaddle.DOM.EventTargetClosures (EventName, unsafeEventName) import Language.Javascript.JSaddle.DOM.Enums -- | put :: (MonadDOM m) => IDBObjectStore -> JSVal -> JSVal -> m (Maybe IDBRequest) put self value key = liftDOM ((self ^. jsf "put" [toJSVal value, toJSVal key]) >>= fromJSVal) -- | add :: (MonadDOM m) => IDBObjectStore -> JSVal -> JSVal -> m (Maybe IDBRequest) add self value key = liftDOM ((self ^. jsf "add" [toJSVal value, toJSVal key]) >>= fromJSVal) -- | deleteRange :: (MonadDOM m) => IDBObjectStore -> Maybe IDBKeyRange -> m (Maybe IDBRequest) deleteRange self keyRange = liftDOM ((self ^. jsf "delete" [toJSVal keyRange]) >>= fromJSVal) -- | delete :: (MonadDOM m) => IDBObjectStore -> JSVal -> m (Maybe IDBRequest) delete self key = liftDOM ((self ^. jsf "delete" [toJSVal key]) >>= fromJSVal) -- | getRange :: (MonadDOM m) => IDBObjectStore -> Maybe IDBKeyRange -> m (Maybe IDBRequest) getRange self key = liftDOM ((self ^. jsf "get" [toJSVal key]) >>= fromJSVal) -- | get :: (MonadDOM m) => IDBObjectStore -> JSVal -> m (Maybe IDBRequest) get self key = liftDOM ((self ^. jsf "get" [toJSVal key]) >>= fromJSVal) -- | clear :: (MonadDOM m) => IDBObjectStore -> m (Maybe IDBRequest) clear self = liftDOM ((self ^. js "clear") >>= fromJSVal) -- | openCursorRange :: (MonadDOM m, ToJSString direction) => IDBObjectStore -> Maybe IDBKeyRange -> direction -> m (Maybe IDBRequest) openCursorRange self range direction = liftDOM ((self ^. jsf "openCursor" [toJSVal range, toJSVal direction]) >>= fromJSVal) -- | openCursor :: (MonadDOM m, ToJSString direction) => IDBObjectStore -> JSVal -> direction -> m (Maybe IDBRequest) openCursor self key direction = liftDOM ((self ^. jsf "openCursor" [toJSVal key, toJSVal direction]) >>= fromJSVal) -- | createIndex' :: (MonadDOM m, ToJSString name, ToJSString keyPath, IsDictionary options) => IDBObjectStore -> name -> [keyPath] -> Maybe options -> m (Maybe IDBIndex) createIndex' self name keyPath options = liftDOM ((self ^. jsf "createIndex" [toJSVal name, toJSVal (array keyPath), toJSVal options]) >>= fromJSVal) -- | createIndex :: (MonadDOM m, ToJSString name, ToJSString keyPath, IsDictionary options) => IDBObjectStore -> name -> keyPath -> Maybe options -> m (Maybe IDBIndex) createIndex self name keyPath options = liftDOM ((self ^. jsf "createIndex" [toJSVal name, toJSVal keyPath, toJSVal options]) >>= fromJSVal) -- | index :: (MonadDOM m, ToJSString name) => IDBObjectStore -> name -> m (Maybe IDBIndex) index self name = liftDOM ((self ^. jsf "index" [toJSVal name]) >>= fromJSVal) -- | deleteIndex :: (MonadDOM m, ToJSString name) => IDBObjectStore -> name -> m () deleteIndex self name = liftDOM (void (self ^. jsf "deleteIndex" [toJSVal name])) -- | countRange :: (MonadDOM m) => IDBObjectStore -> Maybe IDBKeyRange -> m (Maybe IDBRequest) countRange self range = liftDOM ((self ^. jsf "count" [toJSVal range]) >>= fromJSVal) -- | count :: (MonadDOM m) => IDBObjectStore -> JSVal -> m (Maybe IDBRequest) count self key = liftDOM ((self ^. jsf "count" [toJSVal key]) >>= fromJSVal) -- | getName :: (MonadDOM m, FromJSString result) => IDBObjectStore -> m (Maybe result) getName self = liftDOM ((self ^. js "name") >>= fromMaybeJSString) -- | getKeyPath :: (MonadDOM m) => IDBObjectStore -> m (Maybe IDBAny) getKeyPath self = liftDOM ((self ^. js "keyPath") >>= fromJSVal) -- | getIndexNames :: (MonadDOM m) => IDBObjectStore -> m (Maybe DOMStringList) getIndexNames self = liftDOM ((self ^. js "indexNames") >>= fromJSVal) -- | getTransaction :: (MonadDOM m) => IDBObjectStore -> m (Maybe IDBTransaction) getTransaction self = liftDOM ((self ^. js "transaction") >>= fromJSVal) -- | getAutoIncrement :: (MonadDOM m) => IDBObjectStore -> m Bool getAutoIncrement self = liftDOM ((self ^. js "autoIncrement") >>= valToBool)