Initial implementation of typesafe marshaling

See this issue: ghcjs/ghcjs#419

Author: mgsloan

Data/JSString.hs

@@ -166,10 +166,6 @@ import           Data.JSString.Internal.Fusion        (stream, unstream)
 import qualified Data.JSString.Internal.Fusion        as S
 import qualified Data.JSString.Internal.Fusion.Common as S
 
-getJSVal :: JSString -> JSVal
-getJSVal (JSString x) = x
-{-# INLINE getJSVal #-}
-
 instance Exts.IsString JSString where
   fromString = pack
 

Data/JSString/Internal/Type.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples, MagicHash,
-             BangPatterns, ForeignFunctionInterface, JavaScriptFFI #-}
+             BangPatterns, ForeignFunctionInterface, JavaScriptFFI,
+             GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_HADDOCK not-home #-}
 module Data.JSString.Internal.Type ( JSString(..)
                                    , empty
@@ -42,9 +43,7 @@ import GHCJS.Internal.Types
 
 -- | A wrapper around a JavaScript string
 newtype JSString = JSString JSVal
-instance IsJSVal JSString
-
-instance NFData JSString where rnf !x = ()
+    deriving (IsJSVal, Typeable, NFData)
 
 foreign import javascript unsafe
   "$r = '';" js_empty :: JSString

GHCJS/Foreign.hs

@@ -3,11 +3,10 @@
 {-# LANGUAGE DefaultSignatures #-}
 {- | Basic interop between Haskell and JavaScript.
 
-     The principal type here is 'JSVal', which is a lifted type that contains
-     a JavaScript reference. The 'JSVal' type is parameterized with one phantom
-     type, and GHCJS.Types defines several type synonyms for specific variants.
+     The principle type here is 'JSVal', which contains a JavaScript
+     value.
 
-     The code in this module makes no assumptions about 'JSVal a' types.
+     The code in this module makes no assumptions about 'JSVal' types.
      Operations that can result in a JS exception that can kill a Haskell thread
      are marked unsafe (for example if the 'JSVal' contains a null or undefined
      value). There are safe variants where the JS exception is propagated as
@@ -67,8 +66,8 @@ module GHCJS.Foreign ( jsTrue
                      , getPropMaybe, unsafeGetPropMaybe
                      , setProp, unsafeSetProp
                      , listProps -}
-                     , jsTypeOf, JSType(..)
-                     , jsonTypeOf, JSONType(..)
+                     , jsTypeOf, JSTypeOf(..)
+                     , jsonTypeOf, JSONTypeOf(..)
 {-                     , wrapBuffer, wrapMutableBuffer
                      , byteArrayJSVal, mutableByteArrayJSVal
                      , bufferByteString, byteArrayByteString

GHCJS/Foreign/Internal.hs

@@ -2,48 +2,9 @@
     UnboxedTuples, DeriveDataTypeable, GHCForeignImportPrim,
     MagicHash, FlexibleInstances, BangPatterns, Rank2Types, CPP #-}
 
-{- | Basic interop between Haskell and JavaScript.
-
-     The principal type here is 'JSVal', which is a lifted type that contains
-     a JavaScript reference. The 'JSVal' type is parameterized with one phantom
-     type, and GHCJS.Types defines several type synonyms for specific variants.
-
-     The code in this module makes no assumptions about 'JSVal a' types.
-     Operations that can result in a JS exception that can kill a Haskell thread
-     are marked unsafe (for example if the 'JSVal' contains a null or undefined
-     value). There are safe variants where the JS exception is propagated as
-     a Haskell exception, so that it can be handled on the Haskell side.
-
-     For more specific types, like 'JSArray' or 'JSBool', the code assumes that
-     the contents of the 'JSVal' actually is a JavaScript array or bool value.
-     If it contains an unexpected value, the code can result in exceptions that
-     kill the Haskell thread, even for functions not marked unsafe.
-
-     The code makes use of `foreign import javascript', enabled with the
-     `JavaScriptFFI` extension, available since GHC 7.8. There are three different
-     safety levels:
-
-      * unsafe: The imported code is run directly. returning an incorrectly typed
-        value leads to undefined behaviour. JavaScript exceptions in the foreign
-        code kill the Haskell thread.
-      * safe: Returned values are replaced with a default value if they have
-        the wrong type. JavaScript exceptions are caught and propagated as
-        Haskell exceptions ('JSException'), so they can be handled with the
-        standard "Control.Exception" machinery.
-      * interruptible: The import is asynchronous. The calling Haskell thread
-        sleeps until the foreign code calls the `$c` JavaScript function with
-        the result. The thread is in interruptible state while blocked, so it
-        can receive asynchronous exceptions.
-
-     Unlike the FFI for native code, it's safe to call back into Haskell
-     (`h$run`, `h$runSync`) from foreign code in any of the safety levels.
-     Since JavaScript is single threaded, no Haskell threads can run while
-     the foreign code is running.
- -}
-
-module GHCJS.Foreign.Internal ( JSType(..)
+module GHCJS.Foreign.Internal ( JSTypeOf(..)
                               , jsTypeOf
-                              , JSONType(..)
+                              , JSONTypeOf(..)
                               , jsonTypeOf
                               -- , mvarRef
                               , isTruthy
@@ -108,25 +69,25 @@ import qualified Data.Text.Lazy as TL (Text, toStrict, fromStrict)
 import           Unsafe.Coerce
 
 -- types returned by JS typeof operator
-data JSType = Undefined
-            | Object
-            | Boolean
-            | Number
-            | String
-            | Symbol
-            | Function
-            | Other    -- ^ implementation dependent
-            deriving (Show, Eq, Ord, Enum, Typeable)
+data JSTypeOf = Undefined
+              | Object
+              | Boolean
+              | Number
+              | String
+              | Symbol
+              | Function
+              | Other    -- ^ implementation dependent
+              deriving (Show, Eq, Ord, Enum, Typeable)
 
 -- JSON value type
-data JSONType = JSONNull
-              | JSONInteger
-              | JSONFloat
-              | JSONBool
-              | JSONString
-              | JSONArray
-              | JSONObject
-              deriving (Show, Eq, Ord, Enum, Typeable)
+data JSONTypeOf = JSONNull
+                | JSONInteger
+                | JSONFloat
+                | JSONBool
+                | JSONString
+                | JSONArray
+                | JSONObject
+                deriving (Show, Eq, Ord, Enum, Typeable)
 
 fromJSBool :: JSVal -> Bool
 fromJSBool b = js_fromBool b
@@ -257,11 +218,11 @@ listProps :: JSVal a -> IO [JSString]
 listProps o = fmap unsafeCoerce . Prim.fromJSArray =<< js_listProps o
 {-# INLINE listProps #-}
 -}
-jsTypeOf :: JSVal -> JSType
+jsTypeOf :: JSVal -> JSTypeOf
 jsTypeOf r = tagToEnum# (js_jsTypeOf r)
 {-# INLINE jsTypeOf #-}
 
-jsonTypeOf :: JSVal -> JSONType
+jsonTypeOf :: JSVal -> JSONTypeOf
 jsonTypeOf r = tagToEnum# (js_jsonTypeOf r)
 {-# INLINE jsonTypeOf #-}
 

GHCJS/Internal/Types.hs

@@ -18,17 +18,36 @@ import GHCJS.Prim (JSVal)
 instance NFData JSVal where
   rnf x = x `seq` ()
 
+instance IsJSVal JSVal
+
+-- | Instances of this class should be newtype wrappers around 'JSVal`. It
+-- should never be necessary to provide definitions for the methods, as
+-- they have defaults in terms of 'Coercible'. This is why the methods
+-- aren't exported by "GHCJS.Types".
 class IsJSVal a where
   jsval_ :: a -> JSVal
-
   default jsval_ :: Coercible a JSVal => a -> JSVal
   jsval_ = coerce
   {-# INLINE jsval_ #-}
 
+  uncheckedWrapJSVal_ :: JSVal -> a
+  default uncheckedWrapJSVal_ :: Coercible a JSVal => JSVal -> a
+  uncheckedWrapJSVal_ = coerce
+  {-# INLINE uncheckedWrapJSVal_ #-}
+
+-- | This gets the 'JSVal' stored within a newtype wrapper.
 jsval :: IsJSVal a => a -> JSVal
 jsval = jsval_
 {-# INLINE jsval #-}
 
+-- | This is an unchecked downcast from 'JSVal' to some newtype wrapper.
+-- Use with care, because this is an unchecked downcast. It should only
+-- be used when you know that the 'JSVal' is a valid inhabitant of the
+-- newtype.
+uncheckedWrapJSVal :: IsJSVal a => JSVal -> a
+uncheckedWrapJSVal = uncheckedWrapJSVal_
+{-# INLINE uncheckedWrapJSVal #-}
+
 data MutabilityType s = Mutable
                       | Immutable
                       | STMutable s