{-# LANGUAGE PatternSynonyms, ForeignFunctionInterface, JavaScriptFFI #-} module GHCJS.DOM.JSFFI.Generated.IDBCursor (js_update, update, update_, updateUnchecked, js_advance, advance, js_continue, continue, js_delete, delete, delete_, deleteUnchecked, js_getSource, getSource, getSourceUnchecked, js_getDirection, getDirection, js_getKey, getKey, js_getPrimaryKey, getPrimaryKey, IDBCursor, castToIDBCursor, gTypeIDBCursor, IsIDBCursor, toIDBCursor) where import Prelude ((.), (==), (>>=), return, IO, Int, Float, Double, Bool(..), Maybe, maybe, fromIntegral, round, fmap, Show, Read, Eq, Ord) import Data.Typeable (Typeable) import GHCJS.Types (JSVal(..), JSString) import GHCJS.Foreign (jsNull) import GHCJS.Foreign.Callback (syncCallback, asyncCallback, syncCallback1, asyncCallback1, syncCallback2, asyncCallback2, OnBlocked(..)) import GHCJS.Marshal (ToJSVal(..), FromJSVal(..)) import GHCJS.Marshal.Pure (PToJSVal(..), PFromJSVal(..)) import Control.Monad (void) import Control.Monad.IO.Class (MonadIO(..)) import Data.Int (Int64) import Data.Word (Word, Word64) import Data.Maybe (fromJust) import GHCJS.DOM.Types import Control.Applicative ((<$>)) import GHCJS.DOM.EventTargetClosures (EventName, unsafeEventName) import GHCJS.DOM.JSFFI.Generated.Enums foreign import javascript unsafe "$1[\"update\"]($2)" js_update :: IDBCursor -> JSVal -> IO (Nullable IDBRequest) -- | update :: (MonadIO m, IsIDBCursor self) => self -> JSVal -> m (Maybe IDBRequest) update self value = liftIO (nullableToMaybe <$> (js_update (toIDBCursor self) value)) -- | update_ :: (MonadIO m, IsIDBCursor self) => self -> JSVal -> m () update_ self value = liftIO (void (js_update (toIDBCursor self) value)) -- | updateUnchecked :: (MonadIO m, IsIDBCursor self) => self -> JSVal -> m IDBRequest updateUnchecked self value = liftIO (fromJust . nullableToMaybe <$> (js_update (toIDBCursor self) value)) foreign import javascript unsafe "$1[\"advance\"]($2)" js_advance :: IDBCursor -> Word -> IO () -- | advance :: (MonadIO m, IsIDBCursor self) => self -> Word -> m () advance self count = liftIO (js_advance (toIDBCursor self) count) foreign import javascript unsafe "$1[\"continue\"]($2)" js_continue :: IDBCursor -> JSVal -> IO () -- | continue :: (MonadIO m, IsIDBCursor self) => self -> JSVal -> m () continue self key = liftIO (js_continue (toIDBCursor self) key) foreign import javascript unsafe "$1[\"delete\"]()" js_delete :: IDBCursor -> IO (Nullable IDBRequest) -- | delete :: (MonadIO m, IsIDBCursor self) => self -> m (Maybe IDBRequest) delete self = liftIO (nullableToMaybe <$> (js_delete (toIDBCursor self))) -- | delete_ :: (MonadIO m, IsIDBCursor self) => self -> m () delete_ self = liftIO (void (js_delete (toIDBCursor self))) -- | deleteUnchecked :: (MonadIO m, IsIDBCursor self) => self -> m IDBRequest deleteUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_delete (toIDBCursor self))) foreign import javascript unsafe "$1[\"source\"]" js_getSource :: IDBCursor -> IO (Nullable IDBAny) -- | getSource :: (MonadIO m, IsIDBCursor self) => self -> m (Maybe IDBAny) getSource self = liftIO (nullableToMaybe <$> (js_getSource (toIDBCursor self))) -- | getSourceUnchecked :: (MonadIO m, IsIDBCursor self) => self -> m IDBAny getSourceUnchecked self = liftIO (fromJust . nullableToMaybe <$> (js_getSource (toIDBCursor self))) foreign import javascript unsafe "$1[\"direction\"]" js_getDirection :: IDBCursor -> IO JSString -- | getDirection :: (MonadIO m, IsIDBCursor self, FromJSString result) => self -> m result getDirection self = liftIO (fromJSString <$> (js_getDirection (toIDBCursor self))) foreign import javascript unsafe "$1[\"key\"]" js_getKey :: IDBCursor -> IO JSVal -- | getKey :: (MonadIO m, IsIDBCursor self) => self -> m JSVal getKey self = liftIO (js_getKey (toIDBCursor self)) foreign import javascript unsafe "$1[\"primaryKey\"]" js_getPrimaryKey :: IDBCursor -> IO JSVal -- | getPrimaryKey :: (MonadIO m, IsIDBCursor self) => self -> m JSVal getPrimaryKey self = liftIO (js_getPrimaryKey (toIDBCursor self))