{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
module JSDOM.Custom.NavigatorUserMediaError (
    module Generated
  , UserMediaException(..)
  , throwUserMediaException
) where

import Data.Typeable (Typeable)
import Control.Exception (Exception, throwIO)
import Control.Monad.IO.Class (MonadIO(..))

import JSDOM.Types (MonadDOM)

import JSDOM.Custom.DOMError (getName)
import JSDOM.Generated.NavigatorUserMediaError as Generated

data UserMediaException = UserMediaException {
        UserMediaException -> String
userMediaErrorName           :: String,
        UserMediaException -> String
userMediaErrorConstraintName :: String } deriving (Int -> UserMediaException -> ShowS
[UserMediaException] -> ShowS
UserMediaException -> String
(Int -> UserMediaException -> ShowS)
-> (UserMediaException -> String)
-> ([UserMediaException] -> ShowS)
-> Show UserMediaException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserMediaException] -> ShowS
$cshowList :: [UserMediaException] -> ShowS
show :: UserMediaException -> String
$cshow :: UserMediaException -> String
showsPrec :: Int -> UserMediaException -> ShowS
$cshowsPrec :: Int -> UserMediaException -> ShowS
Show, UserMediaException -> UserMediaException -> Bool
(UserMediaException -> UserMediaException -> Bool)
-> (UserMediaException -> UserMediaException -> Bool)
-> Eq UserMediaException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserMediaException -> UserMediaException -> Bool
$c/= :: UserMediaException -> UserMediaException -> Bool
== :: UserMediaException -> UserMediaException -> Bool
$c== :: UserMediaException -> UserMediaException -> Bool
Eq, Typeable)

instance Exception UserMediaException

throwUserMediaException :: MonadDOM m => NavigatorUserMediaError -> m a
throwUserMediaException :: NavigatorUserMediaError -> m a
throwUserMediaException NavigatorUserMediaError
error = do
    String
userMediaErrorName           <- NavigatorUserMediaError -> m String
forall (m :: * -> *) self result.
(MonadDOM m, IsDOMError self, FromJSString result) =>
self -> m result
getName           NavigatorUserMediaError
error
    String
userMediaErrorConstraintName <- NavigatorUserMediaError -> m String
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
NavigatorUserMediaError -> m result
getConstraintName NavigatorUserMediaError
error
    IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ UserMediaException -> IO a
forall e a. Exception e => e -> IO a
throwIO (UserMediaException :: String -> String -> UserMediaException
UserMediaException{String
userMediaErrorConstraintName :: String
userMediaErrorName :: String
userMediaErrorConstraintName :: String
userMediaErrorName :: String
..})