Enhancements to typed arrays

.gitignore

@@ -1,3 +1,4 @@
 *~
 *#
 /dist
+.stack-work/

Data/JSString.hs

@@ -159,16 +159,16 @@ import qualified GHC.CString                          as GHC
 
 import           Unsafe.Coerce
 
-import           GHCJS.Prim                           (JSRef)
+import           GHCJS.Prim                           (JSVal)
 
 import           Data.JSString.Internal.Type
 import           Data.JSString.Internal.Fusion        (stream, unstream)
 import qualified Data.JSString.Internal.Fusion        as S
 import qualified Data.JSString.Internal.Fusion.Common as S
 
-getJSRef :: JSString -> JSRef ()
-getJSRef (JSString x) = x
-{-# INLINE getJSRef #-}
+getJSVal :: JSString -> JSVal
+getJSVal (JSString x) = x
+{-# INLINE getJSVal #-}
 
 instance Exts.IsString JSString where
   fromString = pack
@@ -241,7 +241,7 @@ unpack = S.unstreamList . stream
 {-# INLINE [1] unpack #-}
 
 unpack' :: JSString -> String
-unpack' x = case js_unpack x of (# z #) -> z
+unpack' x = unsafeCoerce (js_unpack x)
 {-# INLINE unpack' #-}
 
 -- | /O(n)/ Convert a literal string into a JSString.  Subject to fusion.
@@ -1181,7 +1181,7 @@ group x = group' x -- fixme, implement lazier version
 {-# INLINE group #-}
 
 group' :: JSString -> [JSString]
-group' x = case js_group x of (# z #) -> z
+group' x = unsafeCoerce (js_group x)
 {-# INLINE group' #-}
 
 -- | /O(n^2)/ Return all initial segments of the given 'JSString', shortest
@@ -1266,7 +1266,7 @@ splitOn' :: JSString
          -> [JSString]
 splitOn' pat src
   | null pat  = emptyError "splitOn'"
-  | otherwise = case js_splitOn pat src of (# z #) -> z
+  | otherwise = unsafeCoerce (js_splitOn pat src)
 {-# NOINLINE splitOn' #-}
 --- {-# INLINE [1] splitOn' #-}
 
@@ -1314,7 +1314,7 @@ chunksOf (I# k) p = go 0#
 -- > chunksOf 3 "foobarbaz"   == ["foo","bar","baz"]
 -- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]
 chunksOf' :: Int -> JSString -> [JSString]
-chunksOf' (I# k) p = case js_chunksOf k p of (# z #) -> z
+chunksOf' (I# k) p = unsafeCoerce (js_chunksOf k p)
 {-# INLINE chunksOf' #-}
 
 -- ----------------------------------------------------------------------------
@@ -1423,7 +1423,7 @@ breakOnAll' :: JSString              -- ^ @needle@ to search for
             -> [(JSString, JSString)]
 breakOnAll' pat src
     | null pat  = emptyError "breakOnAll'"
-    | otherwise = case js_breakOnAll pat src of (# z #) -> z
+    | otherwise = unsafeCoerce (js_breakOnAll pat src)
 {-# INLINE breakOnAll' #-}
 
 -------------------------------------------------------------------------------
@@ -1512,7 +1512,7 @@ words x = loop 0# -- js_words x {- t@(Text arr off len) = loop 0 0
 
 -- fixme: strict words' that allocates the whole list in one go
 words' :: JSString -> [JSString]
-words' x = case js_words x of (# z #) -> z
+words' x = unsafeCoerce (js_words x)
 {-# INLINE words' #-}
 
 -- | /O(n)/ Breaks a 'JSString' up into a list of 'JSString's at
@@ -1527,7 +1527,7 @@ lines ps = loop 0#
 {-# INLINE lines #-}
 
 lines' :: JSString -> [JSString]
-lines' ps = case js_lines ps of (# z #) -> z
+lines' ps = unsafeCoerce (js_lines ps)
 {-# INLINE lines' #-}
 
 {-
@@ -1619,7 +1619,7 @@ isInfixOf needle haystack = js_isInfixOf needle haystack
 -- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
 -- > fnordLength _                                 = -1
 stripPrefix :: JSString -> JSString -> Maybe JSString
-stripPrefix x y = case js_stripPrefix x y of (# z #) -> z
+stripPrefix x y = unsafeCoerce (js_stripPrefix x y)
 {-# INLINE stripPrefix #-}
 
 -- | /O(n)/ Find the longest non-empty common prefix of two strings
@@ -1635,7 +1635,7 @@ stripPrefix x y = case js_stripPrefix x y of (# z #) -> z
 -- > commonPrefixes "veeble" "fetzer"  == Nothing
 -- > commonPrefixes "" "baz"           == Nothing
 commonPrefixes :: JSString -> JSString -> Maybe (JSString,JSString,JSString)
-commonPrefixes x y = case js_commonPrefixes x y of (# z #) -> z
+commonPrefixes x y = unsafeCoerce (js_commonPrefixes x y)
 {-# INLINE commonPrefixes #-}
 
 -- | /O(n)/ Return the prefix of the second string if its suffix
@@ -1657,7 +1657,7 @@ commonPrefixes x y = case js_commonPrefixes x y of (# z #) -> z
 -- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
 -- > quuxLength _                                = -1
 stripSuffix :: JSString -> JSString -> Maybe JSString
-stripSuffix x y = case js_stripSuffix x y of (# z #) -> z
+stripSuffix x y = unsafeCoerce (js_stripSuffix x y)
 {-# INLINE stripSuffix #-}
 
 -- | Add a list of non-negative numbers.  Errors out on overflow.
@@ -1687,7 +1687,7 @@ foreign import javascript unsafe
 foreign import javascript unsafe
   "$1===''" js_null :: JSString -> Bool
 foreign import javascript unsafe
-  "$1===null" js_isNull :: JSRef () -> Bool
+  "$1===null" js_isNull :: JSVal -> Bool
 foreign import javascript unsafe
   "$1===$2" js_eq :: JSString -> JSString -> Bool
 foreign import javascript unsafe
@@ -1699,7 +1699,7 @@ foreign import javascript unsafe
 foreign import javascript unsafe
   "h$jsstringSingleton" js_singleton :: Char -> JSString
 foreign import javascript unsafe
-  "h$jsstringUnpack" js_unpack :: JSString -> (# String #)
+  "h$jsstringUnpack" js_unpack :: JSString -> Exts.Any -- String
 foreign import javascript unsafe
   "h$jsstringCons" js_cons :: Char -> JSString -> JSString
 foreign import javascript unsafe
@@ -1731,13 +1731,13 @@ foreign import javascript unsafe
   "h$jsstringLast" js_last :: JSString -> Int#
 
 foreign import javascript unsafe
-  "h$jsstringInit" js_init :: JSString -> JSRef () -- null for empty string
+  "h$jsstringInit" js_init :: JSString -> JSVal -- null for empty string
 foreign import javascript unsafe
-  "h$jsstringTail" js_tail :: JSString -> JSRef () -- null for empty string
+  "h$jsstringTail" js_tail :: JSString -> JSVal -- null for empty string
 foreign import javascript unsafe
   "h$jsstringReverse" js_reverse :: JSString -> JSString
 foreign import javascript unsafe
-  "h$jsstringGroup"  js_group :: JSString -> (# [JSString] #) -- Exts.Any {- [JSString] -}
+  "h$jsstringGroup"  js_group :: JSString -> Exts.Any {- [JSString] -}
 --foreign import javascript unsafe
 --  "h$jsstringGroup1" js_group1
 --  :: Int# -> Bool -> JSString -> (# Int#, JSString #)
@@ -1751,11 +1751,11 @@ foreign import javascript unsafe
 foreign import javascript unsafe
   "h$jsstringWords1" js_words1 :: Int# -> JSString -> (# Int#, JSString #)
 foreign import javascript unsafe
-  "h$jsstringWords" js_words :: JSString -> (# [JSString] #) -- Exts.Any {- [JSString] -}
+  "h$jsstringWords" js_words :: JSString -> Exts.Any -- [JSString]
 foreign import javascript unsafe
   "h$jsstringLines1" js_lines1 :: Int# -> JSString -> (# Int#, JSString #)
 foreign import javascript unsafe
-  "h$jsstringLines" js_lines :: JSString -> (# [JSString] #) -- Exts.Any {- [JSString] -}
+  "h$jsstringLines" js_lines :: JSString -> Exts.Any -- [JSString]
 foreign import javascript unsafe
   "h$jsstringUnlines" js_unlines :: Exts.Any {- [JSString] -} -> JSString
 foreign import javascript unsafe
@@ -1768,16 +1768,16 @@ foreign import javascript unsafe
   "h$jsstringIsInfixOf" js_isInfixOf :: JSString -> JSString -> Bool
 foreign import javascript unsafe
   "h$jsstringStripPrefix" js_stripPrefix
-  :: JSString -> JSString -> (# Maybe JSString #)
+  :: JSString -> JSString -> Exts.Any -- Maybe JSString
 foreign import javascript unsafe
   "h$jsstringStripSuffix" js_stripSuffix
-  :: JSString -> JSString -> (# Maybe JSString #)
+  :: JSString -> JSString -> Exts.Any -- Maybe JSString
 foreign import javascript unsafe
   "h$jsstringCommonPrefixes" js_commonPrefixes
-  :: JSString -> JSString -> (# Maybe (JSString, JSString, JSString) #)
+  :: JSString -> JSString -> Exts.Any -- Maybe (JSString, JSString, JSString)
 foreign import javascript unsafe
   "h$jsstringChunksOf" js_chunksOf
-  :: Int# -> JSString -> (# [JSString] #)
+  :: Int# -> JSString -> Exts.Any -- [JSString]
 foreign import javascript unsafe
   "h$jsstringChunksOf1" js_chunksOf1
   :: Int# -> Int# -> JSString -> (# Int#, JSString #)
@@ -1786,7 +1786,7 @@ foreign import javascript unsafe
   :: Int# -> JSString -> (# JSString, JSString #)
 foreign import javascript unsafe
   "h$jsstringSplitOn" js_splitOn
-  :: JSString -> JSString -> (# [JSString] #)
+  :: JSString -> JSString -> Exts.Any -- [JSString]
 foreign import javascript unsafe
   "h$jsstringSplitOn1" js_splitOn1
   :: Int# -> JSString -> JSString -> (# Int#, JSString #)
@@ -1798,7 +1798,7 @@ foreign import javascript unsafe
   :: JSString -> JSString -> (# JSString, JSString #)
 foreign import javascript unsafe
   "h$jsstringBreakOnAll" js_breakOnAll
-  :: JSString -> JSString -> (# [(JSString, JSString)] #)
+  :: JSString -> JSString -> Exts.Any -- [(JSString, JSString)]
 foreign import javascript unsafe
   "h$jsstringBreakOnAll1" js_breakOnAll1
   :: Int# -> JSString -> JSString -> (# Int#, JSString, JSString #)

Data/JSString/Internal.hs

@@ -12,9 +12,9 @@ import           Control.DeepSeq (NFData(..))
 import qualified GHC.Exts as Exts
 
 import           Unsafe.Coerce
-import           GHCJS.Prim (JSRef)
+import           GHCJS.Prim (JSVal)
 
-newtype JSString = JSString (JSRef ())
+newtype JSString = JSString (JSVal ())
 
 instance Monoid JSString where
   mempty  = empty

Data/JSString/Internal/Fusion.hs

@@ -185,10 +185,10 @@ foreign import javascript unsafe
 foreign import javascript unsafe
   "$1.length" js_length :: JSString -> Int#
 foreign import javascript unsafe
-  "$r = [$1];" js_newSingletonArray :: Char -> IO (JSRef ())
+  "$r = [$1];" js_newSingletonArray :: Char -> IO JSVal
 foreign import javascript unsafe
-  "$3[$2] = $1;" js_writeArray :: Char -> Int -> (JSRef ()) -> IO ()
+  "$3[$2] = $1;" js_writeArray :: Char -> Int -> JSVal -> IO ()
 foreign import javascript unsafe
-  "h$jsstringPackArray" js_packString :: (JSRef ()) -> IO JSString
+  "h$jsstringPackArray" js_packString :: JSVal -> IO JSString
 foreign import javascript unsafe
-  "h$jsstringPackArrayReverse" js_packReverse :: (JSRef ()) -> IO JSString
+  "h$jsstringPackArrayReverse" js_packReverse :: JSVal -> IO JSString

Data/JSString/Internal/Type.hs

@@ -36,11 +36,13 @@ import Data.Int                       (Int32, Int64)
 import Data.Typeable                  (Typeable)
 import GHC.Exts                       (Char(..), ord#, andI#, (/=#), isTrue#)
 
-import GHCJS.Prim (JSRef)
+import GHCJS.Prim (JSVal)
+
+import GHCJS.Internal.Types
 
 -- | A wrapper around a JavaScript string
-newtype JSString = JSString { unJSString :: JSRef () }
-  deriving Typeable
+newtype JSString = JSString JSVal
+instance IsJSVal JSString
 
 instance NFData JSString where rnf !x = ()
 

Data/JSString/Raw.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI,
-             MagicHash, UnboxedTuples, UnliftedFFITypes
+             MagicHash, UnboxedTuples, UnliftedFFITypes, GHCForeignImportPrim
   #-}
 
 {-
@@ -110,7 +110,7 @@ rawChunksOf (I# k) x =
 {-# INLINE rawChunksOf #-}
 
 rawChunksOf' :: Int -> JSString -> [JSString]
-rawChunksOf' (I# k) x = case js_rawChunksOf k x of (# z #) -> z
+rawChunksOf' (I# k) x = unsafeCoerce (js_rawChunksOf k x)
 {-# INLINE rawChunksOf' #-}
 
 rawSplitAt :: Int -> JSString -> (JSString, JSString)
@@ -144,5 +144,5 @@ foreign import javascript unsafe
 foreign import javascript unsafe
   "$2.charCodeAt($1)" js_charCodeAt :: Int# -> JSString -> Int#
 foreign import javascript unsafe
-  "$hsRawChunksOf" js_rawChunksOf :: Int# -> JSString -> (# [JSString] #)
+  "$hsRawChunksOf" js_rawChunksOf :: Int# -> JSString -> Exts.Any -- [JSString]
 

Data/JSString/Read.hs

@@ -6,14 +6,23 @@ module Data.JSString.Read ( isInteger
                           , isNatural
                           , readInt
                           , readIntMaybe
+                          , lenientReadInt
+                          , readInt64
+                          , readInt64Maybe
+                          , readWord64
+                          , readWord64Maybe
                           , readDouble
                           , readDoubleMaybe
                           , readInteger
                           , readIntegerMaybe
                           ) where
-import GHC.Exts (ByteArray#, Int#, Int64#, Word64#, Int(..))
+
+import GHCJS.Types
+
+import GHC.Exts (Any, Int#, Int64#, Word64#, Int(..))
 import GHC.Int (Int64(..))
 import GHC.Word (Word64(..))
+import Unsafe.Coerce
 import Data.Maybe
 import Data.JSString
 
@@ -127,10 +136,10 @@ readIntegerMaybe j = convertNullMaybe js_readInteger j
 
 -- ----------------------------------------------------------------------------
 
-convertNullMaybe :: (JSString -> ByteArray#) -> JSString -> Maybe a
+convertNullMaybe :: (JSString -> JSVal) -> JSString -> Maybe a
 convertNullMaybe f j
   | js_isNull r = Nothing
-  | otherwise   = case js_toHeapObject r of (# h #) -> Just h
+  | otherwise   = Just (unsafeCoerce (js_toHeapObject r))
   where
     r = f j
 {-# INLINE convertNullMaybe #-}
@@ -141,21 +150,21 @@ readError xs = error ("Data.JSString.Read." ++ xs)
 -- ----------------------------------------------------------------------------
 
 foreign import javascript unsafe
-  "$1===null" js_isNull :: ByteArray# -> Bool
+  "$r = $1===null;" js_isNull :: JSVal -> Bool
 foreign import javascript unsafe
-  "$r=$1;" js_toHeapObject :: ByteArray# -> (# a #)
+  "$r=$1;" js_toHeapObject :: JSVal -> Any
 foreign import javascript unsafe
-  "h$jsstringReadInteger" js_readInteger :: JSString -> ByteArray#
+  "h$jsstringReadInteger" js_readInteger :: JSString -> JSVal
 foreign import javascript unsafe
-  "h$jsstringReadInt" js_readInt :: JSString -> ByteArray#
+  "h$jsstringReadInt" js_readInt :: JSString -> JSVal
 foreign import javascript unsafe
-  "h$jsstringLenientReadInt" js_lenientReadInt :: JSString -> ByteArray#
+  "h$jsstringLenientReadInt" js_lenientReadInt :: JSString -> JSVal
 foreign import javascript unsafe
   "h$jsstringReadInt64" js_readInt64 :: JSString -> (# Int#, Int64# #)
 foreign import javascript unsafe
   "h$jsstringReadWord64" js_readWord64 :: JSString -> (# Int#, Word64# #)
 foreign import javascript unsafe
-  "h$jsstringReadDouble" js_readDouble :: JSString -> ByteArray#
+  "h$jsstringReadDouble" js_readDouble :: JSString -> JSVal
 foreign import javascript unsafe
   "h$jsstringIsInteger" js_isInteger :: JSString -> Bool
 foreign import javascript unsafe