{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.IDBKeyRange
       (only, only_, lowerBound, lowerBound_, upperBound, upperBound_,
        bound, bound_, includes, includes_, getLower, getUpper,
        getLowerOpen, getUpperOpen, IDBKeyRange(..), gTypeIDBKeyRange)
       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/IDBKeyRange.only Mozilla IDBKeyRange.only documentation> 
only :: (MonadDOM m, ToJSVal value) => value -> m IDBKeyRange
only :: value -> m IDBKeyRange
only value
value
  = DOM IDBKeyRange -> m IDBKeyRange
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"IDBKeyRange") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (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]
"only" [value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value]) JSM JSVal -> (JSVal -> DOM IDBKeyRange) -> DOM IDBKeyRange
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM IDBKeyRange
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBKeyRange.only Mozilla IDBKeyRange.only documentation> 
only_ :: (MonadDOM m, ToJSVal value) => value -> m ()
only_ :: value -> m ()
only_ 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 (([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"IDBKeyRange") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (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]
"only" [value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBKeyRange.lowerBound Mozilla IDBKeyRange.lowerBound documentation> 
lowerBound ::
           (MonadDOM m, ToJSVal lower) => lower -> Bool -> m IDBKeyRange
lowerBound :: lower -> Bool -> m IDBKeyRange
lowerBound lower
lower Bool
open
  = DOM IDBKeyRange -> m IDBKeyRange
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"IDBKeyRange") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (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]
"lowerBound"
          [lower -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal lower
lower, Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
open])
         JSM JSVal -> (JSVal -> DOM IDBKeyRange) -> DOM IDBKeyRange
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM IDBKeyRange
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBKeyRange.lowerBound Mozilla IDBKeyRange.lowerBound documentation> 
lowerBound_ :: (MonadDOM m, ToJSVal lower) => lower -> Bool -> m ()
lowerBound_ :: lower -> Bool -> m ()
lowerBound_ lower
lower Bool
open
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"IDBKeyRange") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (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]
"lowerBound"
            [lower -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal lower
lower, Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
open]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBKeyRange.upperBound Mozilla IDBKeyRange.upperBound documentation> 
upperBound ::
           (MonadDOM m, ToJSVal upper) => upper -> Bool -> m IDBKeyRange
upperBound :: upper -> Bool -> m IDBKeyRange
upperBound upper
upper Bool
open
  = DOM IDBKeyRange -> m IDBKeyRange
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"IDBKeyRange") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (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]
"upperBound"
          [upper -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal upper
upper, Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
open])
         JSM JSVal -> (JSVal -> DOM IDBKeyRange) -> DOM IDBKeyRange
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM IDBKeyRange
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBKeyRange.upperBound Mozilla IDBKeyRange.upperBound documentation> 
upperBound_ :: (MonadDOM m, ToJSVal upper) => upper -> Bool -> m ()
upperBound_ :: upper -> Bool -> m ()
upperBound_ upper
upper Bool
open
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"IDBKeyRange") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (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]
"upperBound"
            [upper -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal upper
upper, Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
open]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBKeyRange.bound Mozilla IDBKeyRange.bound documentation> 
bound ::
      (MonadDOM m, ToJSVal lower, ToJSVal upper) =>
        lower -> upper -> Bool -> Bool -> m IDBKeyRange
bound :: lower -> upper -> Bool -> Bool -> m IDBKeyRange
bound lower
lower upper
upper Bool
lowerOpen Bool
upperOpen
  = DOM IDBKeyRange -> m IDBKeyRange
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"IDBKeyRange") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (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]
"bound"
          [lower -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal lower
lower, upper -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal upper
upper, Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
lowerOpen,
           Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
upperOpen])
         JSM JSVal -> (JSVal -> DOM IDBKeyRange) -> DOM IDBKeyRange
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM IDBKeyRange
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBKeyRange.bound Mozilla IDBKeyRange.bound documentation> 
bound_ ::
       (MonadDOM m, ToJSVal lower, ToJSVal upper) =>
         lower -> upper -> Bool -> Bool -> m ()
bound_ :: lower -> upper -> Bool -> Bool -> m ()
bound_ lower
lower upper
upper Bool
lowerOpen Bool
upperOpen
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
         (([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"IDBKeyRange") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (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]
"bound"
            [lower -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal lower
lower, upper -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal upper
upper, Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
lowerOpen,
             Bool -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Bool
upperOpen]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBKeyRange.includes Mozilla IDBKeyRange.includes documentation> 
includes ::
         (MonadDOM m, ToJSVal key) => IDBKeyRange -> key -> m Bool
includes :: IDBKeyRange -> key -> m Bool
includes IDBKeyRange
self key
key
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((IDBKeyRange
self IDBKeyRange
-> Getting (JSM JSVal) IDBKeyRange (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]
"includes" [key -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal key
key]) JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

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

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

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBKeyRange.lowerOpen Mozilla IDBKeyRange.lowerOpen documentation> 
getLowerOpen :: (MonadDOM m) => IDBKeyRange -> m Bool
getLowerOpen :: IDBKeyRange -> m Bool
getLowerOpen IDBKeyRange
self
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((IDBKeyRange
self IDBKeyRange
-> Getting (JSM JSVal) IDBKeyRange (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter IDBKeyRange (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"lowerOpen") JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/IDBKeyRange.upperOpen Mozilla IDBKeyRange.upperOpen documentation> 
getUpperOpen :: (MonadDOM m) => IDBKeyRange -> m Bool
getUpperOpen :: IDBKeyRange -> m Bool
getUpperOpen IDBKeyRange
self
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((IDBKeyRange
self IDBKeyRange
-> Getting (JSM JSVal) IDBKeyRange (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter IDBKeyRange (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"upperOpen") JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JSVal -> DOM Bool
forall value. ToJSVal value => value -> DOM Bool
valToBool)