{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.CSS
       (supports2, supports2_, supports, supports_, escape, escape_,
        CSS(..), gTypeCSS)
       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/CSS.supports Mozilla CSS.supports documentation> 
supports2 ::
          (MonadDOM m, ToJSString property, ToJSString value) =>
            property -> value -> m Bool
supports2 :: forall (m :: * -> *) property value.
(MonadDOM m, ToJSString property, ToJSString value) =>
property -> value -> m Bool
supports2 property
property value
value
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"CSS") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"supports" [property -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal property
property, value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value])
         JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
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/CSS.supports Mozilla CSS.supports documentation> 
supports2_ ::
           (MonadDOM m, ToJSString property, ToJSString value) =>
             property -> value -> m ()
supports2_ :: forall (m :: * -> *) property value.
(MonadDOM m, ToJSString property, ToJSString value) =>
property -> value -> m ()
supports2_ property
property 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
         ((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"CSS") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"supports" [property -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal property
property, value -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal value
value]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/CSS.supports Mozilla CSS.supports documentation> 
supports ::
         (MonadDOM m, ToJSString conditionText) => conditionText -> m Bool
supports :: forall (m :: * -> *) conditionText.
(MonadDOM m, ToJSString conditionText) =>
conditionText -> m Bool
supports conditionText
conditionText
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"CSS") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"supports" [conditionText -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal conditionText
conditionText]) JSM JSVal -> (JSVal -> DOM Bool) -> DOM Bool
forall a b. JSM a -> (a -> JSM b) -> JSM b
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/CSS.supports Mozilla CSS.supports documentation> 
supports_ ::
          (MonadDOM m, ToJSString conditionText) => conditionText -> m ()
supports_ :: forall (m :: * -> *) conditionText.
(MonadDOM m, ToJSString conditionText) =>
conditionText -> m ()
supports_ conditionText
conditionText
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"CSS") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"supports" [conditionText -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal conditionText
conditionText]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/CSS.escape Mozilla CSS.escape documentation> 
escape ::
       (MonadDOM m, ToJSString ident, FromJSString result) =>
         ident -> m result
escape :: forall (m :: * -> *) ident result.
(MonadDOM m, ToJSString ident, FromJSString result) =>
ident -> m result
escape ident
ident
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"CSS") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"escape" [ident -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ident
ident]) JSM JSVal -> (JSVal -> DOM result) -> DOM result
forall a b. JSM a -> (a -> JSM b) -> JSM b
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/CSS.escape Mozilla CSS.escape documentation> 
escape_ :: (MonadDOM m, ToJSString ident) => ident -> m ()
escape_ :: forall (m :: * -> *) conditionText.
(MonadDOM m, ToJSString conditionText) =>
conditionText -> m ()
escape_ ident
ident
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((String -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg String
"CSS") JSM JSVal
-> Getting (JSM JSVal) (JSM JSVal) (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. String -> [JSM JSVal] -> JSF
forall name args.
(ToJSString name, MakeArgs args) =>
name -> args -> JSF
jsf String
"escape" [ident -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal ident
ident]))