{-# LANGUAGE PatternSynonyms #-}
-- For HasCallStack compatibility
{-# LANGUAGE ImplicitParams, ConstraintKinds, KindSignatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module JSDOM.Generated.TextDecoder
       (newTextDecoder, decode, decode_, getEncoding, getFatal,
        getIgnoreBOM, TextDecoder(..), gTypeTextDecoder)
       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/TextDecoder Mozilla TextDecoder documentation> 
newTextDecoder ::
               (MonadDOM m, ToJSString label) =>
                 Maybe label -> Maybe TextDecoderOptions -> m TextDecoder
newTextDecoder :: Maybe label -> Maybe TextDecoderOptions -> m TextDecoder
newTextDecoder Maybe label
label Maybe TextDecoderOptions
options
  = DOM TextDecoder -> m TextDecoder
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSVal -> TextDecoder
TextDecoder (JSVal -> TextDecoder) -> JSM JSVal -> DOM TextDecoder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         JSM JSVal -> [JSM JSVal] -> JSM JSVal
forall constructor args.
(MakeObject constructor, MakeArgs args) =>
constructor -> args -> JSM JSVal
new ([Char] -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg [Char]
"TextDecoder") [Maybe label -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe label
label, Maybe TextDecoderOptions -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe TextDecoderOptions
options])

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

-- | <https://developer.mozilla.org/en-US/docs/Web/API/TextDecoder.decode Mozilla TextDecoder.decode documentation> 
decode_ ::
        (MonadDOM m, IsBufferSource input) =>
          TextDecoder -> Maybe input -> Maybe TextDecodeOptions -> m ()
decode_ :: TextDecoder -> Maybe input -> Maybe TextDecodeOptions -> m ()
decode_ TextDecoder
self Maybe input
input Maybe TextDecodeOptions
options
  = DOM () -> m ()
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM
      (JSM JSVal -> DOM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (TextDecoder
self TextDecoder
-> Getting (JSM JSVal) TextDecoder (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]
"decode" [Maybe input -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe input
input, Maybe TextDecodeOptions -> JSM JSVal
forall a. ToJSVal a => a -> JSM JSVal
toJSVal Maybe TextDecodeOptions
options]))

-- | <https://developer.mozilla.org/en-US/docs/Web/API/TextDecoder.encoding Mozilla TextDecoder.encoding documentation> 
getEncoding ::
            (MonadDOM m, FromJSString result) => TextDecoder -> m result
getEncoding :: TextDecoder -> m result
getEncoding TextDecoder
self
  = DOM result -> m result
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((TextDecoder
self TextDecoder
-> Getting (JSM JSVal) TextDecoder (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter TextDecoder (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"encoding") 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)

-- | <https://developer.mozilla.org/en-US/docs/Web/API/TextDecoder.fatal Mozilla TextDecoder.fatal documentation> 
getFatal :: (MonadDOM m) => TextDecoder -> m Bool
getFatal :: TextDecoder -> m Bool
getFatal TextDecoder
self = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((TextDecoder
self TextDecoder
-> Getting (JSM JSVal) TextDecoder (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter TextDecoder (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"fatal") 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/TextDecoder.ignoreBOM Mozilla TextDecoder.ignoreBOM documentation> 
getIgnoreBOM :: (MonadDOM m) => TextDecoder -> m Bool
getIgnoreBOM :: TextDecoder -> m Bool
getIgnoreBOM TextDecoder
self
  = DOM Bool -> m Bool
forall (m :: * -> *) a. MonadDOM m => DOM a -> m a
liftDOM ((TextDecoder
self TextDecoder
-> Getting (JSM JSVal) TextDecoder (JSM JSVal) -> JSM JSVal
forall s a. s -> Getting a s a -> a
^. [Char] -> IndexPreservingGetter TextDecoder (JSM JSVal)
forall s name.
(MakeObject s, ToJSString name) =>
name -> IndexPreservingGetter s (JSM JSVal)
js [Char]
"ignoreBOM") 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)