{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
module JSDOM.Custom.PositionError (
    module Generated
  , PositionErrorCode(..)
  , PositionException(..)
  , throwPositionException
) where

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

import JSDOM.Types (MonadDOM)

import JSDOM.Generated.PositionError as Generated

data PositionErrorCode = PositionPermissionDenied | PositionUnavailable | PositionTimeout deriving (Int -> PositionErrorCode -> ShowS
[PositionErrorCode] -> ShowS
PositionErrorCode -> String
(Int -> PositionErrorCode -> ShowS)
-> (PositionErrorCode -> String)
-> ([PositionErrorCode] -> ShowS)
-> Show PositionErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PositionErrorCode] -> ShowS
$cshowList :: [PositionErrorCode] -> ShowS
show :: PositionErrorCode -> String
$cshow :: PositionErrorCode -> String
showsPrec :: Int -> PositionErrorCode -> ShowS
$cshowsPrec :: Int -> PositionErrorCode -> ShowS
Show, PositionErrorCode -> PositionErrorCode -> Bool
(PositionErrorCode -> PositionErrorCode -> Bool)
-> (PositionErrorCode -> PositionErrorCode -> Bool)
-> Eq PositionErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositionErrorCode -> PositionErrorCode -> Bool
$c/= :: PositionErrorCode -> PositionErrorCode -> Bool
== :: PositionErrorCode -> PositionErrorCode -> Bool
$c== :: PositionErrorCode -> PositionErrorCode -> Bool
Eq, Int -> PositionErrorCode
PositionErrorCode -> Int
PositionErrorCode -> [PositionErrorCode]
PositionErrorCode -> PositionErrorCode
PositionErrorCode -> PositionErrorCode -> [PositionErrorCode]
PositionErrorCode
-> PositionErrorCode -> PositionErrorCode -> [PositionErrorCode]
(PositionErrorCode -> PositionErrorCode)
-> (PositionErrorCode -> PositionErrorCode)
-> (Int -> PositionErrorCode)
-> (PositionErrorCode -> Int)
-> (PositionErrorCode -> [PositionErrorCode])
-> (PositionErrorCode -> PositionErrorCode -> [PositionErrorCode])
-> (PositionErrorCode -> PositionErrorCode -> [PositionErrorCode])
-> (PositionErrorCode
    -> PositionErrorCode -> PositionErrorCode -> [PositionErrorCode])
-> Enum PositionErrorCode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PositionErrorCode
-> PositionErrorCode -> PositionErrorCode -> [PositionErrorCode]
$cenumFromThenTo :: PositionErrorCode
-> PositionErrorCode -> PositionErrorCode -> [PositionErrorCode]
enumFromTo :: PositionErrorCode -> PositionErrorCode -> [PositionErrorCode]
$cenumFromTo :: PositionErrorCode -> PositionErrorCode -> [PositionErrorCode]
enumFromThen :: PositionErrorCode -> PositionErrorCode -> [PositionErrorCode]
$cenumFromThen :: PositionErrorCode -> PositionErrorCode -> [PositionErrorCode]
enumFrom :: PositionErrorCode -> [PositionErrorCode]
$cenumFrom :: PositionErrorCode -> [PositionErrorCode]
fromEnum :: PositionErrorCode -> Int
$cfromEnum :: PositionErrorCode -> Int
toEnum :: Int -> PositionErrorCode
$ctoEnum :: Int -> PositionErrorCode
pred :: PositionErrorCode -> PositionErrorCode
$cpred :: PositionErrorCode -> PositionErrorCode
succ :: PositionErrorCode -> PositionErrorCode
$csucc :: PositionErrorCode -> PositionErrorCode
Enum)
data PositionException = PositionException {
        PositionException -> PositionErrorCode
positionErrorCode    :: PositionErrorCode,
        PositionException -> String
positionErrorMessage :: String } deriving (Int -> PositionException -> ShowS
[PositionException] -> ShowS
PositionException -> String
(Int -> PositionException -> ShowS)
-> (PositionException -> String)
-> ([PositionException] -> ShowS)
-> Show PositionException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PositionException] -> ShowS
$cshowList :: [PositionException] -> ShowS
show :: PositionException -> String
$cshow :: PositionException -> String
showsPrec :: Int -> PositionException -> ShowS
$cshowsPrec :: Int -> PositionException -> ShowS
Show, PositionException -> PositionException -> Bool
(PositionException -> PositionException -> Bool)
-> (PositionException -> PositionException -> Bool)
-> Eq PositionException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositionException -> PositionException -> Bool
$c/= :: PositionException -> PositionException -> Bool
== :: PositionException -> PositionException -> Bool
$c== :: PositionException -> PositionException -> Bool
Eq, Typeable)

instance Exception PositionException

throwPositionException :: MonadDOM m => PositionError -> m a
throwPositionException :: PositionError -> m a
throwPositionException PositionError
error = do
    PositionErrorCode
positionErrorCode    <- (Int -> PositionErrorCode
forall a. Enum a => Int -> a
toEnum (Int -> PositionErrorCode)
-> (Word -> Int) -> Word -> PositionErrorCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1 (Int -> Int) -> (Word -> Int) -> Word -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Word -> PositionErrorCode) -> m Word -> m PositionErrorCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionError -> m Word
forall (m :: * -> *). MonadDOM m => PositionError -> m Word
getCode PositionError
error
    String
positionErrorMessage <- PositionError -> m String
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
PositionError -> m result
getMessage PositionError
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
$ PositionException -> IO a
forall e a. Exception e => e -> IO a
throwIO (PositionException :: PositionErrorCode -> String -> PositionException
PositionException{String
PositionErrorCode
positionErrorMessage :: String
positionErrorCode :: PositionErrorCode
positionErrorMessage :: String
positionErrorCode :: PositionErrorCode
..})