{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module GHCJS.Prim.Internal ( JSVal(..)
                           , JSValueRef
                           , JSException(..)
                           , WouldBlockException(..)
                           , mkJSException
                           , jsNull
                           ) where

import           Control.DeepSeq (NFData(..))
import           Data.Int (Int64)
import           Data.Typeable (Typeable)
import           Unsafe.Coerce (unsafeCoerce)

import qualified GHC.Exception as Ex
import Data.IORef (newIORef, IORef)
import System.IO.Unsafe (unsafePerformIO)

-- A reference to a particular JavaScript value inside the JavaScript context
type JSValueRef = Int64

{-
  JSVal is a boxed type that can be used as FFI
  argument or result.
-}
newtype JSVal = JSVal (IORef JSValueRef)

instance NFData JSVal where
  rnf :: JSVal -> ()
rnf JSVal
x = JSVal
x JSVal -> () -> ()
forall a b. a -> b -> b
`seq` ()


{-
  When a JavaScript exception is raised inside
  a safe or interruptible foreign call, it is converted
  to a JSException
 -}
data JSException = JSException JSVal String
  deriving (Typeable)

instance Ex.Exception JSException

instance Show JSException where
  show :: JSException -> String
show (JSException JSVal
_ String
xs) = String
"JavaScript exception: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs

mkJSException :: JSVal -> IO JSException
mkJSException :: JSVal -> IO JSException
mkJSException JSVal
ref =
  JSException -> IO JSException
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSVal -> String -> JSException
JSException (JSVal -> JSVal
forall a b. a -> b
unsafeCoerce JSVal
ref) String
"")

jsNull :: JSVal
jsNull :: JSVal
jsNull = IORef JSValueRef -> JSVal
JSVal (IORef JSValueRef -> JSVal)
-> (IO (IORef JSValueRef) -> IORef JSValueRef)
-> IO (IORef JSValueRef)
-> JSVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (IORef JSValueRef) -> IORef JSValueRef
forall a. IO a -> a
unsafePerformIO (IO (IORef JSValueRef) -> JSVal) -> IO (IORef JSValueRef) -> JSVal
forall a b. (a -> b) -> a -> b
$ JSValueRef -> IO (IORef JSValueRef)
forall a. a -> IO (IORef a)
newIORef JSValueRef
0
{-# NOINLINE jsNull #-}

{- | If a synchronous thread tries to do something that can only
     be done asynchronously, and the thread is set up to not
     continue asynchronously, it receives this exception.
 -}
data WouldBlockException = WouldBlockException
  deriving (Typeable)

instance Show WouldBlockException where
  show :: WouldBlockException -> String
show WouldBlockException
_ = String
"thread would block"

instance Ex.Exception WouldBlockException