{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.WebGLDebugShaders
       (getTranslatedShaderSource, getTranslatedShaderSource_,
        getTranslatedShaderSourceUnsafe,
        getTranslatedShaderSourceUnchecked, WebGLDebugShaders(..),
        gTypeWebGLDebugShaders)
       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/WebGLDebugShaders.getTranslatedShaderSource Mozilla WebGLDebugShaders.getTranslatedShaderSource documentation> 
getTranslatedShaderSource ::
                          (MonadDOM m, FromJSString result) =>
                            WebGLDebugShaders -> Maybe WebGLShader -> m (Maybe result)
getTranslatedShaderSource :: WebGLDebugShaders -> Maybe WebGLShader -> m (Maybe result)
getTranslatedShaderSource WebGLDebugShaders
self Maybe WebGLShader
shader
  = DOM (Maybe result) -> m (Maybe result)
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGLDebugShaders
self WebGLDebugShaders
-> Getting (JSM JSVal) WebGLDebugShaders (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]
"getTranslatedShaderSource" [Maybe WebGLShader -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe WebGLShader
shader]) JSM JSVal -> (JSVal -> DOM (Maybe result)) -> DOM (Maybe result)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
         JSVal -> DOM (Maybe result)
forall a. FromJSString a => JSVal -> JSM (Maybe a)
fromMaybeJSString)

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGLDebugShaders.getTranslatedShaderSource Mozilla WebGLDebugShaders.getTranslatedShaderSource documentation> 
getTranslatedShaderSourceUnsafe ::
                                (MonadDOM m, HasCallStack, FromJSString result) =>
                                  WebGLDebugShaders -> Maybe WebGLShader -> m result
getTranslatedShaderSourceUnsafe :: WebGLDebugShaders -> Maybe WebGLShader -> m result
getTranslatedShaderSourceUnsafe WebGLDebugShaders
self Maybe WebGLShader
shader
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (((WebGLDebugShaders
self WebGLDebugShaders
-> Getting (JSM JSVal) WebGLDebugShaders (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]
"getTranslatedShaderSource" [Maybe WebGLShader -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe WebGLShader
shader]) JSM JSVal -> (JSVal -> JSM (Maybe result)) -> JSM (Maybe result)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          JSVal -> JSM (Maybe result)
forall a. FromJSString a => JSVal -> JSM (Maybe a)
fromMaybeJSString)
         JSM (Maybe result) -> (Maybe result -> DOM result) -> DOM result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DOM result -> (result -> DOM result) -> Maybe result -> DOM result
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> DOM result
forall a. HasCallStack => [Char] -> a
Prelude.error [Char]
"Nothing to return") result -> DOM result
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebGLDebugShaders.getTranslatedShaderSource Mozilla WebGLDebugShaders.getTranslatedShaderSource documentation> 
getTranslatedShaderSourceUnchecked ::
                                   (MonadDOM m, FromJSString result) =>
                                     WebGLDebugShaders -> Maybe WebGLShader -> m result
getTranslatedShaderSourceUnchecked :: WebGLDebugShaders -> Maybe WebGLShader -> m result
getTranslatedShaderSourceUnchecked WebGLDebugShaders
self Maybe WebGLShader
shader
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      ((WebGLDebugShaders
self WebGLDebugShaders
-> Getting (JSM JSVal) WebGLDebugShaders (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]
"getTranslatedShaderSource" [Maybe WebGLShader -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe WebGLShader
shader]) 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)