Error.hs

{-# 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 e) = show e

instance Exception SomeJSRuntimeException

jsRuntimeExceptionToException :: Exception e => e -> SomeException
jsRuntimeExceptionToException = toException . SomeJSRuntimeException

jsRuntimeExceptionFromException :: Exception e => SomeException -> Maybe e
jsRuntimeExceptionFromException x = do
    SomeJSRuntimeException a <- fromException x
    cast a



instance ToJSON CLong where
  toJSON cl = toJSON (fromIntegral cl :: Integer)

data UnknownJSTag = UnknownJSTag {raw_tag :: !CLong} 
  deriving (Generic, Typeable)

instance Exception UnknownJSTag where
  toException   = jsRuntimeExceptionToException
  fromException = jsRuntimeExceptionFromException


instance Show UnknownJSTag where
  show UnknownJSTag{..} = "Uknown JS tag: " ++ show raw_tag


data UnsupportedTypeTag = UnsupportedTypeTag {_tag :: JSTagEnum} 
  deriving (Generic, Typeable)

instance Exception UnsupportedTypeTag where
  toException   = jsRuntimeExceptionToException
  fromException = jsRuntimeExceptionFromException

instance Show UnsupportedTypeTag where
  show UnsupportedTypeTag{..} = "Unsupported type tag: " ++ show _tag


data JSException = JSException {location :: Text, message :: Text} 
  deriving (Generic, Typeable)

instance Exception JSException where
  toException   = jsRuntimeExceptionToException
  fromException = jsRuntimeExceptionFromException


instance Show JSException where
    show JSException{..} = "JS runtime threw an exception in " ++ toS location ++ ":\n=================\n" ++ toS message ++ "\n=================\n"



data JSValueUndefined = JSValueUndefined {value :: Text} 
  deriving (Generic, Typeable)

instance Exception JSValueUndefined where
  toException   = jsRuntimeExceptionToException
  fromException = jsRuntimeExceptionFromException


instance Show JSValueUndefined where
  show JSValueUndefined{..} =  "The JS value '" ++ toS value ++ "' is undefined."


data JSValueIncorrectType = 
  JSValueIncorrectType {
    name :: Text
  , expected :: JSTypeEnum
  , found :: JSTypeEnum
  } 
  deriving (Generic, Typeable)

instance Exception JSValueIncorrectType where
  toException   = jsRuntimeExceptionToException
  fromException = jsRuntimeExceptionFromException


instance Show JSValueIncorrectType where
  show JSValueIncorrectType{..} = "Type mismatch of the JS value '" ++ toS name ++ "'. Expected: " ++ show expected ++ ", found: " ++ show found


data InternalError = InternalError { message :: Text } 
  deriving (Generic, Typeable)

instance Exception InternalError where
  toException   = jsRuntimeExceptionToException
  fromException = jsRuntimeExceptionFromException

instance Show InternalError where
  show InternalError{..} = "Internal error occured:\n" ++ toS message