{-# LANGUAGE ExistentialQuantification, DuplicateRecordFields, GeneralizedNewtypeDeriving, DerivingStrategies, DeriveGeneric, DerivingVia, 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 where
    toException :: SomeJSRuntimeException -> SomeException
toException = SomeJSRuntimeException -> SomeException
forall e. Exception e => e -> SomeException
jsRuntimeExceptionToException
    fromException :: SomeException -> Maybe SomeJSRuntimeException
fromException = SomeException -> Maybe SomeJSRuntimeException
forall e. Exception e => SomeException -> Maybe e
jsRuntimeExceptionFromException


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


newtype JSRuntimeException e = JSRuntimeException e 
  deriving (forall x. JSRuntimeException e -> Rep (JSRuntimeException e) x)
-> (forall x. Rep (JSRuntimeException e) x -> JSRuntimeException e)
-> Generic (JSRuntimeException e)
forall x. Rep (JSRuntimeException e) x -> JSRuntimeException e
forall x. JSRuntimeException e -> Rep (JSRuntimeException e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (JSRuntimeException e) x -> JSRuntimeException e
forall e x. JSRuntimeException e -> Rep (JSRuntimeException e) x
$cto :: forall e x. Rep (JSRuntimeException e) x -> JSRuntimeException e
$cfrom :: forall e x. JSRuntimeException e -> Rep (JSRuntimeException e) x
Generic
  deriving newtype Int -> JSRuntimeException e -> ShowS
[JSRuntimeException e] -> ShowS
JSRuntimeException e -> String
(Int -> JSRuntimeException e -> ShowS)
-> (JSRuntimeException e -> String)
-> ([JSRuntimeException e] -> ShowS)
-> Show (JSRuntimeException e)
forall e. Show e => Int -> JSRuntimeException e -> ShowS
forall e. Show e => [JSRuntimeException e] -> ShowS
forall e. Show e => JSRuntimeException e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSRuntimeException e] -> ShowS
$cshowList :: forall e. Show e => [JSRuntimeException e] -> ShowS
show :: JSRuntimeException e -> String
$cshow :: forall e. Show e => JSRuntimeException e -> String
showsPrec :: Int -> JSRuntimeException e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> JSRuntimeException e -> ShowS
Show

instance (Show e, Typeable e) => Exception (JSRuntimeException e)
  where
    toException :: JSRuntimeException e -> SomeException
toException = JSRuntimeException e -> SomeException
forall e. Exception e => e -> SomeException
jsRuntimeExceptionToException
    fromException :: SomeException -> Maybe (JSRuntimeException e)
fromException = SomeException -> Maybe (JSRuntimeException e)
forall e. Exception e => SomeException -> Maybe e
jsRuntimeExceptionFromException



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)
  deriving Show UnknownJSTag
Typeable UnknownJSTag
Typeable UnknownJSTag
-> Show UnknownJSTag
-> (UnknownJSTag -> SomeException)
-> (SomeException -> Maybe UnknownJSTag)
-> (UnknownJSTag -> String)
-> Exception UnknownJSTag
SomeException -> Maybe UnknownJSTag
UnknownJSTag -> String
UnknownJSTag -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: UnknownJSTag -> String
$cdisplayException :: UnknownJSTag -> String
fromException :: SomeException -> Maybe UnknownJSTag
$cfromException :: SomeException -> Maybe UnknownJSTag
toException :: UnknownJSTag -> SomeException
$ctoException :: UnknownJSTag -> SomeException
$cp2Exception :: Show UnknownJSTag
$cp1Exception :: Typeable UnknownJSTag
Exception via (JSRuntimeException UnknownJSTag)

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)
  deriving Show UnsupportedTypeTag
