{-# LANGUAGE ExistentialQuantification, DuplicateRecordFields, GeneralizedNewtypeDeriving, DerivingStrategies, DeriveGeneric, RecordWildCards #-}

module Quickjs.Error where
import           Control.Exception   (Exception(..), SomeException)
import           Data.Typeable       (cast)
import           Data.Text           (Text)
import           Data.String.Conv    (toS)
import           Type.Reflection     (Typeable)
import           GHC.Generics
import           Foreign.C.Types
import           Data.Aeson          (ToJSON(..))

import           Quickjs.Types


data SomeJSRuntimeException = forall e . Exception e => SomeJSRuntimeException e deriving Typeable

instance Show SomeJSRuntimeException where
    show :: SomeJSRuntimeException -> String
show (SomeJSRuntimeException e
e) = e -> String
forall a. Show a => a -> String
show e
e

instance Exception SomeJSRuntimeException

jsRuntimeExceptionToException :: Exception e => e -> SomeException
jsRuntimeExceptionToException :: e -> SomeException
jsRuntimeExceptionToException = SomeJSRuntimeException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeJSRuntimeException -> SomeException)
-> (e -> SomeJSRuntimeException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeJSRuntimeException
forall e. Exception e => e -> SomeJSRuntimeException
SomeJSRuntimeException

jsRuntimeExceptionFromException :: Exception e => SomeException -> Maybe e
jsRuntimeExceptionFromException :: SomeException -> Maybe e
jsRuntimeExceptionFromException SomeException
x = do
    SomeJSRuntimeException e
a <- SomeException -> Maybe SomeJSRuntimeException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
    e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a



instance ToJSON CLong where
  toJSON :: CLong -> Value
toJSON CLong
cl = Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (CLong -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
cl :: Integer)

data UnknownJSTag = UnknownJSTag {UnknownJSTag -> CLong
raw_tag :: !CLong} 
  deriving ((forall x. UnknownJSTag -> Rep UnknownJSTag x)
-> (forall x. Rep UnknownJSTag x -> UnknownJSTag)
-> Generic UnknownJSTag
forall x. Rep UnknownJSTag x -> UnknownJSTag
forall x. UnknownJSTag -> Rep UnknownJSTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnknownJSTag x -> UnknownJSTag
$cfrom :: forall x. UnknownJSTag -> Rep UnknownJSTag x
Generic, Typeable)

instance Exception UnknownJSTag where
  toException :: UnknownJSTag -> SomeException
toException   = UnknownJSTag -> SomeException
forall e. Exception e => e -> SomeException
jsRuntimeExceptionToException
  fromException :: SomeException -> Maybe UnknownJSTag
fromException = SomeException -> Maybe UnknownJSTag
forall e. Exception e => SomeException -> Maybe e
jsRuntimeExceptionFromException


instance Show UnknownJSTag where
  show :: UnknownJSTag -> String
show UnknownJSTag{CLong
raw_tag :: CLong
$sel:raw_tag:UnknownJSTag :: UnknownJSTag -> CLong
..} = String
"Uknown JS tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CLong -> String
forall a. Show a => a -> String
show CLong
raw_tag


data UnsupportedTypeTag = UnsupportedTypeTag {UnsupportedTypeTag -> JSTagEnum
_tag :: JSTagEnum} 
  deriving ((forall x. UnsupportedTypeTag -> Rep UnsupportedTypeTag x)
-> (forall x. Rep UnsupportedTypeTag x -> UnsupportedTypeTag)
-> Generic UnsupportedTypeTag
forall x. Rep UnsupportedTypeTag x -> UnsupportedTypeTag
forall x. UnsupportedTypeTag -> Rep UnsupportedTypeTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnsupportedTypeTag x -> UnsupportedTypeTag
$cfrom :: forall x. UnsupportedTypeTag -> Rep UnsupportedTypeTag x
Generic, Typeable)

instance Exception UnsupportedTypeTag where
  toException :: UnsupportedTypeTag -> SomeException
toException   = UnsupportedTypeTag -> SomeException
forall e. Exception e => e -> SomeException
jsRuntimeExceptionToException
  fromException :: SomeException -> Maybe UnsupportedTypeTag
fromException = SomeException -> Maybe UnsupportedTypeTag
forall e. Exception e => SomeException -> Maybe e
jsRuntimeExceptionFromException

instance Show UnsupportedTypeTag where
  show :: UnsupportedTypeTag -> String
show UnsupportedTypeTag{JSTagEnum
_tag :: JSTagEnum
$sel:_tag:UnsupportedTypeTag :: UnsupportedTypeTag -> JSTagEnum
..} = String
"Unsupported type tag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ JSTagEnum -> String
forall a. Show a => a -> String
show JSTagEnum
_tag


data JSException = JSException {JSException -> Text
location :: Text, JSException -> Text
message :: Text} 
  deriving ((forall x. JSException -> Rep JSException x)
-> (forall x. Rep JSException x -> JSException)
-> Generic JSException
forall x. Rep JSException x -> JSException
forall x. JSException -> Rep JSException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JSException x -> JSException
$cfrom :: forall x. JSException -> Rep JSException x
Generic, Typeable)

instance Exception JSException where
  toException :: JSException -> SomeException
toException   = JSException -> SomeException
forall e. Exception e => e -> SomeException
jsRuntimeExceptionToException
  fromException :: SomeException -> Maybe JSException
fromException = SomeException -> Maybe JSException
forall e. Exception e => SomeException -> Maybe e
jsRuntimeExceptionFromException


instance Show JSException where
    show :: JSException -> String
show JSException{Text
message :: Text
location :: Text
$sel:message:JSException :: JSException -> Text
$sel:location:JSException :: JSException -> Text
..} = String
"JS runtime threw an exception in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a b. StringConv a b => a -> b
toS Text
location String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n=================\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a b. StringConv a b => a -> b
toS Text
message String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n=================\n"



data JSValueUndefined = JSValueUndefined {JSValueUndefined -> Text
value :: Text} 
  deriving ((forall x. JSValueUndefined -> Rep JSValueUndefined x)
-> (forall x. Rep JSValueUndefined x -> JSValueUndefined)
-> Generic JSValueUndefined
forall x. Rep JSValueUndefined x -> JSValueUndefined
forall x. JSValueUndefined -> Rep JSValueUndefined x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JSValueUndefined x -> JSValueUndefined
$cfrom :: forall x. JSValueUndefined -> Rep JSValueUndefined x
Generic, Typeable)

instance Exception JSValueUndefined where
  toException :: JSValueUndefined -> SomeException
toException   = JSValueUndefined -> SomeException
forall e. Exception e => e -> SomeException
jsRuntimeExceptionToException
  fromException :: SomeException -> Maybe JSValueUndefined
fromException = SomeException -> Maybe JSValueUndefined
forall e. Exception e => SomeException -> Maybe e
jsRuntimeExceptionFromException


instance Show JSValueUndefined where
  show :: JSValueUndefined -> String
show JSValueUndefined{Text
value :: Text
$sel:value:JSValueUndefined :: JSValueUndefined -> Text
..} =  String
"The JS value '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a b. StringConv a b => a -> b
toS Text
value String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' is undefined."


data JSValueIncorrectType = 
  JSValueIncorrectType {
    JSValueIncorrectType -> Text
name :: Text
  , JSValueIncorrectType -> JSTypeEnum
expected :: JSTypeEnum
  , JSValueIncorrectType -> JSTypeEnum
found :: JSTypeEnum
  } 
  deriving ((forall x. JSValueIncorrectType -> Rep JSValueIncorrectType x)
-> (forall x. Rep JSValueIncorrectType x -> JSValueIncorrectType)
-> Generic JSValueIncorrectType
forall x. Rep JSValueIncorrectType x -> JSValueIncorrectType
forall x. JSValueIncorrectType -> Rep JSValueIncorrectType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JSValueIncorrectType x -> JSValueIncorrectType
$cfrom :: forall x. JSValueIncorrectType -> Rep JSValueIncorrectType x
Generic, Typeable)

instance Exception JSValueIncorrectType where
  toException :: JSValueIncorrectType -> SomeException
toException   = JSValueIncorrectType -> SomeException
forall e. Exception e => e -> SomeException
jsRuntimeExceptionToException
  fromException :: SomeException -> Maybe JSValueIncorrectType
fromException = SomeException -> Maybe JSValueIncorrectType
forall e. Exception e => SomeException -> Maybe e
jsRuntimeExceptionFromException


instance Show JSValueIncorrectType where
  show :: JSValueIncorrectType -> String
show JSValueIncorrectType{Text
JSTypeEnum
found :: JSTypeEnum
expected :: JSTypeEnum
name :: Text
$sel:found:JSValueIncorrectType :: JSValueIncorrectType -> JSTypeEnum
$sel:expected:JSValueIncorrectType :: JSValueIncorrectType -> JSTypeEnum
$sel:name:JSValueIncorrectType :: JSValueIncorrectType -> Text
..} = String
"Type mismatch of the JS value '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a b. StringConv a b => a -> b
toS Text
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'. Expected: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ JSTypeEnum -> String
forall a. Show a => a -> String
show JSTypeEnum
expected String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ JSTypeEnum -> String
forall a. Show a => a -> String
show JSTypeEnum
found


data InternalError = InternalError { InternalError -> Text
message :: Text } 
  deriving ((forall x. InternalError -> Rep InternalError x)
-> (forall x. Rep InternalError x -> InternalError)
-> Generic InternalError
forall x. Rep InternalError x -> InternalError
forall x. InternalError -> Rep InternalError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InternalError x -> InternalError
$cfrom :: forall x. InternalError -> Rep InternalError x
Generic, Typeable)

instance Exception InternalError where
  toException :: InternalError -> SomeException
toException   = InternalError -> SomeException
forall e. Exception e => e -> SomeException
jsRuntimeExceptionToException
  fromException :: SomeException -> Maybe InternalError
fromException = SomeException -> Maybe InternalError
forall e. Exception e => SomeException -> Maybe e
jsRuntimeExceptionFromException

instance Show InternalError where
  show :: InternalError -> String
show InternalError{Text
message :: Text
$sel:message:InternalError :: InternalError -> Text
..} = String
"Internal error occured:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a b. StringConv a b => a -> b
toS Text
message