Typeable UnsupportedTypeTag
Typeable UnsupportedTypeTag
-> Show UnsupportedTypeTag
-> (UnsupportedTypeTag -> SomeException)
-> (SomeException -> Maybe UnsupportedTypeTag)
-> (UnsupportedTypeTag -> String)
-> Exception UnsupportedTypeTag
SomeException -> Maybe UnsupportedTypeTag
UnsupportedTypeTag -> String
UnsupportedTypeTag -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: UnsupportedTypeTag -> String
$cdisplayException :: UnsupportedTypeTag -> String
fromException :: SomeException -> Maybe UnsupportedTypeTag
$cfromException :: SomeException -> Maybe UnsupportedTypeTag
toException :: UnsupportedTypeTag -> SomeException
$ctoException :: UnsupportedTypeTag -> SomeException
$cp2Exception :: Show UnsupportedTypeTag
$cp1Exception :: Typeable UnsupportedTypeTag
Exception via (JSRuntimeException UnsupportedTypeTag)


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)
  deriving Show JSException
Typeable JSException
Typeable JSException
-> Show JSException
-> (JSException -> SomeException)
-> (SomeException -> Maybe JSException)
-> (JSException -> String)
-> Exception JSException
SomeException -> Maybe JSException
JSException -> String
JSException -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: JSException -> String
$cdisplayException :: JSException -> String
fromException :: SomeException -> Maybe JSException
$cfromException :: SomeException -> Maybe JSException
toException :: JSException -> SomeException
$ctoException :: JSException -> SomeException
$cp2Exception :: Show JSException
$cp1Exception :: Typeable JSException
Exception via (JSRuntimeException JSException)

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)
  deriving Show JSValueUndefined
Typeable JSValueUndefined
Typeable JSValueUndefined
-> Show JSValueUndefined
-> (JSValueUndefined -> SomeException)
-> (SomeException -> Maybe JSValueUndefined)
-> (JSValueUndefined -> String)
-> Exception JSValueUndefined
SomeException -> Maybe JSValueUndefined
JSValueUndefined -> String
JSValueUndefined -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: JSValueUndefined -> String
$cdisplayException :: JSValueUndefined -> String
fromException :: SomeException -> Maybe JSValueUndefined
$cfromException :: SomeException -> Maybe JSValueUndefined
toException :: JSValueUndefined -> SomeException
$ctoException :: JSValueUndefined -> SomeException
$cp2Exception :: Show JSValueUndefined
$cp1Exception :: Typeable JSValueUndefined
Exception via (JSRuntimeException JSValueUndefined)

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)
  deriving Show JSValueIncorrectType
Typeable JSValueIncorrectType
Typeable JSValueIncorrectType
-> Show JSValueIncorrectType
-> (JSValueIncorrectType -> SomeException)
-> (SomeException -> Maybe JSValueIncorrectType)
-> (JSValueIncorrectType -> String)
-> Exception JSValueIncorrectType
SomeException -> Maybe JSValueIncorrectType
JSValueIncorrectType -> String
JSValueIncorrectType -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: JSValueIncorrectType -> String
$cdisplayException :: JSValueIncorrectType -> String
fromException :: SomeException -> Maybe JSValueIncorrectType
$cfromException :: SomeException -> Maybe JSValueIncorrectType
toException :: JSValueIncorrectType -> SomeException
$ctoException :: JSValueIncorrectType -> SomeException
$cp2Exception :: Show JSValueIncorrectType
$cp1Exception :: Typeable JSValueIncorrectType
Exception via (JSRuntimeException JSValueIncorrectType)

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)
  deriving Show InternalError
Typeable InternalError
Typeable InternalError
-> Show InternalError
-> (InternalError -> SomeException)
-> (SomeException -> Maybe InternalError)
-> (InternalError -> String)
-> Exception InternalError
SomeException -> Maybe InternalError
InternalError -> String
InternalError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: InternalError -> String
$cdisplayException :: InternalError -> String
fromException :: SomeException -> Maybe InternalError
$cfromException :: SomeException -> Maybe InternalError
toException :: InternalError -> SomeException
$ctoException :: InternalError -> SomeException
$cp2Exception :: Show InternalError
$cp1Exception :: Typeable InternalError
Exception via (JSRuntimeException InternalError)

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