From db50683c8a20f79c04c385f3ec43dc5730d966ce Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Fri, 12 May 2023 17:47:42 +0200 Subject: [PATCH 01/53] Fix build with JS backend --- Data/JSString.hs | 6 +- Data/JSString/Int.hs | 42 +++++++------- Data/JSString/Internal/Fusion.hs | 2 +- Data/JSString/Internal/Type.hs | 2 +- Data/JSString/Raw.hs | 2 +- Data/JSString/RegExp.hs | 2 +- Data/JSString/Text.hs | 8 +-- GHCJS/Buffer.hs | 2 +- GHCJS/Concurrent.hs | 2 +- GHCJS/Foreign/Callback.hs | 2 +- GHCJS/Foreign/Export.hs | 2 +- GHCJS/Foreign/Internal.hs | 2 +- GHCJS/Internal/Types.hs | 2 +- GHCJS/Marshal/Internal.hs | 2 +- GHCJS/Marshal/Pure.hs | 28 +++++----- GHCJS/Nullable.hs | 2 +- GHCJS/Types.hs | 2 +- JavaScript/Array.hs | 2 +- JavaScript/Array/Internal.hs | 2 +- JavaScript/Cast.hs | 2 +- JavaScript/JSON/Types/Generic.hs | 2 +- JavaScript/JSON/Types/Instances.hs | 8 +-- JavaScript/JSON/Types/Internal.hs | 2 +- JavaScript/Object/Internal.hs | 2 +- JavaScript/TypedArray/DataView.hs | 2 +- JavaScript/TypedArray/DataView/Internal.hs | 2 +- JavaScript/TypedArray/DataView/ST.hs | 2 +- JavaScript/TypedArray/Internal.hs | 56 +++++++++---------- JavaScript/TypedArray/ST.hs | 10 ++-- JavaScript/Web/WebSocket.hs | 2 +- JavaScript/Web/Worker.hs | 2 +- JavaScript/Web/XMLHttpRequest.hs | 2 +- ghcjs-base.cabal | 29 +++++----- ...animationFrame.js.pp => animationFrame.js} | 1 + jsbits/{array.js.pp => array.js} | 2 +- jsbits/{export.js.pp => export.js} | 1 + jsbits/{foreign.js.pp => foreign.js} | 1 + jsbits/json.js.pp | 4 -- jsbits/{jsstring.js.pp => jsstring.js} | 2 +- jsbits/{jsstringRaw.js.pp => jsstringRaw.js} | 2 +- jsbits/object.js.pp | 2 - jsbits/{text.js.pp => text.js} | 2 +- jsbits/{utils.js.pp => utils.js} | 2 +- jsbits/{websocket.js.pp => websocket.js} | 2 +- jsbits/{xhr.js.pp => xhr.js} | 1 + 45 files changed, 127 insertions(+), 132 deletions(-) rename jsbits/{animationFrame.js.pp => animationFrame.js} (96%) rename jsbits/{array.js.pp => array.js} (97%) rename jsbits/{export.js.pp => export.js} (97%) rename jsbits/{foreign.js.pp => foreign.js} (91%) delete mode 100644 jsbits/json.js.pp rename jsbits/{jsstring.js.pp => jsstring.js} (99%) rename jsbits/{jsstringRaw.js.pp => jsstringRaw.js} (96%) delete mode 100644 jsbits/object.js.pp rename jsbits/{text.js.pp => text.js} (98%) rename jsbits/{utils.js.pp => utils.js} (98%) rename jsbits/{websocket.js.pp => websocket.js} (98%) rename jsbits/{xhr.js.pp => xhr.js} (94%) diff --git a/Data/JSString.hs b/Data/JSString.hs index 36fb370..821b6b6 100644 --- a/Data/JSString.hs +++ b/Data/JSString.hs @@ -167,8 +167,8 @@ import Data.Semigroup (Semigroup(..)) import Unsafe.Coerce -import GHCJS.Prim (JSVal) -import qualified GHCJS.Prim as Prim +import GHC.JS.Prim (JSVal) +import qualified GHC.JS.Prim as Prim import Data.JSString.Internal.Type import Data.JSString.Internal.Fusion (stream, unstream) @@ -300,11 +300,13 @@ unpackCString# addr# = unstream (S.streamCString# addr#) unstream (S.map safe (S.streamList [a])) = singleton a #-} +#ifdef MIN_VERSION_ghcjs_prim #if MIN_VERSION_ghcjs_prim(0,1,1) {-# RULES "JSSTRING literal prim" [0] forall a. unpackCString# a = JSString (Prim.unsafeUnpackJSStringUtf8# a) #-} #endif +#endif -- | /O(1)/ Convert a character into a 'JSString'. Subject to fusion. -- Performs replacement on invalid scalar values. diff --git a/Data/JSString/Int.hs b/Data/JSString/Int.hs index 1c8ecb3..844a6f2 100644 --- a/Data/JSString/Int.hs +++ b/Data/JSString/Int.hs @@ -16,14 +16,10 @@ import Data.Monoid import GHC.Int import GHC.Word -import GHC.Exts ( ByteArray# - , Int(..), Int#, Int64# - , Word(..), Word#, Word64# - , (<#), (<=#), isTrue# ) - -import GHC.Integer.GMP.Internals +import GHC.Exts hiding (Any) +import GHC.Num.Integer import Unsafe.Coerce -import GHCJS.Prim +import GHC.JS.Prim decimal :: Integral a => a -> JSString decimal i = decimal' i @@ -56,15 +52,15 @@ decimalI (I# x) = js_decI x {-# INLINE decimalI #-} decimalI8 :: Int8 -> JSString -decimalI8 (I8# x) = js_decI x +decimalI8 (I8# x) = js_decI (int8ToInt# x) {-# INLINE decimalI8 #-} decimalI16 :: Int16 -> JSString -decimalI16 (I16# x) = js_decI x +decimalI16 (I16# x) = js_decI (int16ToInt# x) {-# INLINE decimalI16 #-} decimalI32 :: Int32 -> JSString -decimalI32 (I32# x) = js_decI x +decimalI32 (I32# x) = js_decI (int32ToInt# x) {-# INLINE decimalI32 #-} decimalI64 :: Int64 -> JSString @@ -72,15 +68,15 @@ decimalI64 (I64# x) = js_decI64 x {-# INLINE decimalI64 #-} decimalW8 :: Word8 -> JSString -decimalW8 (W8# x) = js_decW x +decimalW8 (W8# x) = js_decW (word8ToWord# x) {-# INLINE decimalW8 #-} decimalW16 :: Word16 -> JSString -decimalW16 (W16# x) = js_decW x +decimalW16 (W16# x) = js_decW (word16ToWord# x) {-# INLINE decimalW16 #-} decimalW32 :: Word32 -> JSString -decimalW32 (W32# x) = js_decW32 x +decimalW32 (W32# x) = js_decW32 (word32ToWord# x) {-# INLINE decimalW32 #-} decimalW64 :: Word64 -> JSString @@ -163,23 +159,23 @@ hexI (I# x) = if isTrue# (x <# 0#) hexI8 :: Int8 -> JSString hexI8 (I8# x) = - if isTrue# (x <# 0#) + if isTrue# (int8ToInt# x <# 0#) then error hexErrMsg - else js_hexI x + else js_hexI (int8ToInt# x) {-# INLINE hexI8 #-} hexI16 :: Int16 -> JSString hexI16 (I16# x) = - if isTrue# (x <# 0#) + if isTrue# (int16ToInt# x <# 0#) then error hexErrMsg - else js_hexI x + else js_hexI (int16ToInt# x) {-# INLINE hexI16 #-} hexI32 :: Int32 -> JSString hexI32 (I32# x) = - if isTrue# (x <# 0#) + if isTrue# (int32ToInt# x <# 0#) then error hexErrMsg - else js_hexI x + else js_hexI (int32ToInt# x) {-# INLINE hexI32 #-} hexI64 :: Int64 -> JSString @@ -190,15 +186,15 @@ hexI64 i@(I64# x) = {-# INLINE hexI64 #-} hexW :: Word -> JSString -hexW (W# x) = js_hexW32 x +hexW (W# x) = js_hexW x {-# INLINE hexW #-} hexW8 :: Word8 -> JSString -hexW8 (W8# x) = js_hexW x +hexW8 (W8# x) = js_hexW (word8ToWord# x) {-# INLINE hexW8 #-} hexW16 :: Word16 -> JSString -hexW16 (W16# x) = js_hexW x +hexW16 (W16# x) = js_hexW (word16ToWord# x) {-# INLINE hexW16 #-} hexW32 :: Word32 -> JSString @@ -246,7 +242,7 @@ foreign import javascript unsafe js_hexW :: Word# -> JSString foreign import javascript unsafe "(($1>=0)?$1:($1+4294967296)).toString(16)" - js_hexW32 :: Word# -> JSString + js_hexW32 :: Word32# -> JSString foreign import javascript unsafe "h$jsstringHexW64($1_1, $1_2)" js_hexW64 :: Word64# -> JSString diff --git a/Data/JSString/Internal/Fusion.hs b/Data/JSString/Internal/Fusion.hs index 4118acb..c7578e3 100644 --- a/Data/JSString/Internal/Fusion.hs +++ b/Data/JSString/Internal/Fusion.hs @@ -43,7 +43,7 @@ import qualified Data.JSString.Internal.Fusion.Common as S import System.IO.Unsafe -import GHCJS.Prim +import GHC.JS.Prim default (Int) diff --git a/Data/JSString/Internal/Type.hs b/Data/JSString/Internal/Type.hs index 4fff668..0f1c611 100644 --- a/Data/JSString/Internal/Type.hs +++ b/Data/JSString/Internal/Type.hs @@ -36,7 +36,7 @@ import Data.Int (Int32, Int64) import Data.Typeable (Typeable) import GHC.Exts (Char(..), ord#, andI#, (/=#), isTrue#) -import GHCJS.Prim (JSVal) +import GHC.JS.Prim (JSVal) import GHCJS.Internal.Types diff --git a/Data/JSString/Raw.hs b/Data/JSString/Raw.hs index 58142c3..7c9c9d8 100644 --- a/Data/JSString/Raw.hs +++ b/Data/JSString/Raw.hs @@ -25,7 +25,7 @@ import GHC.Exts , (+#), (-#), (>=#), (<#) , isTrue#, chr#) import qualified GHC.Exts as Exts -import GHCJS.Prim (JSVal) +import GHC.JS.Prim (JSVal) import Unsafe.Coerce diff --git a/Data/JSString/RegExp.hs b/Data/JSString/RegExp.hs index 0ec8e1c..2b98f73 100644 --- a/Data/JSString/RegExp.hs +++ b/Data/JSString/RegExp.hs @@ -18,7 +18,7 @@ module Data.JSString.RegExp ( RegExp , execNext ) where -import GHCJS.Prim +import GHC.JS.Prim import GHC.Exts (Any, Int#, Int(..)) import Unsafe.Coerce (unsafeCoerce) diff --git a/Data/JSString/Text.hs b/Data/JSString/Text.hs index 897880f..1d0c858 100644 --- a/Data/JSString/Text.hs +++ b/Data/JSString/Text.hs @@ -15,7 +15,7 @@ module Data.JSString.Text , lazyTextFromJSVal ) where -import GHCJS.Prim +import GHC.JS.Prim import GHC.Exts (ByteArray#, Int(..), Int#, Any) @@ -31,7 +31,7 @@ import Data.JSString.Internal.Type import Unsafe.Coerce textToJSString :: T.Text -> JSString -textToJSString (T.Text (A.Array ba) (I# offset) (I# length)) = +textToJSString (T.Text (A.ByteArray ba) (I# offset) (I# length)) = js_toString ba offset length {-# INLINE textToJSString #-} @@ -39,7 +39,7 @@ textFromJSString :: JSString -> T.Text textFromJSString j = case js_fromString j of (# _ , 0# #) -> T.empty - (# ba, length #) -> T.Text (A.Array ba) 0 (I# length) + (# ba, length #) -> T.Text (A.ByteArray ba) 0 (I# length) {-# INLINE textFromJSString #-} lazyTextToJSString :: TL.Text -> JSString @@ -54,7 +54,7 @@ lazyTextFromJSString = TL.fromStrict . textFromJSString textFromJSVal :: JSVal -> T.Text textFromJSVal j = case js_fromString' j of (# _, 0# #) -> T.empty - (# ba, length #) -> T.Text (A.Array ba) 0 (I# length) + (# ba, length #) -> T.Text (A.ByteArray ba) 0 (I# length) {-# INLINE textFromJSVal #-} -- | returns the empty Text if not a string diff --git a/GHCJS/Buffer.hs b/GHCJS/Buffer.hs index b9cc421..8e11b46 100644 --- a/GHCJS/Buffer.hs +++ b/GHCJS/Buffer.hs @@ -41,7 +41,7 @@ module GHCJS.Buffer import GHC.Exts (ByteArray#, MutableByteArray#, Addr#, Ptr(..), Any) import GHCJS.Buffer.Types -import GHCJS.Prim +import GHC.JS.Prim import GHCJS.Internal.Types import Data.Int diff --git a/GHCJS/Concurrent.hs b/GHCJS/Concurrent.hs index 74735af..80b2a18 100644 --- a/GHCJS/Concurrent.hs +++ b/GHCJS/Concurrent.hs @@ -33,7 +33,7 @@ module GHCJS.Concurrent ( isThreadSynchronous , synchronously ) where -import GHCJS.Prim +import GHC.JS.Prim import Control.Applicative import Control.Concurrent diff --git a/GHCJS/Foreign/Callback.hs b/GHCJS/Foreign/Callback.hs index 7e8e846..a5f7b8a 100644 --- a/GHCJS/Foreign/Callback.hs +++ b/GHCJS/Foreign/Callback.hs @@ -25,7 +25,7 @@ import GHCJS.Concurrent import GHCJS.Marshal import GHCJS.Marshal.Pure import GHCJS.Foreign.Callback.Internal -import GHCJS.Prim +import GHC.JS.Prim import GHCJS.Types import qualified GHC.Exts as Exts diff --git a/GHCJS/Foreign/Export.hs b/GHCJS/Foreign/Export.hs index f14f968..31de434 100644 --- a/GHCJS/Foreign/Export.hs +++ b/GHCJS/Foreign/Export.hs @@ -27,7 +27,7 @@ import Data.Word import Unsafe.Coerce import qualified GHC.Exts as Exts -import GHCJS.Prim +import GHC.JS.Prim import GHCJS.Types newtype Export a = Export JSVal diff --git a/GHCJS/Foreign/Internal.hs b/GHCJS/Foreign/Internal.hs index 8a16901..8196ec6 100644 --- a/GHCJS/Foreign/Internal.hs +++ b/GHCJS/Foreign/Internal.hs @@ -80,7 +80,7 @@ module GHCJS.Foreign.Internal ( JSType(..) ) where import GHCJS.Types -import qualified GHCJS.Prim as Prim +import qualified GHC.JS.Prim as Prim import GHC.Prim import GHC.Exts diff --git a/GHCJS/Internal/Types.hs b/GHCJS/Internal/Types.hs index ded5112..4965719 100644 --- a/GHCJS/Internal/Types.hs +++ b/GHCJS/Internal/Types.hs @@ -13,7 +13,7 @@ import Unsafe.Coerce import Control.DeepSeq -import GHCJS.Prim (JSVal) +import GHC.JS.Prim (JSVal) instance NFData JSVal where rnf x = x `seq` () diff --git a/GHCJS/Marshal/Internal.hs b/GHCJS/Marshal/Internal.hs index 0b4884a..a26ec26 100644 --- a/GHCJS/Marshal/Internal.hs +++ b/GHCJS/Marshal/Internal.hs @@ -23,7 +23,7 @@ import Data.Typeable import GHC.Generics -import qualified GHCJS.Prim as Prim +import qualified GHC.JS.Prim as Prim import qualified GHCJS.Foreign as F import GHCJS.Types diff --git a/GHCJS/Marshal/Pure.hs b/GHCJS/Marshal/Pure.hs index 902fa20..17cb26c 100644 --- a/GHCJS/Marshal/Pure.hs +++ b/GHCJS/Marshal/Pure.hs @@ -42,7 +42,7 @@ import GHC.Float import GHC.Prim import GHCJS.Types -import qualified GHCJS.Prim as Prim +import qualified GHC.JS.Prim as Prim import GHCJS.Foreign.Internal import GHCJS.Marshal.Internal @@ -77,7 +77,7 @@ instance PFromJSVal Int8 where pFromJSVal x = I8# (jsvalToInt8 x) {-# INLINE pFromJSVal #-} instance PFromJSVal Int16 where pFromJSVal x = I16# (jsvalToInt16 x) {-# INLINE pFromJSVal #-} -instance PFromJSVal Int32 where pFromJSVal x = I32# (jsvalToInt x) +instance PFromJSVal Int32 where pFromJSVal x = I32# (jsvalToInt32 x) {-# INLINE pFromJSVal #-} instance PFromJSVal Word where pFromJSVal x = W# (jsvalToWord x) {-# INLINE pFromJSVal #-} @@ -85,7 +85,7 @@ instance PFromJSVal Word8 where pFromJSVal x = W8# (jsvalToWord8 x) {-# INLINE pFromJSVal #-} instance PFromJSVal Word16 where pFromJSVal x = W16# (jsvalToWord16 x) {-# INLINE pFromJSVal #-} -instance PFromJSVal Word32 where pFromJSVal x = W32# (jsvalToWord x) +instance PFromJSVal Word32 where pFromJSVal x = W32# (jsvalToWord32 x) {-# INLINE pFromJSVal #-} instance PFromJSVal Float where pFromJSVal x = F# (jsvalToFloat x) {-# INLINE pFromJSVal #-} @@ -112,19 +112,19 @@ instance PToJSVal Bool where pToJSVal True = jsTrue {-# INLINE pToJSVal #-} instance PToJSVal Int where pToJSVal (I# x) = intToJSVal x {-# INLINE pToJSVal #-} -instance PToJSVal Int8 where pToJSVal (I8# x) = intToJSVal x +instance PToJSVal Int8 where pToJSVal (I8# x) = intToJSVal (int8ToInt# x) {-# INLINE pToJSVal #-} -instance PToJSVal Int16 where pToJSVal (I16# x) = intToJSVal x +instance PToJSVal Int16 where pToJSVal (I16# x) = intToJSVal (int16ToInt# x) {-# INLINE pToJSVal #-} -instance PToJSVal Int32 where pToJSVal (I32# x) = intToJSVal x +instance PToJSVal Int32 where pToJSVal (I32# x) = intToJSVal (int32ToInt# x) {-# INLINE pToJSVal #-} instance PToJSVal Word where pToJSVal (W# x) = wordToJSVal x {-# INLINE pToJSVal #-} -instance PToJSVal Word8 where pToJSVal (W8# x) = wordToJSVal x +instance PToJSVal Word8 where pToJSVal (W8# x) = wordToJSVal (word8ToWord# x) {-# INLINE pToJSVal #-} -instance PToJSVal Word16 where pToJSVal (W16# x) = wordToJSVal x +instance PToJSVal Word16 where pToJSVal (W16# x) = wordToJSVal (word16ToWord# x) {-# INLINE pToJSVal #-} -instance PToJSVal Word32 where pToJSVal (W32# x) = wordToJSVal x +instance PToJSVal Word32 where pToJSVal (W32# x) = wordToJSVal (word32ToWord# x) {-# INLINE pToJSVal #-} instance PToJSVal Float where pToJSVal (F# x) = floatToJSVal x {-# INLINE pToJSVal #-} @@ -137,11 +137,13 @@ instance PToJSVal a => PToJSVal (Maybe a) where {-# INLINE pToJSVal #-} foreign import javascript unsafe "$r = $1|0;" jsvalToWord :: JSVal -> Word# -foreign import javascript unsafe "$r = $1&0xff;" jsvalToWord8 :: JSVal -> Word# -foreign import javascript unsafe "$r = $1&0xffff;" jsvalToWord16 :: JSVal -> Word# +foreign import javascript unsafe "$r = $1&0xff;" jsvalToWord8 :: JSVal -> Word8# +foreign import javascript unsafe "$r = $1&0xffff;" jsvalToWord16 :: JSVal -> Word16# +foreign import javascript unsafe "$r = $1|0;" jsvalToWord32 :: JSVal -> Word32# foreign import javascript unsafe "$r = $1|0;" jsvalToInt :: JSVal -> Int# -foreign import javascript unsafe "$r = $1<<24>>24;" jsvalToInt8 :: JSVal -> Int# -foreign import javascript unsafe "$r = $1<<16>>16;" jsvalToInt16 :: JSVal -> Int# +foreign import javascript unsafe "$r = $1<<24>>24;" jsvalToInt8 :: JSVal -> Int8# +foreign import javascript unsafe "$r = $1<<16>>16;" jsvalToInt16 :: JSVal -> Int16# +foreign import javascript unsafe "$r = $1|0;" jsvalToInt32 :: JSVal -> Int32# foreign import javascript unsafe "$r = +$1;" jsvalToFloat :: JSVal -> Float# foreign import javascript unsafe "$r = +$1;" jsvalToDouble :: JSVal -> Double# foreign import javascript unsafe "$r = $1&0x7fffffff;" jsvalToChar :: JSVal -> Char# diff --git a/GHCJS/Nullable.hs b/GHCJS/Nullable.hs index bad2c56..3cc98c3 100644 --- a/GHCJS/Nullable.hs +++ b/GHCJS/Nullable.hs @@ -3,7 +3,7 @@ module GHCJS.Nullable ( Nullable(..) , maybeToNullable ) where -import GHCJS.Prim (JSVal(..)) +import GHC.JS.Prim (JSVal(..)) import GHCJS.Marshal.Pure (PToJSVal(..), PFromJSVal(..)) newtype Nullable a = Nullable JSVal diff --git a/GHCJS/Types.hs b/GHCJS/Types.hs index 9ef0892..6ac7ab4 100644 --- a/GHCJS/Types.hs +++ b/GHCJS/Types.hs @@ -24,7 +24,7 @@ module GHCJS.Types ( JSVal import Data.JSString.Internal.Type (JSString) import GHCJS.Internal.Types -import GHCJS.Prim +import GHC.JS.Prim import GHC.Int import GHC.Types diff --git a/JavaScript/Array.hs b/JavaScript/Array.hs index 33fd4b9..2294557 100644 --- a/JavaScript/Array.hs +++ b/JavaScript/Array.hs @@ -33,7 +33,7 @@ module JavaScript.Array import Prelude hiding (length, drop, read, take, reverse, null) -import qualified GHCJS.Prim as Prim +import qualified GHC.JS.Prim as Prim import GHCJS.Types import JavaScript.Array.Internal (JSArray(..)) diff --git a/JavaScript/Array/Internal.hs b/JavaScript/Array/Internal.hs index 135fe5a..3964feb 100644 --- a/JavaScript/Array/Internal.hs +++ b/JavaScript/Array/Internal.hs @@ -16,7 +16,7 @@ import qualified GHC.Exts as Exts import GHC.Exts (State#) import GHCJS.Internal.Types -import qualified GHCJS.Prim as Prim +import qualified GHC.JS.Prim as Prim import GHCJS.Types newtype SomeJSArray (m :: MutabilityType s) = SomeJSArray JSVal diff --git a/JavaScript/Cast.hs b/JavaScript/Cast.hs index 517b36a..9282278 100644 --- a/JavaScript/Cast.hs +++ b/JavaScript/Cast.hs @@ -5,7 +5,7 @@ module JavaScript.Cast ( Cast(..) , unsafeCast ) where -import GHCJS.Prim +import GHC.JS.Prim cast :: forall a. Cast a => JSVal -> Maybe a cast x | js_checkCast x (instanceRef (undefined :: a)) = Just (unsafeWrap x) diff --git a/JavaScript/JSON/Types/Generic.hs b/JavaScript/JSON/Types/Generic.hs index 7cb5abd..2e5df98 100644 --- a/JavaScript/JSON/Types/Generic.hs +++ b/JavaScript/JSON/Types/Generic.hs @@ -28,7 +28,7 @@ import qualified Data.JSString as JSS import qualified JavaScript.JSON.Types.Internal as I import qualified JavaScript.Array as JSA import qualified JavaScript.Array.ST as JSAST -import Data.Bits +import Data.Bits hiding (And) import Data.DList (DList, toList, empty) diff --git a/JavaScript/JSON/Types/Instances.hs b/JavaScript/JSON/Types/Instances.hs index 2b288ec..a57374a 100644 --- a/JavaScript/JSON/Types/Instances.hs +++ b/JavaScript/JSON/Types/Instances.hs @@ -77,7 +77,7 @@ import Data.Monoid (Dual(..), First(..), Last(..), mappend) import Data.Ratio (Ratio, (%), numerator, denominator) import Data.Text (Text, pack, unpack) import Data.Time (UTCTime, ZonedTime(..), TimeZone(..)) -import Data.Time.Format (FormatTime, formatTime, parseTime) +import Data.Time.Format (FormatTime, formatTime, parseTimeM) import Data.Traversable (traverse) import Data.Vector (Vector) import Data.Word (Word, Word8, Word16, Word32, Word64) @@ -491,7 +491,7 @@ instance FromJSON DotNetTime where parseJSON = withJSString "DotNetTime" $ \t -> let (s,m) = JSS.splitAt (JSS.length t - 5) t t' = JSS.concat [s,".",m] - in case parseTime defaultTimeLocale "/Date(%s%Q)/" (JSS.unpack t') of + in case parseTimeM True defaultTimeLocale "/Date(%s%Q)/" (JSS.unpack t') of Just d -> pure (DotNetTime d) _ -> fail "could not parse .NET time" {-# INLINE parseJSON #-} @@ -513,7 +513,7 @@ instance FromJSON ZonedTime where <|> fail "could not parse ECMA-262 ISO-8601 date" where tryFormat f = - case parseTime defaultTimeLocale f (JSS.unpack t) of + case parseTimeM True defaultTimeLocale f (JSS.unpack t) of Just d -> pure d Nothing -> empty tryFormats = foldr1 (<|>) . map tryFormat @@ -536,7 +536,7 @@ instance ToJSON UTCTime where instance FromJSON UTCTime where parseJSON = withJSString "UTCTime" $ \t -> - case parseTime defaultTimeLocale "%FT%T%QZ" (JSS.unpack t) of + case parseTimeM True defaultTimeLocale "%FT%T%QZ" (JSS.unpack t) of Just d -> pure d _ -> fail "could not parse ISO-8601 date" {-# INLINE parseJSON #-} diff --git a/JavaScript/JSON/Types/Internal.hs b/JavaScript/JSON/Types/Internal.hs index f68689f..c2a6579 100644 --- a/JavaScript/JSON/Types/Internal.hs +++ b/JavaScript/JSON/Types/Internal.hs @@ -72,7 +72,7 @@ import GHC.Types (IO(..)) import qualified GHCJS.Foreign as F import GHCJS.Internal.Types import GHCJS.Types -import qualified GHCJS.Prim.Internal.Build as IB +import qualified GHC.JS.Prim.Internal.Build as IB import qualified JavaScript.Array as A import qualified JavaScript.Array.Internal as AI diff --git a/JavaScript/Object/Internal.hs b/JavaScript/Object/Internal.hs index aa05cb3..7b6ae30 100644 --- a/JavaScript/Object/Internal.hs +++ b/JavaScript/Object/Internal.hs @@ -21,7 +21,7 @@ module JavaScript.Object.Internal import Data.JSString import Data.Typeable -import qualified GHCJS.Prim as Prim +import qualified GHC.JS.Prim as Prim import GHCJS.Types import qualified JavaScript.Array as JA diff --git a/JavaScript/TypedArray/DataView.hs b/JavaScript/TypedArray/DataView.hs index 83e074b..4fcb05e 100644 --- a/JavaScript/TypedArray/DataView.hs +++ b/JavaScript/TypedArray/DataView.hs @@ -40,7 +40,7 @@ import GHC.Types (IO(..)) import Data.Int import Data.Word -import GHCJS.Prim +import GHC.JS.Prim import JavaScript.TypedArray.ArrayBuffer.Internal ( SomeArrayBuffer(..), ArrayBuffer, MutableArrayBuffer ) diff --git a/JavaScript/TypedArray/DataView/Internal.hs b/JavaScript/TypedArray/DataView/Internal.hs index e304cc6..0b53f6d 100644 --- a/JavaScript/TypedArray/DataView/Internal.hs +++ b/JavaScript/TypedArray/DataView/Internal.hs @@ -18,7 +18,7 @@ import Data.Word import GHC.Exts ( State# ) -import GHCJS.Prim +import GHC.JS.Prim import GHCJS.Internal.Types import JavaScript.TypedArray.ArrayBuffer.Internal diff --git a/JavaScript/TypedArray/DataView/ST.hs b/JavaScript/TypedArray/DataView/ST.hs index 1e2a59b..09b19dd 100644 --- a/JavaScript/TypedArray/DataView/ST.hs +++ b/JavaScript/TypedArray/DataView/ST.hs @@ -28,7 +28,7 @@ import Data.Word import GHC.ST -import GHCJS.Prim +import GHC.JS.Prim import JavaScript.TypedArray.ArrayBuffer.ST import JavaScript.TypedArray.ArrayBuffer.Internal as AI diff --git a/JavaScript/TypedArray/Internal.hs b/JavaScript/TypedArray/Internal.hs index 1118f86..126c7f6 100644 --- a/JavaScript/TypedArray/Internal.hs +++ b/JavaScript/TypedArray/Internal.hs @@ -48,10 +48,10 @@ elemSize a = js_elemSize a instance TypedArray IOInt8Array where index i a = IO (indexI8 i a) unsafeIndex i a = IO (unsafeIndexI8 i a) - setIndex i (I8# x) a = IO (setIndexI i x a) - unsafeSetIndex i (I8# x) a = IO (unsafeSetIndexI i x a) - indexOf s (I8# x) a = IO (indexOfI s x a) - lastIndexOf s (I8# x) a = IO (lastIndexOfI s x a) + setIndex i (I8# x) a = IO (setIndexI i (int8ToInt# x) a) + unsafeSetIndex i (I8# x) a = IO (unsafeSetIndexI i (int8ToInt# x) a) + indexOf s (I8# x) a = IO (indexOfI s (int8ToInt# x) a) + lastIndexOf s (I8# x) a = IO (lastIndexOfI s (int8ToInt# x) a) create l = IO (js_createInt8Array l) fromArray a = int8ArrayFrom a fromArrayBuffer b = undefined @@ -59,10 +59,10 @@ instance TypedArray IOInt8Array where instance TypedArray IOInt16Array where index i a = IO (indexI16 i a) unsafeIndex i a = IO (unsafeIndexI16 i a) - setIndex i (I16# x) a = IO (setIndexI i x a) - unsafeSetIndex i (I16# x) a = IO (unsafeSetIndexI i x a) - indexOf s (I16# x) a = IO (indexOfI s x a) - lastIndexOf s (I16# x) a = IO (lastIndexOfI s x a) + setIndex i (I16# x) a = IO (setIndexI i (int16ToInt# x) a) + unsafeSetIndex i (I16# x) a = IO (unsafeSetIndexI i (int16ToInt# x) a) + indexOf s (I16# x) a = IO (indexOfI s (int16ToInt# x) a) + lastIndexOf s (I16# x) a = IO (lastIndexOfI s (int16ToInt# x) a) create l = IO (js_createInt16Array l) fromArray a = int16ArrayFrom a fromArrayBuffer b = undefined @@ -81,10 +81,10 @@ instance TypedArray IOInt32Array where instance TypedArray IOUint8ClampedArray where index i a = IO (indexW8 i a) unsafeIndex i a = IO (unsafeIndexW8 i a) - setIndex i (W8# x) a = IO (setIndexW i x a) - unsafeSetIndex i (W8# x) a = IO (unsafeSetIndexW i x a) - indexOf s (W8# x) a = IO (indexOfW s x a) - lastIndexOf s (W8# x) a = IO (lastIndexOfW s x a) + setIndex i (W8# x) a = IO (setIndexW i (word8ToWord# x) a) + unsafeSetIndex i (W8# x) a = IO (unsafeSetIndexW i (word8ToWord# x) a) + indexOf s (W8# x) a = IO (indexOfW s (word8ToWord# x) a) + lastIndexOf s (W8# x) a = IO (lastIndexOfW s (word8ToWord# x) a) create l = IO (js_createUint8ClampedArray l) fromArray a = uint8ClampedArrayFrom a fromArrayBuffer b = undefined @@ -92,10 +92,10 @@ instance TypedArray IOUint8ClampedArray where instance TypedArray IOUint8Array where index i a = IO (indexW8 i a) unsafeIndex i a = IO (unsafeIndexW8 i a) - setIndex i (W8# x) a = IO (setIndexW i x a) - unsafeSetIndex i (W8# x) a = IO (unsafeSetIndexW i x a) - indexOf s (W8# x) a = IO (indexOfW s x a) - lastIndexOf s (W8# x) a = IO (lastIndexOfW s x a) + setIndex i (W8# x) a = IO (setIndexW i (word8ToWord# x) a) + unsafeSetIndex i (W8# x) a = IO (unsafeSetIndexW i (word8ToWord# x) a) + indexOf s (W8# x) a = IO (indexOfW s (word8ToWord# x) a) + lastIndexOf s (W8# x) a = IO (lastIndexOfW s (word8ToWord# x) a) create l = IO (js_createUint8Array l) fromArray a = uint8ArrayFrom a fromArrayBuffer b = undefined @@ -103,10 +103,10 @@ instance TypedArray IOUint8Array where instance TypedArray IOUint16Array where index i a = IO (indexW16 i a) unsafeIndex i a = IO (unsafeIndexW16 i a) - setIndex i (W16# x) a = IO (setIndexW i x a) - unsafeSetIndex i (W16# x) a = IO (unsafeSetIndexW i x a) - indexOf s (W16# x) a = IO (indexOfW s x a) - lastIndexOf s (W16# x) a = IO (lastIndexOfW s x a) + setIndex i (W16# x) a = IO (setIndexW i (word16ToWord# x) a) + unsafeSetIndex i (W16# x) a = IO (unsafeSetIndexW i (word16ToWord# x) a) + indexOf s (W16# x) a = IO (indexOfW s (word16ToWord# x) a) + lastIndexOf s (W16# x) a = IO (lastIndexOfW s (word16ToWord# x) a) create l = IO (js_createUint16Array l) fromArray a = uint16ArrayFrom a fromArrayBuffer b = undefined @@ -163,11 +163,11 @@ indexI a i = \s -> case js_indexI a i s of (# s', v #) -> (# s', I# v #) {-# INLINE indexI #-} indexI16 :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Int16 #) -indexI16 a i = \s -> case js_indexI a i s of (# s', v #) -> (# s', I16# v #) +indexI16 a i = \s -> case js_indexI a i s of (# s', v #) -> (# s', I16# (intToInt16# v) #) {-# INLINE indexI16 #-} indexI8 :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Int8 #) -indexI8 a i = \s -> case js_indexI a i s of (# s', v #) -> (# s', I8# v #) +indexI8 a i = \s -> case js_indexI a i s of (# s', v #) -> (# s', I8# (intToInt8# v) #) {-# INLINE indexI8 #-} indexW :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Word #) @@ -175,11 +175,11 @@ indexW a i = \s -> case js_indexW a i s of (# s', v #) -> (# s', W# v #) {-# INLINE indexW #-} indexW16 :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Word16 #) -indexW16 a i = \s -> case js_indexW a i s of (# s', v #) -> (# s', W16# v #) +indexW16 a i = \s -> case js_indexW a i s of (# s', v #) -> (# s', W16# (wordToWord16# v) #) {-# INLINE indexW16 #-} indexW8 :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Word8 #) -indexW8 a i = \s -> case js_indexW a i s of (# s', v #) -> (# s', W8# v #) +indexW8 a i = \s -> case js_indexW a i s of (# s', v #) -> (# s', W8# (wordToWord8# v) #) {-# INLINE indexW8 #-} indexD :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Double #) @@ -193,11 +193,11 @@ unsafeIndexI a i = \s -> case js_unsafeIndexI a i s of (# s', v #) -> (# s', I# {-# INLINE unsafeIndexI #-} unsafeIndexI16 :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Int16 #) -unsafeIndexI16 a i = \s -> case js_unsafeIndexI a i s of (# s', v #) -> (# s', I16# v #) +unsafeIndexI16 a i = \s -> case js_unsafeIndexI a i s of (# s', v #) -> (# s', I16# (intToInt16# v) #) {-# INLINE unsafeIndexI16 #-} unsafeIndexI8 :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Int8 #) -unsafeIndexI8 a i = \s -> case js_unsafeIndexI a i s of (# s', v #) -> (# s', I8# v #) +unsafeIndexI8 a i = \s -> case js_unsafeIndexI a i s of (# s', v #) -> (# s', I8# (intToInt8# v) #) {-# INLINE unsafeIndexI8 #-} unsafeIndexW :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Word #) @@ -205,11 +205,11 @@ unsafeIndexW a i = \s -> case js_unsafeIndexW a i s of (# s', v #) -> (# s', W# {-# INLINE unsafeIndexW #-} unsafeIndexW16 :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Word16 #) -unsafeIndexW16 a i = \s -> case js_unsafeIndexW a i s of (# s', v #) -> (# s', W16# v #) +unsafeIndexW16 a i = \s -> case js_unsafeIndexW a i s of (# s', v #) -> (# s', W16# (wordToWord16# v) #) {-# INLINE unsafeIndexW16 #-} unsafeIndexW8 :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Word8 #) -unsafeIndexW8 a i = \s -> case js_unsafeIndexW a i s of (# s', v #) -> (# s', W8# v #) +unsafeIndexW8 a i = \s -> case js_unsafeIndexW a i s of (# s', v #) -> (# s', W8# (wordToWord8# v) #) {-# INLINE unsafeIndexW8 #-} unsafeIndexD :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Double #) diff --git a/JavaScript/TypedArray/ST.hs b/JavaScript/TypedArray/ST.hs index 6fbe27a..a34a660 100644 --- a/JavaScript/TypedArray/ST.hs +++ b/JavaScript/TypedArray/ST.hs @@ -24,7 +24,7 @@ import GHC.Word import GHCJS.Types import GHCJS.Buffer.Types -import GHCJS.Prim +import GHC.JS.Prim import GHCJS.Internal.Types import qualified Data.ByteString as B @@ -53,11 +53,11 @@ class STTypedArray s a where instance STTypedArray s (STInt8Array s) where index i a = ST (I.indexI8 i a) unsafeIndex i a = ST (I.unsafeIndexI8 i a) - setIndex i (I8# x) a = ST (I.setIndexI i x a) - unsafeSetIndex i (I8# x) a = ST (I.unsafeSetIndexI i x a) - indexOf s (I8# x) a = ST (I.indexOfI s x a) + setIndex i (I8# x) a = ST (I.setIndexI i (int8ToInt# x) a) + unsafeSetIndex i (I8# x) a = ST (I.unsafeSetIndexI i (int8ToInt# x) a) + indexOf s (I8# x) a = ST (I.indexOfI s (int8ToInt# x) a) fromBuffer = undefined - lastIndexOf s (I8# x) a = ST (I.lastIndexOfI s x a) + lastIndexOf s (I8# x) a = ST (I.lastIndexOfI s (int8ToInt# x) a) create l = ST (I.js_createInt8Array l) -- --------------------------------------------------------------------------- diff --git a/JavaScript/Web/WebSocket.hs b/JavaScript/Web/WebSocket.hs index b298b83..4f42aa8 100644 --- a/JavaScript/Web/WebSocket.hs +++ b/JavaScript/Web/WebSocket.hs @@ -27,7 +27,7 @@ module JavaScript.Web.WebSocket ( WebSocket ) where import GHCJS.Concurrent -import GHCJS.Prim +import GHC.JS.Prim import GHCJS.Foreign.Callback.Internal (Callback(..)) import qualified GHCJS.Foreign.Callback as CB diff --git a/JavaScript/Web/Worker.hs b/JavaScript/Web/Worker.hs index ef5f93d..f086023 100644 --- a/JavaScript/Web/Worker.hs +++ b/JavaScript/Web/Worker.hs @@ -6,7 +6,7 @@ module JavaScript.Web.Worker ( Worker , terminate ) where -import GHCJS.Prim +import GHC.JS.Prim import Data.JSString import Data.Typeable diff --git a/JavaScript/Web/XMLHttpRequest.hs b/JavaScript/Web/XMLHttpRequest.hs index 70a3f8e..f378107 100644 --- a/JavaScript/Web/XMLHttpRequest.hs +++ b/JavaScript/Web/XMLHttpRequest.hs @@ -22,7 +22,7 @@ import Control.Exception import Control.Monad import GHCJS.Types -import GHCJS.Prim +import GHC.JS.Prim import GHCJS.Marshal import GHCJS.Marshal.Pure import GHCJS.Internal.Types diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index 94b9cc5..cc61c3a 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -16,16 +16,16 @@ source-repository head library if impl(ghc >= 8.10.1) - js-sources: jsbits/array.js.pp - jsbits/animationFrame.js.pp - jsbits/export.js.pp - jsbits/jsstring.js.pp - jsbits/jsstringRaw.js.pp - jsbits/foreign.js.pp - jsbits/text.js.pp - jsbits/utils.js.pp - jsbits/xhr.js.pp - jsbits/websocket.js.pp + js-sources: jsbits/array.js + jsbits/animationFrame.js + jsbits/export.js + jsbits/jsstring.js + jsbits/jsstringRaw.js + jsbits/foreign.js + jsbits/text.js + jsbits/utils.js + jsbits/xhr.js + jsbits/websocket.js else js-sources: jsbits-old/array.js jsbits-old/animationFrame.js @@ -40,7 +40,7 @@ library other-extensions: DeriveDataTypeable DeriveGeneric ForeignFunctionInterface - JavaScriptFFI +-- JavaScriptFFI GHCForeignImportPrim MagicHash UnboxedTuples @@ -140,8 +140,6 @@ library JavaScript.TypedArray.DataView.Internal build-depends: base >= 4.7 && < 5, ghc-prim, - ghcjs-prim, - integer-gmp, binary >= 0.8 && < 0.11, bytestring >= 0.10 && < 0.11, text >= 1.1 && < 1.3, @@ -158,7 +156,7 @@ library deepseq >= 1.3 && < 1.5, dlist >= 0.7 && < 1.1 default-language: Haskell2010 - if !impl(ghcjs) && !os(ghcjs) + if !arch(javascript) buildable: False test-suite tests @@ -184,7 +182,6 @@ test-suite tests deepseq, directory, ghc-prim, - ghcjs-prim, ghcjs-base, primitive, quickcheck-unicode, @@ -193,5 +190,5 @@ test-suite tests test-framework-hunit >= 0.2, test-framework-quickcheck2 >= 0.2 default-language: Haskell2010 - if !impl(ghcjs) && !os(ghcjs) + if !arch(javascript) buildable: False diff --git a/jsbits/animationFrame.js.pp b/jsbits/animationFrame.js similarity index 96% rename from jsbits/animationFrame.js.pp rename to jsbits/animationFrame.js index 7a3e942..bac2d4c 100644 --- a/jsbits/animationFrame.js.pp +++ b/jsbits/animationFrame.js @@ -1,3 +1,4 @@ +//#OPTIONS: CPP function h$animationFrameCancel(h) { if(h.handle) window.cancelAnimationFrame(h.handle); if(h.callback) { diff --git a/jsbits/array.js.pp b/jsbits/array.js similarity index 97% rename from jsbits/array.js.pp rename to jsbits/array.js index 8230cdf..d179ead 100644 --- a/jsbits/array.js.pp +++ b/jsbits/array.js @@ -1,4 +1,4 @@ -#include +//#OPTIONS: CPP /* convert an array to a Haskell list, wrapping each element in a diff --git a/jsbits/export.js.pp b/jsbits/export.js similarity index 97% rename from jsbits/export.js.pp rename to jsbits/export.js index cc3043a..9ea6902 100644 --- a/jsbits/export.js.pp +++ b/jsbits/export.js @@ -1,3 +1,4 @@ +//#OPTIONS: CPP function h$exportValue(fp1a,fp1b,fp2a,fp2b,o) { var e = { fp1a: fp1a , fp1b: fp1b diff --git a/jsbits/foreign.js.pp b/jsbits/foreign.js similarity index 91% rename from jsbits/foreign.js.pp rename to jsbits/foreign.js index a4e4cf0..34cd7c6 100644 --- a/jsbits/foreign.js.pp +++ b/jsbits/foreign.js @@ -1,3 +1,4 @@ +//#OPTIONS: CPP function h$foreignListProps(o) { var r = HS_NIL; if(typeof o === 'undefined' || o === null) return null; diff --git a/jsbits/json.js.pp b/jsbits/json.js.pp deleted file mode 100644 index 15d2ee3..0000000 --- a/jsbits/json.js.pp +++ /dev/null @@ -1,4 +0,0 @@ -#include - - - diff --git a/jsbits/jsstring.js.pp b/jsbits/jsstring.js similarity index 99% rename from jsbits/jsstring.js.pp rename to jsbits/jsstring.js index e8a4ef9..d476ee8 100644 --- a/jsbits/jsstring.js.pp +++ b/jsbits/jsstring.js @@ -1,4 +1,4 @@ -#include +//#OPTIONS: CPP /* * Support code for the Data.JSString module. This code presents a JSString diff --git a/jsbits/jsstringRaw.js.pp b/jsbits/jsstringRaw.js similarity index 96% rename from jsbits/jsstringRaw.js.pp rename to jsbits/jsstringRaw.js index 4d31c3c..3a4e457 100644 --- a/jsbits/jsstringRaw.js.pp +++ b/jsbits/jsstringRaw.js @@ -1,4 +1,4 @@ -#include +//#OPTIONS: CPP /* * Functions that directly access JavaScript strings, ignoring character diff --git a/jsbits/object.js.pp b/jsbits/object.js.pp deleted file mode 100644 index 44e0ca3..0000000 --- a/jsbits/object.js.pp +++ /dev/null @@ -1,2 +0,0 @@ -// object manipulation - diff --git a/jsbits/text.js.pp b/jsbits/text.js similarity index 98% rename from jsbits/text.js.pp rename to jsbits/text.js index 7046d36..e55c952 100644 --- a/jsbits/text.js.pp +++ b/jsbits/text.js @@ -1,5 +1,5 @@ +//#OPTIONS: CPP // conversion between JavaScript string and Data.Text -#include /* diff --git a/jsbits/utils.js.pp b/jsbits/utils.js similarity index 98% rename from jsbits/utils.js.pp rename to jsbits/utils.js index 722b793..202c523 100644 --- a/jsbits/utils.js.pp +++ b/jsbits/utils.js @@ -1,4 +1,4 @@ -#include +//#OPTIONS: CPP function h$allProps(o) { var a = [], i = 0; diff --git a/jsbits/websocket.js.pp b/jsbits/websocket.js similarity index 98% rename from jsbits/websocket.js.pp rename to jsbits/websocket.js index 25df07b..fb0e0da 100644 --- a/jsbits/websocket.js.pp +++ b/jsbits/websocket.js @@ -1,4 +1,4 @@ -#include +//#OPTIONS: CPP function h$createWebSocket(url, protocols) { return new WebSocket(url, protocols); diff --git a/jsbits/xhr.js.pp b/jsbits/xhr.js similarity index 94% rename from jsbits/xhr.js.pp rename to jsbits/xhr.js index 419cfe7..7520f7d 100644 --- a/jsbits/xhr.js.pp +++ b/jsbits/xhr.js @@ -1,3 +1,4 @@ +//#OPTIONS: CPP function h$sendXHR(xhr, d, cont) { xhr.addEventListener('error', function () { cont(2); From 9770bc4b0a10b976b6aacee7c65acdea18d9c708 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Mon, 5 Jun 2023 12:29:01 +0000 Subject: [PATCH 02/53] Convert GHCJS foreign import syntax to GHC JavaScript backend syntax --- Data/JSString.hs | 26 +-- Data/JSString/Int.hs | 24 +-- Data/JSString/Internal/Fusion.hs | 6 +- Data/JSString/Internal/Search.hs | 2 +- Data/JSString/Internal/Type.hs | 2 +- Data/JSString/Raw.hs | 20 +- Data/JSString/Read.hs | 4 +- Data/JSString/RealFloat.hs | 8 +- Data/JSString/RegExp.hs | 10 +- Data/JSString/Text.hs | 2 +- GHCJS/Buffer.hs | 28 +-- GHCJS/Concurrent.hs | 8 +- GHCJS/Foreign/Export.hs | 2 +- GHCJS/Foreign/Internal.hs | 22 +-- GHCJS/Marshal.hs | 21 +- GHCJS/Marshal/Pure.hs | 32 +-- GHCJS/Types.hs | 6 +- JavaScript/Array/Internal.hs | 40 ++-- JavaScript/Cast.hs | 2 +- JavaScript/JSON/Types/Internal.hs | 28 +-- JavaScript/Object/Internal.hs | 12 +- JavaScript/TypedArray/ArrayBuffer/Internal.hs | 10 +- JavaScript/TypedArray/DataView/Internal.hs | 186 +++++++++--------- JavaScript/TypedArray/Internal.hs | 94 ++++----- JavaScript/Web/AnimationFrame.hs | 6 +- JavaScript/Web/Blob/Internal.hs | 10 +- JavaScript/Web/Canvas.hs | 97 +++++---- JavaScript/Web/Canvas/ImageData.hs | 6 +- JavaScript/Web/Canvas/TextMetrics.hs | 24 +-- JavaScript/Web/CloseEvent.hs | 6 +- JavaScript/Web/ErrorEvent.hs | 10 +- JavaScript/Web/File.hs | 4 +- JavaScript/Web/Location.hs | 52 ++--- JavaScript/Web/MessageEvent.hs | 5 +- JavaScript/Web/Performance.hs | 2 +- JavaScript/Web/Storage.hs | 16 +- JavaScript/Web/StorageEvent.hs | 10 +- JavaScript/Web/WebSocket.hs | 32 +-- JavaScript/Web/Worker.hs | 6 +- JavaScript/Web/XMLHttpRequest.hs | 32 +-- 40 files changed, 459 insertions(+), 454 deletions(-) diff --git a/Data/JSString.hs b/Data/JSString.hs index 821b6b6..4c5359e 100644 --- a/Data/JSString.hs +++ b/Data/JSString.hs @@ -1815,16 +1815,16 @@ charWidth cp | isTrue# (cp >=# 0x10000#) = 2# -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "h$jsstringPack($1)" js_pack :: Exts.Any -> JSString + "h$jsstringPack" js_pack :: Exts.Any -> JSString foreign import javascript unsafe - "$1===''" js_null :: JSString -> Bool + "((x) => { return x === ''; })" js_null :: JSString -> Bool foreign import javascript unsafe - "$1===null" js_isNull :: JSVal -> Bool + "((x) => { return x === null; })" js_isNull :: JSVal -> Bool foreign import javascript unsafe - "$1===$2" js_eq :: JSString -> JSString -> Bool + "((x,y) => { return x === y; })" js_eq :: JSString -> JSString -> Bool foreign import javascript unsafe -- "h$jsstringAppend" js_append :: JSString -> JSString -> JSString -- debug - "$1+$2" js_append :: JSString -> JSString -> JSString + "((x,y) => { return x + y; })" js_append :: JSString -> JSString -> JSString foreign import javascript unsafe "h$jsstringCompare" js_compare :: JSString -> JSString -> Int# -- "($1<$2)?-1:(($1>$2)?1:0)" js_compare :: JSString -> JSString -> Int# @@ -1841,15 +1841,15 @@ foreign import javascript unsafe foreign import javascript unsafe "h$jsstringUnsnoc" js_unsnoc :: JSString -> (# Int#, JSString #) foreign import javascript unsafe - "$3.substr($1,$2)" js_substr :: Int# -> Int# -> JSString -> JSString + "((x,y,z) => { return z.substr(x,y); })" js_substr :: Int# -> Int# -> JSString -> JSString foreign import javascript unsafe - "$2.substr($1)" js_substr1 :: Int# -> JSString -> JSString + "((x,y) => { return y.substr(x); })" js_substr1 :: Int# -> JSString -> JSString foreign import javascript unsafe - "$3.substring($1,$2)" js_substring :: Int# -> Int# -> JSString -> JSString + "((x,y,z) => { return z.substring(x,y); })" js_substring :: Int# -> Int# -> JSString -> JSString foreign import javascript unsafe - "$1.length" js_length :: JSString -> Int# + "((x) => { return x.length; })" js_length :: JSString -> Int# foreign import javascript unsafe - "(($2.charCodeAt($1)|1023)===0xDBFF)?2:1" js_charWidthAt + "((x,y) => { return ((y.charCodeAt(x)|1023)===0xDBFF)?2:1; })" js_charWidthAt :: Int# -> JSString -> Int# foreign import javascript unsafe "h$jsstringIndex" js_index :: Int# -> JSString -> Int# @@ -1951,7 +1951,7 @@ foreign import javascript unsafe foreign import javascript unsafe "h$jsstringReplicateChar" js_replicateChar :: Int -> Char -> JSString foreign import javascript unsafe - "var l=$1.length; $r=l==1||(l==2&&($1.charCodeAt(0)|1023)==0xDFFF);" + "((x) => { var l = x.length; return l==1 || (l==2 && (x.charCodeAt(0)|1023) == 0xDFFF); })" js_isSingleton :: JSString -> Bool foreign import javascript unsafe "h$jsstringIntersperse" @@ -1960,6 +1960,6 @@ foreign import javascript unsafe "h$jsstringIntercalate" js_intercalate :: JSString -> Exts.Any {- [JSString] -} -> JSString foreign import javascript unsafe - "$1.toUpperCase()" js_toUpper :: JSString -> JSString + "((x) => { return x.toUpperCase(); })" js_toUpper :: JSString -> JSString foreign import javascript unsafe - "$1.toLowerCase()" js_toLower :: JSString -> JSString + "((x) => { return x.toLowerCase(); })" js_toLower :: JSString -> JSString diff --git a/Data/JSString/Int.hs b/Data/JSString/Int.hs index 844a6f2..eca7fb3 100644 --- a/Data/JSString/Int.hs +++ b/Data/JSString/Int.hs @@ -211,50 +211,50 @@ hexErrMsg = "Data.JSString.Int.hexadecimal: applied to negative number" -- ---------------------------------------------------------------------------- foreign import javascript unsafe - "''+$1" + "((x) => { return '' + x; })" js_decI :: Int# -> JSString foreign import javascript unsafe "h$jsstringDecI64" js_decI64 :: Int64# -> JSString foreign import javascript unsafe - "''+$1" + "((x) => { return '' + x; })" js_decW :: Word# -> JSString foreign import javascript unsafe - "''+(($1>=0)?$1:($1+4294967296))" + "((x) => { return ''+((x>=0)?x:(x+4294967296)); })" js_decW32 :: Word# -> JSString foreign import javascript unsafe - "h$jsstringDecW64($1_1, $1_2)" + "h$jsstringDecW64" js_decW64 :: Word64# -> JSString foreign import javascript unsafe - "h$jsstringDecInteger($1)" + "h$jsstringDecInteger" js_decInteger :: Any -> JSString -- these are expected to be only applied to nonnegative integers foreign import javascript unsafe - "$1.toString(16)" + "((x) => { return x.toString(16); })" js_hexI :: Int# -> JSString foreign import javascript unsafe "h$jsstringHexI64" js_hexI64 :: Int64# -> JSString foreign import javascript unsafe - "$1.toString(16)" + "((x) => { return x.toString(16); })" js_hexW :: Word# -> JSString foreign import javascript unsafe - "(($1>=0)?$1:($1+4294967296)).toString(16)" + "((x) => { return ((x>=0)?x:(x+4294967296)).toString(16); })" js_hexW32 :: Word32# -> JSString foreign import javascript unsafe - "h$jsstringHexW64($1_1, $1_2)" + "h$jsstringHexW64" js_hexW64 :: Word64# -> JSString foreign import javascript unsafe - "h$jsstringHexInteger($1)" + "h$jsstringHexInteger)" js_hexInteger :: Any -> JSString foreign import javascript unsafe - "'-'+$1+(-$2)" + "((x,y) => { return '-'+x+(-y); })" js_minusDigit :: JSString -> Int# -> JSString foreign import javascript unsafe - "'-'+$1" + "((x) => { return '-'+x; })" js_minus :: JSString -> JSString -- diff --git a/Data/JSString/Internal/Fusion.hs b/Data/JSString/Internal/Fusion.hs index c7578e3..6c955ee 100644 --- a/Data/JSString/Internal/Fusion.hs +++ b/Data/JSString/Internal/Fusion.hs @@ -183,11 +183,11 @@ foreign import javascript unsafe foreign import javascript unsafe "h$jsstringIndexR" js_indexR :: Int -> JSString -> Int# foreign import javascript unsafe - "$1.length" js_length :: JSString -> Int# + "((x) => { return x.length; })" js_length :: JSString -> Int# foreign import javascript unsafe - "$r = [$1];" js_newSingletonArray :: Char -> IO JSVal + "((x) => { return [$1]; })" js_newSingletonArray :: Char -> IO JSVal foreign import javascript unsafe - "$3[$2] = $1;" js_writeArray :: Char -> Int -> JSVal -> IO () + "((x,y,z) => z[y] = x; })" js_writeArray :: Char -> Int -> JSVal -> IO () foreign import javascript unsafe "h$jsstringPackArray" js_packString :: JSVal -> IO JSString foreign import javascript unsafe diff --git a/Data/JSString/Internal/Search.hs b/Data/JSString/Internal/Search.hs index 45d4139..a7e6ac9 100644 --- a/Data/JSString/Internal/Search.hs +++ b/Data/JSString/Internal/Search.hs @@ -18,5 +18,5 @@ indices needle haystack = go 0# n -> I# n : go (n +# 1#) foreign import javascript unsafe - "$3.indexOf($1,$2)" + "((x,y,z) => { return z.indexOf(x,y); })" js_indexOf :: JSString -> Int# -> JSString -> Int# diff --git a/Data/JSString/Internal/Type.hs b/Data/JSString/Internal/Type.hs index 0f1c611..be180fb 100644 --- a/Data/JSString/Internal/Type.hs +++ b/Data/JSString/Internal/Type.hs @@ -47,7 +47,7 @@ instance IsJSVal JSString instance NFData JSString where rnf !x = () foreign import javascript unsafe - "$r = '';" js_empty :: JSString + "(() => return ''; })" js_empty :: JSString -- | /O(1)/ The empty 'JSString'. empty :: JSString diff --git a/Data/JSString/Raw.hs b/Data/JSString/Raw.hs index 7c9c9d8..6108cb8 100644 --- a/Data/JSString/Raw.hs +++ b/Data/JSString/Raw.hs @@ -127,25 +127,25 @@ overflowError fun = error $ "Data.JSString.Raw." ++ fun ++ ": size overflow" -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1===''" js_null :: JSString -> Bool + "((x) => { return x===''; })" js_null :: JSString -> Bool foreign import javascript unsafe - "$1.length" js_length :: JSString -> Int# + "((x) => { return x.length; })" js_length :: JSString -> Int# foreign import javascript unsafe - "$3.substr($1,$2)" js_substr :: Int# -> Int# -> JSString -> JSString + "((x,y,z) => { return z.substr(x,y); })" js_substr :: Int# -> Int# -> JSString -> JSString foreign import javascript unsafe - "$2.substr($1)" js_substr1 :: Int# -> JSString -> JSString + "((x,y) => { return y.substr(x); })" js_substr1 :: Int# -> JSString -> JSString foreign import javascript unsafe - "$3.slice($1,$2)" js_slice :: Int# -> Int# -> JSString -> JSString + "((x,y,z) => { return z.slice(x,y); })" js_slice :: Int# -> Int# -> JSString -> JSString foreign import javascript unsafe - "$2.slice($1)" js_slice1 :: Int# -> JSString -> JSString + "((x,y) => { return y.slice(x); })" js_slice1 :: Int# -> JSString -> JSString foreign import javascript unsafe - "$3.indexOf($1,$2)" js_indexOf :: JSString -> Int# -> JSString -> Int# + "((x,y,z) => { return z.indexOf(x,y); })" js_indexOf :: JSString -> Int# -> JSString -> Int# foreign import javascript unsafe - "$2.indexOf($1)" js_indexOf1 :: JSString -> JSString -> Int# + "((x,y) => { return y.indexOf(x); })" js_indexOf1 :: JSString -> JSString -> Int# foreign import javascript unsafe - "$2.charCodeAt($1)" js_charCodeAt :: Int# -> JSString -> Int# + "((x,y) => { return y.charCodeAt(x); })" js_charCodeAt :: Int# -> JSString -> Int# foreign import javascript unsafe - "$2.codePointAt($1)" js_codePointAt :: Int# -> JSString -> Int# + "((x,y) => { return y.codePointAt(x); })" js_codePointAt :: Int# -> JSString -> Int# foreign import javascript unsafe "$hsRawChunksOf" js_rawChunksOf :: Int# -> JSString -> Exts.Any -- [JSString] foreign import javascript unsafe diff --git a/Data/JSString/Read.hs b/Data/JSString/Read.hs index 2dbbd03..c809619 100644 --- a/Data/JSString/Read.hs +++ b/Data/JSString/Read.hs @@ -150,9 +150,9 @@ readError xs = error ("Data.JSString.Read." ++ xs) -- ---------------------------------------------------------------------------- foreign import javascript unsafe - "$r = $1===null;" js_isNull :: JSVal -> Bool + "((x) => { return x===null; })" js_isNull :: JSVal -> Bool foreign import javascript unsafe - "$r=$1;" js_toHeapObject :: JSVal -> Any + "((x) => { return x; })" js_toHeapObject :: JSVal -> Any foreign import javascript unsafe "h$jsstringReadInteger" js_readInteger :: JSString -> JSVal foreign import javascript unsafe diff --git a/Data/JSString/RealFloat.hs b/Data/JSString/RealFloat.hs index 97070f5..cf44579 100644 --- a/Data/JSString/RealFloat.hs +++ b/Data/JSString/RealFloat.hs @@ -85,15 +85,15 @@ foreign import javascript unsafe js_floatToFixed :: Int# -> Float# -> JSString foreign import javascript unsafe - "h$jsstringDoubleToExponent($1,$2)" + "h$jsstringDoubleToExponent" js_doubleToExponent :: Int# -> Double# -> JSString foreign import javascript unsafe - "h$jsstringDoubleToExponent($1,$2)" + "h$jsstringDoubleToExponent" js_floatToExponent :: Int# -> Float# -> JSString foreign import javascript unsafe - "h$jsstringDoubleGeneric($1,$2)" + "h$jsstringDoubleGeneric" js_doubleGeneric :: Int# -> Double# -> JSString foreign import javascript unsafe - "h$jsstringDoubleGeneric($1,$2)" + "h$jsstringDoubleGeneric" js_floatGeneric :: Int# -> Float# -> JSString diff --git a/Data/JSString/RegExp.hs b/Data/JSString/RegExp.hs index 2b98f73..48f620f 100644 --- a/Data/JSString/RegExp.hs +++ b/Data/JSString/RegExp.hs @@ -94,9 +94,9 @@ splitN (I# k) x r = unsafeCoerce (js_split k x r) -- ---------------------------------------------------------------------------- foreign import javascript unsafe - "new RegExp($1,$2)" js_createRE :: JSString -> JSString -> RegExp + "((x,y) => { return new RegExp(x,y); })" js_createRE :: JSString -> JSString -> RegExp foreign import javascript unsafe - "$2.test($1)" js_test :: JSString -> RegExp -> Bool + "((x,y) => { return y.test(x); })" js_test :: JSString -> RegExp -> Bool foreign import javascript unsafe "h$jsstringExecRE" js_exec :: Int# -> JSString -> RegExp -> (# Int#, JSString, Any {- [JSString] -} #) @@ -105,9 +105,9 @@ foreign import javascript unsafe foreign import javascript unsafe "h$jsstringSplitRE" js_split :: Int# -> JSString -> RegExp -> Any -- [JSString] foreign import javascript unsafe - "$1.multiline" js_isMultiline :: RegExp -> Bool + "((x) => { return x.multiline; })" js_isMultiline :: RegExp -> Bool foreign import javascript unsafe - "$1.ignoreCase" js_isIgnoreCase :: RegExp -> Bool + "((x) => { return x.ignoreCase; })" js_isIgnoreCase :: RegExp -> Bool foreign import javascript unsafe - "$1.pattern" js_pattern :: RegExp -> JSString + "((x) => { return x.pattern; })" js_pattern :: RegExp -> JSString diff --git a/Data/JSString/Text.hs b/Data/JSString/Text.hs index 1d0c858..5d7d500 100644 --- a/Data/JSString/Text.hs +++ b/Data/JSString/Text.hs @@ -65,7 +65,7 @@ lazyTextFromJSVal = TL.fromStrict . textFromJSVal -- ---------------------------------------------------------------------------- foreign import javascript unsafe - "h$textToString($1,$2,$3)" + "h$textToString" js_toString :: ByteArray# -> Int# -> Int# -> JSString foreign import javascript unsafe "h$textFromString" diff --git a/GHCJS/Buffer.hs b/GHCJS/Buffer.hs index 8e11b46..a4b83b2 100644 --- a/GHCJS/Buffer.hs +++ b/GHCJS/Buffer.hs @@ -194,35 +194,35 @@ foreign import javascript unsafe "h$wrapBuffer($1.buf.slice($1.u8.byteOffset, $1.len))" js_clone :: SomeBuffer any1 -> IO (SomeBuffer any2) foreign import javascript unsafe - "$1.len" js_byteLength :: SomeBuffer any -> Int + "((x) => { return x.len; })" js_byteLength :: SomeBuffer any -> Int foreign import javascript unsafe - "$1.buf" js_getArrayBuffer :: SomeBuffer any -> SomeArrayBuffer any + "((x) => { return x.buf; })" js_getArrayBuffer :: SomeBuffer any -> SomeArrayBuffer any foreign import javascript unsafe - "$1.i3" js_getInt32Array :: SomeBuffer any -> I.SomeInt32Array any + "((x) => { return x.i3; })" js_getInt32Array :: SomeBuffer any -> I.SomeInt32Array any foreign import javascript unsafe - "$1.u8" js_getUint8Array :: SomeBuffer any -> I.SomeUint8Array any + "((x) => { return x.u8; })" js_getUint8Array :: SomeBuffer any -> I.SomeUint8Array any foreign import javascript unsafe - "$1.u1" js_getUint16Array :: SomeBuffer any -> I.SomeUint16Array any + "((x) => { return x.u1; })" js_getUint16Array :: SomeBuffer any -> I.SomeUint16Array any foreign import javascript unsafe - "$1.f3" js_getFloat32Array :: SomeBuffer any -> I.SomeFloat32Array any + "((x) => { return x.f3; })" js_getFloat32Array :: SomeBuffer any -> I.SomeFloat32Array any foreign import javascript unsafe - "$1.f6" js_getFloat64Array :: SomeBuffer any -> I.SomeFloat64Array any + "((x) => { return x.f6; })" js_getFloat64Array :: SomeBuffer any -> I.SomeFloat64Array any foreign import javascript unsafe - "$1.dv" js_getDataView :: SomeBuffer any -> SomeDataView any + "((x) => { return x.dv; })" js_getDataView :: SomeBuffer any -> SomeDataView any -- ---------------------------------------------------------------------------- -- these things have the same representation (modulo boxing), -- conversion is free foreign import javascript unsafe - "$r = $1;" js_toByteArray :: SomeBuffer any -> ByteArray# + "((x) => { return x; })" js_toByteArray :: SomeBuffer any -> ByteArray# foreign import javascript unsafe - "$r = $1;" js_fromByteArray :: ByteArray# -> JSVal + "((x) => { return x; })" js_fromByteArray :: ByteArray# -> JSVal foreign import javascript unsafe - "$r = $1;" js_fromMutableByteArray :: MutableByteArray# s -> JSVal + "((x) => { return x; })" js_fromMutableByteArray :: MutableByteArray# s -> JSVal foreign import javascript unsafe - "$r = $1;" js_toMutableByteArray :: JSVal -> MutableByteArray# s + "((x) => { return x; })" js_toMutableByteArray :: JSVal -> MutableByteArray# s foreign import javascript unsafe - "$r1 = $1; $r2 = 0;" js_toAddr :: SomeBuffer any -> Addr# + "((x,y) => { RETURN_UBX_TUP2(x,y); })" js_toAddr :: SomeBuffer any -> Addr# foreign import javascript unsafe - "$r = $1;" js_fromAddr :: Addr# -> SomeBuffer any + "((x) => { return x; })" js_fromAddr :: Addr# -> SomeBuffer any diff --git a/GHCJS/Concurrent.hs b/GHCJS/Concurrent.hs index 80b2a18..9f113eb 100644 --- a/GHCJS/Concurrent.hs +++ b/GHCJS/Concurrent.hs @@ -118,15 +118,13 @@ syncThreadState (ThreadId tid) = js_syncThreadState tid -- ---------------------------------------------------------------------------- -foreign import javascript unsafe "h$syncThreadState($1)" +foreign import javascript unsafe "h$syncThreadState" js_syncThreadState :: ThreadId# -> IO Int foreign import javascript unsafe - "$r = h$currentThread.noPreemption;\ - \h$currentThread.noPreemption = $1;" + "((x) => { var r = h$currentThread.noPreemption; h$currentThread.noPreemption = x; return r; })" js_setNoPreemption :: Bool -> IO Bool; foreign import javascript unsafe - "$r = h$currentThread.isSynchronous;\ - \h$currentThread.isSynchronous = $1;" + "((x) => { var r = h$currentThread.isSynchronous; h$currentThread.isSynchronous = x; return r; })" js_setSynchronous :: Bool -> IO Bool diff --git a/GHCJS/Foreign/Export.hs b/GHCJS/Foreign/Export.hs index 31de434..4f42483 100644 --- a/GHCJS/Foreign/Export.hs +++ b/GHCJS/Foreign/Export.hs @@ -84,7 +84,7 @@ foreign import javascript unsafe "h$derefExport" js_derefExport :: Word64 -> Word64 -> Export a -> IO JSVal foreign import javascript unsafe - "$r = $1;" js_toHeapObject :: JSVal -> IO Any + "((x) => { return x; })" js_toHeapObject :: JSVal -> IO Any foreign import javascript unsafe "h$releaseExport" js_releaseExport :: Export a -> IO () diff --git a/GHCJS/Foreign/Internal.hs b/GHCJS/Foreign/Internal.hs index 8196ec6..ed8d648 100644 --- a/GHCJS/Foreign/Internal.hs +++ b/GHCJS/Foreign/Internal.hs @@ -317,7 +317,7 @@ mutableByteArrayJSVal :: MutableByteArray# s -> JSVal a mutableByteArrayJSVal a = unsafeCoerce (MutableByteArray a) {-# INLINE mutableByteArrayJSVal #-} -foreign import javascript safe "h$wrapBuffer($3, true, $1, $2)" +foreign import javascript safe "((x,y,z) => { return h$wrapBuffer(z, true, x, y); })" js_wrapBuffer :: Int -> Int -> JSVal a -> IO (JSVal ()) {- | Convert an ArrayBuffer to a strict 'ByteString' @@ -368,15 +368,15 @@ unsafeMutableByteArrayByteString arr = -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$r = $1===true;" + "((x) => { return x===true; })" js_fromBool :: JSVal -> Bool foreign import javascript unsafe - "$1 ? true : false" + "((x) => { return x ? true : false; })" js_isTruthy :: JSVal -> Bool -foreign import javascript unsafe "$r = true;" js_true :: Int# -> Ref# -foreign import javascript unsafe "$r = false;" js_false :: Int# -> Ref# -foreign import javascript unsafe "$r = null;" js_null :: Int# -> Ref# -foreign import javascript unsafe "$r = undefined;" js_undefined :: Int# -> Ref# +foreign import javascript unsafe "((x) => { return true; })" js_true :: Int# -> Ref# +foreign import javascript unsafe "((x) => { return false; })" js_false :: Int# -> Ref# +foreign import javascript unsafe "((x) => { return null; })" js_null :: Int# -> Ref# +foreign import javascript unsafe "((x) => { return undefined; })" js_undefined :: Int# -> Ref# -- foreign import javascript unsafe "$r = [];" js_emptyArray :: IO (JSArray a) -- foreign import javascript unsafe "$r = {};" js_emptyObj :: IO (JSVal a) --foreign import javascript unsafe "$3[$1] = $2;" @@ -390,17 +390,17 @@ foreign import javascript unsafe "$r = undefined;" js_undefined :: Int# -> Ref# -- js_index :: Int -> JSArray a -> IO (JSVal a) --foreign import javascript unsafe "$2[$1]" -- js_unsafeIndex :: Int -> JSArray a -> IO (JSVal a) -foreign import javascript unsafe "$2[$1]" +foreign import javascript unsafe "((x,y) => { return y[x]; })" js_unsafeGetProp :: JSString -> JSVal -> IO JSVal -foreign import javascript unsafe "$3[$1] = $2" +foreign import javascript unsafe "((x,y,z) => { return z[x] = y; })" js_unsafeSetProp :: JSString -> JSVal -> JSVal -> IO () {- foreign import javascript safe "h$listProps($1)" js_listProps :: JSVal a -> IO (JSArray JSString) -} -foreign import javascript unsafe "h$jsTypeOf($1)" +foreign import javascript unsafe "h$jsTypeOf" js_jsTypeOf :: JSVal -> Int# -foreign import javascript unsafe "h$jsonTypeOf($1)" +foreign import javascript unsafe "h$jsonTypeOf" js_jsonTypeOf :: JSVal -> Int# -- foreign import javascript unsafe "h$listToArray" -- js_toArray :: Any -> IO (JSArray a) diff --git a/GHCJS/Marshal.hs b/GHCJS/Marshal.hs index 44051fe..6c17668 100644 --- a/GHCJS/Marshal.hs +++ b/GHCJS/Marshal.hs @@ -286,13 +286,20 @@ instance (ToJSVal a, ToJSVal b, ToJSVal c, ToJSVal d, ToJSVal e, ToJSVal f, ToJS toJSVal (a,b,c,d,e,f,g) = join $ arr7 <$> toJSVal a <*> toJSVal b <*> toJSVal c <*> toJSVal d <*> toJSVal e <*> toJSVal f <*> toJSVal g {-# INLINE toJSVal #-} -foreign import javascript unsafe "[$1]" arr1 :: JSVal -> IO JSVal -foreign import javascript unsafe "[$1,$2]" arr2 :: JSVal -> JSVal -> IO JSVal -foreign import javascript unsafe "[$1,$2,$3]" arr3 :: JSVal -> JSVal -> JSVal -> IO JSVal -foreign import javascript unsafe "[$1,$2,$3,$4]" arr4 :: JSVal -> JSVal -> JSVal -> JSVal -> IO JSVal -foreign import javascript unsafe "[$1,$2,$3,$4,$5]" arr5 :: JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> IO JSVal -foreign import javascript unsafe "[$1,$2,$3,$4,$5,$6]" arr6 :: JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> IO JSVal -foreign import javascript unsafe "[$1,$2,$3,$4,$5,$6,$7]" arr7 :: JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> IO JSVal +foreign import javascript unsafe "(($1) => { return [$1]; })" + arr1 :: JSVal -> IO JSVal +foreign import javascript unsafe "(($1,$2) => { return [$1,$2]; })" + arr2 :: JSVal -> JSVal -> IO JSVal +foreign import javascript unsafe "(($1,$2,$3) => { return [$1,$2,$3]; })" + arr3 :: JSVal -> JSVal -> JSVal -> IO JSVal +foreign import javascript unsafe "(($1,$2,$3,$4) => { return [$1,$2,$3,$4]; })" + arr4 :: JSVal -> JSVal -> JSVal -> JSVal -> IO JSVal +foreign import javascript unsafe "(($1,$2,$3,$4,$5) => { return [$1,$2,$3,$4,$5]; })" + arr5 :: JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> IO JSVal +foreign import javascript unsafe "(($1,$2,$3,$4,$5,$6) => { return [$1,$2,$3,$4,$5,$6]; })" + arr6 :: JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> IO JSVal +foreign import javascript unsafe "(($1,$2,$3,$4,$5,$6,$7) => { return [$1,$2,$3,$4,$5,$6,$7]; })" + arr7 :: JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> JSVal -> IO JSVal toJSVal_aeson :: AE.ToJSON a => a -> IO JSVal toJSVal_aeson x = cv (AE.toJSON x) diff --git a/GHCJS/Marshal/Pure.hs b/GHCJS/Marshal/Pure.hs index 17cb26c..552f36c 100644 --- a/GHCJS/Marshal/Pure.hs +++ b/GHCJS/Marshal/Pure.hs @@ -136,21 +136,21 @@ instance PToJSVal a => PToJSVal (Maybe a) where pToJSVal (Just a) = pToJSVal a {-# INLINE pToJSVal #-} -foreign import javascript unsafe "$r = $1|0;" jsvalToWord :: JSVal -> Word# -foreign import javascript unsafe "$r = $1&0xff;" jsvalToWord8 :: JSVal -> Word8# -foreign import javascript unsafe "$r = $1&0xffff;" jsvalToWord16 :: JSVal -> Word16# -foreign import javascript unsafe "$r = $1|0;" jsvalToWord32 :: JSVal -> Word32# -foreign import javascript unsafe "$r = $1|0;" jsvalToInt :: JSVal -> Int# -foreign import javascript unsafe "$r = $1<<24>>24;" jsvalToInt8 :: JSVal -> Int8# -foreign import javascript unsafe "$r = $1<<16>>16;" jsvalToInt16 :: JSVal -> Int16# -foreign import javascript unsafe "$r = $1|0;" jsvalToInt32 :: JSVal -> Int32# -foreign import javascript unsafe "$r = +$1;" jsvalToFloat :: JSVal -> Float# -foreign import javascript unsafe "$r = +$1;" jsvalToDouble :: JSVal -> Double# -foreign import javascript unsafe "$r = $1&0x7fffffff;" jsvalToChar :: JSVal -> Char# +foreign import javascript unsafe "((x) => { return x|0; })" jsvalToWord :: JSVal -> Word# +foreign import javascript unsafe "((x) => { return x&0xff; })" jsvalToWord8 :: JSVal -> Word8# +foreign import javascript unsafe "((x) => { return x&0xffff; })" jsvalToWord16 :: JSVal -> Word16# +foreign import javascript unsafe "((x) => { return x|0; })" jsvalToWord32 :: JSVal -> Word32# +foreign import javascript unsafe "((x) => { return x|0; })" jsvalToInt :: JSVal -> Int# +foreign import javascript unsafe "((x) => { return x<<24>>24; })" jsvalToInt8 :: JSVal -> Int8# +foreign import javascript unsafe "((x) => { return x<<16>>16; })" jsvalToInt16 :: JSVal -> Int16# +foreign import javascript unsafe "((x) => { return x|0; })" jsvalToInt32 :: JSVal -> Int32# +foreign import javascript unsafe "((x) => { return +x; })" jsvalToFloat :: JSVal -> Float# +foreign import javascript unsafe "((x) => { return +x; })" jsvalToDouble :: JSVal -> Double# +foreign import javascript unsafe "((x) => { return x&0x7fffffff; })" jsvalToChar :: JSVal -> Char# -foreign import javascript unsafe "$r = $1;" wordToJSVal :: Word# -> JSVal -foreign import javascript unsafe "$r = $1;" intToJSVal :: Int# -> JSVal -foreign import javascript unsafe "$r = $1;" doubleToJSVal :: Double# -> JSVal -foreign import javascript unsafe "$r = $1;" floatToJSVal :: Float# -> JSVal -foreign import javascript unsafe "$r = $1;" charToJSVal :: Char# -> JSVal +foreign import javascript unsafe "((x) => { return x; })" wordToJSVal :: Word# -> JSVal +foreign import javascript unsafe "((x) => { return x; })" intToJSVal :: Int# -> JSVal +foreign import javascript unsafe "((x) => { return x; })" doubleToJSVal :: Double# -> JSVal +foreign import javascript unsafe "((x) => { return x; })" floatToJSVal :: Float# -> JSVal +foreign import javascript unsafe "((x) => { return x; })" charToJSVal :: Char# -> JSVal diff --git a/GHCJS/Types.hs b/GHCJS/Types.hs index 6ac7ab4..89a826a 100644 --- a/GHCJS/Types.hs +++ b/GHCJS/Types.hs @@ -50,13 +50,13 @@ fromPtr :: Ptr a -> JSVal fromPtr p = js_ptrVal p {-# INLINE fromPtr #-} -foreign import javascript unsafe "$r = null;" +foreign import javascript unsafe "((x) => { return null; })" js_nullRef :: JSVal -foreign import javascript unsafe "$r = $1_1;" +foreign import javascript unsafe "((x,y) => { return x; })" js_ptrVal :: Ptr a -> JSVal -foreign import javascript unsafe "$r1 = $1; $r2 = 0;" +foreign import javascript unsafe "((x) => { RETURN_UBX_TUP2(x,0); })" js_mkPtr :: JSVal -> Ptr a -- | This is a deprecated copmatibility wrapper for the old JSRef type. diff --git a/JavaScript/Array/Internal.hs b/JavaScript/Array/Internal.hs index 3964feb..8e1cfd7 100644 --- a/JavaScript/Array/Internal.hs +++ b/JavaScript/Array/Internal.hs @@ -140,54 +140,54 @@ unsafeThaw (SomeJSArray x) = pure (SomeJSArray x) -- ----------------------------------------------------------------------------- -foreign import javascript unsafe "$r = [];" +foreign import javascript unsafe "((x) => { return []; })" js_create :: State# s -> (# State# s, SomeJSArray m #) -foreign import javascript unsafe "$1.length" +foreign import javascript unsafe "((x) => { return x.length; })" js_length :: SomeJSArray m -> State# s -> (# State# s, Int #) -foreign import javascript unsafe "$2[$1]" +foreign import javascript unsafe "((x,y) => { return y[x]; })" js_index :: Int -> SomeJSArray m -> State# s -> (# State# s, JSVal #) -foreign import javascript unsafe "$2[$1]" +foreign import javascript unsafe "((x,y) => { return y[x]; })" js_indexPure :: Int -> JSArray -> JSVal -foreign import javascript unsafe "$1.length" +foreign import javascript unsafe "((x) => { x.length; })" js_lengthPure :: JSArray -> Int -foreign import javascript unsafe "$3[$1] = $2" +foreign import javascript unsafe "((x,y,z) => { z[x] = y; })" js_setIndex :: Int -> JSVal -> SomeJSArray m -> State# s -> (# State# s, () #) -foreign import javascript unsafe "$3.slice($1,$2)" +foreign import javascript unsafe "((x,y,z) => { return z.slice(x,y); })" js_slice :: Int -> Int -> SomeJSArray m -> State# s -> (# State# s, SomeJSArray m1 #) -foreign import javascript unsafe "$2.slice($1)" +foreign import javascript unsafe "((x,y) => { return y.slice(x); })" js_slice1 :: Int -> SomeJSArray m -> State# s -> (# State# s, SomeJSArray m1 #) -foreign import javascript unsafe "$3.slice($1,2)" +foreign import javascript unsafe "((x,y,z) => { return z.slice(x,y); })" js_slicePure :: Int -> Int -> JSArray -> JSArray -foreign import javascript unsafe "$2.slice($1)" +foreign import javascript unsafe "((x,y) => { return y.slice(x); })" js_slice1Pure :: Int -> JSArray -> JSArray -foreign import javascript unsafe "$1.concat($2)" +foreign import javascript unsafe "((x,y) => { return x.concat(y); })" js_append :: SomeJSArray m0 -> SomeJSArray m1 -> State# s -> (# State# s, SomeJSArray m2 #) -foreign import javascript unsafe "$2.push($1)" +foreign import javascript unsafe "((x,y) => { y.push(x); })" js_push :: JSVal -> SomeJSArray m -> State# s -> (# State# s, () #) -foreign import javascript unsafe "$1.pop()" +foreign import javascript unsafe "((x) => { return x.pop(); })" js_pop :: SomeJSArray m -> State# s -> (# State# s, JSVal #) -foreign import javascript unsafe "$2.unshift($1)" +foreign import javascript unsafe "((x,y) => { y.unshift(x); })" js_unshift :: JSVal -> SomeJSArray m -> State# s -> (# State# s, () #) -foreign import javascript unsafe "$1.shift()" +foreign import javascript unsafe "((x) => { return x.shift(); })" js_shift :: SomeJSArray m -> State# s -> (# State# s, JSVal #) -foreign import javascript unsafe "$1.reverse()" +foreign import javascript unsafe "((x) => { x.reverse(); })" js_reverse :: SomeJSArray m -> State# s -> (# State# s, () #) -foreign import javascript unsafe "h$toHsListJSVal($1)" +foreign import javascript unsafe "h$toHsListJSVal)" js_fromJSArray :: SomeJSArray m -> State# s -> (# State# s, Exts.Any #) -foreign import javascript unsafe "h$toHsListJSVal($1)" +foreign import javascript unsafe "h$toHsListJSVal" js_fromJSArrayPure :: JSArray -> Exts.Any -- [JSVal] -foreign import javascript unsafe "h$fromHsListJSVal($1)" +foreign import javascript unsafe "h$fromHsListJSVal" js_toJSArray :: Exts.Any -> State# s -> (# State# s, SomeJSArray m #) -foreign import javascript unsafe "h$fromHsListJSVal($1)" +foreign import javascript unsafe "h$fromHsListJSVal" js_toJSArrayPure :: Exts.Any -> JSArray diff --git a/JavaScript/Cast.hs b/JavaScript/Cast.hs index 9282278..9b96e00 100644 --- a/JavaScript/Cast.hs +++ b/JavaScript/Cast.hs @@ -23,4 +23,4 @@ class Cast a where -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1 instanceof $2" js_checkCast :: JSVal -> JSVal -> Bool + "((x,y) => { return x instanceof y; })" js_checkCast :: JSVal -> JSVal -> Bool diff --git a/JavaScript/JSON/Types/Internal.hs b/JavaScript/JSON/Types/Internal.hs index c2a6579..0ddcea5 100644 --- a/JavaScript/JSON/Types/Internal.hs +++ b/JavaScript/JSON/Types/Internal.hs @@ -264,47 +264,47 @@ encode v = js_encode v -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$r = [];" js_emptyArray :: Value + "(() => { return []; })" js_emptyArray :: Value foreign import javascript unsafe - "$r = {};" js_emptyObject :: Object + "(() => { return {}; })" js_emptyObject :: Object foreign import javascript unsafe - "$1.length === 0" js_isEmptyArray :: Value -> Bool + "((x) => { return x.length === 0; })" js_isEmptyArray :: Value -> Bool foreign import javascript unsafe - "$r = true;" js_trueValue :: Value + "(() => { return true; })" js_trueValue :: Value foreign import javascript unsafe - "$r = false;" js_falseValue :: Value + "(() => { return false; })" js_falseValue :: Value -- ----------------------------------------------------------------------------- -- types must be checked before using these conversions foreign import javascript unsafe - "$r = $1;" js_jsvalToDouble :: JSVal -> Double + "((x) => { return x; })" js_jsvalToDouble :: JSVal -> Double foreign import javascript unsafe - "$r = $1;" js_jsvalToBool :: JSVal -> Bool + "((x) => { return x; })" js_jsvalToBool :: JSVal -> Bool -- ----------------------------------------------------------------------------- -- various lookups foreign import javascript unsafe - "$2[$1]" + "((x,y) => { return y[x]; })" js_lookupDictPure :: JSString -> Object -> JSVal foreign import javascript unsafe - "typeof($2)==='object'?$2[$1]:undefined" + "((x,y) => { return typeof(y) === 'object' ? y[x] : undefined; })" js_lookupDictPureSafe :: JSString -> Value -> JSVal foreign import javascript unsafe - "$2[$1]" js_lookupArrayPure :: Int -> A.JSArray -> JSVal + "((x,y) => { return y[x]; })" js_lookupArrayPure :: Int -> A.JSArray -> JSVal foreign import javascript unsafe - "h$isArray($2) ? $2[$1] : undefined" + "((x,y) => { return h$isArray(y) ? y[x] : undefined; })" js_lookupArrayPureSafe :: Int -> Value -> JSVal foreign import javascript unsafe - "$r = $1;" + "((x) => { return x; })" js_doubleToJSVal :: Double -> JSVal foreign import javascript unsafe - "JSON.decode(JSON.encode($1))" + "((x) => { return JSON.decode(JSON.encode(x)); })" js_clone :: SomeValue m0 -> IO (SomeValue m1) -- ----------------------------------------------------------------------------- @@ -324,5 +324,5 @@ foreign import javascript unsafe js_listAssocs :: SomeObject m -> Exts.State# s -> (# Exts.State# s, Exts.Any {- [(JSString, Value)] -} #) foreign import javascript unsafe - "JSON.stringify($1)" + "JSON.stringify" js_encode :: Value -> JSString diff --git a/JavaScript/Object/Internal.hs b/JavaScript/Object/Internal.hs index 7b6ae30..6f26bc3 100644 --- a/JavaScript/Object/Internal.hs +++ b/JavaScript/Object/Internal.hs @@ -73,17 +73,17 @@ isInstanceOf o s = js_isInstanceOf o s -- ----------------------------------------------------------------------------- -foreign import javascript unsafe "$r = {};" +foreign import javascript unsafe "(() => { return {}; })" js_create :: IO Object -foreign import javascript safe "$2[$1]" +foreign import javascript safe "((x,y) => { return y[x]; })" js_getProp :: JSString -> Object -> IO JSVal -foreign import javascript unsafe "$2[$1]" +foreign import javascript unsafe "((x,y) => { return y[x]; })" js_unsafeGetProp :: JSString -> Object -> IO JSVal -foreign import javascript safe "$3[$1] = $2" +foreign import javascript safe "((x,y,z) => { z[x] = y; })" js_setProp :: JSString -> JSVal -> Object -> IO () -foreign import javascript unsafe "$3[$1] = $2" +foreign import javascript unsafe "((x,y,z) => { z[x] = y; })" js_unsafeSetProp :: JSString -> JSVal -> Object -> IO () -foreign import javascript unsafe "$1 instanceof $2" +foreign import javascript unsafe "((x,y) => { return x instanceof y; })" js_isInstanceOf :: Object -> JSVal -> Bool foreign import javascript unsafe "h$allProps" js_allProps :: Object -> IO JSArray diff --git a/JavaScript/TypedArray/ArrayBuffer/Internal.hs b/JavaScript/TypedArray/ArrayBuffer/Internal.hs index 87c93a6..f11dfc7 100644 --- a/JavaScript/TypedArray/ArrayBuffer/Internal.hs +++ b/JavaScript/TypedArray/ArrayBuffer/Internal.hs @@ -38,16 +38,16 @@ instance PFromJSVal MutableArrayBuffer where -- ---------------------------------------------------------------------------- foreign import javascript unsafe - "$1.byteLength" js_byteLength :: SomeArrayBuffer any -> Int + "((x) => { return x.byteLength; })" js_byteLength :: SomeArrayBuffer any -> Int foreign import javascript unsafe - "new ArrayBuffer($1)" js_create :: Int -> State# s -> (# State# s, JSVal #) + "((x) => { return new ArrayBuffer(x); })" js_create :: Int -> State# s -> (# State# s, JSVal #) foreign import javascript unsafe - "$2.slice($1)" js_slice1 :: Int -> JSVal -> State# s -> (# State# s, JSVal #) + "((x,y) => { return y.slice(x); })" js_slice1 :: Int -> JSVal -> State# s -> (# State# s, JSVal #) -- ---------------------------------------------------------------------------- -- immutable non-IO slice foreign import javascript unsafe - "$2.slice($1)" js_slice1_imm :: Int -> SomeArrayBuffer any -> SomeArrayBuffer any + "((x,y) => { return y.slice(x); })" js_slice1_imm :: Int -> SomeArrayBuffer any -> SomeArrayBuffer any foreign import javascript unsafe - "$3.slice($1,$2)" js_slice_imm :: Int -> Int -> SomeArrayBuffer any -> SomeArrayBuffer any + "((x,y,z) => { return z.slice(x,y); })" js_slice_imm :: Int -> Int -> SomeArrayBuffer any -> SomeArrayBuffer any diff --git a/JavaScript/TypedArray/DataView/Internal.hs b/JavaScript/TypedArray/DataView/Internal.hs index 0b53f6d..bdef01c 100644 --- a/JavaScript/TypedArray/DataView/Internal.hs +++ b/JavaScript/TypedArray/DataView/Internal.hs @@ -33,115 +33,115 @@ type STDataView s = SomeDataView (STMutable s) #define JSU foreign import javascript unsafe #define JSS foreign import javascript safe -JSU "new DataView($1)" +JSU "((x) => { return new DataView(x); })" js_dataView1 :: JSVal -> JSVal -JSS "new DataView($2,$1)" +JSS "((x,y) => { return new DataView(y,x); })" js_dataView2 :: Int -> JSVal -> SomeDataView m -JSU "new DataView($2,$1)" +JSU "((x,y) => { return new DataView(y,x); })" js_unsafeDataView2 :: Int -> JSVal-> SomeDataView m -JSS "new DataView($3,$1,$2)" +JSS "((x,y,z) => { return new DataView(z,x,y); })" js_dataView :: Int -> Int -> JSVal -> SomeDataView m -JSU "new DataView($3,$1,$2)" +JSU "((x,y,z) => { return new DataView(z,x,y); })" js_unsafeDataView :: Int -> Int -> JSVal -> JSVal -JSU "new DataView($1.buffer.slice($1.byteOffset, $1.byteLength))" +JSU "((x) => { return new DataView(x.buffer.slice(x.byteOffset, x.byteLength)); })" js_cloneDataView :: SomeDataView m -> IO (SomeDataView m1) -- ---------------------------------------------------------------------------- -- immutable getters -JSU "$2.getInt8($1)" js_i_unsafeGetInt8 :: Int -> DataView -> Int8 -JSU "$2.getUint8($1)" js_i_unsafeGetUint8 :: Int -> DataView -> Word8 -JSU "$2.getInt16($1)" js_i_unsafeGetInt16BE :: Int -> DataView -> Int16 -JSU "$2.getInt32($1)" js_i_unsafeGetInt32BE :: Int -> DataView -> Int -JSU "$2.getUint16($1)" js_i_unsafeGetUint16BE :: Int -> DataView -> Word16 -JSU "$2.getUint32($1)|0" js_i_unsafeGetUint32BE :: Int -> DataView -> Word -JSU "$2.getFloat32($1)" js_i_unsafeGetFloat32BE :: Int -> DataView -> Double -JSU "$2.getFloat64($1)" js_i_unsafeGetFloat64BE :: Int -> DataView -> Double -JSU "$2.getInt16($1,true)" js_i_unsafeGetInt16LE :: Int -> DataView -> Int16 -JSU "$2.getInt32($1,true)" js_i_unsafeGetInt32LE :: Int -> DataView -> Int -JSU "$2.getUint16($1,true)" js_i_unsafeGetUint16LE :: Int -> DataView -> Word16 -JSU "$2.getUint32($1,true)|0" js_i_unsafeGetUint32LE :: Int -> DataView -> Word -JSU "$2.getFloat32($1,true)" js_i_unsafeGetFloat32LE :: Int -> DataView -> Double -JSU "$2.getFloat64($1,true)" js_i_unsafeGetFloat64LE :: Int -> DataView -> Double - -JSS "$2.getInt8($1)" js_i_getInt8 :: Int -> DataView -> Int8 -JSS "$2.getUint8($1)" js_i_getUint8 :: Int -> DataView -> Word8 -JSS "$2.getInt16($1)" js_i_getInt16BE :: Int -> DataView -> Int16 -JSS "$2.getInt32($1)" js_i_getInt32BE :: Int -> DataView -> Int -JSS "$2.getUint16($1)" js_i_getUint16BE :: Int -> DataView -> Word16 -JSS "$2.getUint32($1)|0" js_i_getUint32BE :: Int -> DataView -> Word -JSS "$2.getFloat32($1)" js_i_getFloat32BE :: Int -> DataView -> Double -JSS "$2.getFloat64($1)" js_i_getFloat64BE :: Int -> DataView -> Double -JSS "$2.getInt16($1,true)" js_i_getInt16LE :: Int -> DataView -> Int16 -JSS "$2.getInt32($1,true)" js_i_getInt32LE :: Int -> DataView -> Int -JSS "$2.getUint16($1,true)" js_i_getUint16LE :: Int -> DataView -> Word16 -JSS "$2.getUint32($1,true)|0" js_i_getUint32LE :: Int -> DataView -> Word -JSS "$2.getFloat32($1,true)" js_i_getFloat32LE :: Int -> DataView -> Double -JSS "$2.getFloat64($1,true)" js_i_getFloat64LE :: Int -> DataView -> Double +JSU "((x,y) => { return y.getInt8(x); })" js_i_unsafeGetInt8 :: Int -> DataView -> Int8 +JSU "((x,y) => { return y.getUint8(x); })" js_i_unsafeGetUint8 :: Int -> DataView -> Word8 +JSU "((x,y) => { return y.getInt16(x); })" js_i_unsafeGetInt16BE :: Int -> DataView -> Int16 +JSU "((x,y) => { return y.getInt32(x); })" js_i_unsafeGetInt32BE :: Int -> DataView -> Int +JSU "((x,y) => { return y.getUint16(x); })" js_i_unsafeGetUint16BE :: Int -> DataView -> Word16 +JSU "((x,y) => { return y.getUint32(x)|0; })" js_i_unsafeGetUint32BE :: Int -> DataView -> Word +JSU "((x,y) => { return y.getFloat32(x); })" js_i_unsafeGetFloat32BE :: Int -> DataView -> Double +JSU "((x,y) => { return y.getFloat64(x); })" js_i_unsafeGetFloat64BE :: Int -> DataView -> Double +JSU "((x,y) => { return y.getInt16(x,true); })" js_i_unsafeGetInt16LE :: Int -> DataView -> Int16 +JSU "((x,y) => { return y.getInt32(x,true); })" js_i_unsafeGetInt32LE :: Int -> DataView -> Int +JSU "((x,y) => { return y.getUint16(x,true); })" js_i_unsafeGetUint16LE :: Int -> DataView -> Word16 +JSU "((x,y) => { return y.getUint32(x,true)|0; })" js_i_unsafeGetUint32LE :: Int -> DataView -> Word +JSU "((x,y) => { return y.getFloat32(x,true); })" js_i_unsafeGetFloat32LE :: Int -> DataView -> Double +JSU "((x,y) => { return y.getFloat64(x,true); })" js_i_unsafeGetFloat64LE :: Int -> DataView -> Double + +JSS "((x,y) => { return y.getInt8(x); })" js_i_getInt8 :: Int -> DataView -> Int8 +JSS "((x,y) => { return y.getUint8(x); })" js_i_getUint8 :: Int -> DataView -> Word8 +JSS "((x,y) => { return y.getInt16(x); })" js_i_getInt16BE :: Int -> DataView -> Int16 +JSS "((x,y) => { return y.getInt32(x); })" js_i_getInt32BE :: Int -> DataView -> Int +JSS "((x,y) => { return y.getUint16(x); })" js_i_getUint16BE :: Int -> DataView -> Word16 +JSS "((x,y) => { return y.getUint32(x)|0; })" js_i_getUint32BE :: Int -> DataView -> Word +JSS "((x,y) => { return y.getFloat32(x); })" js_i_getFloat32BE :: Int -> DataView -> Double +JSS "((x,y) => { return y.getFloat64(x); })" js_i_getFloat64BE :: Int -> DataView -> Double +JSS "((x,y) => { return y.getInt16(x,true); })" js_i_getInt16LE :: Int -> DataView -> Int16 +JSS "((x,y) => { return y.getInt32(x,true); })" js_i_getInt32LE :: Int -> DataView -> Int +JSS "((x,y) => { return y.getUint16(x,true); })" js_i_getUint16LE :: Int -> DataView -> Word16 +JSS "((x,y) => { return y.getUint32(x,true)|0; })" js_i_getUint32LE :: Int -> DataView -> Word +JSS "((x,y) => { return y.getFloat32(x,true); })" js_i_getFloat32LE :: Int -> DataView -> Double +JSS "((x,y) => { return y.getFloat64(x,true); })" js_i_getFloat64LE :: Int -> DataView -> Double -- ---------------------------------------------------------------------------- -- mutable getters -JSU "$2.getInt8($1)" js_m_unsafeGetInt8 :: Int -> SomeDataView m -> State# s -> (# State# s, Int8 #) -JSU "$2.getUint8($1)" js_m_unsafeGetUint8 :: Int -> SomeDataView m -> State# s -> (# State# s, Word8 #) -JSU "$2.getInt16($1)" js_m_unsafeGetInt16BE :: Int -> SomeDataView m -> State# s -> (# State# s, Int16 #) -JSU "$2.getInt32($1)" js_m_unsafeGetInt32BE :: Int -> SomeDataView m -> State# s -> (# State# s, Int #) -JSU "$2.getUint16($1)" js_m_unsafeGetUint16BE :: Int -> SomeDataView m -> State# s -> (# State# s, Word16 #) -JSU "$2.getUint32($1)|0" js_m_unsafeGetUint32BE :: Int -> SomeDataView m -> State# s -> (# State# s, Word #) -JSU "$2.getFloat32($1)" js_m_unsafeGetFloat32BE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) -JSU "$2.getFloat64($1)" js_m_unsafeGetFloat64BE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) -JSU "$2.getInt16($1,true)" js_m_unsafeGetInt16LE :: Int -> SomeDataView m -> State# s -> (# State# s, Int16 #) -JSU "$2.getInt32($1,true)" js_m_unsafeGetInt32LE :: Int -> SomeDataView m -> State# s -> (# State# s, Int #) -JSU "$2.getUint16($1,true)" js_m_unsafeGetUint16LE :: Int -> SomeDataView m -> State# s -> (# State# s, Word16 #) -JSU "$2.getUint32($1,true)|0" js_m_unsafeGetUint32LE :: Int -> SomeDataView m -> State# s -> (# State# s, Word #) -JSU "$2.getFloat32($1,true)" js_m_unsafeGetFloat32LE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) -JSU "$2.getFloat64($1,true)" js_m_unsafeGetFloat64LE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) - -JSS "$2.getInt8($1)" js_m_getInt8 :: Int -> SomeDataView m -> State# s -> (# State# s, Int8 #) -JSS "$2.getUint8($1)" js_m_getUint8 :: Int -> SomeDataView m -> State# s -> (# State# s, Word8 #) -JSS "$2.getInt16($1)" js_m_getInt16BE :: Int -> SomeDataView m -> State# s -> (# State# s, Int16 #) -JSS "$2.getInt32($1)" js_m_getInt32BE :: Int -> SomeDataView m -> State# s -> (# State# s, Int #) -JSS "$2.getUint16($1)" js_m_getUint16BE :: Int -> SomeDataView m -> State# s -> (# State# s, Word16 #) -JSS "$2.getUint32($1)|0" js_m_getUint32BE :: Int -> SomeDataView m -> State# s -> (# State# s, Word #) -JSS "$2.getFloat32($1)" js_m_getFloat32BE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) -JSS "$2.getFloat64($1)" js_m_getFloat64BE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) -JSS "$2.getInt16($1,true)" js_m_getInt16LE :: Int -> SomeDataView m -> State# s -> (# State# s, Int16 #) -JSS "$2.getInt32($1,true)" js_m_getInt32LE :: Int -> SomeDataView m -> State# s -> (# State# s, Int #) -JSS "$2.getUint16($1,true)" js_m_getUint16LE :: Int -> SomeDataView m -> State# s -> (# State# s, Word16 #) -JSS "$2.getUint32($1,true)|0" js_m_getUint32LE :: Int -> SomeDataView m -> State# s -> (# State# s, Word #) -JSS "$2.getFloat32($1,true)" js_m_getFloat32LE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) -JSS "$2.getFloat64($1,true)" js_m_getFloat64LE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) +JSU "((x,y) => { return y.getInt8(x); })" js_m_unsafeGetInt8 :: Int -> SomeDataView m -> State# s -> (# State# s, Int8 #) +JSU "((x,y) => { return y.getUint8(x); })" js_m_unsafeGetUint8 :: Int -> SomeDataView m -> State# s -> (# State# s, Word8 #) +JSU "((x,y) => { return y.getInt16(x); })" js_m_unsafeGetInt16BE :: Int -> SomeDataView m -> State# s -> (# State# s, Int16 #) +JSU "((x,y) => { return y.getInt32(x); })" js_m_unsafeGetInt32BE :: Int -> SomeDataView m -> State# s -> (# State# s, Int #) +JSU "((x,y) => { return y.getUint16(x); })" js_m_unsafeGetUint16BE :: Int -> SomeDataView m -> State# s -> (# State# s, Word16 #) +JSU "((x,y) => { return y.getUint32(x)|0; })" js_m_unsafeGetUint32BE :: Int -> SomeDataView m -> State# s -> (# State# s, Word #) +JSU "((x,y) => { return y.getFloat32(x); })" js_m_unsafeGetFloat32BE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) +JSU "((x,y) => { return y.getFloat64(x); })" js_m_unsafeGetFloat64BE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) +JSU "((x,y) => { return y.getInt16(x,true); })" js_m_unsafeGetInt16LE :: Int -> SomeDataView m -> State# s -> (# State# s, Int16 #) +JSU "((x,y) => { return y.getInt32(x,true); })" js_m_unsafeGetInt32LE :: Int -> SomeDataView m -> State# s -> (# State# s, Int #) +JSU "((x,y) => { return y.getUint16(x,true); })" js_m_unsafeGetUint16LE :: Int -> SomeDataView m -> State# s -> (# State# s, Word16 #) +JSU "((x,y) => { return y.getUint32(x,true)|0; })" js_m_unsafeGetUint32LE :: Int -> SomeDataView m -> State# s -> (# State# s, Word #) +JSU "((x,y) => { return y.getFloat32(x,true); })" js_m_unsafeGetFloat32LE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) +JSU "((x,y) => { return y.getFloat64(x,true); })" js_m_unsafeGetFloat64LE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) + +JSS "((x,y) => { return y.getInt8(x); })" js_m_getInt8 :: Int -> SomeDataView m -> State# s -> (# State# s, Int8 #) +JSS "((x,y) => { return y.getUint8(x); })" js_m_getUint8 :: Int -> SomeDataView m -> State# s -> (# State# s, Word8 #) +JSS "((x,y) => { return y.getInt16(x); })" js_m_getInt16BE :: Int -> SomeDataView m -> State# s -> (# State# s, Int16 #) +JSS "((x,y) => { return y.getInt32(x); })" js_m_getInt32BE :: Int -> SomeDataView m -> State# s -> (# State# s, Int #) +JSS "((x,y) => { return y.getUint16(x); })" js_m_getUint16BE :: Int -> SomeDataView m -> State# s -> (# State# s, Word16 #) +JSS "((x,y) => { return y.getUint32(x)|0; })" js_m_getUint32BE :: Int -> SomeDataView m -> State# s -> (# State# s, Word #) +JSS "((x,y) => { return y.getFloat32(x); })" js_m_getFloat32BE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) +JSS "((x,y) => { return y.getFloat64(x); })" js_m_getFloat64BE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) +JSS "((x,y) => { return y.getInt16(x,true); })" js_m_getInt16LE :: Int -> SomeDataView m -> State# s -> (# State# s, Int16 #) +JSS "((x,y) => { return y.getInt32(x,true); })" js_m_getInt32LE :: Int -> SomeDataView m -> State# s -> (# State# s, Int #) +JSS "((x,y) => { return y.getUint16(x,true); })" js_m_getUint16LE :: Int -> SomeDataView m -> State# s -> (# State# s, Word16 #) +JSS "((x,y) => { return y.getUint32(x,true)|0; })" js_m_getUint32LE :: Int -> SomeDataView m -> State# s -> (# State# s, Word #) +JSS "((x,y) => { return y.getFloat32(x,true); })" js_m_getFloat32LE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) +JSS "((x,y) => { return y.getFloat64(x,true); })" js_m_getFloat64LE :: Int -> SomeDataView m -> State# s -> (# State# s, Double #) -- ---------------------------------------------------------------------------- -- mutable setters -JSU "$3.setInt8($1,$2)" js_unsafeSetInt8 :: Int -> Int8 -> SomeDataView m -> State# s -> (# State# s, () #) -JSU "$3.setUint8($1,$2)" js_unsafeSetUint8 :: Int -> Word8 -> SomeDataView m -> State# s -> (# State# s, () #) -JSU "$3.setInt16($1,$2)" js_unsafeSetInt16BE :: Int -> Int16 -> SomeDataView m -> State# s -> (# State# s, () #) -JSU "$3.setInt32($1,$2)" js_unsafeSetInt32BE :: Int -> Int -> SomeDataView m -> State# s -> (# State# s, () #) -JSU "$3.setUint16($1,$2)" js_unsafeSetUint16BE :: Int -> Word16 -> SomeDataView m -> State# s -> (# State# s, () #) -JSU "$3.setUint32($1,$2)" js_unsafeSetUint32BE :: Int -> Word -> SomeDataView m -> State# s -> (# State# s, () #) -JSU "$3.setFloat32($1,$2)" js_unsafeSetFloat32BE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) -JSU "$3.setFloat64($1,$2)" js_unsafeSetFloat64BE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) -JSU "$3.setInt16($1,$2,true)" js_unsafeSetInt16LE :: Int -> Int16 -> SomeDataView m -> State# s -> (# State# s, () #) -JSU "$3.setInt32($1,$2,true)" js_unsafeSetInt32LE :: Int -> Int -> SomeDataView m -> State# s -> (# State# s, () #) -JSU "$3.setUint16($1,$2,true)" js_unsafeSetUint16LE :: Int -> Word16 -> SomeDataView m -> State# s -> (# State# s, () #) -JSU "$3.setUint32($1,$2,true)" js_unsafeSetUint32LE :: Int -> Word -> SomeDataView m -> State# s -> (# State# s, () #) -JSU "$3.setFloat32($1,$2,true)" js_unsafeSetFloat32LE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) -JSU "$3.setFloat64($1,$2,true)" js_unsafeSetFloat64LE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) - -JSS "$3.setInt8($1,$2)" js_setInt8 :: Int -> Int8 -> SomeDataView m -> State# s -> (# State# s, () #) -JSS "$3.setUint8($1,$2)" js_setUint8 :: Int -> Word8 -> SomeDataView m -> State# s -> (# State# s, () #) -JSS "$3.setInt16($1,$2)" js_setInt16BE :: Int -> Int16 -> SomeDataView m -> State# s -> (# State# s, () #) -JSS "$3.setInt32($1,$2)" js_setInt32BE :: Int -> Int -> SomeDataView m -> State# s -> (# State# s, () #) -JSS "$3.setUint16($1,$2)" js_setUint16BE :: Int -> Word16 -> SomeDataView m -> State# s -> (# State# s, () #) -JSS "$3.setUint32($1,$2)" js_setUint32BE :: Int -> Word -> SomeDataView m -> State# s -> (# State# s, () #) -JSS "$3.setFloat32($1,$2)" js_setFloat32BE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) -JSS "$3.setFloat64($1,$2)" js_setFloat64BE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) -JSS "$3.setInt16($1,$2,true)" js_setInt16LE :: Int -> Int16 -> SomeDataView m -> State# s -> (# State# s, () #) -JSS "$3.setInt32($1,$2,true)" js_setInt32LE :: Int -> Int -> SomeDataView m -> State# s -> (# State# s, () #) -JSS "$3.setUint16($1,$2,true)" js_setUint16LE :: Int -> Word16 -> SomeDataView m -> State# s -> (# State# s, () #) -JSS "$3.setUint32($1,$2,true)" js_setUint32LE :: Int -> Word -> SomeDataView m -> State# s -> (# State# s, () #) -JSS "$3.setFloat32($1,$2,true)" js_setFloat32LE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) -JSS "$3.setFloat64($1,$2,true)" js_setFloat64LE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setInt8(x,y); })" js_unsafeSetInt8 :: Int -> Int8 -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setUint8(x,y); })" js_unsafeSetUint8 :: Int -> Word8 -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setInt16(x,y); })" js_unsafeSetInt16BE :: Int -> Int16 -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setInt32(x,y); })" js_unsafeSetInt32BE :: Int -> Int -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setUint16(x,y); })" js_unsafeSetUint16BE :: Int -> Word16 -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setUint32(x,y); })" js_unsafeSetUint32BE :: Int -> Word -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setFloat32(x,y); })" js_unsafeSetFloat32BE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setFloat64(x,y); })" js_unsafeSetFloat64BE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setInt16(x,y,true); })" js_unsafeSetInt16LE :: Int -> Int16 -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setInt32(x,y,true); })" js_unsafeSetInt32LE :: Int -> Int -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setUint16(x,y,true); })" js_unsafeSetUint16LE :: Int -> Word16 -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setUint32(x,y,true); })" js_unsafeSetUint32LE :: Int -> Word -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setFloat32(x,y,true); })" js_unsafeSetFloat32LE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) +JSU "((x,y,z) => { x.setFloat64(x,y,true); })" js_unsafeSetFloat64LE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) + +JSS "((x,y,z) => { x.setInt8(x,y); })" js_setInt8 :: Int -> Int8 -> SomeDataView m -> State# s -> (# State# s, () #) +JSS "((x,y,z) => { x.setUint8(x,y); })" js_setUint8 :: Int -> Word8 -> SomeDataView m -> State# s -> (# State# s, () #) +JSS "((x,y,z) => { x.setInt16(x,y); })" js_setInt16BE :: Int -> Int16 -> SomeDataView m -> State# s -> (# State# s, () #) +JSS "((x,y,z) => { x.setInt32(x,y); })" js_setInt32BE :: Int -> Int -> SomeDataView m -> State# s -> (# State# s, () #) +JSS "((x,y,z) => { x.setUint16(x,y); })" js_setUint16BE :: Int -> Word16 -> SomeDataView m -> State# s -> (# State# s, () #) +JSS "((x,y,z) => { x.setUint32(x,y); })" js_setUint32BE :: Int -> Word -> SomeDataView m -> State# s -> (# State# s, () #) +JSS "((x,y,z) => { x.setFloat32(x,y); })" js_setFloat32BE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) +JSS "((x,y,z) => { x.setFloat64(x,y); })" js_setFloat64BE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) +JSS "((x,y,z) => { x.setInt16(x,y,true); })" js_setInt16LE :: Int -> Int16 -> SomeDataView m -> State# s -> (# State# s, () #) +JSS "((x,y,z) => { x.setInt32(x,y,true); })" js_setInt32LE :: Int -> Int -> SomeDataView m -> State# s -> (# State# s, () #) +JSS "((x,y,z) => { x.setUint16(x,y,true); })" js_setUint16LE :: Int -> Word16 -> SomeDataView m -> State# s -> (# State# s, () #) +JSS "((x,y,z) => { x.setUint32(x,y,true); })" js_setUint32LE :: Int -> Word -> SomeDataView m -> State# s -> (# State# s, () #) +JSS "((x,y,z) => { x.setFloat32(x,y,true); })" js_setFloat32LE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) +JSS "((x,y,z) => { x.setFloat64(x,y,true); })" js_setFloat64LE :: Int -> Double -> SomeDataView m -> State# s -> (# State# s, () #) diff --git a/JavaScript/TypedArray/Internal.hs b/JavaScript/TypedArray/Internal.hs index 126c7f6..47ee9d3 100644 --- a/JavaScript/TypedArray/Internal.hs +++ b/JavaScript/TypedArray/Internal.hs @@ -351,70 +351,70 @@ unsafeSet offset src dest = IO (js_unsafeSet offset src dest) -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1.length" js_length :: SomeTypedArray e m -> Int + "((x) => { return x.length; })" js_length :: SomeTypedArray e m -> Int foreign import javascript unsafe - "$1.byteLength" js_byteLength :: SomeTypedArray e m -> Int + "((x) => { return x.byteLength; })" js_byteLength :: SomeTypedArray e m -> Int foreign import javascript unsafe - "$1.byteOffset" js_byteOffset :: SomeTypedArray e m -> Int + "((x) => { return x.byteOffset; })" js_byteOffset :: SomeTypedArray e m -> Int foreign import javascript unsafe - "$1.buffer" js_buffer :: SomeTypedArray e m -> SomeArrayBuffer m + "((x) => { return x.buffer; })" js_buffer :: SomeTypedArray e m -> SomeArrayBuffer m foreign import javascript unsafe - "$3.subarray($1,$2)" + "((x,y,z) => { return z.subarray(x,y); })" js_subarray :: Int -> Int -> SomeTypedArray e m -> SomeTypedArray e m foreign import javascript safe - "$3.set($1,$2)" + "((x,y,z) => { z.set(x,y); })" js_set :: Int -> SomeTypedArray e m -> SomeTypedArray e1 m1 -> State# s -> (# State# s, () #) foreign import javascript unsafe - "$3.set($1,$2)" + "((x,y,z) => { z.set(x,y); })" js_unsafeSet :: Int -> SomeTypedArray e m -> SomeTypedArray e1 m1 -> State# s -> (# State# s, () #) foreign import javascript unsafe - "$1.BYTES_PER_ELEMENT" + "((x) => { return x.BYTES_PER_ELEMENT; })" js_elemSize :: SomeTypedArray e m -> Int -- ----------------------------------------------------------------------------- -- index foreign import javascript safe - "$2[$1]" js_indexI + "((x,y) => { return y[x]; })" js_indexI :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Int# #) foreign import javascript safe - "$2[$1]" js_indexW + "((x,y) => { return y[x]; })" js_indexW :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Word# #) foreign import javascript safe - "$2[$1]" js_indexD + "((x,y) => { return y[x]; })" js_indexD :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Double #) foreign import javascript unsafe - "$2[$1]" js_unsafeIndexI + "((x,y) => { return y[x]; })" js_unsafeIndexI :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Int# #) foreign import javascript unsafe - "$2[$1]" js_unsafeIndexW + "((x,y) => { return y[x]; })" js_unsafeIndexW :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Word# #) foreign import javascript unsafe - "$2[$1]" js_unsafeIndexD + "((x,y) => { return y[x]; })" js_unsafeIndexD :: Int -> SomeTypedArray e m -> State# s -> (# State# s, Double #) -- ----------------------------------------------------------------------------- -- setIndex foreign import javascript safe - "$3[$1] = $2;" js_setIndexI + "((x,y,z) => { z[x] = y; })" js_setIndexI :: Int -> Int# -> SomeTypedArray e m -> State# s -> (# State# s, () #) foreign import javascript safe - "$3[$1] = $2;" js_setIndexW + "((x,y,z) => { z[x] = y; })" js_setIndexW :: Int -> Word# -> SomeTypedArray e m -> State# s -> (# State# s, () #) foreign import javascript safe - "$3[$1] = $2;" js_setIndexD + "((x,y,z) => { z[x] = y; })" js_setIndexD :: Int -> Double -> SomeTypedArray e m -> State# s -> (# State# s, () #) foreign import javascript unsafe - "$3[$1] = $2;" js_unsafeSetIndexI + "((x,y,z) => { z[x] = y; })" js_unsafeSetIndexI :: Int -> Int# -> SomeTypedArray e m -> State# s -> (# State# s, () #) foreign import javascript unsafe - "$3[$1] = $2;" js_unsafeSetIndexW + "((x,y,z) => { z[x] = y; })" js_unsafeSetIndexW :: Int -> Word# -> SomeTypedArray e m -> State# s -> (# State# s, () #) foreign import javascript unsafe - "$3[$1] = $2;" js_unsafeSetIndexD + "((x,y,z) => { z[x] = y; })" js_unsafeSetIndexD :: Int -> Double -> SomeTypedArray e m -> State# s -> (# State# s, () #) -- ------------------------------------------------------------------------------ @@ -443,94 +443,94 @@ foreign import javascript unsafe -- create foreign import javascript unsafe - "new Int8Array($1)" + "((x) => { return new Int8Array(x); })" js_createInt8Array :: Int -> State# s -> (# State# s, SomeInt8Array m #) foreign import javascript unsafe - "new Int16Array($1)" + "((x) => { return new Int16Array(x); })" js_createInt16Array :: Int -> State# s -> (# State# s, SomeInt16Array m #) foreign import javascript unsafe - "new Int32Array($1)" + "((x) => { return new Int32Array(x); })" js_createInt32Array :: Int -> State# s -> (# State# s, SomeInt32Array m #) foreign import javascript unsafe - "new Uint8ClampedArray($1)" + "((x) => { return new Uint8ClampedArray(x); })" js_createUint8ClampedArray :: Int -> State# s -> (# State# s, SomeUint8ClampedArray m #) foreign import javascript unsafe - "new Uint8Array($1)" + "((x) => { return new Uint8Array(x); })" js_createUint8Array :: Int -> State# s -> (# State# s, SomeUint8Array m #) foreign import javascript unsafe - "new Uint16Array($1)" + "((x) => { return new Uint16Array(x); })" js_createUint16Array :: Int -> State# s -> (# State# s, SomeUint16Array m #) foreign import javascript unsafe - "new Uint32Array($1)" + "((x) => { return new Uint32Array(x); })" js_createUint32Array :: Int -> State# s -> (# State# s, SomeUint32Array m #) foreign import javascript unsafe - "new Float32Array($1)" + "((x) => { return new Float32Array(x); })" js_createFloat32Array :: Int -> State# s -> (# State# s, SomeFloat32Array m #) foreign import javascript unsafe - "new Float64Array($1)" + "((x) => { return new Float64Array(x); })" js_createFloat64Array :: Int -> State# s -> (# State# s, SomeFloat64Array m #) -- ------------------------------------------------------------------------------ -- from array foreign import javascript unsafe - "Int8Array.from($1)" + "((x) => { return Int8Array.from(x); })" js_int8ArrayFromArray :: SomeJSArray m0 -> IO (SomeInt8Array m1) foreign import javascript unsafe - "Int16Array.from($1)" + "((x) => { return Int16Array.from(x); })" js_int16ArrayFromArray :: SomeJSArray m0 -> IO (SomeInt16Array m1) foreign import javascript unsafe - "Int32Array.from($1)" + "((x) => { return Int32Array.from(x); })" js_int32ArrayFromArray :: SomeJSArray m0 -> IO (SomeInt32Array m1) foreign import javascript unsafe - "Uint8ClampedArray.from($1)" + "((x) => { return Uint8ClampedArray.from(x); })" js_uint8ClampedArrayFromArray :: SomeJSArray m0 -> IO (SomeUint8ClampedArray m1) foreign import javascript unsafe - "Uint8Array.from($1)" + "((x) => { return Uint8Array.from(x); })" js_uint8ArrayFromArray :: SomeJSArray m0 -> IO (SomeUint8Array m1) foreign import javascript unsafe - "Uint16Array.from($1)" + "((x) => { return Uint16Array.from(x); })" js_uint16ArrayFromArray :: SomeJSArray m0 -> IO (SomeUint16Array m1) foreign import javascript unsafe - "Uint32Array.from($1)" + "((x) => { return Uint32Array.from(x); })" js_uint32ArrayFromArray :: SomeJSArray m0 -> IO (SomeUint32Array m1) foreign import javascript unsafe - "Float32Array.from($1)" + "((x) => { return Float32Array.from(x); })" js_float32ArrayFromArray :: SomeJSArray m0 -> IO (SomeFloat32Array m1) foreign import javascript unsafe - "Float64Array.from($1)" + "((x) => { return Float64Array.from(x); })" js_float64ArrayFromArray :: SomeJSArray m0 -> IO (SomeFloat64Array m1) -- ------------------------------------------------------------------------------ -- from ArrayBuffer foreign import javascript unsafe - "new Int8Array($1)" + "((x) => { return new Int8Array(x); })" js_int8ArrayFromJSVal :: JSVal -> SomeInt8Array m foreign import javascript unsafe - "new Int16Array($1)" + "((x) => { return new Int16Array(x); })" js_int16ArrayFromJSVal :: JSVal -> SomeInt16Array m foreign import javascript unsafe - "new Int32Array($1)" + "((x) => { return new Int32Array(x); })" js_int32ArrayFromJSVal :: JSVal -> SomeInt32Array m foreign import javascript unsafe - "new Uint8ClampedArray($1)" + "((x) => { return new Uint8ClampedArray(x); })" js_uint8ClampedArrayFromJSVal :: JSVal -> SomeUint8ClampedArray m foreign import javascript unsafe - "new Uint8Array($1)" + "((x) => { return new Uint8Array(x); })" js_uint8ArrayFromJSVal :: JSVal -> SomeUint8Array m foreign import javascript unsafe - "new Uint16Array($1)" + "((x) => { return new Uint16Array(x); })" js_uint16ArrayFromJSVal :: JSVal -> SomeUint16Array m foreign import javascript unsafe - "new Uint32Array($1)" + "((x) => { return new Uint32Array(x); })" js_uint32ArrayFromJSVal :: JSVal -> SomeUint32Array m foreign import javascript unsafe - "new Float32Array($1)" + "((x) => { return new Float32Array(x); })" js_float32ArrayFromJSVal :: JSVal -> SomeFloat32Array m foreign import javascript unsafe - "new Float64Array($1)" + "((x) => { return new Float64Array(x); })" js_float64ArrayFromJSVal :: JSVal -> SomeFloat64Array m diff --git a/JavaScript/Web/AnimationFrame.hs b/JavaScript/Web/AnimationFrame.hs index d03833b..cb61717 100644 --- a/JavaScript/Web/AnimationFrame.hs +++ b/JavaScript/Web/AnimationFrame.hs @@ -62,14 +62,14 @@ cancelAnimationFrame h = js_cancelAnimationFrame h -- ----------------------------------------------------------------------------- -foreign import javascript unsafe "{ handle: null, callback: null }" +foreign import javascript unsafe "(() => { return { handle: null, callback: null }; })" js_makeAnimationFrameHandle :: IO AnimationFrameHandle -foreign import javascript unsafe "{ handle: null, callback: $1 }" +foreign import javascript unsafe "(() => { return { handle: null, callback: $1 }; })" js_makeAnimationFrameHandleCallback :: JSVal -> IO AnimationFrameHandle foreign import javascript unsafe "h$animationFrameCancel" js_cancelAnimationFrame :: AnimationFrameHandle -> IO () foreign import javascript interruptible - "$1.handle = window.requestAnimationFrame($c);" + "((x,c) => { return x.handle = window.requestAnimationFrame(c); })" js_waitForAnimationFrame :: AnimationFrameHandle -> IO Double foreign import javascript unsafe "h$animationFrameRequest" js_requestAnimationFrame :: AnimationFrameHandle -> IO () diff --git a/JavaScript/Web/Blob/Internal.hs b/JavaScript/Web/Blob/Internal.hs index 6004687..ec7e5ac 100644 --- a/JavaScript/Web/Blob/Internal.hs +++ b/JavaScript/Web/Blob/Internal.hs @@ -42,14 +42,14 @@ close b = js_close b -- ----------------------------------------------------------------------------- -foreign import javascript unsafe "$1.size" js_size :: SomeBlob a -> Int -foreign import javascript unsafe "$1.type" js_type :: SomeBlob a -> JSString +foreign import javascript unsafe "((x) => { return x.size; })" js_size :: SomeBlob a -> Int +foreign import javascript unsafe "((x) => { return x.type; })" js_type :: SomeBlob a -> JSString -- fixme figure out if we need to support older browsers with obsolete slice -foreign import javascript unsafe "$4.slice($1,$2,$3)" +foreign import javascript unsafe "(($1,$2,$3,$4) => { return $4.slice($1,$2,$3); })" js_slice :: Int -> Int -> JSString -> SomeBlob a -> SomeBlob a -foreign import javascript unsafe "$1.isClosed" +foreign import javascript unsafe "((x) => { return x.isClosed; })" js_isClosed :: SomeBlob a -> IO Bool -foreign import javascript unsafe "$1.close();" +foreign import javascript unsafe "((x) => { return x.close(); })" js_close :: SomeBlob a -> IO () diff --git a/JavaScript/Web/Canvas.hs b/JavaScript/Web/Canvas.hs index 0a7684c..adc02f9 100644 --- a/JavaScript/Web/Canvas.hs +++ b/JavaScript/Web/Canvas.hs @@ -332,102 +332,101 @@ height c = js_height c -- ---------------------------------------------------------------------------- -foreign import javascript unsafe "$r = document.createElement('canvas');\ - \$r.width = $1;\ - \$r.height = $2;" +foreign import javascript unsafe + "((x,y) => { var r = document.createElement('canvas'); r.width = x; r.height = y; return r; })" js_create :: Int -> Int -> IO Canvas -foreign import javascript unsafe "$1.getContext('2d')" +foreign import javascript unsafe "((x) => { x.getContext('2d'); })" js_getContext :: Canvas -> IO Context -foreign import javascript unsafe "$1.save()" +foreign import javascript unsafe "((x) => { x.save(); })" js_save :: Context -> IO () -foreign import javascript unsafe "$1.restore()" +foreign import javascript unsafe "((x) => { x.restore(); })" js_restore :: Context -> IO () -foreign import javascript unsafe "$7.transform($1,$2,$3,$4,$5,$6)" +foreign import javascript unsafe "(($1,$2,$3,$4,$5,$6,$7) => { $7.transform($1,$2,$3,$4,$5,$6); })" js_transform :: Double -> Double -> Double -> Double -> Double -> Double -> Context -> IO () -foreign import javascript unsafe "$7.setTransform($1,$2,$3,$4,$5,$6)" +foreign import javascript unsafe "(($1,$2,$3,$4,$5,$6,$7) => { $7.setTransform($1,$2,$3,$4,$5,$6); })" js_setTransform :: Double -> Double -> Double -> Double -> Double -> Double -> Context -> IO () -foreign import javascript unsafe "$3.scale($1,$2)" +foreign import javascript unsafe "((x,y,z) => { x.scale(x,y); })" js_scale :: Double -> Double -> Context -> IO () -foreign import javascript unsafe "$3.translate($1,$2)" +foreign import javascript unsafe "((x,y,z) => { x.translate(x,y); })" js_translate :: Double -> Double -> Context -> IO () -foreign import javascript unsafe "$2.rotate($1)" +foreign import javascript unsafe "((x,y) => { y.rotate(x); })" js_rotate :: Double -> Context -> IO () -foreign import javascript unsafe "$1.fill()" +foreign import javascript unsafe "((x) => { x.fill(); })" js_fill :: Context -> IO () -foreign import javascript unsafe "$2.fill($1)" +foreign import javascript unsafe "((x,y) => { y.fill(x); })" js_fill_rule :: JSString -> Context -> IO () -foreign import javascript unsafe "$1.stroke()" +foreign import javascript unsafe "((x) => { x.stroke(); })" js_stroke :: Context -> IO () -foreign import javascript unsafe "$1.beginPath()" +foreign import javascript unsafe "((x) => { x.beginPath(); })" js_beginPath :: Context -> IO () -foreign import javascript unsafe "$1.closePath()" +foreign import javascript unsafe "((x) => { x.closePath(); })" js_closePath :: Context -> IO () -foreign import javascript unsafe "$1.clip()" +foreign import javascript unsafe "((x) => { x.clip(); })" js_clip :: Context -> IO () -foreign import javascript unsafe "$3.moveTo($1,$2)" +foreign import javascript unsafe "((x,y,z) => { x.moveTo(x,y); })" js_moveTo :: Double -> Double -> Context -> IO () -foreign import javascript unsafe "$3.lineTo($1,$2)" +foreign import javascript unsafe "((x,y,z) => { x.lineTo(x,y); })" js_lineTo :: Double -> Double -> Context -> IO () -foreign import javascript unsafe "$5.quadraticCurveTo($1,$2,$3,$4)" +foreign import javascript unsafe "(($1,$2,$3,$4,$5) => { $5.quadraticCurveTo($1,$2,$3,$4); })" js_quadraticCurveTo :: Double -> Double -> Double -> Double -> Context -> IO () -foreign import javascript unsafe "$7.bezierCurveTo($1,$2,$3,$4,$5,$6)" +foreign import javascript unsafe "(($1,$2,$3,$4,$5,$6,$7) => { $7.bezierCurveTo($1,$2,$3,$4,$5,$6); })" js_bezierCurveTo :: Double -> Double -> Double -> Double -> Double -> Double -> Context -> IO () -foreign import javascript unsafe "$7.arc($1,$2,$3,$4,$5,$6)" +foreign import javascript unsafe "(($1,$2,$3,$4,$5,$6,$7) => { $7.arc($1,$2,$3,$4,$5,$6); })" js_arc :: Double -> Double -> Double -> Double -> Double -> Bool -> Context -> IO () -foreign import javascript unsafe "$6.arcTo($1,$2,$3,$4,$5)" +foreign import javascript unsafe "(($1,$2,$3,$4,$5,$6) => { $6.arcTo($1,$2,$3,$4,$5); })" js_arcTo :: Double -> Double -> Double -> Double -> Double -> Context -> IO () -foreign import javascript unsafe "$5.rect($1,$2,$3,$4)" +foreign import javascript unsafe "(($1,$2,$3,$4,$5) => { $5.rect($1,$2,$3,$4); })" js_rect :: Double -> Double -> Double -> Double -> Context -> IO () -foreign import javascript unsafe "$3.isPointInPath($1,$2)" +foreign import javascript unsafe "((x,y,z) => { x.isPointInPath(x,y); })" js_isPointInPath :: Double -> Double -> Context -> IO () foreign import javascript unsafe - "$5.fillStyle = 'rgba(' + $1 + ',' + $2 + ',' + $3 + ',' + $4 + ')'" + "(($1,$2,$3,$4,$5) => { $5.fillStyle = 'rgba(' + $1 + ',' + $2 + ',' + $3 + ',' + $4 + ')'; })" js_fillStyle :: Int -> Int -> Int -> Double -> Context -> IO () foreign import javascript unsafe - "$5.strokeStyle = 'rgba(' + $1 + ',' + $2 + ',' + $3 + ',' + $4 + ')'" + "(($1,$2,$3,$4,$5) => { $5.strokeStyle = 'rgba(' + $1 + ',' + $2 + ',' + $3 + ',' + $4 + ')'; })" js_strokeStyle :: Int -> Int -> Int -> Double -> Context -> IO () -foreign import javascript unsafe "$2.globalAlpha = $1" +foreign import javascript unsafe "((x,y) => { y.globalAlpha = x; })" js_globalAlpha :: Double -> Context -> IO () foreign import javascript unsafe - "$2.lineJoin = $1" + "((x,y) => { y.lineJoin = x; })" js_lineJoin :: JSString -> Context -> IO () -foreign import javascript unsafe "$2.lineCap = $1" +foreign import javascript unsafe "((x,y) => { y.lineCap = x; })" js_lineCap :: JSString -> Context -> IO () -foreign import javascript unsafe "$2.miterLimit = $1" +foreign import javascript unsafe "((x,y) => { y.miterLimit = x; })" js_miterLimit :: Double -> Context -> IO () -foreign import javascript unsafe "$2.setLineDash($1)" +foreign import javascript unsafe "((x,y) => { y.setLineDash(x); })" js_setLineDash :: JSArray -> Context -> IO () -foreign import javascript unsafe "$2.lineDashOffset = $1" +foreign import javascript unsafe "((x,y) => { y.lineDashOffset = x; })" js_lineDashOffset :: Double -> Context -> IO () -foreign import javascript unsafe "$2.font = $1" +foreign import javascript unsafe "((x,y) => { y.font = x; })" js_font :: JSString -> Context -> IO () -foreign import javascript unsafe "$2.textAlign = $1" +foreign import javascript unsafe "((x,y) => { y.textAlign = x; })" js_textAlign :: JSString -> Context -> IO () -foreign import javascript unsafe "$2.textBaseline = $1" +foreign import javascript unsafe "((x,y) => { y.textBaseline = x; })" js_textBaseline :: JSString -> Context -> IO () -foreign import javascript unsafe "$2.lineWidth = $1" +foreign import javascript unsafe "((x,y) => { y.lineWidth = x; })" js_lineWidth :: Double -> Context -> IO () -foreign import javascript unsafe "$4.fillText($1,$2,$3)" +foreign import javascript unsafe "(($1,$2,$3,$4) => { $4.fillText($1,$2,$3); })" js_fillText :: JSString -> Double -> Double -> Context -> IO () -foreign import javascript unsafe "$4.strokeText($1,$2,$3)" +foreign import javascript unsafe "(($1,$2,$3,$4) => { $4.strokeText($1,$2,$3); })" js_strokeText :: JSString -> Double -> Double -> Context -> IO () -foreign import javascript unsafe "$2.measureText($1)" +foreign import javascript unsafe "((x,y) => { y.measureText(x); })" js_measureText :: JSString -> Context -> IO Object -foreign import javascript unsafe "$5.fillRect($1,$2,$3,$4)" +foreign import javascript unsafe "(($1,$2,$3,$4,$5) => { $5.fillRect($1,$2,$3,$4); })" js_fillRect :: Double -> Double -> Double -> Double -> Context -> IO () -foreign import javascript unsafe "$5.clearRect($1,$2,$3,$4)" +foreign import javascript unsafe "(($1,$2,$3,$4,$5) => { $5.clearRect($1,$2,$3,$4); })" js_clearRect :: Double -> Double -> Double -> Double -> Context -> IO () -foreign import javascript unsafe "$5.strokeRect($1,$2,$3,$4)" +foreign import javascript unsafe "(($1,$2,$3,$4,$5) => { $5.strokeRect($1,$2,$3,$4); })" js_strokeRect :: Double -> Double -> Double -> Double -> Context -> IO () -foreign import javascript unsafe "$6.drawImage($1,$2,$3,$4,$5)" +foreign import javascript unsafe "(($1,$2,$3,$4,$5,$6) => { $6.drawImage($1,$2,$3,$4,$5); })" js_drawImage :: Image -> Int -> Int -> Int -> Int -> Context -> IO () -foreign import javascript unsafe "$3.createPattern($1,$2)" +foreign import javascript unsafe "((x,y,z) => { return x.createPattern(x,y); })" js_createPattern :: Image -> JSString -> Context -> IO Pattern -foreign import javascript unsafe "$1.width" +foreign import javascript unsafe "((x) => { return x.width; })" js_width :: Canvas -> IO Int -foreign import javascript unsafe "$1.height" +foreign import javascript unsafe "((x) => { return x.height; })" js_height :: Canvas -> IO Int -foreign import javascript unsafe "$2.width = $1;" +foreign import javascript unsafe "((x,y) => { return y.width = x;; })" js_setWidth :: Int -> Canvas -> IO () -foreign import javascript unsafe "$2.height = $1;" +foreign import javascript unsafe "((x,y) => { return y.height = x;; })" js_setHeight :: Int -> Canvas -> IO () diff --git a/JavaScript/Web/Canvas/ImageData.hs b/JavaScript/Web/Canvas/ImageData.hs index fbebf0d..887198e 100644 --- a/JavaScript/Web/Canvas/ImageData.hs +++ b/JavaScript/Web/Canvas/ImageData.hs @@ -25,9 +25,9 @@ getData i = js_getData i -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1.width" js_width :: ImageData -> Int + "((x) => { return x.width; })" js_width :: ImageData -> Int foreign import javascript unsafe - "$1.height" js_height :: ImageData -> Int + "((x) => { return x.height; })" js_height :: ImageData -> Int foreign import javascript unsafe - "$1.data" js_getData :: ImageData -> Uint8ClampedArray + "((x) => { return x.data; })" js_getData :: ImageData -> Uint8ClampedArray diff --git a/JavaScript/Web/Canvas/TextMetrics.hs b/JavaScript/Web/Canvas/TextMetrics.hs index 25358d1..1c3c208 100644 --- a/JavaScript/Web/Canvas/TextMetrics.hs +++ b/JavaScript/Web/Canvas/TextMetrics.hs @@ -67,28 +67,28 @@ ideographicBaseline tm = js_ideographicBaseline tm -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1.width" js_width :: TextMetrics -> Double + "((x) => { return x.width; })" js_width :: TextMetrics -> Double foreign import javascript unsafe - "$1.actualBoundingBoxLeft" js_actualBoundingBoxLeft :: TextMetrics -> Double + "((x) => { return x.actualBoundingBoxLeft; })" js_actualBoundingBoxLeft :: TextMetrics -> Double foreign import javascript unsafe - "$1.actualBoundingBoxRight" js_actualBoundingBoxRight :: TextMetrics -> Double + "((x) => { return x.actualBoundingBoxRight; })" js_actualBoundingBoxRight :: TextMetrics -> Double foreign import javascript unsafe - "$1.fontBoundingBoxAscent" js_fontBoundingBoxAscent :: TextMetrics -> Double + "((x) => { return x.fontBoundingBoxAscent; })" js_fontBoundingBoxAscent :: TextMetrics -> Double foreign import javascript unsafe - "$1.fontBoundingBoxDescent" js_fontBoundingBoxDescent :: TextMetrics -> Double + "((x) => { return x.fontBoundingBoxDescent; })" js_fontBoundingBoxDescent :: TextMetrics -> Double foreign import javascript unsafe - "$1.actualBoundingBoxAscent" js_actualBoundingBoxAscent :: TextMetrics -> Double + "((x) => { return x.actualBoundingBoxAscent; })" js_actualBoundingBoxAscent :: TextMetrics -> Double foreign import javascript unsafe - "$1.actualBoundingBoxDescent" js_actualBoundingBoxDescent :: TextMetrics -> Double + "((x) => { return x.actualBoundingBoxDescent; })" js_actualBoundingBoxDescent :: TextMetrics -> Double foreign import javascript unsafe - "$1.emHeightAscent" js_emHeightAscent :: TextMetrics -> Double + "((x) => { return x.emHeightAscent; })" js_emHeightAscent :: TextMetrics -> Double foreign import javascript unsafe - "$1.emHeightDescent" js_emHeightDescent :: TextMetrics -> Double + "((x) => { return x.emHeightDescent; })" js_emHeightDescent :: TextMetrics -> Double foreign import javascript unsafe - "$1.hangingBaseline" js_hangingBaseline :: TextMetrics -> Double + "((x) => { return x.hangingBaseline; })" js_hangingBaseline :: TextMetrics -> Double foreign import javascript unsafe - "$1.alphabeticBaseline" js_alphabeticBaseline :: TextMetrics -> Double + "((x) => { return x.alphabeticBaseline; })" js_alphabeticBaseline :: TextMetrics -> Double foreign import javascript unsafe - "$1.ideographicBaseline" js_ideographicBaseline :: TextMetrics -> Double + "((x) => { return x.ideographicBaseline; })" js_ideographicBaseline :: TextMetrics -> Double diff --git a/JavaScript/Web/CloseEvent.hs b/JavaScript/Web/CloseEvent.hs index 7cb9542..bb0bf22 100644 --- a/JavaScript/Web/CloseEvent.hs +++ b/JavaScript/Web/CloseEvent.hs @@ -25,8 +25,8 @@ wasClean c = js_wasClean c -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1.code" js_getCode :: CloseEvent -> Int + "((x) => { return x.code; })" js_getCode :: CloseEvent -> Int foreign import javascript unsafe - "$1.reason" js_getReason :: CloseEvent -> JSString + "((x) => { return x.reason; })" js_getReason :: CloseEvent -> JSString foreign import javascript unsafe - "$1.wasClean" js_wasClean :: CloseEvent -> Bool + "((x) => { return x.wasClean; })" js_wasClean :: CloseEvent -> Bool diff --git a/JavaScript/Web/ErrorEvent.hs b/JavaScript/Web/ErrorEvent.hs index ad95631..a057601 100644 --- a/JavaScript/Web/ErrorEvent.hs +++ b/JavaScript/Web/ErrorEvent.hs @@ -39,13 +39,13 @@ error ee = js_getError ee -- ----------------------------------------------------------------------------- -foreign import javascript unsafe "$1.message" +foreign import javascript unsafe "((x) => { return x.message; })" js_getMessage :: ErrorEvent -> JSString -foreign import javascript unsafe "$1.filename" +foreign import javascript unsafe "((x) => { return x.filename; })" js_getFilename :: ErrorEvent -> JSString -foreign import javascript unsafe "$1.lineno" +foreign import javascript unsafe "((x) => { return x.lineno; })" js_getLineno :: ErrorEvent -> Int -foreign import javascript unsafe "$1.colno" +foreign import javascript unsafe "((x) => { return x.colno; })" js_getColno :: ErrorEvent -> Int -foreign import javascript unsafe "$1.error" +foreign import javascript unsafe "((x) => { return x.error; })" js_getError :: ErrorEvent -> JSVal diff --git a/JavaScript/Web/File.hs b/JavaScript/Web/File.hs index 83b41f7..61516b1 100644 --- a/JavaScript/Web/File.hs +++ b/JavaScript/Web/File.hs @@ -26,6 +26,6 @@ lastModified b = js_lastModified b -- ----------------------------------------------------------------------------- -foreign import javascript unsafe "$1.name" js_name :: File -> JSString -foreign import javascript unsafe "$1.lastModified" js_lastModified :: File -> Double +foreign import javascript unsafe "((x) => { return x.name; })" js_name :: File -> JSString +foreign import javascript unsafe "((x) => { return x.lastModified; })" js_lastModified :: File -> Double diff --git a/JavaScript/Web/Location.hs b/JavaScript/Web/Location.hs index 7468499..b8c7461 100644 --- a/JavaScript/Web/Location.hs +++ b/JavaScript/Web/Location.hs @@ -144,29 +144,29 @@ replace = js_assign foreign import javascript safe "window.location" js_getWindowLocation :: IO Location -foreign import javascript unsafe "$1.href" js_getHref :: Location -> IO JSString -foreign import javascript unsafe "$1.protocol" js_getProtocol :: Location -> IO JSString -foreign import javascript unsafe "$1.host" js_getHost :: Location -> IO JSString -foreign import javascript unsafe "$1.hostname" js_getHostname :: Location -> IO JSString -foreign import javascript unsafe "$1.port" js_getPort :: Location -> IO JSString -foreign import javascript unsafe "$1.pathname" js_getPathname :: Location -> IO JSString -foreign import javascript unsafe "$1.search" js_getSearch :: Location -> IO JSString -foreign import javascript unsafe "$1.hash" js_getHash :: Location -> IO JSString -foreign import javascript unsafe "$1.username" js_getUsername :: Location -> IO JSString -foreign import javascript unsafe "$1.password" js_getPassword :: Location -> IO JSString -foreign import javascript unsafe "$1.origin" js_getOrigin :: Location -> IO JSString - -foreign import javascript safe "$2.href = $1;" js_setHref :: JSString -> Location -> IO () -foreign import javascript safe "$2.protocol = $1;" js_setProtocol :: JSString -> Location -> IO () -foreign import javascript safe "$2.host = $1;" js_setHost :: JSString -> Location -> IO () -foreign import javascript safe "$2.hostname = $1;" js_setHostname :: JSString -> Location -> IO () -foreign import javascript safe "$2.port = $1;" js_setPort :: JSString -> Location -> IO () -foreign import javascript safe "$2.pathname = $1;" js_setPathname :: JSString -> Location -> IO () -foreign import javascript safe "$2.search = $1;" js_setSearch :: JSString -> Location -> IO () -foreign import javascript safe "$2.hash = $1;" js_setHash :: JSString -> Location -> IO () -foreign import javascript safe "$2.username = $1;" js_setUsername :: JSString -> Location -> IO () -foreign import javascript safe "$2.password = $1;" js_setPassword :: JSString -> Location -> IO () - -foreign import javascript safe "$2.assign($1);" js_assign :: JSString -> Location -> IO () -foreign import javascript safe "$2.reload($1);" js_reload :: Bool -> Location -> IO () -foreign import javascript safe "$2.replace($1);" js_replace :: JSString -> Location -> IO () +foreign import javascript unsafe "((x) => { return x.href; })" js_getHref :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.protocol; })" js_getProtocol :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.host; })" js_getHost :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.hostname; })" js_getHostname :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.port; })" js_getPort :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.pathname; })" js_getPathname :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.search; })" js_getSearch :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.hash; })" js_getHash :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.username; })" js_getUsername :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.password; })" js_getPassword :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.origin; })" js_getOrigin :: Location -> IO JSString + +foreign import javascript safe "((x,y) => { y.href = x; })" js_setHref :: JSString -> Location -> IO () +foreign import javascript safe "((x,y) => { y.protocol = x; })" js_setProtocol :: JSString -> Location -> IO () +foreign import javascript safe "((x,y) => { y.host = x; })" js_setHost :: JSString -> Location -> IO () +foreign import javascript safe "((x,y) => { y.hostname = x; })" js_setHostname :: JSString -> Location -> IO () +foreign import javascript safe "((x,y) => { y.port = x; })" js_setPort :: JSString -> Location -> IO () +foreign import javascript safe "((x,y) => { y.pathname = x; })" js_setPathname :: JSString -> Location -> IO () +foreign import javascript safe "((x,y) => { y.search = x; })" js_setSearch :: JSString -> Location -> IO () +foreign import javascript safe "((x,y) => { y.hash = x; })" js_setHash :: JSString -> Location -> IO () +foreign import javascript safe "((x,y) => { y.username = x; })" js_setUsername :: JSString -> Location -> IO () +foreign import javascript safe "((x,y) => { y.password = x; })" js_setPassword :: JSString -> Location -> IO () + +foreign import javascript safe "((x,y) => { y.assign(x); })" js_assign :: JSString -> Location -> IO () +foreign import javascript safe "((x,y) => { y.reload(x); })" js_reload :: Bool -> Location -> IO () +foreign import javascript safe "((x,y) => { y.replace(x); })" js_replace :: JSString -> Location -> IO () diff --git a/JavaScript/Web/MessageEvent.hs b/JavaScript/Web/MessageEvent.hs index 4cb0b8e..a7fef26 100644 --- a/JavaScript/Web/MessageEvent.hs +++ b/JavaScript/Web/MessageEvent.hs @@ -38,6 +38,7 @@ getData me = case js_getData me of -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$r2 = $1.data;\ - \$r1 = typeof $r2 === 'string' ? 1 : ($r2 instanceof ArrayBuffer ? 3 : 2)" + "((x) => { var r2 = x.data;\ + \ var r1 = typeof r === 'string' ? 1 : (r instanceof ArrayBuffer ? 3 : 2);\ + \ RETURN_UBX_TUP2(r1, r2); })" js_getData :: MessageEvent -> (# Int#, JSVal #) diff --git a/JavaScript/Web/Performance.hs b/JavaScript/Web/Performance.hs index 7e32c7a..633a271 100644 --- a/JavaScript/Web/Performance.hs +++ b/JavaScript/Web/Performance.hs @@ -27,5 +27,5 @@ now = js_performanceNow -- ----------------------------------------------------------------------------- -foreign import javascript unsafe "performance.now()" +foreign import javascript unsafe "(() => { return performance.now(); })" js_performanceNow :: IO Double diff --git a/JavaScript/Web/Storage.hs b/JavaScript/Web/Storage.hs index dba9875..cdbe4d7 100644 --- a/JavaScript/Web/Storage.hs +++ b/JavaScript/Web/Storage.hs @@ -57,18 +57,18 @@ clear s = js_clear s -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "window.localStorage" js_localStorage :: Storage + "window.localStorage" js_localStorage :: Storage foreign import javascript unsafe - "window.sessionStorage" js_sessionStorage :: Storage + "window.sessionStorage" js_sessionStorage :: Storage foreign import javascript unsafe - "$1.length" js_getLength :: Storage -> IO Int + "((x) => { return x.length; })" js_getLength :: Storage -> IO Int foreign import javascript unsafe - "$2.key($1)" js_getIndex :: Int -> Storage -> IO JSVal + "((x,y) => { y.key(x); })" js_getIndex :: Int -> Storage -> IO JSVal foreign import javascript unsafe - "$2.getItem($1)" js_getItem :: JSString -> Storage -> IO JSVal + "((x,y) => { y.getItem(x); })" js_getItem :: JSString -> Storage -> IO JSVal foreign import javascript safe - "$3.setItem($1,$2)" js_setItem :: JSString -> JSString -> Storage -> IO () + "((x,y,z) => { x.setItem(x,y); })" js_setItem :: JSString -> JSString -> Storage -> IO () foreign import javascript unsafe - "$2.removeItem($1)" js_removeItem :: JSString -> Storage -> IO () + "((x,y) => { y.removeItem(x); })" js_removeItem :: JSString -> Storage -> IO () foreign import javascript unsafe - "$1.clear();" js_clear :: Storage -> IO () + "((x) => { x.clear(); })" js_clear :: Storage -> IO () diff --git a/JavaScript/Web/StorageEvent.hs b/JavaScript/Web/StorageEvent.hs index 9bc3838..496e5a8 100644 --- a/JavaScript/Web/StorageEvent.hs +++ b/JavaScript/Web/StorageEvent.hs @@ -51,12 +51,12 @@ storageArea se | isNull r = Nothing -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1.key" js_getKey :: StorageEvent -> JSVal + "((x) => { return x.key; })" js_getKey :: StorageEvent -> JSVal foreign import javascript unsafe - "$1.oldValue" js_getOldValue :: StorageEvent -> JSVal + "((x) => { return x.oldValue; })" js_getOldValue :: StorageEvent -> JSVal foreign import javascript unsafe - "$1.newValue" js_getNewValue :: StorageEvent -> JSVal + "((x) => { return x.newValue; })" js_getNewValue :: StorageEvent -> JSVal foreign import javascript unsafe - "$1.url" js_getUrl :: StorageEvent -> JSString + "((x) => { return x.url; })" js_getUrl :: StorageEvent -> JSString foreign import javascript unsafe - "$1.storageArea" js_getStorageArea :: StorageEvent -> JSVal + "((x) => { return x.storageArea; })" js_getStorageArea :: StorageEvent -> JSVal diff --git a/JavaScript/Web/WebSocket.hs b/JavaScript/Web/WebSocket.hs index 4f42aa8..ae6826d 100644 --- a/JavaScript/Web/WebSocket.hs +++ b/JavaScript/Web/WebSocket.hs @@ -151,40 +151,40 @@ setBinaryType ArrayBuffer = js_setBinaryType (JSS.pack "arraybuffer") -- ----------------------------------------------------------------------------- foreign import javascript safe - "new WebSocket($1)" js_createDefault :: JSString -> IO WebSocket + "(($1) => { return new WebSocket($1); })" js_createDefault :: JSString -> IO WebSocket foreign import javascript safe - "new WebSocket($1, $2)" js_createStr :: JSString -> JSString -> IO WebSocket + "(($1,$2) => { return new WebSocket($1, $2); })" js_createStr :: JSString -> JSString -> IO WebSocket foreign import javascript safe - "new WebSocket($1, $2)" js_createArr :: JSString -> JSArray -> IO WebSocket + "(($1,$2) => { return new WebSocket($1, $2); })" js_createArr :: JSString -> JSArray -> IO WebSocket foreign import javascript interruptible - "h$openWebSocket($1, $2, $3, $c);" + "h$openWebSocket" js_open :: WebSocket -> JSVal -> JSVal -> IO JSVal foreign import javascript safe - "h$closeWebSocket($1, $2, $3);" + "h$closeWebSocket" js_close :: Int -> JSString -> WebSocket -> IO () foreign import javascript unsafe - "$2.send($1);" js_send :: JSString -> WebSocket -> IO () + "((x,y) => { y.send(x); })" js_send :: JSString -> WebSocket -> IO () foreign import javascript unsafe - "$2.send($1);" js_sendBlob :: Blob -> WebSocket -> IO () + "((x,y) => { y.send(x); })" js_sendBlob :: Blob -> WebSocket -> IO () foreign import javascript unsafe - "$2.send($1);" js_sendArrayBuffer :: ArrayBuffer -> WebSocket -> IO () + "((x,y) => { y.send(x); })" js_sendArrayBuffer :: ArrayBuffer -> WebSocket -> IO () foreign import javascript unsafe - "$1.bufferedAmount" js_getBufferedAmount :: WebSocket -> IO Int + "((x) => { return x.bufferedAmount; })" js_getBufferedAmount :: WebSocket -> IO Int foreign import javascript unsafe - "$1.readyState" js_getReadyState :: WebSocket -> IO Int + "((x) => { return x.readyState; })" js_getReadyState :: WebSocket -> IO Int foreign import javascript unsafe - "$1.protocol" js_getProtocol :: WebSocket -> IO JSString + "((x) => { return x.protocol; })" js_getProtocol :: WebSocket -> IO JSString foreign import javascript unsafe - "$1.extensions" js_getExtensions :: WebSocket -> IO JSString + "((x) => { return x.extensions; })" js_getExtensions :: WebSocket -> IO JSString foreign import javascript unsafe - "$1.url" js_getUrl :: WebSocket -> JSString + "((x) => { return x.url; })" js_getUrl :: WebSocket -> JSString foreign import javascript unsafe - "$1.binaryType === 'blob' ? 0 : 1" + "((x) => { return x.binaryType === 'blob' ? 0 : 1; })" js_getBinaryType :: WebSocket -> IO Int foreign import javascript unsafe - "$1.lastError" js_getLastError :: WebSocket -> IO JSVal + "((x) => { return x.lastError; })" js_getLastError :: WebSocket -> IO JSVal foreign import javascript unsafe - "$2.binaryType = $1" + "((x,y) => { y.binaryType = x; })" js_setBinaryType :: JSString -> WebSocket -> IO () diff --git a/JavaScript/Web/Worker.hs b/JavaScript/Web/Worker.hs index f086023..49707b7 100644 --- a/JavaScript/Web/Worker.hs +++ b/JavaScript/Web/Worker.hs @@ -28,8 +28,8 @@ terminate w = js_terminate w -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "new Worker($1)" js_create :: JSString -> IO Worker + "(($1) => { return new Worker($1); })" js_create :: JSString -> IO Worker foreign import javascript unsafe - "$2.postMessage($1)" js_postMessage :: JSVal -> Worker -> IO () + "((x,y) => { y.postMessage(x); })" js_postMessage :: JSVal -> Worker -> IO () foreign import javascript unsafe - "$1.terminate()" js_terminate :: Worker -> IO () + "((x) => { x.terminate(); })" js_terminate :: Worker -> IO () diff --git a/JavaScript/Web/XMLHttpRequest.hs b/JavaScript/Web/XMLHttpRequest.hs index f378107..3e05742 100644 --- a/JavaScript/Web/XMLHttpRequest.hs +++ b/JavaScript/Web/XMLHttpRequest.hs @@ -201,57 +201,57 @@ xhrByteString = fmap -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1.withCredentials = true;" + "((x) => { return x.withCredentials = true; })" js_setWithCredentials :: XHR -> IO () foreign import javascript unsafe - "new XMLHttpRequest()" + "((x) => { return new XMLHttpRequest(); })" js_createXHR :: IO XHR foreign import javascript unsafe - "$2.responseType = $1;" + "((x,y) => { y.responseType = x; })" js_setResponseType :: JSString -> XHR -> IO () foreign import javascript unsafe - "$1.abort();" + "((x) => { return x.abort(); })" js_abort :: XHR -> IO () foreign import javascript unsafe - "$3.setRequestHeader($1,$2);" + "((x,y,z) => { x.setRequestHeader(x,y); })" js_setRequestHeader :: JSString -> JSString -> XHR -> IO () foreign import javascript unsafe - "$3.open($1,$2)" + "((x,y,z) => { x.open(x,y); })" js_open2 :: JSString -> JSString -> XHR -> IO () foreign import javascript unsafe - "$5.open($1,$2,true,$4,$5);" + "(($1,$2,$3,$4,$5) => { $5.open($1,$2,true,$4,$5); })" js_open4 :: JSString -> JSString -> JSString -> JSString -> XHR -> IO () foreign import javascript unsafe "new FormData()" js_createFormData :: IO JSFormData foreign import javascript unsafe - "$3.append($1,$2)" + "((x,y,z) => { x.append(x,y); })" js_appendFormData2 :: JSString -> JSVal -> JSFormData -> IO () foreign import javascript unsafe - "$4.append($1,$2,$3)" + "(($1,$2,$3,$4) => { $4.append($1,$2,$3); })" js_appendFormData3 :: JSString -> JSVal -> JSString -> JSFormData -> IO () foreign import javascript unsafe - "$1.status" + "((x) => { return x.status; })" js_getStatus :: XHR -> IO Int foreign import javascript unsafe - "$1.response" + "((x) => { return x.response; })" js_getResponse :: XHR -> IO JSVal foreign import javascript unsafe - "$1.response ? true : false" + "((x) => { return x.response ? true : false; })" js_hasResponse :: XHR -> IO Bool foreign import javascript unsafe - "$1.getAllResponseHeaders()" + "((x) => { return x.getAllResponseHeaders(); })" js_getAllResponseHeaders :: XHR -> IO JSString foreign import javascript unsafe - "$2.getResponseHeader($1)" + "((x,y) => { y.getResponseHeader(x); })" js_getResponseHeader :: JSString -> XHR -> IO JSVal -- ----------------------------------------------------------------------------- foreign import javascript interruptible - "h$sendXHR($1, null, $c);" + "h$sendXHR" js_send0 :: XHR -> IO Int foreign import javascript interruptible - "h$sendXHR($2, $1, $c);" + "h$sendXHR" js_send1 :: JSVal -> XHR -> IO Int From 15b2c00b07f25b18fddc568e4ed2b4e8a9b057b2 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Tue, 18 Jul 2023 01:27:19 +1000 Subject: [PATCH 03/53] Testsuite fixes --- Data/JSString/Int.hs | 2 +- Data/JSString/Internal/Fusion.hs | 4 ++-- Data/JSString/Internal/Type.hs | 2 +- GHCJS/Buffer.hs | 9 +++++---- GHCJS/Marshal/Pure.hs | 8 +++++--- GHCJS/Types.hs | 2 +- JavaScript/Array/Internal.hs | 2 +- JavaScript/TypedArray/DataView/Internal.hs | 2 +- JavaScript/Web/Canvas.hs | 2 +- JavaScript/Web/MessageEvent.hs | 2 +- JavaScript/Web/Storage.hs | 16 ++++++++-------- JavaScript/Web/XMLHttpRequest.hs | 6 +++--- ghcjs-base.cabal | 12 +++++++----- jsbits/buffer.js | 9 +++++++++ jsbits/jsstring.js | 4 ++-- test/Tests/Properties.hs | 19 ++++++++++--------- test/Tests/QuickCheckUtils.hs | 2 ++ 17 files changed, 60 insertions(+), 43 deletions(-) create mode 100644 jsbits/buffer.js diff --git a/Data/JSString/Int.hs b/Data/JSString/Int.hs index eca7fb3..0cb55ff 100644 --- a/Data/JSString/Int.hs +++ b/Data/JSString/Int.hs @@ -247,7 +247,7 @@ foreign import javascript unsafe "h$jsstringHexW64" js_hexW64 :: Word64# -> JSString foreign import javascript unsafe - "h$jsstringHexInteger)" + "h$jsstringHexInteger" js_hexInteger :: Any -> JSString foreign import javascript unsafe diff --git a/Data/JSString/Internal/Fusion.hs b/Data/JSString/Internal/Fusion.hs index 6c955ee..803c130 100644 --- a/Data/JSString/Internal/Fusion.hs +++ b/Data/JSString/Internal/Fusion.hs @@ -185,9 +185,9 @@ foreign import javascript unsafe foreign import javascript unsafe "((x) => { return x.length; })" js_length :: JSString -> Int# foreign import javascript unsafe - "((x) => { return [$1]; })" js_newSingletonArray :: Char -> IO JSVal + "((x) => { return [x]; })" js_newSingletonArray :: Char -> IO JSVal foreign import javascript unsafe - "((x,y,z) => z[y] = x; })" js_writeArray :: Char -> Int -> JSVal -> IO () + "((x,y,z) => { z[y] = x; })" js_writeArray :: Char -> Int -> JSVal -> IO () foreign import javascript unsafe "h$jsstringPackArray" js_packString :: JSVal -> IO JSString foreign import javascript unsafe diff --git a/Data/JSString/Internal/Type.hs b/Data/JSString/Internal/Type.hs index be180fb..cf541b0 100644 --- a/Data/JSString/Internal/Type.hs +++ b/Data/JSString/Internal/Type.hs @@ -47,7 +47,7 @@ instance IsJSVal JSString instance NFData JSString where rnf !x = () foreign import javascript unsafe - "(() => return ''; })" js_empty :: JSString + "(() => { return ''; })" js_empty :: JSString -- | /O(1)/ The empty 'JSString'. empty :: JSString diff --git a/GHCJS/Buffer.hs b/GHCJS/Buffer.hs index a4b83b2..c181577 100644 --- a/GHCJS/Buffer.hs +++ b/GHCJS/Buffer.hs @@ -146,13 +146,14 @@ toMutableByteArrayPrim (SomeBuffer buf) = js_toMutableByteArray buf -- as a reference for the purpose of determining when that finalizer -- should run. fromByteString :: ByteString -> (Buffer, Int, Int) -fromByteString (BS.PS fp off len) = +fromByteString (BS.BS fp len) = -- not super happy with this. What if the bytestring's foreign ptr -- has a nontrivial finalizer attached to it? I don't think there's -- a way to do that without someone else messing with the PS constructor -- directly though. let !(Ptr addr) = unsafeForeignPtrToPtr fp - in (js_fromAddr addr, off, len) + (ptr, off) = js_fromAddr addr + in (ptr, off, len) {-# INLINE fromByteString #-} -- | Wrap a 'Buffer' into a 'ByteString' using the given offset @@ -223,6 +224,6 @@ foreign import javascript unsafe foreign import javascript unsafe "((x) => { return x; })" js_toMutableByteArray :: JSVal -> MutableByteArray# s foreign import javascript unsafe - "((x,y) => { RETURN_UBX_TUP2(x,y); })" js_toAddr :: SomeBuffer any -> Addr# + "h$toAddr" js_toAddr :: SomeBuffer any -> Addr# foreign import javascript unsafe - "((x) => { return x; })" js_fromAddr :: Addr# -> SomeBuffer any + "h$fromAddr" js_fromAddr :: Addr# -> (SomeBuffer any, Int) diff --git a/GHCJS/Marshal/Pure.hs b/GHCJS/Marshal/Pure.hs index 552f36c..5311aae 100644 --- a/GHCJS/Marshal/Pure.hs +++ b/GHCJS/Marshal/Pure.hs @@ -21,6 +21,8 @@ -} module GHCJS.Marshal.Pure ( PFromJSVal(..) , PToJSVal(..) + , jsvalToChar + , charToJSVal ) where import Data.Char (chr, ord) @@ -85,7 +87,7 @@ instance PFromJSVal Word8 where pFromJSVal x = W8# (jsvalToWord8 x) {-# INLINE pFromJSVal #-} instance PFromJSVal Word16 where pFromJSVal x = W16# (jsvalToWord16 x) {-# INLINE pFromJSVal #-} -instance PFromJSVal Word32 where pFromJSVal x = W32# (jsvalToWord32 x) +instance PFromJSVal Word32 where pFromJSVal x = (jsvalToWord32 x) {-# INLINE pFromJSVal #-} instance PFromJSVal Float where pFromJSVal x = F# (jsvalToFloat x) {-# INLINE pFromJSVal #-} @@ -136,10 +138,10 @@ instance PToJSVal a => PToJSVal (Maybe a) where pToJSVal (Just a) = pToJSVal a {-# INLINE pToJSVal #-} -foreign import javascript unsafe "((x) => { return x|0; })" jsvalToWord :: JSVal -> Word# +foreign import javascript unsafe "((x) => { return x>>>0; })" jsvalToWord :: JSVal -> Word# foreign import javascript unsafe "((x) => { return x&0xff; })" jsvalToWord8 :: JSVal -> Word8# foreign import javascript unsafe "((x) => { return x&0xffff; })" jsvalToWord16 :: JSVal -> Word16# -foreign import javascript unsafe "((x) => { return x|0; })" jsvalToWord32 :: JSVal -> Word32# +foreign import javascript unsafe "((x) => { return x>>>0; })" jsvalToWord32 :: JSVal -> Word32 foreign import javascript unsafe "((x) => { return x|0; })" jsvalToInt :: JSVal -> Int# foreign import javascript unsafe "((x) => { return x<<24>>24; })" jsvalToInt8 :: JSVal -> Int8# foreign import javascript unsafe "((x) => { return x<<16>>16; })" jsvalToInt16 :: JSVal -> Int16# diff --git a/GHCJS/Types.hs b/GHCJS/Types.hs index 89a826a..b59cd8e 100644 --- a/GHCJS/Types.hs +++ b/GHCJS/Types.hs @@ -56,7 +56,7 @@ foreign import javascript unsafe "((x) => { return null; })" foreign import javascript unsafe "((x,y) => { return x; })" js_ptrVal :: Ptr a -> JSVal -foreign import javascript unsafe "((x) => { RETURN_UBX_TUP2(x,0); })" +foreign import javascript unsafe "((x) => { h$ret1 = 0; return x; })" js_mkPtr :: JSVal -> Ptr a -- | This is a deprecated copmatibility wrapper for the old JSRef type. diff --git a/JavaScript/Array/Internal.hs b/JavaScript/Array/Internal.hs index 8e1cfd7..f0be42e 100644 --- a/JavaScript/Array/Internal.hs +++ b/JavaScript/Array/Internal.hs @@ -181,7 +181,7 @@ foreign import javascript unsafe "((x) => { return x.shift(); })" foreign import javascript unsafe "((x) => { x.reverse(); })" js_reverse :: SomeJSArray m -> State# s -> (# State# s, () #) -foreign import javascript unsafe "h$toHsListJSVal)" +foreign import javascript unsafe "h$toHsListJSVal" js_fromJSArray :: SomeJSArray m -> State# s -> (# State# s, Exts.Any #) foreign import javascript unsafe "h$toHsListJSVal" js_fromJSArrayPure :: JSArray -> Exts.Any -- [JSVal] diff --git a/JavaScript/TypedArray/DataView/Internal.hs b/JavaScript/TypedArray/DataView/Internal.hs index bdef01c..cda9f7d 100644 --- a/JavaScript/TypedArray/DataView/Internal.hs +++ b/JavaScript/TypedArray/DataView/Internal.hs @@ -41,7 +41,7 @@ JSU "((x,y) => { return new DataView(y,x); })" js_unsafeDataView2 :: Int -> JSVal-> SomeDataView m JSS "((x,y,z) => { return new DataView(z,x,y); })" js_dataView :: Int -> Int -> JSVal -> SomeDataView m -JSU "((x,y,z) => { return new DataView(z,x,y); })" +JSU "((x,y,z) => { return new DataView(z,x,y); })" js_unsafeDataView :: Int -> Int -> JSVal -> JSVal JSU "((x) => { return new DataView(x.buffer.slice(x.byteOffset, x.byteLength)); })" js_cloneDataView :: SomeDataView m -> IO (SomeDataView m1) diff --git a/JavaScript/Web/Canvas.hs b/JavaScript/Web/Canvas.hs index adc02f9..4efd03a 100644 --- a/JavaScript/Web/Canvas.hs +++ b/JavaScript/Web/Canvas.hs @@ -410,7 +410,7 @@ foreign import javascript unsafe "(($1,$2,$3,$4) => { $4.fillText($1,$2,$3); })" js_fillText :: JSString -> Double -> Double -> Context -> IO () foreign import javascript unsafe "(($1,$2,$3,$4) => { $4.strokeText($1,$2,$3); })" js_strokeText :: JSString -> Double -> Double -> Context -> IO () -foreign import javascript unsafe "((x,y) => { y.measureText(x); })" +foreign import javascript unsafe "((x,y) => { return y.measureText(x); })" js_measureText :: JSString -> Context -> IO Object foreign import javascript unsafe "(($1,$2,$3,$4,$5) => { $5.fillRect($1,$2,$3,$4); })" js_fillRect :: Double -> Double -> Double -> Double -> Context -> IO () diff --git a/JavaScript/Web/MessageEvent.hs b/JavaScript/Web/MessageEvent.hs index a7fef26..faa7e10 100644 --- a/JavaScript/Web/MessageEvent.hs +++ b/JavaScript/Web/MessageEvent.hs @@ -40,5 +40,5 @@ getData me = case js_getData me of foreign import javascript unsafe "((x) => { var r2 = x.data;\ \ var r1 = typeof r === 'string' ? 1 : (r instanceof ArrayBuffer ? 3 : 2);\ - \ RETURN_UBX_TUP2(r1, r2); })" + \ h$ret1 = r2; return r1; })" js_getData :: MessageEvent -> (# Int#, JSVal #) diff --git a/JavaScript/Web/Storage.hs b/JavaScript/Web/Storage.hs index cdbe4d7..568c6bf 100644 --- a/JavaScript/Web/Storage.hs +++ b/JavaScript/Web/Storage.hs @@ -57,18 +57,18 @@ clear s = js_clear s -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "window.localStorage" js_localStorage :: Storage + "window.localStorage" js_localStorage :: Storage foreign import javascript unsafe - "window.sessionStorage" js_sessionStorage :: Storage + "window.sessionStorage" js_sessionStorage :: Storage foreign import javascript unsafe - "((x) => { return x.length; })" js_getLength :: Storage -> IO Int + "((x) => { return x.length; })" js_getLength :: Storage -> IO Int foreign import javascript unsafe - "((x,y) => { y.key(x); })" js_getIndex :: Int -> Storage -> IO JSVal + "((x,y) => { return y.key(x); })" js_getIndex :: Int -> Storage -> IO JSVal foreign import javascript unsafe - "((x,y) => { y.getItem(x); })" js_getItem :: JSString -> Storage -> IO JSVal + "((x,y) => { return y.getItem(x); })" js_getItem :: JSString -> Storage -> IO JSVal foreign import javascript safe - "((x,y,z) => { x.setItem(x,y); })" js_setItem :: JSString -> JSString -> Storage -> IO () + "((x,y,z) => { x.setItem(x,y); })" js_setItem :: JSString -> JSString -> Storage -> IO () foreign import javascript unsafe - "((x,y) => { y.removeItem(x); })" js_removeItem :: JSString -> Storage -> IO () + "((x,y) => { y.removeItem(x); })" js_removeItem :: JSString -> Storage -> IO () foreign import javascript unsafe - "((x) => { x.clear(); })" js_clear :: Storage -> IO () + "((x) => { x.clear(); })" js_clear :: Storage -> IO () diff --git a/JavaScript/Web/XMLHttpRequest.hs b/JavaScript/Web/XMLHttpRequest.hs index 3e05742..7f81548 100644 --- a/JavaScript/Web/XMLHttpRequest.hs +++ b/JavaScript/Web/XMLHttpRequest.hs @@ -201,7 +201,7 @@ xhrByteString = fmap -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "((x) => { return x.withCredentials = true; })" + "((x) => { x.withCredentials = true; })" js_setWithCredentials :: XHR -> IO () foreign import javascript unsafe @@ -250,8 +250,8 @@ foreign import javascript unsafe -- ----------------------------------------------------------------------------- foreign import javascript interruptible - "h$sendXHR" + "((x,c) => { return h$sendXHR(x, null, c); })" js_send0 :: XHR -> IO Int foreign import javascript interruptible - "h$sendXHR" + "((x,y,c) => { return h$sendXHR(y, x, c); })" js_send1 :: JSVal -> XHR -> IO Int diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index cc61c3a..e9e344e 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -18,6 +18,7 @@ library if impl(ghc >= 8.10.1) js-sources: jsbits/array.js jsbits/animationFrame.js + jsbits/buffer.js jsbits/export.js jsbits/jsstring.js jsbits/jsstringRaw.js @@ -141,13 +142,13 @@ library build-depends: base >= 4.7 && < 5, ghc-prim, binary >= 0.8 && < 0.11, - bytestring >= 0.10 && < 0.11, - text >= 1.1 && < 1.3, - aeson >= 0.8 && < 2.1, - scientific >= 0.3 && < 0.4, + bytestring >= 0.10 && < 0.12, + text >= 1.1 && < 2.1, + aeson >= 0.8 && < 2.3, + scientific >= 0.3.7 && < 0.4, vector >= 0.10 && < 0.13, containers >= 0.5 && < 0.7, - time >= 1.5 && < 1.10, + time >= 1.5 && < 1.13, hashable >= 1.2 && < 1.5, unordered-containers >= 0.2 && < 0.3, attoparsec >= 0.11 && < 0.15, @@ -170,6 +171,7 @@ test-suite tests Tests.QuickCheckUtils Tests.Regressions Tests.Utils + Tests.Buffer ghc-options: -Wall -rtsopts build-depends: diff --git a/jsbits/buffer.js b/jsbits/buffer.js new file mode 100644 index 0000000..c816047 --- /dev/null +++ b/jsbits/buffer.js @@ -0,0 +1,9 @@ +//#OPTIONS: CPP + +function h$fromAddr(ptr, off) { + RETURN_UBX_TUP2(ptr, off); +} + +function h$toAddr(ptr) { + RETURN_UBX_TUP2(ptr,0); +} diff --git a/jsbits/jsstring.js b/jsbits/jsstring.js index d476ee8..0a99bb2 100644 --- a/jsbits/jsstring.js +++ b/jsbits/jsstring.js @@ -354,7 +354,7 @@ function h$jsstringTakeEnd(n, str) { if(n <= 0) return ''; var l = str.length, i = l-1, ch; if(n >= l) return str; - while(n-- && i > 0) { + while(n-- && i >= 0) { ch = str.charCodeAt(i--); if(IS_LO_SURR(ch)) i--; } @@ -366,7 +366,7 @@ function h$jsstringDropEnd(n, str) { if(n <= 0) return str; var l = str.length, i = l-1, ch; if(n >= l) return ''; - while(n-- && i > 0) { + while(n-- && i >= 0) { ch = str.charCodeAt(i--); if(IS_LO_SURR(ch)) i--; } diff --git a/test/Tests/Properties.hs b/test/Tests/Properties.hs index e184f5c..5c44ad0 100644 --- a/test/Tests/Properties.hs +++ b/test/Tests/Properties.hs @@ -521,7 +521,7 @@ tests = testProperty "sf_cons" sf_cons, testProperty "j_cons" j_cons, testProperty "s_snoc" s_snoc, - testProperty "j_snoc" j_snoc, +-- testProperty "j_snoc" j_snoc, -- property `.f` testProperty "s_append" s_append, testProperty "s_append_s" s_append_s, testProperty "sf_append" sf_append, @@ -740,8 +740,8 @@ tests = testProperty "j_index" j_index, testProperty "j_findIndex" j_findIndex, testProperty "j_count" j_count, - testProperty "j_indices" j_indices, - testProperty "j_indices_occurs" j_indices_occurs + testProperty "j_indices" j_indices--, +-- testProperty "j_indices_occurs" j_indices_occurs ], testGroup "zips" [ @@ -752,25 +752,26 @@ tests = testGroup "numeric conversion" [ testGroup "integral" [ - testProperty "j_decimal_integer" j_decimal_integer, +-- testProperty "j_decimal_integer" j_decimal_integer, -- IS_INTEGER_S testProperty "j_decimal_int" j_decimal_int, testProperty "j_decimal_int8" j_decimal_int8, testProperty "j_decimal_int16" j_decimal_int16, testProperty "j_decimal_int32" j_decimal_int32, testProperty "j_decimal_int64" j_decimal_int64, + testProperty "j_decimal_word" j_decimal_word, testProperty "j_decimal_word8" j_decimal_word8, testProperty "j_decimal_word16" j_decimal_word16, testProperty "j_decimal_word32" j_decimal_word32, testProperty "j_decimal_word64" j_decimal_word64, - testProperty "j_decimal_integer_big" j_decimal_integer_big, +-- testProperty "j_decimal_integer_big" j_decimal_integer_big, -- IS_INTEGER_S testProperty "j_decimal_int_big" j_decimal_int_big, testProperty "j_decimal_int64_big" j_decimal_int64_big, testProperty "j_decimal_word_big" j_decimal_word_big, testProperty "j_decimal_word64_big" j_decimal_word64_big, - testProperty "j_hexadecimal_integer" j_hexadecimal_integer, +-- testProperty "j_hexadecimal_integer" j_hexadecimal_integer, -- IS_INTEGER_S testProperty "j_hexadecimal_int" j_hexadecimal_int, testProperty "j_hexadecimal_int8" j_hexadecimal_int8, testProperty "j_hexadecimal_int16" j_hexadecimal_int16, @@ -783,9 +784,9 @@ tests = testProperty "j_hexadecimal_word64" j_hexadecimal_word64 ], testGroup "realfloat" [ - -- disabled due to rounding differences - -- testProperty "j_realfloat_double" j_realfloat_double, - -- testProperty "j_formatRealFloat_double" j_formatRealFloat_double + -- disabled due to rounding differences + -- testProperty "j_realfloat_double" j_realfloat_double, + -- testProperty "j_formatRealFloat_double" j_formatRealFloat_double ] ], diff --git a/test/Tests/QuickCheckUtils.hs b/test/Tests/QuickCheckUtils.hs index 942c51a..4a9c4b6 100644 --- a/test/Tests/QuickCheckUtils.hs +++ b/test/Tests/QuickCheckUtils.hs @@ -276,11 +276,13 @@ windowsNewlineMode = IO.NewlineMode { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF } +{- instance Arbitrary IO.NewlineMode where arbitrary = oneof . map return $ [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode , windowsNewlineMode ] +-} instance Arbitrary IO.BufferMode where arbitrary = oneof [ return IO.NoBuffering, From d58f439ab6f98bbfa7dc6e29edebd1d6226734e7 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 01:09:07 +1000 Subject: [PATCH 04/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 .github/workflows/ghcjs-base.yml diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml new file mode 100644 index 0000000..a0c4a67 --- /dev/null +++ b/.github/workflows/ghcjs-base.yml @@ -0,0 +1,17 @@ +name: ghcjs-base + +on: + pull_request: + +jobs: + build: + runs-on: ubuntu-latest + steps: + - uses: mymindstorm/setup-emsdk@v11 + - uses: haskell/actions/setup@v2 + + - name: Build + run: cabal build all + + - name: Test + run: cabal test test:tests From 3c1262e09507a5eac3107895351d72bb96fdbd2d Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 01:24:51 +1000 Subject: [PATCH 05/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index a0c4a67..5261769 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -7,6 +7,7 @@ jobs: build: runs-on: ubuntu-latest steps: + - uses: actions/checkout@v3 - uses: mymindstorm/setup-emsdk@v11 - uses: haskell/actions/setup@v2 From 05841cb2b17d8bd6512bb8b130fb18020aca2a03 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 02:03:07 +1000 Subject: [PATCH 06/53] Test to trigger PR action --- .github/workflows/ghcjs-base.yml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 5261769..06d307d 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -9,7 +9,11 @@ jobs: steps: - uses: actions/checkout@v3 - uses: mymindstorm/setup-emsdk@v11 - - uses: haskell/actions/setup@v2 + - uses: cachix/install-nix-action@v22 + # - uses: haskell/actions/setup@v2 + + - name: Install GHC + run: nix develop github:input-output-hk/devx#ghc962-js - name: Build run: cabal build all From c0d152626fdc0caf49fa197ec91e77bd432500d8 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 15:15:32 +1000 Subject: [PATCH 07/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 06d307d..cfa753a 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -12,8 +12,14 @@ jobs: - uses: cachix/install-nix-action@v22 # - uses: haskell/actions/setup@v2 - - name: Install GHC - run: nix develop github:input-output-hk/devx#ghc962-js + # - name: Install GHC + # run: nix develop github:input-output-hk/devx#ghc962-js + + - uses: input-output-hk/actions/devx@latest + with: + platform: 'x86_64-linux' + target-platform: 'javascript' + compiler-nix-name: 'ghc962' - name: Build run: cabal build all From 34d32117e07229c5d6e70ecf2280c9e7aac71767 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 15:23:31 +1000 Subject: [PATCH 08/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index cfa753a..d37d816 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -17,9 +17,9 @@ jobs: - uses: input-output-hk/actions/devx@latest with: - platform: 'x86_64-linux' - target-platform: 'javascript' - compiler-nix-name: 'ghc962' + platform: "x86_64-linux" + target-platform: "-js" + compiler-nix-name: "ghc962" - name: Build run: cabal build all From 42bf0645fd1a79ab8cc7ea103c97c24fc6a82332 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 15:31:06 +1000 Subject: [PATCH 09/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index d37d816..26493b5 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -22,7 +22,9 @@ jobs: compiler-nix-name: "ghc962" - name: Build - run: cabal build all + run: | + cabal update + cabal build all - name: Test run: cabal test test:tests From 1a9d2331759e0343c143c2ef701867b3049c3421 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 15:38:56 +1000 Subject: [PATCH 10/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 1 + ghcjs-base.cabal | 29 +++++++++++++++++++++++++---- 2 files changed, 26 insertions(+), 4 deletions(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 26493b5..1fc04e0 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -19,6 +19,7 @@ jobs: with: platform: "x86_64-linux" target-platform: "-js" + minimal: false compiler-nix-name: "ghc962" - name: Build diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index e9e344e..96763f6 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -157,8 +157,29 @@ library deepseq >= 1.3 && < 1.5, dlist >= 0.7 && < 1.1 default-language: Haskell2010 - if !arch(javascript) - buildable: False +-- if !arch(javascript) +-- buildable: False + +executable example + hs-source-dirs: ., test + main-is: Example.hs + build-depends: ghcjs-base, base, ghc-prim, deepseq, primitive, bytestring, text, binary, + HUnit >= 1.2, + QuickCheck >= 2.7, + array, + text, + base, + bytestring, + deepseq, + directory, + ghc-prim, + ghcjs-base, + primitive, + quickcheck-unicode, + random, + test-framework >= 0.4, + test-framework-hunit >= 0.2, + test-framework-quickcheck2 >= 0.2 test-suite tests type: exitcode-stdio-1.0 @@ -192,5 +213,5 @@ test-suite tests test-framework-hunit >= 0.2, test-framework-quickcheck2 >= 0.2 default-language: Haskell2010 - if !arch(javascript) - buildable: False +-- if !arch(javascript) +-- buildable: False From 455027654272b6cd4770f0b2a83e7dd99c2078b7 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 15:52:52 +1000 Subject: [PATCH 11/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 3 +++ ghcjs-base.cabal | 8 ++++---- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 1fc04e0..8d916e9 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -22,6 +22,9 @@ jobs: minimal: false compiler-nix-name: "ghc962" + - name: Info + run: ghc --info + - name: Build run: | cabal update diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index 96763f6..9975cb0 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -157,8 +157,8 @@ library deepseq >= 1.3 && < 1.5, dlist >= 0.7 && < 1.1 default-language: Haskell2010 --- if !arch(javascript) --- buildable: False + if !arch(javascript) + buildable: False executable example hs-source-dirs: ., test @@ -213,5 +213,5 @@ test-suite tests test-framework-hunit >= 0.2, test-framework-quickcheck2 >= 0.2 default-language: Haskell2010 --- if !arch(javascript) --- buildable: False + if !arch(javascript) + buildable: False From 97e24adff2680ec1851f687b0ef7d87e486e9d2f Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 16:05:12 +1000 Subject: [PATCH 12/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 8d916e9..381f7ca 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -17,10 +17,10 @@ jobs: - uses: input-output-hk/actions/devx@latest with: - platform: "x86_64-linux" + platform: x86_64-linux target-platform: "-js" - minimal: false - compiler-nix-name: "ghc962" + minimal: true + compiler-nix-name: ghc962 - name: Info run: ghc --info From 69d545068281834479cfc4833664874cf0841a8d Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 16:08:28 +1000 Subject: [PATCH 13/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 381f7ca..55d6eeb 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -18,7 +18,7 @@ jobs: - uses: input-output-hk/actions/devx@latest with: platform: x86_64-linux - target-platform: "-js" + target-platform: "-windows" minimal: true compiler-nix-name: ghc962 From f6b944205c5e233c996daaade6ce4d59bb607794 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 16:13:35 +1000 Subject: [PATCH 14/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 55d6eeb..9dafc4a 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -15,10 +15,11 @@ jobs: # - name: Install GHC # run: nix develop github:input-output-hk/devx#ghc962-js - - uses: input-output-hk/actions/devx@latest + - name: Install GHC $${{ compiler-nix-name }}${{ target-platform }} + uses: input-output-hk/actions/devx@latest with: platform: x86_64-linux - target-platform: "-windows" + target-platform: "-js" minimal: true compiler-nix-name: ghc962 From f1f3f98041c32fe1dc23e53bbceb8e4a1bd9be52 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 16:17:26 +1000 Subject: [PATCH 15/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 9dafc4a..5faafca 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -2,6 +2,11 @@ name: ghcjs-base on: pull_request: + inputs: + platform: x86_64-linux + target-platform: "-js" + minimal: true + compiler-nix-name: ghc962 jobs: build: @@ -15,13 +20,13 @@ jobs: # - name: Install GHC # run: nix develop github:input-output-hk/devx#ghc962-js - - name: Install GHC $${{ compiler-nix-name }}${{ target-platform }} + - name: Install GHC $${{ inputs.compiler-nix-name }}${{ inputs.target-platform }} uses: input-output-hk/actions/devx@latest with: - platform: x86_64-linux - target-platform: "-js" - minimal: true - compiler-nix-name: ghc962 + platform: inputs.platform + target-platform: inputs.target-platform + minimal: inputs.minimal + compiler-nix-name: inputs.compiler-nix-name - name: Info run: ghc --info From adae93f52a63a2fbc7e42277853c58dfa6343ef0 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 16:28:59 +1000 Subject: [PATCH 16/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 5faafca..1f9a831 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -2,15 +2,12 @@ name: ghcjs-base on: pull_request: - inputs: - platform: x86_64-linux - target-platform: "-js" - minimal: true - compiler-nix-name: ghc962 jobs: build: runs-on: ubuntu-latest + strategy: + steps: - uses: actions/checkout@v3 - uses: mymindstorm/setup-emsdk@v11 @@ -20,13 +17,13 @@ jobs: # - name: Install GHC # run: nix develop github:input-output-hk/devx#ghc962-js - - name: Install GHC $${{ inputs.compiler-nix-name }}${{ inputs.target-platform }} + - name: Install GHC $${{ with.compiler-nix-name }}${{ with.target-platform }} uses: input-output-hk/actions/devx@latest with: - platform: inputs.platform - target-platform: inputs.target-platform - minimal: inputs.minimal - compiler-nix-name: inputs.compiler-nix-name + platform: x86_linux + target-platform: "-js" + minimal: true + compiler-nix-name: ghc962 - name: Info run: ghc --info From 62674a442ac832706192ab94a29b563b278bfab3 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 16:31:12 +1000 Subject: [PATCH 17/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 1f9a831..7ebebc3 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -17,7 +17,7 @@ jobs: # - name: Install GHC # run: nix develop github:input-output-hk/devx#ghc962-js - - name: Install GHC $${{ with.compiler-nix-name }}${{ with.target-platform }} + - name: Install GHC uses: input-output-hk/actions/devx@latest with: platform: x86_linux From 3b527ce684d59b5f43ab83fa64f3320c0bd73257 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 16:32:35 +1000 Subject: [PATCH 18/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 7ebebc3..b772274 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -6,7 +6,6 @@ on: jobs: build: runs-on: ubuntu-latest - strategy: steps: - uses: actions/checkout@v3 From 83d341b6aa599fabdb55814e9d296b00ae1f46ee Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 17:35:12 +1000 Subject: [PATCH 19/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index b772274..6829a1d 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -9,8 +9,8 @@ jobs: steps: - uses: actions/checkout@v3 - - uses: mymindstorm/setup-emsdk@v11 - - uses: cachix/install-nix-action@v22 + # - uses: mymindstorm/setup-emsdk@v11 + # - uses: cachix/install-nix-action@v22 # - uses: haskell/actions/setup@v2 # - name: Install GHC From 0020c49f681f9297719f3bfb475d7eb77c52d1a9 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 17:37:24 +1000 Subject: [PATCH 20/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 6829a1d..e4f52d5 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -19,7 +19,7 @@ jobs: - name: Install GHC uses: input-output-hk/actions/devx@latest with: - platform: x86_linux + platform: x86_64-linux target-platform: "-js" minimal: true compiler-nix-name: ghc962 From c15a18d2508a9c57c3d90f2c534bc5efdd14a172 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 18:03:06 +1000 Subject: [PATCH 21/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index e4f52d5..69bc1b0 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -25,12 +25,12 @@ jobs: compiler-nix-name: ghc962 - name: Info - run: ghc --info + run: javascript-unknown-ghcjs-ghc --info - name: Build run: | cabal update - cabal build all + cabal build all --with-ghc=javascript-unknown-ghcjs-ghc --with-ghc-pkg=javascript-unknown-ghcjs-ghc-pkg --with-hsc2hs=javascript-unknown-ghcjs-hsc2hs - name: Test run: cabal test test:tests From 1c1f9b82a9e90537a2e760e12147b84eee1df0f3 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 18:09:17 +1000 Subject: [PATCH 22/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 69bc1b0..932ee90 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -7,6 +7,10 @@ jobs: build: runs-on: ubuntu-latest + defaults: + run: + shell: devx + steps: - uses: actions/checkout@v3 # - uses: mymindstorm/setup-emsdk@v11 @@ -24,13 +28,16 @@ jobs: minimal: true compiler-nix-name: ghc962 + - name: Cabal + run: file $(which cabal) + - name: Info run: javascript-unknown-ghcjs-ghc --info - name: Build run: | cabal update - cabal build all --with-ghc=javascript-unknown-ghcjs-ghc --with-ghc-pkg=javascript-unknown-ghcjs-ghc-pkg --with-hsc2hs=javascript-unknown-ghcjs-hsc2hs + cabal build all - name: Test run: cabal test test:tests From 6740746e02714adca9dce865dca019149a7a3503 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 18:12:03 +1000 Subject: [PATCH 23/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 932ee90..553829c 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -9,7 +9,7 @@ jobs: defaults: run: - shell: devx + shell: devx {0} steps: - uses: actions/checkout@v3 From 559dd6546a2cb1dac5c6d9023c50fee7fd0f4ab6 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 19 Jul 2023 18:21:54 +1000 Subject: [PATCH 24/53] WIP github actions --- ghcjs-base.cabal | 21 --------------------- 1 file changed, 21 deletions(-) diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index 9975cb0..e9e344e 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -160,27 +160,6 @@ library if !arch(javascript) buildable: False -executable example - hs-source-dirs: ., test - main-is: Example.hs - build-depends: ghcjs-base, base, ghc-prim, deepseq, primitive, bytestring, text, binary, - HUnit >= 1.2, - QuickCheck >= 2.7, - array, - text, - base, - bytestring, - deepseq, - directory, - ghc-prim, - ghcjs-base, - primitive, - quickcheck-unicode, - random, - test-framework >= 0.4, - test-framework-hunit >= 0.2, - test-framework-quickcheck2 >= 0.2 - test-suite tests type: exitcode-stdio-1.0 hs-source-dirs: test From 177fef1add65228fa35ddcd930851f05ba985082 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 27 Sep 2023 18:43:53 +1000 Subject: [PATCH 25/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 553829c..976420f 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -26,7 +26,7 @@ jobs: platform: x86_64-linux target-platform: "-js" minimal: true - compiler-nix-name: ghc962 + compiler-nix-name: ghc99 - name: Cabal run: file $(which cabal) From 4364ae8f0edb31c996f2ca3604fac36d1d5b4cde Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20L=C3=A4ndle?= Date: Sat, 21 Oct 2023 09:08:28 +0200 Subject: [PATCH 26/53] Newer dependencies for ghcjs-base. --- ghcjs-base.cabal | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index cc61c3a..9f8ed69 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -141,19 +141,19 @@ library build-depends: base >= 4.7 && < 5, ghc-prim, binary >= 0.8 && < 0.11, - bytestring >= 0.10 && < 0.11, - text >= 1.1 && < 1.3, - aeson >= 0.8 && < 2.1, + bytestring >= 0.10 && < 0.13, + text >= 1.1 && < 2.2, + aeson >= 0.8 && < 2.3, scientific >= 0.3 && < 0.4, - vector >= 0.10 && < 0.13, - containers >= 0.5 && < 0.7, - time >= 1.5 && < 1.10, + vector >= 0.10 && < 0.14, + containers >= 0.5 && < 0.8, + time >= 1.5 && < 1.14, hashable >= 1.2 && < 1.5, unordered-containers >= 0.2 && < 0.3, attoparsec >= 0.11 && < 0.15, transformers >= 0.3 && < 0.7, - primitive >= 0.5 && < 0.8, - deepseq >= 1.3 && < 1.5, + primitive >= 0.5 && < 0.10, + deepseq >= 1.3 && < 1.6, dlist >= 0.7 && < 1.1 default-language: Haskell2010 if !arch(javascript) From 890cae6bbaa3f7830148a57a64521ddd29786a61 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20L=C3=A4ndle?= Date: Sat, 21 Oct 2023 13:07:30 +0000 Subject: [PATCH 27/53] Up to date QuickCheck provides Arbitrary instance for Newline/NewlineMode --- ghcjs-base.cabal | 2 +- test/Tests/QuickCheckUtils.hs | 11 ----------- 2 files changed, 1 insertion(+), 12 deletions(-) diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index 9f8ed69..69afe85 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -174,7 +174,7 @@ test-suite tests -Wall -rtsopts build-depends: HUnit >= 1.2, - QuickCheck >= 2.7, + QuickCheck >= 2.14.3, array, text, base, diff --git a/test/Tests/QuickCheckUtils.hs b/test/Tests/QuickCheckUtils.hs index 942c51a..0653092 100644 --- a/test/Tests/QuickCheckUtils.hs +++ b/test/Tests/QuickCheckUtils.hs @@ -271,17 +271,6 @@ instance Arbitrary Encoding where , E "32le" IO.utf32le, E "32be" IO.utf32be ] -windowsNewlineMode :: IO.NewlineMode -windowsNewlineMode = IO.NewlineMode - { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF - } - -instance Arbitrary IO.NewlineMode where - arbitrary = oneof . map return $ - [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode - , windowsNewlineMode - ] - instance Arbitrary IO.BufferMode where arbitrary = oneof [ return IO.NoBuffering, return IO.LineBuffering, From 5c166b65ebf6db26bc19577ab98ef4de522912dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20L=C3=A4ndle?= Date: Sat, 21 Oct 2023 13:32:25 +0000 Subject: [PATCH 28/53] First inlining (workaround haskellari/splitmix#75) --- Data/JSString/Internal/Type.hs | 2 +- GHCJS/Buffer.hs | 10 +++++----- GHCJS/Foreign/Export.hs | 2 +- GHCJS/Marshal/Pure.hs | 10 +++++----- JavaScript/JSON/Types/Internal.hs | 6 +++--- jsbits/foreign.js | 4 ++++ 6 files changed, 19 insertions(+), 15 deletions(-) diff --git a/Data/JSString/Internal/Type.hs b/Data/JSString/Internal/Type.hs index 0f1c611..7a7652e 100644 --- a/Data/JSString/Internal/Type.hs +++ b/Data/JSString/Internal/Type.hs @@ -47,7 +47,7 @@ instance IsJSVal JSString instance NFData JSString where rnf !x = () foreign import javascript unsafe - "$r = '';" js_empty :: JSString + "((x) => { return ''; })" js_empty :: JSString -- | /O(1)/ The empty 'JSString'. empty :: JSString diff --git a/GHCJS/Buffer.hs b/GHCJS/Buffer.hs index 8e11b46..ced4adc 100644 --- a/GHCJS/Buffer.hs +++ b/GHCJS/Buffer.hs @@ -215,14 +215,14 @@ foreign import javascript unsafe -- conversion is free foreign import javascript unsafe - "$r = $1;" js_toByteArray :: SomeBuffer any -> ByteArray# + "((x) => { return x; })" js_toByteArray :: SomeBuffer any -> ByteArray# foreign import javascript unsafe - "$r = $1;" js_fromByteArray :: ByteArray# -> JSVal + "((x) => { return x; })" js_fromByteArray :: ByteArray# -> JSVal foreign import javascript unsafe - "$r = $1;" js_fromMutableByteArray :: MutableByteArray# s -> JSVal + "((x) => { return x; })" js_fromMutableByteArray :: MutableByteArray# s -> JSVal foreign import javascript unsafe - "$r = $1;" js_toMutableByteArray :: JSVal -> MutableByteArray# s + "((x) => { return x; })" js_toMutableByteArray :: JSVal -> MutableByteArray# s foreign import javascript unsafe "$r1 = $1; $r2 = 0;" js_toAddr :: SomeBuffer any -> Addr# foreign import javascript unsafe - "$r = $1;" js_fromAddr :: Addr# -> SomeBuffer any + "((x) => { return x; })" js_fromAddr :: Addr# -> SomeBuffer any diff --git a/GHCJS/Foreign/Export.hs b/GHCJS/Foreign/Export.hs index 31de434..4f42483 100644 --- a/GHCJS/Foreign/Export.hs +++ b/GHCJS/Foreign/Export.hs @@ -84,7 +84,7 @@ foreign import javascript unsafe "h$derefExport" js_derefExport :: Word64 -> Word64 -> Export a -> IO JSVal foreign import javascript unsafe - "$r = $1;" js_toHeapObject :: JSVal -> IO Any + "((x) => { return x; })" js_toHeapObject :: JSVal -> IO Any foreign import javascript unsafe "h$releaseExport" js_releaseExport :: Export a -> IO () diff --git a/GHCJS/Marshal/Pure.hs b/GHCJS/Marshal/Pure.hs index 17cb26c..1d3755d 100644 --- a/GHCJS/Marshal/Pure.hs +++ b/GHCJS/Marshal/Pure.hs @@ -148,9 +148,9 @@ foreign import javascript unsafe "$r = +$1;" jsvalToFloat :: JSVal -> foreign import javascript unsafe "$r = +$1;" jsvalToDouble :: JSVal -> Double# foreign import javascript unsafe "$r = $1&0x7fffffff;" jsvalToChar :: JSVal -> Char# -foreign import javascript unsafe "$r = $1;" wordToJSVal :: Word# -> JSVal -foreign import javascript unsafe "$r = $1;" intToJSVal :: Int# -> JSVal -foreign import javascript unsafe "$r = $1;" doubleToJSVal :: Double# -> JSVal -foreign import javascript unsafe "$r = $1;" floatToJSVal :: Float# -> JSVal -foreign import javascript unsafe "$r = $1;" charToJSVal :: Char# -> JSVal +foreign import javascript unsafe "((x) => { return x; })" wordToJSVal :: Word# -> JSVal +foreign import javascript unsafe "((x) => { return x; })" intToJSVal :: Int# -> JSVal +foreign import javascript unsafe "((x) => { return x; })" doubleToJSVal :: Double# -> JSVal +foreign import javascript unsafe "((x) => { return x; })" floatToJSVal :: Float# -> JSVal +foreign import javascript unsafe "((x) => { return x; })" charToJSVal :: Char# -> JSVal diff --git a/JavaScript/JSON/Types/Internal.hs b/JavaScript/JSON/Types/Internal.hs index c2a6579..4318233 100644 --- a/JavaScript/JSON/Types/Internal.hs +++ b/JavaScript/JSON/Types/Internal.hs @@ -279,9 +279,9 @@ foreign import javascript unsafe -- types must be checked before using these conversions foreign import javascript unsafe - "$r = $1;" js_jsvalToDouble :: JSVal -> Double + "((x) => { return x; })" js_jsvalToDouble :: JSVal -> Double foreign import javascript unsafe - "$r = $1;" js_jsvalToBool :: JSVal -> Bool + "((x) => { return x; })" js_jsvalToBool :: JSVal -> Bool -- ----------------------------------------------------------------------------- -- various lookups @@ -300,7 +300,7 @@ foreign import javascript unsafe "h$isArray($2) ? $2[$1] : undefined" js_lookupArrayPureSafe :: Int -> Value -> JSVal foreign import javascript unsafe - "$r = $1;" + "((x) => { return x; })" js_doubleToJSVal :: Double -> JSVal foreign import javascript unsafe diff --git a/jsbits/foreign.js b/jsbits/foreign.js index 34cd7c6..fd9caa4 100644 --- a/jsbits/foreign.js +++ b/jsbits/foreign.js @@ -7,3 +7,7 @@ function h$foreignListProps(o) { } */ } + +function h$splitmix_init() { + return Math.floor(Math.random()*0x100000000); +} \ No newline at end of file From f3aa075f8a72c0ec0d21f0c7852f3b3a4770a9b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20L=C3=A4ndle?= Date: Sat, 21 Oct 2023 13:59:59 +0000 Subject: [PATCH 29/53] Solved - for "\$1\.(.*)" --- Data/JSString.hs | 6 ++--- Data/JSString/Int.hs | 4 ++-- Data/JSString/Internal.hs | 2 +- Data/JSString/Internal/Fusion.hs | 2 +- Data/JSString/Raw.hs | 2 +- Data/JSString/RegExp.hs | 6 ++--- GHCJS/Buffer.hs | 16 ++++++------- GHCJS/Foreign/Internal.hs | 2 +- JavaScript/Array/Internal.hs | 12 +++++----- JavaScript/JSON/Types/Internal.hs | 2 +- JavaScript/TypedArray/ArrayBuffer/Internal.hs | 2 +- JavaScript/TypedArray/Internal.hs | 10 ++++---- JavaScript/Web/AnimationFrame.hs | 2 +- JavaScript/Web/Blob/Internal.hs | 8 +++---- JavaScript/Web/Canvas.hs | 20 ++++++++-------- JavaScript/Web/Canvas/ImageData.hs | 6 ++--- JavaScript/Web/Canvas/TextMetrics.hs | 24 +++++++++---------- JavaScript/Web/CloseEvent.hs | 6 ++--- JavaScript/Web/ErrorEvent.hs | 10 ++++---- JavaScript/Web/File.hs | 4 ++-- JavaScript/Web/Location.hs | 22 ++++++++--------- JavaScript/Web/Storage.hs | 4 ++-- JavaScript/Web/StorageEvent.hs | 10 ++++---- JavaScript/Web/WebSocket.hs | 14 +++++------ JavaScript/Web/Worker.hs | 2 +- JavaScript/Web/XMLHttpRequest.hs | 12 +++++----- 26 files changed, 105 insertions(+), 105 deletions(-) diff --git a/Data/JSString.hs b/Data/JSString.hs index 821b6b6..97b7d3b 100644 --- a/Data/JSString.hs +++ b/Data/JSString.hs @@ -1847,7 +1847,7 @@ foreign import javascript unsafe foreign import javascript unsafe "$3.substring($1,$2)" js_substring :: Int# -> Int# -> JSString -> JSString foreign import javascript unsafe - "$1.length" js_length :: JSString -> Int# + "((x) => { return x.length; })" js_length :: JSString -> Int# foreign import javascript unsafe "(($2.charCodeAt($1)|1023)===0xDBFF)?2:1" js_charWidthAt :: Int# -> JSString -> Int# @@ -1960,6 +1960,6 @@ foreign import javascript unsafe "h$jsstringIntercalate" js_intercalate :: JSString -> Exts.Any {- [JSString] -} -> JSString foreign import javascript unsafe - "$1.toUpperCase()" js_toUpper :: JSString -> JSString + "((x) => { return x.toUpperCase(); })" js_toUpper :: JSString -> JSString foreign import javascript unsafe - "$1.toLowerCase()" js_toLower :: JSString -> JSString + "((x) => { return x.toLowerCase(); })" js_toLower :: JSString -> JSString diff --git a/Data/JSString/Int.hs b/Data/JSString/Int.hs index 844a6f2..06981c6 100644 --- a/Data/JSString/Int.hs +++ b/Data/JSString/Int.hs @@ -231,14 +231,14 @@ foreign import javascript unsafe -- these are expected to be only applied to nonnegative integers foreign import javascript unsafe - "$1.toString(16)" + "((x) => { return x.toString(16); })" js_hexI :: Int# -> JSString foreign import javascript unsafe "h$jsstringHexI64" js_hexI64 :: Int64# -> JSString foreign import javascript unsafe - "$1.toString(16)" + "((x) => { return x.toString(16); })" js_hexW :: Word# -> JSString foreign import javascript unsafe "(($1>=0)?$1:($1+4294967296)).toString(16)" diff --git a/Data/JSString/Internal.hs b/Data/JSString/Internal.hs index 7b66280..b7d0c5c 100644 --- a/Data/JSString/Internal.hs +++ b/Data/JSString/Internal.hs @@ -68,7 +68,7 @@ foreign import javascript unsafe foreign import javascript unsafe "$1===$2" js_eq :: JSString -> JSString -> Bool foreign import javascript unsafe - "$1.localeCompare($2)" js_compare :: JSString -> JSString -> Exts.Int# + "((x, y) => { return x.localeCompare(y); })" js_compare :: JSString -> JSString -> Exts.Int# foreign import javascript unsafe "h$jsstringConcat" js_concat :: Exts.Any -> JSString -} diff --git a/Data/JSString/Internal/Fusion.hs b/Data/JSString/Internal/Fusion.hs index c7578e3..0c554a0 100644 --- a/Data/JSString/Internal/Fusion.hs +++ b/Data/JSString/Internal/Fusion.hs @@ -183,7 +183,7 @@ foreign import javascript unsafe foreign import javascript unsafe "h$jsstringIndexR" js_indexR :: Int -> JSString -> Int# foreign import javascript unsafe - "$1.length" js_length :: JSString -> Int# + "((x) => { return x.length; })" js_length :: JSString -> Int# foreign import javascript unsafe "$r = [$1];" js_newSingletonArray :: Char -> IO JSVal foreign import javascript unsafe diff --git a/Data/JSString/Raw.hs b/Data/JSString/Raw.hs index 7c9c9d8..75277b6 100644 --- a/Data/JSString/Raw.hs +++ b/Data/JSString/Raw.hs @@ -129,7 +129,7 @@ overflowError fun = error $ "Data.JSString.Raw." ++ fun ++ ": size overflow" foreign import javascript unsafe "$1===''" js_null :: JSString -> Bool foreign import javascript unsafe - "$1.length" js_length :: JSString -> Int# + "((x) => { return x.length; })" js_length :: JSString -> Int# foreign import javascript unsafe "$3.substr($1,$2)" js_substr :: Int# -> Int# -> JSString -> JSString foreign import javascript unsafe diff --git a/Data/JSString/RegExp.hs b/Data/JSString/RegExp.hs index 2b98f73..8b643ab 100644 --- a/Data/JSString/RegExp.hs +++ b/Data/JSString/RegExp.hs @@ -105,9 +105,9 @@ foreign import javascript unsafe foreign import javascript unsafe "h$jsstringSplitRE" js_split :: Int# -> JSString -> RegExp -> Any -- [JSString] foreign import javascript unsafe - "$1.multiline" js_isMultiline :: RegExp -> Bool + "((x) => { return x.multiline; })" js_isMultiline :: RegExp -> Bool foreign import javascript unsafe - "$1.ignoreCase" js_isIgnoreCase :: RegExp -> Bool + "((x) => { return x.ignoreCase; })" js_isIgnoreCase :: RegExp -> Bool foreign import javascript unsafe - "$1.pattern" js_pattern :: RegExp -> JSString + "((x) => { return x.pattern; })" js_pattern :: RegExp -> JSString diff --git a/GHCJS/Buffer.hs b/GHCJS/Buffer.hs index ced4adc..cf7dafa 100644 --- a/GHCJS/Buffer.hs +++ b/GHCJS/Buffer.hs @@ -194,21 +194,21 @@ foreign import javascript unsafe "h$wrapBuffer($1.buf.slice($1.u8.byteOffset, $1.len))" js_clone :: SomeBuffer any1 -> IO (SomeBuffer any2) foreign import javascript unsafe - "$1.len" js_byteLength :: SomeBuffer any -> Int + "((x) => { return x.len; })" js_byteLength :: SomeBuffer any -> Int foreign import javascript unsafe - "$1.buf" js_getArrayBuffer :: SomeBuffer any -> SomeArrayBuffer any + "((x) => { return x.buf; })" js_getArrayBuffer :: SomeBuffer any -> SomeArrayBuffer any foreign import javascript unsafe - "$1.i3" js_getInt32Array :: SomeBuffer any -> I.SomeInt32Array any + "((x) => { return x.i3; })" js_getInt32Array :: SomeBuffer any -> I.SomeInt32Array any foreign import javascript unsafe - "$1.u8" js_getUint8Array :: SomeBuffer any -> I.SomeUint8Array any + "((x) => { return x.u8; })" js_getUint8Array :: SomeBuffer any -> I.SomeUint8Array any foreign import javascript unsafe - "$1.u1" js_getUint16Array :: SomeBuffer any -> I.SomeUint16Array any + "((x) => { return x.u1; })" js_getUint16Array :: SomeBuffer any -> I.SomeUint16Array any foreign import javascript unsafe - "$1.f3" js_getFloat32Array :: SomeBuffer any -> I.SomeFloat32Array any + "((x) => { return x.f3; })" js_getFloat32Array :: SomeBuffer any -> I.SomeFloat32Array any foreign import javascript unsafe - "$1.f6" js_getFloat64Array :: SomeBuffer any -> I.SomeFloat64Array any + "((x) => { return x.f6; })" js_getFloat64Array :: SomeBuffer any -> I.SomeFloat64Array any foreign import javascript unsafe - "$1.dv" js_getDataView :: SomeBuffer any -> SomeDataView any + "((x) => { return x.dv; })" js_getDataView :: SomeBuffer any -> SomeDataView any -- ---------------------------------------------------------------------------- -- these things have the same representation (modulo boxing), diff --git a/GHCJS/Foreign/Internal.hs b/GHCJS/Foreign/Internal.hs index 8196ec6..26baa9b 100644 --- a/GHCJS/Foreign/Internal.hs +++ b/GHCJS/Foreign/Internal.hs @@ -385,7 +385,7 @@ foreign import javascript unsafe "$r = undefined;" js_undefined :: Int# -> Ref# -- js_fromArray :: JSArray a -> IO Ref# -- [a] --foreign import javascript safe "$2.push($1)" -- js_push :: JSVal a -> JSArray a -> IO () ---foreign import javascript safe "$1.length" js_length :: JSArray a -> IO Int +--foreign import javascript safe "((x) => { return x.length; })" js_length :: JSArray a -> IO Int --foreign import javascript safe "$2[$1]" -- js_index :: Int -> JSArray a -> IO (JSVal a) --foreign import javascript unsafe "$2[$1]" diff --git a/JavaScript/Array/Internal.hs b/JavaScript/Array/Internal.hs index 3964feb..d8f62c1 100644 --- a/JavaScript/Array/Internal.hs +++ b/JavaScript/Array/Internal.hs @@ -143,14 +143,14 @@ unsafeThaw (SomeJSArray x) = pure (SomeJSArray x) foreign import javascript unsafe "$r = [];" js_create :: State# s -> (# State# s, SomeJSArray m #) -foreign import javascript unsafe "$1.length" +foreign import javascript unsafe "((x) => { return x.length; })" js_length :: SomeJSArray m -> State# s -> (# State# s, Int #) foreign import javascript unsafe "$2[$1]" js_index :: Int -> SomeJSArray m -> State# s -> (# State# s, JSVal #) foreign import javascript unsafe "$2[$1]" js_indexPure :: Int -> JSArray -> JSVal -foreign import javascript unsafe "$1.length" +foreign import javascript unsafe "((x) => { return x.length; })" js_lengthPure :: JSArray -> Int foreign import javascript unsafe "$3[$1] = $2" @@ -166,19 +166,19 @@ foreign import javascript unsafe "$3.slice($1,2)" foreign import javascript unsafe "$2.slice($1)" js_slice1Pure :: Int -> JSArray -> JSArray -foreign import javascript unsafe "$1.concat($2)" +foreign import javascript unsafe "((x, y) => { return x.concat(y); })" js_append :: SomeJSArray m0 -> SomeJSArray m1 -> State# s -> (# State# s, SomeJSArray m2 #) foreign import javascript unsafe "$2.push($1)" js_push :: JSVal -> SomeJSArray m -> State# s -> (# State# s, () #) -foreign import javascript unsafe "$1.pop()" +foreign import javascript unsafe "((x) => { return x.pop(); })" js_pop :: SomeJSArray m -> State# s -> (# State# s, JSVal #) foreign import javascript unsafe "$2.unshift($1)" js_unshift :: JSVal -> SomeJSArray m -> State# s -> (# State# s, () #) -foreign import javascript unsafe "$1.shift()" +foreign import javascript unsafe "((x) => { return x.shift(); })" js_shift :: SomeJSArray m -> State# s -> (# State# s, JSVal #) -foreign import javascript unsafe "$1.reverse()" +foreign import javascript unsafe "((x) => { return x.reverse(); })" js_reverse :: SomeJSArray m -> State# s -> (# State# s, () #) foreign import javascript unsafe "h$toHsListJSVal($1)" diff --git a/JavaScript/JSON/Types/Internal.hs b/JavaScript/JSON/Types/Internal.hs index 4318233..8788cee 100644 --- a/JavaScript/JSON/Types/Internal.hs +++ b/JavaScript/JSON/Types/Internal.hs @@ -268,7 +268,7 @@ foreign import javascript unsafe foreign import javascript unsafe "$r = {};" js_emptyObject :: Object foreign import javascript unsafe - "$1.length === 0" js_isEmptyArray :: Value -> Bool + "((x) => { return x.length === 0; })" js_isEmptyArray :: Value -> Bool foreign import javascript unsafe "$r = true;" js_trueValue :: Value diff --git a/JavaScript/TypedArray/ArrayBuffer/Internal.hs b/JavaScript/TypedArray/ArrayBuffer/Internal.hs index 87c93a6..558d891 100644 --- a/JavaScript/TypedArray/ArrayBuffer/Internal.hs +++ b/JavaScript/TypedArray/ArrayBuffer/Internal.hs @@ -38,7 +38,7 @@ instance PFromJSVal MutableArrayBuffer where -- ---------------------------------------------------------------------------- foreign import javascript unsafe - "$1.byteLength" js_byteLength :: SomeArrayBuffer any -> Int + "((x) => { return x.byteLength; })" js_byteLength :: SomeArrayBuffer any -> Int foreign import javascript unsafe "new ArrayBuffer($1)" js_create :: Int -> State# s -> (# State# s, JSVal #) foreign import javascript unsafe diff --git a/JavaScript/TypedArray/Internal.hs b/JavaScript/TypedArray/Internal.hs index 126c7f6..aaeddce 100644 --- a/JavaScript/TypedArray/Internal.hs +++ b/JavaScript/TypedArray/Internal.hs @@ -351,13 +351,13 @@ unsafeSet offset src dest = IO (js_unsafeSet offset src dest) -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1.length" js_length :: SomeTypedArray e m -> Int + "((x) => { return x.length; })" js_length :: SomeTypedArray e m -> Int foreign import javascript unsafe - "$1.byteLength" js_byteLength :: SomeTypedArray e m -> Int + "((x) => { return x.byteLength; })" js_byteLength :: SomeTypedArray e m -> Int foreign import javascript unsafe - "$1.byteOffset" js_byteOffset :: SomeTypedArray e m -> Int + "((x) => { return x.byteOffset; })" js_byteOffset :: SomeTypedArray e m -> Int foreign import javascript unsafe - "$1.buffer" js_buffer :: SomeTypedArray e m -> SomeArrayBuffer m + "((x) => { return x.buffer; })" js_buffer :: SomeTypedArray e m -> SomeArrayBuffer m foreign import javascript unsafe "$3.subarray($1,$2)" js_subarray :: Int -> Int -> SomeTypedArray e m -> SomeTypedArray e m @@ -368,7 +368,7 @@ foreign import javascript unsafe "$3.set($1,$2)" js_unsafeSet :: Int -> SomeTypedArray e m -> SomeTypedArray e1 m1 -> State# s -> (# State# s, () #) foreign import javascript unsafe - "$1.BYTES_PER_ELEMENT" + "((x) => { return x.BYTES_PER_ELEMENT; })" js_elemSize :: SomeTypedArray e m -> Int -- ----------------------------------------------------------------------------- diff --git a/JavaScript/Web/AnimationFrame.hs b/JavaScript/Web/AnimationFrame.hs index d03833b..e4d436a 100644 --- a/JavaScript/Web/AnimationFrame.hs +++ b/JavaScript/Web/AnimationFrame.hs @@ -69,7 +69,7 @@ foreign import javascript unsafe "{ handle: null, callback: $1 }" foreign import javascript unsafe "h$animationFrameCancel" js_cancelAnimationFrame :: AnimationFrameHandle -> IO () foreign import javascript interruptible - "$1.handle = window.requestAnimationFrame($c);" + "((x, c) => { return x.handle = window.requestAnimationFrame(c); })" js_waitForAnimationFrame :: AnimationFrameHandle -> IO Double foreign import javascript unsafe "h$animationFrameRequest" js_requestAnimationFrame :: AnimationFrameHandle -> IO () diff --git a/JavaScript/Web/Blob/Internal.hs b/JavaScript/Web/Blob/Internal.hs index 6004687..196c132 100644 --- a/JavaScript/Web/Blob/Internal.hs +++ b/JavaScript/Web/Blob/Internal.hs @@ -42,14 +42,14 @@ close b = js_close b -- ----------------------------------------------------------------------------- -foreign import javascript unsafe "$1.size" js_size :: SomeBlob a -> Int -foreign import javascript unsafe "$1.type" js_type :: SomeBlob a -> JSString +foreign import javascript unsafe "((x) => { return x.size; })" js_size :: SomeBlob a -> Int +foreign import javascript unsafe "((x) => { return x.type; })" js_type :: SomeBlob a -> JSString -- fixme figure out if we need to support older browsers with obsolete slice foreign import javascript unsafe "$4.slice($1,$2,$3)" js_slice :: Int -> Int -> JSString -> SomeBlob a -> SomeBlob a -foreign import javascript unsafe "$1.isClosed" +foreign import javascript unsafe "((x) => { return x.isClosed; })" js_isClosed :: SomeBlob a -> IO Bool -foreign import javascript unsafe "$1.close();" +foreign import javascript unsafe "((x) => { return x.close(); })" js_close :: SomeBlob a -> IO () diff --git a/JavaScript/Web/Canvas.hs b/JavaScript/Web/Canvas.hs index 0a7684c..b4909d1 100644 --- a/JavaScript/Web/Canvas.hs +++ b/JavaScript/Web/Canvas.hs @@ -336,11 +336,11 @@ foreign import javascript unsafe "$r = document.createElement('canvas');\ \$r.width = $1;\ \$r.height = $2;" js_create :: Int -> Int -> IO Canvas -foreign import javascript unsafe "$1.getContext('2d')" +foreign import javascript unsafe "((x) => { return x.getContext('2d'); })" js_getContext :: Canvas -> IO Context -foreign import javascript unsafe "$1.save()" +foreign import javascript unsafe "((x) => { return x.save(); })" js_save :: Context -> IO () -foreign import javascript unsafe "$1.restore()" +foreign import javascript unsafe "((x) => { return x.restore(); })" js_restore :: Context -> IO () foreign import javascript unsafe "$7.transform($1,$2,$3,$4,$5,$6)" js_transform :: Double -> Double -> Double -> Double -> Double -> Double -> Context -> IO () @@ -352,17 +352,17 @@ foreign import javascript unsafe "$3.translate($1,$2)" js_translate :: Double -> Double -> Context -> IO () foreign import javascript unsafe "$2.rotate($1)" js_rotate :: Double -> Context -> IO () -foreign import javascript unsafe "$1.fill()" +foreign import javascript unsafe "((x) => { return x.fill(); })" js_fill :: Context -> IO () foreign import javascript unsafe "$2.fill($1)" js_fill_rule :: JSString -> Context -> IO () -foreign import javascript unsafe "$1.stroke()" +foreign import javascript unsafe "((x) => { return x.stroke(); })" js_stroke :: Context -> IO () -foreign import javascript unsafe "$1.beginPath()" +foreign import javascript unsafe "((x) => { return x.beginPath(); })" js_beginPath :: Context -> IO () -foreign import javascript unsafe "$1.closePath()" +foreign import javascript unsafe "((x) => { return x.closePath(); })" js_closePath :: Context -> IO () -foreign import javascript unsafe "$1.clip()" +foreign import javascript unsafe "((x) => { return x.clip(); })" js_clip :: Context -> IO () foreign import javascript unsafe "$3.moveTo($1,$2)" js_moveTo :: Double -> Double -> Context -> IO () @@ -423,9 +423,9 @@ foreign import javascript unsafe "$6.drawImage($1,$2,$3,$4,$5)" js_drawImage :: Image -> Int -> Int -> Int -> Int -> Context -> IO () foreign import javascript unsafe "$3.createPattern($1,$2)" js_createPattern :: Image -> JSString -> Context -> IO Pattern -foreign import javascript unsafe "$1.width" +foreign import javascript unsafe "((x) => { return x.width; })" js_width :: Canvas -> IO Int -foreign import javascript unsafe "$1.height" +foreign import javascript unsafe "((x) => { return x.height; })" js_height :: Canvas -> IO Int foreign import javascript unsafe "$2.width = $1;" js_setWidth :: Int -> Canvas -> IO () diff --git a/JavaScript/Web/Canvas/ImageData.hs b/JavaScript/Web/Canvas/ImageData.hs index fbebf0d..887198e 100644 --- a/JavaScript/Web/Canvas/ImageData.hs +++ b/JavaScript/Web/Canvas/ImageData.hs @@ -25,9 +25,9 @@ getData i = js_getData i -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1.width" js_width :: ImageData -> Int + "((x) => { return x.width; })" js_width :: ImageData -> Int foreign import javascript unsafe - "$1.height" js_height :: ImageData -> Int + "((x) => { return x.height; })" js_height :: ImageData -> Int foreign import javascript unsafe - "$1.data" js_getData :: ImageData -> Uint8ClampedArray + "((x) => { return x.data; })" js_getData :: ImageData -> Uint8ClampedArray diff --git a/JavaScript/Web/Canvas/TextMetrics.hs b/JavaScript/Web/Canvas/TextMetrics.hs index 25358d1..1c3c208 100644 --- a/JavaScript/Web/Canvas/TextMetrics.hs +++ b/JavaScript/Web/Canvas/TextMetrics.hs @@ -67,28 +67,28 @@ ideographicBaseline tm = js_ideographicBaseline tm -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1.width" js_width :: TextMetrics -> Double + "((x) => { return x.width; })" js_width :: TextMetrics -> Double foreign import javascript unsafe - "$1.actualBoundingBoxLeft" js_actualBoundingBoxLeft :: TextMetrics -> Double + "((x) => { return x.actualBoundingBoxLeft; })" js_actualBoundingBoxLeft :: TextMetrics -> Double foreign import javascript unsafe - "$1.actualBoundingBoxRight" js_actualBoundingBoxRight :: TextMetrics -> Double + "((x) => { return x.actualBoundingBoxRight; })" js_actualBoundingBoxRight :: TextMetrics -> Double foreign import javascript unsafe - "$1.fontBoundingBoxAscent" js_fontBoundingBoxAscent :: TextMetrics -> Double + "((x) => { return x.fontBoundingBoxAscent; })" js_fontBoundingBoxAscent :: TextMetrics -> Double foreign import javascript unsafe - "$1.fontBoundingBoxDescent" js_fontBoundingBoxDescent :: TextMetrics -> Double + "((x) => { return x.fontBoundingBoxDescent; })" js_fontBoundingBoxDescent :: TextMetrics -> Double foreign import javascript unsafe - "$1.actualBoundingBoxAscent" js_actualBoundingBoxAscent :: TextMetrics -> Double + "((x) => { return x.actualBoundingBoxAscent; })" js_actualBoundingBoxAscent :: TextMetrics -> Double foreign import javascript unsafe - "$1.actualBoundingBoxDescent" js_actualBoundingBoxDescent :: TextMetrics -> Double + "((x) => { return x.actualBoundingBoxDescent; })" js_actualBoundingBoxDescent :: TextMetrics -> Double foreign import javascript unsafe - "$1.emHeightAscent" js_emHeightAscent :: TextMetrics -> Double + "((x) => { return x.emHeightAscent; })" js_emHeightAscent :: TextMetrics -> Double foreign import javascript unsafe - "$1.emHeightDescent" js_emHeightDescent :: TextMetrics -> Double + "((x) => { return x.emHeightDescent; })" js_emHeightDescent :: TextMetrics -> Double foreign import javascript unsafe - "$1.hangingBaseline" js_hangingBaseline :: TextMetrics -> Double + "((x) => { return x.hangingBaseline; })" js_hangingBaseline :: TextMetrics -> Double foreign import javascript unsafe - "$1.alphabeticBaseline" js_alphabeticBaseline :: TextMetrics -> Double + "((x) => { return x.alphabeticBaseline; })" js_alphabeticBaseline :: TextMetrics -> Double foreign import javascript unsafe - "$1.ideographicBaseline" js_ideographicBaseline :: TextMetrics -> Double + "((x) => { return x.ideographicBaseline; })" js_ideographicBaseline :: TextMetrics -> Double diff --git a/JavaScript/Web/CloseEvent.hs b/JavaScript/Web/CloseEvent.hs index 7cb9542..bb0bf22 100644 --- a/JavaScript/Web/CloseEvent.hs +++ b/JavaScript/Web/CloseEvent.hs @@ -25,8 +25,8 @@ wasClean c = js_wasClean c -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1.code" js_getCode :: CloseEvent -> Int + "((x) => { return x.code; })" js_getCode :: CloseEvent -> Int foreign import javascript unsafe - "$1.reason" js_getReason :: CloseEvent -> JSString + "((x) => { return x.reason; })" js_getReason :: CloseEvent -> JSString foreign import javascript unsafe - "$1.wasClean" js_wasClean :: CloseEvent -> Bool + "((x) => { return x.wasClean; })" js_wasClean :: CloseEvent -> Bool diff --git a/JavaScript/Web/ErrorEvent.hs b/JavaScript/Web/ErrorEvent.hs index ad95631..a057601 100644 --- a/JavaScript/Web/ErrorEvent.hs +++ b/JavaScript/Web/ErrorEvent.hs @@ -39,13 +39,13 @@ error ee = js_getError ee -- ----------------------------------------------------------------------------- -foreign import javascript unsafe "$1.message" +foreign import javascript unsafe "((x) => { return x.message; })" js_getMessage :: ErrorEvent -> JSString -foreign import javascript unsafe "$1.filename" +foreign import javascript unsafe "((x) => { return x.filename; })" js_getFilename :: ErrorEvent -> JSString -foreign import javascript unsafe "$1.lineno" +foreign import javascript unsafe "((x) => { return x.lineno; })" js_getLineno :: ErrorEvent -> Int -foreign import javascript unsafe "$1.colno" +foreign import javascript unsafe "((x) => { return x.colno; })" js_getColno :: ErrorEvent -> Int -foreign import javascript unsafe "$1.error" +foreign import javascript unsafe "((x) => { return x.error; })" js_getError :: ErrorEvent -> JSVal diff --git a/JavaScript/Web/File.hs b/JavaScript/Web/File.hs index 83b41f7..61516b1 100644 --- a/JavaScript/Web/File.hs +++ b/JavaScript/Web/File.hs @@ -26,6 +26,6 @@ lastModified b = js_lastModified b -- ----------------------------------------------------------------------------- -foreign import javascript unsafe "$1.name" js_name :: File -> JSString -foreign import javascript unsafe "$1.lastModified" js_lastModified :: File -> Double +foreign import javascript unsafe "((x) => { return x.name; })" js_name :: File -> JSString +foreign import javascript unsafe "((x) => { return x.lastModified; })" js_lastModified :: File -> Double diff --git a/JavaScript/Web/Location.hs b/JavaScript/Web/Location.hs index 7468499..b51e90b 100644 --- a/JavaScript/Web/Location.hs +++ b/JavaScript/Web/Location.hs @@ -144,17 +144,17 @@ replace = js_assign foreign import javascript safe "window.location" js_getWindowLocation :: IO Location -foreign import javascript unsafe "$1.href" js_getHref :: Location -> IO JSString -foreign import javascript unsafe "$1.protocol" js_getProtocol :: Location -> IO JSString -foreign import javascript unsafe "$1.host" js_getHost :: Location -> IO JSString -foreign import javascript unsafe "$1.hostname" js_getHostname :: Location -> IO JSString -foreign import javascript unsafe "$1.port" js_getPort :: Location -> IO JSString -foreign import javascript unsafe "$1.pathname" js_getPathname :: Location -> IO JSString -foreign import javascript unsafe "$1.search" js_getSearch :: Location -> IO JSString -foreign import javascript unsafe "$1.hash" js_getHash :: Location -> IO JSString -foreign import javascript unsafe "$1.username" js_getUsername :: Location -> IO JSString -foreign import javascript unsafe "$1.password" js_getPassword :: Location -> IO JSString -foreign import javascript unsafe "$1.origin" js_getOrigin :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.href; })" js_getHref :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.protocol; })" js_getProtocol :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.host; })" js_getHost :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.hostname; })" js_getHostname :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.port; })" js_getPort :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.pathname; })" js_getPathname :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.search; })" js_getSearch :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.hash; })" js_getHash :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.username; })" js_getUsername :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.password; })" js_getPassword :: Location -> IO JSString +foreign import javascript unsafe "((x) => { return x.origin; })" js_getOrigin :: Location -> IO JSString foreign import javascript safe "$2.href = $1;" js_setHref :: JSString -> Location -> IO () foreign import javascript safe "$2.protocol = $1;" js_setProtocol :: JSString -> Location -> IO () diff --git a/JavaScript/Web/Storage.hs b/JavaScript/Web/Storage.hs index dba9875..6bbecba 100644 --- a/JavaScript/Web/Storage.hs +++ b/JavaScript/Web/Storage.hs @@ -61,7 +61,7 @@ foreign import javascript unsafe foreign import javascript unsafe "window.sessionStorage" js_sessionStorage :: Storage foreign import javascript unsafe - "$1.length" js_getLength :: Storage -> IO Int + "((x) => { return x.length; })" js_getLength :: Storage -> IO Int foreign import javascript unsafe "$2.key($1)" js_getIndex :: Int -> Storage -> IO JSVal foreign import javascript unsafe @@ -71,4 +71,4 @@ foreign import javascript safe foreign import javascript unsafe "$2.removeItem($1)" js_removeItem :: JSString -> Storage -> IO () foreign import javascript unsafe - "$1.clear();" js_clear :: Storage -> IO () + "((x) => { return x.clear(); })" js_clear :: Storage -> IO () diff --git a/JavaScript/Web/StorageEvent.hs b/JavaScript/Web/StorageEvent.hs index 9bc3838..496e5a8 100644 --- a/JavaScript/Web/StorageEvent.hs +++ b/JavaScript/Web/StorageEvent.hs @@ -51,12 +51,12 @@ storageArea se | isNull r = Nothing -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1.key" js_getKey :: StorageEvent -> JSVal + "((x) => { return x.key; })" js_getKey :: StorageEvent -> JSVal foreign import javascript unsafe - "$1.oldValue" js_getOldValue :: StorageEvent -> JSVal + "((x) => { return x.oldValue; })" js_getOldValue :: StorageEvent -> JSVal foreign import javascript unsafe - "$1.newValue" js_getNewValue :: StorageEvent -> JSVal + "((x) => { return x.newValue; })" js_getNewValue :: StorageEvent -> JSVal foreign import javascript unsafe - "$1.url" js_getUrl :: StorageEvent -> JSString + "((x) => { return x.url; })" js_getUrl :: StorageEvent -> JSString foreign import javascript unsafe - "$1.storageArea" js_getStorageArea :: StorageEvent -> JSVal + "((x) => { return x.storageArea; })" js_getStorageArea :: StorageEvent -> JSVal diff --git a/JavaScript/Web/WebSocket.hs b/JavaScript/Web/WebSocket.hs index 4f42aa8..0ff272e 100644 --- a/JavaScript/Web/WebSocket.hs +++ b/JavaScript/Web/WebSocket.hs @@ -170,20 +170,20 @@ foreign import javascript unsafe foreign import javascript unsafe "$2.send($1);" js_sendArrayBuffer :: ArrayBuffer -> WebSocket -> IO () foreign import javascript unsafe - "$1.bufferedAmount" js_getBufferedAmount :: WebSocket -> IO Int + "((x) => { return x.bufferedAmount; })" js_getBufferedAmount :: WebSocket -> IO Int foreign import javascript unsafe - "$1.readyState" js_getReadyState :: WebSocket -> IO Int + "((x) => { return x.readyState; })" js_getReadyState :: WebSocket -> IO Int foreign import javascript unsafe - "$1.protocol" js_getProtocol :: WebSocket -> IO JSString + "((x) => { return x.protocol; })" js_getProtocol :: WebSocket -> IO JSString foreign import javascript unsafe - "$1.extensions" js_getExtensions :: WebSocket -> IO JSString + "((x) => { return x.extensions; })" js_getExtensions :: WebSocket -> IO JSString foreign import javascript unsafe - "$1.url" js_getUrl :: WebSocket -> JSString + "((x) => { return x.url; })" js_getUrl :: WebSocket -> JSString foreign import javascript unsafe - "$1.binaryType === 'blob' ? 0 : 1" + "((x) => { return x.binaryType === 'blob' ? 0 : 1; })" js_getBinaryType :: WebSocket -> IO Int foreign import javascript unsafe - "$1.lastError" js_getLastError :: WebSocket -> IO JSVal + "((x) => { return x.lastError; })" js_getLastError :: WebSocket -> IO JSVal foreign import javascript unsafe "$2.binaryType = $1" diff --git a/JavaScript/Web/Worker.hs b/JavaScript/Web/Worker.hs index f086023..a0ec291 100644 --- a/JavaScript/Web/Worker.hs +++ b/JavaScript/Web/Worker.hs @@ -32,4 +32,4 @@ foreign import javascript unsafe foreign import javascript unsafe "$2.postMessage($1)" js_postMessage :: JSVal -> Worker -> IO () foreign import javascript unsafe - "$1.terminate()" js_terminate :: Worker -> IO () + "((x) => { return x.terminate(); })" js_terminate :: Worker -> IO () diff --git a/JavaScript/Web/XMLHttpRequest.hs b/JavaScript/Web/XMLHttpRequest.hs index f378107..5e42d35 100644 --- a/JavaScript/Web/XMLHttpRequest.hs +++ b/JavaScript/Web/XMLHttpRequest.hs @@ -201,7 +201,7 @@ xhrByteString = fmap -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1.withCredentials = true;" + "((x) => { return x.withCredentials = true; })" js_setWithCredentials :: XHR -> IO () foreign import javascript unsafe @@ -211,7 +211,7 @@ foreign import javascript unsafe "$2.responseType = $1;" js_setResponseType :: JSString -> XHR -> IO () foreign import javascript unsafe - "$1.abort();" + "((x) => { return x.abort(); })" js_abort :: XHR -> IO () foreign import javascript unsafe "$3.setRequestHeader($1,$2);" @@ -232,16 +232,16 @@ foreign import javascript unsafe "$4.append($1,$2,$3)" js_appendFormData3 :: JSString -> JSVal -> JSString -> JSFormData -> IO () foreign import javascript unsafe - "$1.status" + "((x) => { return x.status; })" js_getStatus :: XHR -> IO Int foreign import javascript unsafe - "$1.response" + "((x) => { return x.response; })" js_getResponse :: XHR -> IO JSVal foreign import javascript unsafe - "$1.response ? true : false" + "((x) => { return x.response ? true : false; })" js_hasResponse :: XHR -> IO Bool foreign import javascript unsafe - "$1.getAllResponseHeaders()" + "((x) => { return x.getAllResponseHeaders(); })" js_getAllResponseHeaders :: XHR -> IO JSString foreign import javascript unsafe "$2.getResponseHeader($1)" From be36c53d09a311b738fb4eb1d1edf1ebe69ab482 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Mon, 30 Oct 2023 23:17:13 +1100 Subject: [PATCH 30/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 976420f..924d98a 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -26,7 +26,7 @@ jobs: platform: x86_64-linux target-platform: "-js" minimal: true - compiler-nix-name: ghc99 + compiler-nix-name: ghc980 - name: Cabal run: file $(which cabal) From 4ebdcbf797ed897ba2bf4fbca721f93ba0e373a9 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Mon, 30 Oct 2023 23:20:17 +1100 Subject: [PATCH 31/53] WIP github actions --- .github/workflows/ghcjs-base.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 924d98a..e9cd6a7 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -26,7 +26,7 @@ jobs: platform: x86_64-linux target-platform: "-js" minimal: true - compiler-nix-name: ghc980 + compiler-nix-name: ghc98 - name: Cabal run: file $(which cabal) From a061be1c0d48ba0f9aec0d726a91903aaa47eb88 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Thu, 2 Nov 2023 16:17:07 +1100 Subject: [PATCH 32/53] Bump packages --- ghcjs-base.cabal | 10 +++++----- test/compat.js | 7 +++++++ 2 files changed, 12 insertions(+), 5 deletions(-) create mode 100644 test/compat.js diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index e9e344e..382ac4b 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -142,19 +142,19 @@ library build-depends: base >= 4.7 && < 5, ghc-prim, binary >= 0.8 && < 0.11, - bytestring >= 0.10 && < 0.12, - text >= 1.1 && < 2.1, + bytestring >= 0.10 && < 0.13, + text >= 1.1 && < 2.2, aeson >= 0.8 && < 2.3, scientific >= 0.3.7 && < 0.4, - vector >= 0.10 && < 0.13, + vector >= 0.10 && < 0.14, containers >= 0.5 && < 0.7, time >= 1.5 && < 1.13, hashable >= 1.2 && < 1.5, unordered-containers >= 0.2 && < 0.3, attoparsec >= 0.11 && < 0.15, transformers >= 0.3 && < 0.7, - primitive >= 0.5 && < 0.8, - deepseq >= 1.3 && < 1.5, + primitive >= 0.5 && < 0.10, + deepseq >= 1.3 && < 1.6, dlist >= 0.7 && < 1.1 default-language: Haskell2010 if !arch(javascript) diff --git a/test/compat.js b/test/compat.js new file mode 100644 index 0000000..8f5e380 --- /dev/null +++ b/test/compat.js @@ -0,0 +1,7 @@ +function h$_hs_test_measure_off() { + return 0; +} + +function h$splitmix_init() { + return Math.floor(Math.random() * 0 * 100000000); +} From c5ef40a74dc3c216a1b5dcd8c4767c1b5f49893b Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Thu, 2 Nov 2023 16:36:00 +1100 Subject: [PATCH 33/53] Add tests/compat.js to ghc-options for the testsuite --- ghcjs-base.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index 382ac4b..505f596 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -173,7 +173,7 @@ test-suite tests Tests.Utils Tests.Buffer ghc-options: - -Wall -rtsopts + -Wall -rtsopts tests/compat.js build-depends: HUnit >= 1.2, QuickCheck >= 2.7, From eda5ca7221706c6d1058a0358d46f4af4f9387a6 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Thu, 2 Nov 2023 16:49:39 +1100 Subject: [PATCH 34/53] Fix typo --- ghcjs-base.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index 505f596..526699f 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -173,7 +173,7 @@ test-suite tests Tests.Utils Tests.Buffer ghc-options: - -Wall -rtsopts tests/compat.js + -Wall -rtsopts test/compat.js build-depends: HUnit >= 1.2, QuickCheck >= 2.7, From 9322ce70d75899ab0ca2f92254d5b8391cff3d1c Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Thu, 2 Nov 2023 17:04:32 +1100 Subject: [PATCH 35/53] Fix typo --- test/compat.js | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/compat.js b/test/compat.js index 8f5e380..d32f590 100644 --- a/test/compat.js +++ b/test/compat.js @@ -1,4 +1,4 @@ -function h$_hs_test_measure_off() { +function h$_hs_text_measure_off() { return 0; } From 819552cb02de4761203df8d2ceea92b33183d2a6 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Thu, 2 Nov 2023 18:36:09 +1100 Subject: [PATCH 36/53] Bump GHC version --- .github/workflows/ghcjs-base.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index e9cd6a7..976420f 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -26,7 +26,7 @@ jobs: platform: x86_64-linux target-platform: "-js" minimal: true - compiler-nix-name: ghc98 + compiler-nix-name: ghc99 - name: Cabal run: file $(which cabal) From 1dc1aca50c5954cc219c6047bbf3c115191a1e63 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Thu, 2 Nov 2023 19:13:20 +1100 Subject: [PATCH 37/53] Fixes --- .github/workflows/ghcjs-base.yml | 2 +- test/compat.js | 8 ++++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ghcjs-base.yml b/.github/workflows/ghcjs-base.yml index 976420f..e9cd6a7 100644 --- a/.github/workflows/ghcjs-base.yml +++ b/.github/workflows/ghcjs-base.yml @@ -26,7 +26,7 @@ jobs: platform: x86_64-linux target-platform: "-js" minimal: true - compiler-nix-name: ghc99 + compiler-nix-name: ghc98 - name: Cabal run: file $(which cabal) diff --git a/test/compat.js b/test/compat.js index d32f590..591d3dd 100644 --- a/test/compat.js +++ b/test/compat.js @@ -5,3 +5,11 @@ function h$_hs_text_measure_off() { function h$splitmix_init() { return Math.floor(Math.random() * 0 * 100000000); } + +function MK_TUP2(x1, x2) { + h$c2(h$ghczmprimZCGHCziTupleziPrimziZ2T_con_e, x1, x2); +} + +function MK_TUP3(x1, x2, x3) { + h$c3(h$ghczmprimZCGHCziTupleziPrimziZ3T_con_e, x1, x2, x3); +} From 2cb5651a1cede800577319d12d8dcdd2ef190486 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Thu, 2 Nov 2023 19:34:04 +1100 Subject: [PATCH 38/53] Fixes --- test/compat.js | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/test/compat.js b/test/compat.js index 591d3dd..cdbfe5b 100644 --- a/test/compat.js +++ b/test/compat.js @@ -6,10 +6,5 @@ function h$splitmix_init() { return Math.floor(Math.random() * 0 * 100000000); } -function MK_TUP2(x1, x2) { - h$c2(h$ghczmprimZCGHCziTupleziPrimziZ2T_con_e, x1, x2); -} - -function MK_TUP3(x1, x2, x3) { - h$c3(h$ghczmprimZCGHCziTupleziPrimziZ3T_con_e, x1, x2, x3); -} +var h$ghczmprimZCGHCziTupleziPrimziZLz2cUZR_con_e = h$ghczmprimZCGHCziTupleziPrimziZ2T_con_e; +var h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUZR_con_e = h$ghczmprimZCGHCziTupleziPrimziZ3T_con_e; From 144c1c8cc970a38bb06a18731947a6e9ba6bdbd9 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Mon, 6 Nov 2023 21:18:23 +1100 Subject: [PATCH 39/53] Fix warnings --- Data/JSString/RealFloat.hs | 4 ---- GHCJS/Foreign/Internal.hs | 2 +- GHCJS/Marshal.hs | 1 - GHCJS/Marshal/Pure.hs | 4 ++-- JavaScript/JSON/Types/Generic.hs | 15 ++++++++------- JavaScript/JSON/Types/Instances.hs | 12 +----------- JavaScript/JSON/Types/Internal.hs | 1 - JavaScript/TypedArray/Internal.hs | 1 + JavaScript/TypedArray/Internal/Types.hs | 12 +----------- JavaScript/Web/XMLHttpRequest.hs | 3 ++- 10 files changed, 16 insertions(+), 39 deletions(-) diff --git a/Data/JSString/RealFloat.hs b/Data/JSString/RealFloat.hs index cf44579..c653b66 100644 --- a/Data/JSString/RealFloat.hs +++ b/Data/JSString/RealFloat.hs @@ -26,8 +26,6 @@ realFloat :: (RealFloat a) => a -> JSString realFloat = error "Data.JSString.RealFloat.realFloat not yet implemented" {-# RULES "realFloat/Double" realFloat = genericDouble #-} {-# RULES "realFoat/Float" realFloat = genericFloat #-} -{-# SPECIALIZE realFloat :: Double -> JSString #-} -{-# SPECIALIZE realFloat :: Float -> JSString #-} {-# NOINLINE realFloat #-} formatRealFloat :: (RealFloat a) @@ -38,8 +36,6 @@ formatRealFloat :: (RealFloat a) formatRealFloat = error "Data.JSString.RealFloat.formatRealFloat not yet implemented" {-# RULES "formatRealFloat/Double" formatRealFloat = formatDouble #-} {-# RULES "formatRealFloat/Float" formatRealFloat = formatFloat #-} -{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> JSString #-} -{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> JSString #-} {-# NOINLINE formatRealFloat #-} genericDouble :: Double -> JSString diff --git a/GHCJS/Foreign/Internal.hs b/GHCJS/Foreign/Internal.hs index ed8d648..06e8bee 100644 --- a/GHCJS/Foreign/Internal.hs +++ b/GHCJS/Foreign/Internal.hs @@ -90,7 +90,7 @@ import Control.Concurrent.MVar import Control.DeepSeq (force) import Control.Exception (evaluate, Exception) -import Foreign.ForeignPtr.Safe +import Foreign.ForeignPtr import Foreign.Ptr import Data.Primitive.ByteArray diff --git a/GHCJS/Marshal.hs b/GHCJS/Marshal.hs index 6c17668..c850d60 100644 --- a/GHCJS/Marshal.hs +++ b/GHCJS/Marshal.hs @@ -25,7 +25,6 @@ import Control.Monad import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) import qualified Data.Aeson as AE -import Data.Attoparsec.Number (Number(..)) import Data.Bits ((.&.)) import Data.Char (chr, ord) #if MIN_VERSION_aeson (2,0,0) diff --git a/GHCJS/Marshal/Pure.hs b/GHCJS/Marshal/Pure.hs index 5311aae..a43931f 100644 --- a/GHCJS/Marshal/Pure.hs +++ b/GHCJS/Marshal/Pure.hs @@ -21,8 +21,8 @@ -} module GHCJS.Marshal.Pure ( PFromJSVal(..) , PToJSVal(..) - , jsvalToChar - , charToJSVal + , jsvalToChar + , charToJSVal ) where import Data.Char (chr, ord) diff --git a/JavaScript/JSON/Types/Generic.hs b/JavaScript/JSON/Types/Generic.hs index 2e5df98..5297baa 100644 --- a/JavaScript/JSON/Types/Generic.hs +++ b/JavaScript/JSON/Types/Generic.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP, DefaultSignatures, EmptyDataDecls, FlexibleInstances, - FunctionalDependencies, KindSignatures, OverlappingInstances, + FunctionalDependencies, KindSignatures, MonoLocalBinds, ScopedTypeVariables, TypeOperators, UndecidableInstances, ViewPatterns, NamedFieldPuns, FlexibleContexts, PatternGuards, RecordWildCards, DataKinds #-} @@ -39,6 +39,7 @@ import Data.Monoid (mappend) -- import Data.Text (Text, pack, unpack) import GHC.Generics +import Data.Kind {- import qualified Data.HashMap.Strict as H @@ -63,7 +64,7 @@ instance GToJSON U1 where gToJSON _opts _ = emptyArray {-# INLINE gToJSON #-} -instance (ConsToJSON a) => GToJSON (C1 c a) where +instance {-# OVERLAPS #-} (ConsToJSON a) => GToJSON (C1 c a) where -- Constructors need to be encoded differently depending on whether they're -- a record or not. This distinction is made by 'constToJSON': gToJSON opts = consToJSON opts . unM1 @@ -265,7 +266,7 @@ instance ( WriteProduct a ixR = ix + lenL {-# INLINE writeProduct #-} -instance (GToJSON a) => WriteProduct a where +instance {-# OVERLAPPABLE #-} (GToJSON a) => WriteProduct a where writeProduct opts mv ix _ = (\(SomeValue v) -> JSAST.write ix v mv) . gToJSON opts {-# INLINE writeProduct #-} @@ -309,7 +310,7 @@ instance GFromJSON U1 where | otherwise = typeMismatch "unit constructor (U1)" v {-# INLINE gParseJSON #-} -instance (ConsFromJSON a) => GFromJSON (C1 c a) where +instance {-# OVERLAPS #-} (ConsFromJSON a) => GFromJSON (C1 c a) where -- Constructors need to be decoded differently depending on whether they're -- a record or not. This distinction is made by consParseJSON: gParseJSON opts = fmap M1 . consParseJSON opts @@ -568,7 +569,7 @@ instance (Constructor c, GFromJSON a, ConsFromJSON a) => FromPair (C1 c a) where -------------------------------------------------------------------------------- -class IsRecord (f :: * -> *) isRecord | f -> isRecord +class IsRecord (f :: Type -> Type) isRecord | f -> isRecord instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord #if MIN_VERSION_base(4,9,0) @@ -582,7 +583,7 @@ instance IsRecord U1 False -------------------------------------------------------------------------------- -class AllNullary (f :: * -> *) allNullary | f -> allNullary +class AllNullary (f :: Type -> Type) allNullary | f -> allNullary instance ( AllNullary a allNullaryL , AllNullary b allNullaryR @@ -609,7 +610,7 @@ instance And True False False newtype Tagged s b = Tagged {unTagged :: b} -newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b} +newtype Tagged2 (s :: Type -> Type) b = Tagged2 {unTagged2 :: b} -------------------------------------------------------------------------------- diff --git a/JavaScript/JSON/Types/Instances.hs b/JavaScript/JSON/Types/Instances.hs index a57374a..de69177 100644 --- a/JavaScript/JSON/Types/Instances.hs +++ b/JavaScript/JSON/Types/Instances.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances, - GeneralizedNewtypeDeriving, IncoherentInstances, OverlappingInstances, + GeneralizedNewtypeDeriving, IncoherentInstances, OverloadedStrings, UndecidableInstances, ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -68,7 +68,6 @@ import qualified JavaScript.JSON.Types.Internal as I import Data.Scientific (Scientific) import qualified Data.Scientific as Scientific (coefficient, base10Exponent, fromFloatDigits, toRealFloat) -import Data.Attoparsec.Number (Number(..)) import Data.Fixed import Data.Hashable (Hashable(..)) import Data.Int (Int8, Int16, Int32, Int64) @@ -1064,15 +1063,6 @@ realFloatToJSON d | otherwise = doubleValue (realToFrac d) {-# INLINE realFloatToJSON #-} -scientificToNumber :: Scientific -> Number -scientificToNumber s - | e < 0 = D $ Scientific.toRealFloat s - | otherwise = I $ c * 10 ^ e - where - e = Scientific.base10Exponent s - c = Scientific.coefficient s -{-# INLINE scientificToNumber #-} - parseRealFloat :: RealFloat a => String -> Value -> Parser a parseRealFloat _ (match -> Number d) = pure $ realToFrac d parseRealFloat _ (match -> Null) = pure (0/0) diff --git a/JavaScript/JSON/Types/Internal.hs b/JavaScript/JSON/Types/Internal.hs index 0ddcea5..231dd09 100644 --- a/JavaScript/JSON/Types/Internal.hs +++ b/JavaScript/JSON/Types/Internal.hs @@ -8,7 +8,6 @@ module JavaScript.JSON.Types.Internal ( -- * Core JSON types SomeValue(..), Value, MutableValue , SomeValue'(..), Value', MutableValue' - , MutableValue, MutableValue' , emptyArray, isEmptyArray , Pair , Object, MutableObject diff --git a/JavaScript/TypedArray/Internal.hs b/JavaScript/TypedArray/Internal.hs index 47ee9d3..dbbe379 100644 --- a/JavaScript/TypedArray/Internal.hs +++ b/JavaScript/TypedArray/Internal.hs @@ -7,6 +7,7 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} diff --git a/JavaScript/TypedArray/Internal/Types.hs b/JavaScript/TypedArray/Internal/Types.hs index 5759109..407333f 100644 --- a/JavaScript/TypedArray/Internal/Types.hs +++ b/JavaScript/TypedArray/Internal/Types.hs @@ -98,7 +98,7 @@ type STUint8ClampedArray s = SomeSTTypedArray s Uint8ClampedElem -- ----------------------------------------------------------------------------- type family Elem x where - Elem (SomeUint8Array m) = Word8 + Elem (SomeUint8Array m) = Word8 -- SomeTypedArray Uint8Elem Elem (SomeUint8ClampedArray m) = Word8 Elem (SomeUint16Array m) = Word16 Elem (SomeUint32Array m) = Word @@ -108,13 +108,3 @@ type family Elem x where Elem (SomeFloat32Array m) = Double Elem (SomeFloat64Array m) = Double - Elem (STUint8Array s) = Word8 - Elem (STUint8ClampedArray s) = Word8 - Elem (STUint16Array s) = Word16 - Elem (STUint32Array s) = Word - Elem (STInt8Array s) = Int8 - Elem (STInt16Array s) = Int16 - Elem (STInt32Array s) = Int - Elem (STFloat32Array s) = Double - Elem (STFloat64Array s) = Double - diff --git a/JavaScript/Web/XMLHttpRequest.hs b/JavaScript/Web/XMLHttpRequest.hs index 7f81548..3b0f4be 100644 --- a/JavaScript/Web/XMLHttpRequest.hs +++ b/JavaScript/Web/XMLHttpRequest.hs @@ -2,7 +2,8 @@ ForeignFunctionInterface, JavaScriptFFI, EmptyDataDecls, TypeFamilies, DataKinds, ScopedTypeVariables, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, - LambdaCase, MultiParamTypeClasses, DeriveGeneric #-} + LambdaCase, MultiParamTypeClasses, DeriveGeneric, + TypeOperators #-} module JavaScript.Web.XMLHttpRequest ( xhr , xhrByteString From 5b4353a98b0c038e0426fcb94a5dc0bbaff7fb38 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Wed, 8 Nov 2023 22:50:51 +1100 Subject: [PATCH 40/53] Fix jsstringHexI64 --- jsbits/jsstring.js | 74 ++++++++++++++++++---------------------------- 1 file changed, 29 insertions(+), 45 deletions(-) diff --git a/jsbits/jsstring.js b/jsbits/jsstring.js index 0a99bb2..814c977 100644 --- a/jsbits/jsstring.js +++ b/jsbits/jsstring.js @@ -798,29 +798,11 @@ function h$jsstringUnpack(str) { return r; } - - -#if __GLASGOW_HASKELL__ >= 800 -function h$jsstringDecInteger(val) { - TRACE_JSSTRING("decInteger"); - if(IS_INTEGER_S(val)) { - return '' + INTEGER_S_DATA(val); - } else if(IS_INTEGER_Jp(val)) { - return h$ghcjsbn_showBase(INTEGER_J_DATA(val), 10); - } else { - return '-' + h$ghcjsbn_showBase(INTEGER_J_DATA(val), 10); - } +function h$jsstringDecBigNat(positive,x) { + TRACE_JSSTRING("decBigNat"); + const y = BigInt("0x" + h$jsstringHexBigNat(positive,x)).toString(); + return positive ? y : "-"+y; } -#else -function h$jsstringDecInteger(val) { - TRACE_JSSTRING("decInteger"); - if(IS_INTEGER_S(val)) { - return '' + INTEGER_S_DATA(val); - } else { - return INTEGER_J_DATA(val).toString(); - } -} -#endif function h$jsstringDecI64(hi,lo) { TRACE_JSSTRING("decI64: " + hi + " " + lo); @@ -853,37 +835,39 @@ function h$jsstringDecW64(hi,lo) { return '' + x2 + h$jsstringDecIPadded6(x1); } -#if __GLASGOW_HASKELL__ >= 800 -function h$jsstringHexInteger(val) { - TRACE_JSSTRING("hexInteger"); - if(IS_INTEGER_S(val)) { - return '' + INTEGER_S_DATA(val); - } else { - // we assume it's nonnegative. this condition is checked by the Haskell code - return h$ghcjsbn_showBase(INTEGER_J_DATA(val), 16); +function h$jsstringHexBigNat(positive,x) { + TRACE_JSSTRING("hexBigNat"); + var v = ""; + var i = x.u1.length - 1; + while (i >= 0) { + if (x.u1[i] !== 0) { + break; + } else { + i--; + } } -} -#else -function h$jsstringHexInteger(val) { - TRACE_JSSTRING("hexInteger"); - if(IS_INTEGER_S(val)) { - return '' + INTEGER_S_DATA(val); - } else { - return INTEGER_J_DATA(val).toRadix(16); + if (i >= 0) { + v += x.u1[i].toString(16); + i--; } + for (; i >= 0; i--) { + v += x.u1[i].toString(16).padStart(4, '0'); + } + return positive ? v : "-"+v; } -#endif function h$jsstringHexI64(hi,lo) { - var lo0 = lo<0 ? lo+4294967296 : lo; - if(hi === 0) return lo0.toString(16); - return ((hi<0)?hi+4294967296:hi).toString(16) + h$jsstringHexIPadded8(lo0); + TRACE_JSSTRING("hexI64: " + hi + " " + lo); + var sign = (hi >>> 31) ? '-' : ''; + var lo0 = sign ? ~(lo - 1) >>> 0 : lo; + if(hi === 0 || hi === -1) return sign + lo0.toString(16); + var hi0 = sign ? ~hi >>> 0 : hi; + return sign + hi0.toString(16) + lo0.toString(16).padStart(8, '0'); } function h$jsstringHexW64(hi,lo) { - var lo0 = lo<0 ? lo+4294967296 : lo; - if(hi === 0) return lo0.toString(16); - return ((hi<0)?hi+4294967296:hi).toString(16) + h$jsstringHexIPadded8(lo0); + if (hi === 0) return lo.toString(16); + return hi.toString(16) + lo.toString(16).padStart(8, '0'); } // n in [0, 1000000000) From c64b07a05ac4a34a25b68d0b7c33260f83c1bc6b Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Mon, 20 Nov 2023 22:14:53 +1100 Subject: [PATCH 41/53] Fix `inidicies` function --- Data/JSString/Int.hs | 74 ++++++++++++++++++-------------- Data/JSString/Internal/Search.hs | 13 +++--- jsbits/jsstring.js | 14 ++++++ test/Tests/Properties.hs | 10 ++--- test/Tests/Properties/Numeric.hs | 5 ++- 5 files changed, 70 insertions(+), 46 deletions(-) diff --git a/Data/JSString/Int.hs b/Data/JSString/Int.hs index 0cb55ff..37a5a01 100644 --- a/Data/JSString/Int.hs +++ b/Data/JSString/Int.hs @@ -4,6 +4,7 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE LambdaCase #-} module Data.JSString.Int ( decimal @@ -18,6 +19,7 @@ import GHC.Int import GHC.Word import GHC.Exts hiding (Any) import GHC.Num.Integer +import GHC.Num.Natural import Unsafe.Coerce import GHC.JS.Prim @@ -34,7 +36,9 @@ decimal i = decimal' i {-# RULES "decimal/Word32" decimal = decimalW32 :: Word32 -> JSString #-} {-# RULES "decimal/Word64" decimal = decimalW64 :: Word64 -> JSString #-} {-# RULES "decimal/Integer" decimal = decimalInteger :: Integer -> JSString #-} +{-# RULES "decimal/Natural" decimal = decimalNatural :: Natural -> JSString #-} {-# SPECIALIZE decimal :: Integer -> JSString #-} +{-# SPECIALIZE decimal :: Natural -> JSString #-} {-# SPECIALIZE decimal :: Int -> JSString #-} {-# SPECIALIZE decimal :: Int8 -> JSString #-} {-# SPECIALIZE decimal :: Int16 -> JSString #-} @@ -76,7 +80,7 @@ decimalW16 (W16# x) = js_decW (word16ToWord# x) {-# INLINE decimalW16 #-} decimalW32 :: Word32 -> JSString -decimalW32 (W32# x) = js_decW32 (word32ToWord# x) +decimalW32 (W32# x) = js_decW32 x {-# INLINE decimalW32 #-} decimalW64 :: Word64 -> JSString @@ -84,16 +88,25 @@ decimalW64 (W64# x) = js_decW64 x {-# INLINE decimalW64 #-} decimalW :: Word -> JSString -decimalW (W# x) = js_decW32 x +decimalW (W# x) = js_decW x {-# INLINE decimalW #-} -- hack warning, we should really expose J# somehow data MyI = MyS Int# | MyJ Int# ByteArray# decimalInteger :: Integer -> JSString -decimalInteger !i = js_decInteger (unsafeCoerce i) +decimalInteger = \case + IS x -> js_decI x + IP x -> js_decBigNat True x + IN x -> js_decBigNat False x {-# INLINE decimalInteger #-} +decimalNatural :: Natural -> JSString +decimalNatural = \case + NS x -> js_decW x + NB x -> js_decBigNat True x +{-# INLINE decimalNatural #-} + decimal' :: Integral a => a -> JSString decimal' i = decimalInteger (toInteger i) {-# NOINLINE decimal' #-} @@ -126,7 +139,9 @@ hexadecimal i = hexadecimal' i {-# RULES "hexadecimal/Word32" hexadecimal = hexW32 :: Word32 -> JSString #-} {-# RULES "hexadecimal/Word64" hexadecimal = hexW64 :: Word64 -> JSString #-} {-# RULES "hexadecimal/Integer" hexadecimal = hexInteger :: Integer -> JSString #-} +{-# RULES "hexadecimal/Natural" hexadecimal = hexNatural :: Natural -> JSString #-} {-# SPECIALIZE hexadecimal :: Integer -> JSString #-} +{-# SPECIALIZE hexadecimal :: Natural -> JSString #-} {-# SPECIALIZE hexadecimal :: Int -> JSString #-} {-# SPECIALIZE hexadecimal :: Int8 -> JSString #-} {-# SPECIALIZE hexadecimal :: Int16 -> JSString #-} @@ -146,43 +161,36 @@ hexadecimal' i {-# NOINLINE hexadecimal' #-} hexInteger :: Integer -> JSString -hexInteger !i - | i < 0 = error hexErrMsg - | otherwise = js_hexInteger (unsafeCoerce i) +hexInteger = \case + IS x -> js_hexI x + IP x -> js_hexBigNat True x + IN x -> js_hexBigNat False x {-# INLINE hexInteger #-} +hexNatural :: Natural -> JSString +hexNatural = \case + NS x -> js_hexW x + NB x -> js_hexBigNat True x +{-# INLINE hexNatural #-} + hexI :: Int -> JSString -hexI (I# x) = if isTrue# (x <# 0#) - then error hexErrMsg - else js_hexI x +hexI (I# x) = js_hexI x {-# INLINE hexI #-} hexI8 :: Int8 -> JSString -hexI8 (I8# x) = - if isTrue# (int8ToInt# x <# 0#) - then error hexErrMsg - else js_hexI (int8ToInt# x) +hexI8 (I8# x) = js_hexI (int8ToInt# x) {-# INLINE hexI8 #-} hexI16 :: Int16 -> JSString -hexI16 (I16# x) = - if isTrue# (int16ToInt# x <# 0#) - then error hexErrMsg - else js_hexI (int16ToInt# x) +hexI16 (I16# x) = js_hexI (int16ToInt# x) {-# INLINE hexI16 #-} hexI32 :: Int32 -> JSString -hexI32 (I32# x) = - if isTrue# (int32ToInt# x <# 0#) - then error hexErrMsg - else js_hexI (int32ToInt# x) +hexI32 (I32# x) = js_hexI (int32ToInt# x) {-# INLINE hexI32 #-} hexI64 :: Int64 -> JSString -hexI64 i@(I64# x) = - if i < 0 - then error hexErrMsg - else js_hexI64 x +hexI64 i@(I64# x) = js_hexI64 x {-# INLINE hexI64 #-} hexW :: Word -> JSString @@ -220,14 +228,14 @@ foreign import javascript unsafe "((x) => { return '' + x; })" js_decW :: Word# -> JSString foreign import javascript unsafe - "((x) => { return ''+((x>=0)?x:(x+4294967296)); })" - js_decW32 :: Word# -> JSString + "((x) => { return '' + x; })" + js_decW32 :: Word32# -> JSString foreign import javascript unsafe "h$jsstringDecW64" js_decW64 :: Word64# -> JSString foreign import javascript unsafe - "h$jsstringDecInteger" - js_decInteger :: Any -> JSString + "h$jsstringDecBigNat" + js_decBigNat :: Bool -> ByteArray# -> JSString -- these are expected to be only applied to nonnegative integers foreign import javascript unsafe @@ -241,14 +249,14 @@ foreign import javascript unsafe "((x) => { return x.toString(16); })" js_hexW :: Word# -> JSString foreign import javascript unsafe - "((x) => { return ((x>=0)?x:(x+4294967296)).toString(16); })" - js_hexW32 :: Word32# -> JSString + "((x) => { return x.toString(16); })" + js_hexW32 :: Word32# -> JSString foreign import javascript unsafe "h$jsstringHexW64" js_hexW64 :: Word64# -> JSString foreign import javascript unsafe - "h$jsstringHexInteger" - js_hexInteger :: Any -> JSString + "h$jsstringHexBigNat" + js_hexBigNat :: Bool -> ByteArray# -> JSString foreign import javascript unsafe "((x,y) => { return '-'+x+(-y); })" diff --git a/Data/JSString/Internal/Search.hs b/Data/JSString/Internal/Search.hs index a7e6ac9..22c6165 100644 --- a/Data/JSString/Internal/Search.hs +++ b/Data/JSString/Internal/Search.hs @@ -9,14 +9,13 @@ module Data.JSString.Internal.Search ( indices import GHC.Exts (Int#, (+#), Int(..)) import Data.JSString --- returns uncorrected offsets in the String indices :: JSString -> JSString -> [Int] -indices needle haystack = go 0# +indices needle haystack = go 0# 0# where - go i = case js_indexOf needle i haystack of - -1# -> [] - n -> I# n : go (n +# 1#) + go n i = case js_indexOf needle n i haystack of + (# -1#, _ #) -> [] + (# n' , i' #) -> I# n' : go (n' +# 1#) (i' +# 1#) foreign import javascript unsafe - "((x,y,z) => { return z.indexOf(x,y); })" - js_indexOf :: JSString -> Int# -> JSString -> Int# + "h$jsstringIndices" + js_indexOf :: JSString -> Int# -> Int# -> JSString -> (# Int#, Int# #) diff --git a/jsbits/jsstring.js b/jsbits/jsstring.js index 814c977..b29522e 100644 --- a/jsbits/jsstring.js +++ b/jsbits/jsstring.js @@ -1163,3 +1163,17 @@ function h$jsstringSplitRE(limit, re, str) { while(--i>=0) r = MK_CONS(MK_JSVAL(a[i]), r); return r; } + +function h$jsstringIndices(needle, startN, startI, haystack) { + var endI = haystack.indexOf(needle, startI); + if (endI === -1) { + RETURN_UBX_TUP2(-1, -1); + } + var n = startN; + for (var i = startI; i < endI; i++) { + if (!IS_LO_SURR(haystack.charCodeAt(i))) { + n++; + } + } + RETURN_UBX_TUP2(n, endI); +} diff --git a/test/Tests/Properties.hs b/test/Tests/Properties.hs index 5c44ad0..0aac378 100644 --- a/test/Tests/Properties.hs +++ b/test/Tests/Properties.hs @@ -740,8 +740,8 @@ tests = testProperty "j_index" j_index, testProperty "j_findIndex" j_findIndex, testProperty "j_count" j_count, - testProperty "j_indices" j_indices--, --- testProperty "j_indices_occurs" j_indices_occurs + testProperty "j_indices" j_indices, + testProperty "j_indices_occurs" j_indices_occurs ], testGroup "zips" [ @@ -752,7 +752,7 @@ tests = testGroup "numeric conversion" [ testGroup "integral" [ --- testProperty "j_decimal_integer" j_decimal_integer, -- IS_INTEGER_S + testProperty "j_decimal_integer" j_decimal_integer, -- IS_INTEGER_S testProperty "j_decimal_int" j_decimal_int, testProperty "j_decimal_int8" j_decimal_int8, testProperty "j_decimal_int16" j_decimal_int16, @@ -765,13 +765,13 @@ tests = testProperty "j_decimal_word32" j_decimal_word32, testProperty "j_decimal_word64" j_decimal_word64, --- testProperty "j_decimal_integer_big" j_decimal_integer_big, -- IS_INTEGER_S + testProperty "j_decimal_integer_big" j_decimal_integer_big, -- IS_INTEGER_S testProperty "j_decimal_int_big" j_decimal_int_big, testProperty "j_decimal_int64_big" j_decimal_int64_big, testProperty "j_decimal_word_big" j_decimal_word_big, testProperty "j_decimal_word64_big" j_decimal_word64_big, --- testProperty "j_hexadecimal_integer" j_hexadecimal_integer, -- IS_INTEGER_S + testProperty "j_hexadecimal_integer" j_hexadecimal_integer, -- IS_INTEGER_S testProperty "j_hexadecimal_int" j_hexadecimal_int, testProperty "j_hexadecimal_int8" j_hexadecimal_int8, testProperty "j_hexadecimal_int16" j_hexadecimal_int16, diff --git a/test/Tests/Properties/Numeric.hs b/test/Tests/Properties/Numeric.hs index 4ffd6d8..e4b774b 100644 --- a/test/Tests/Properties/Numeric.hs +++ b/test/Tests/Properties/Numeric.hs @@ -40,7 +40,10 @@ j_decimal_word_big (BigBounded (a::Word)) = j_decimal a j_decimal_word64_big (BigBounded (a::Word64)) = j_decimal a j_hex :: (Integral a, Show a) => a -> Bool -j_hex = flip showHex "" `eq` (J.unpack . JI.hexadecimal) +j_hex = hex `eq` (J.unpack . JI.hexadecimal) + where + hex n | n < 0 = '-' : showHex (-n) "" + | otherwise = showHex n "" j_hexadecimal_integer (a::Integer) = j_hex a j_hexadecimal_int (a::Int) = j_hex a From 632ff5ad5c2ac72e3ea561e8cd62b1c0dd24742a Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Mon, 5 Feb 2024 12:14:47 +1300 Subject: [PATCH 42/53] Fix callbacks --- GHCJS/Foreign/Callback.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/GHCJS/Foreign/Callback.hs b/GHCJS/Foreign/Callback.hs index a5f7b8a..aca8170 100644 --- a/GHCJS/Foreign/Callback.hs +++ b/GHCJS/Foreign/Callback.hs @@ -141,19 +141,19 @@ asyncCallback3 x = js_asyncCallbackApply 3 (unsafeCoerce x) -- ---------------------------------------------------------------------------- -foreign import javascript unsafe "h$makeCallback(h$runSync, [$1], $2)" +foreign import javascript unsafe "(($1,$2) => { return h$makeCallback(h$runSync, [$1], $2)); })" js_syncCallback :: Bool -> Exts.Any -> IO (Callback (IO b)) -foreign import javascript unsafe "h$makeCallback(h$run, [], $1)" +foreign import javascript unsafe "(($1) => { return h$makeCallback(h$run, [], $1); })" js_asyncCallback :: Exts.Any -> IO (Callback (IO b)) -foreign import javascript unsafe "h$makeCallback(h$runSyncReturn, [false], $1)" +foreign import javascript unsafe "(($1) => { return h$makeCallback(h$runSyncReturn, [false], $1); })" js_syncCallbackReturn :: Exts.Any -> IO (Callback (IO JSVal)) -foreign import javascript unsafe "h$makeCallbackApply($2, h$runSync, [$1], $3)" +foreign import javascript unsafe "(($1,$2,$3) => { return h$makeCallbackApply($2, h$runSync, [$1], $3); })" js_syncCallbackApply :: Bool -> Int -> Exts.Any -> IO (Callback b) -foreign import javascript unsafe "h$makeCallbackApply($1, h$run, [], $2)" +foreign import javascript unsafe "(($1,$2) => { return h$makeCallbackApply($1, h$run, [], $2); })" js_asyncCallbackApply :: Int -> Exts.Any -> IO (Callback b) foreign import javascript unsafe - "h$makeCallbackApply($1, h$runSyncReturn, [false], $2)" + "(($1,$2) => { return h$makeCallbackApply($1, h$runSyncReturn, [false], $2); })" js_syncCallbackApplyReturn :: Int -> Exts.Any -> IO (Callback b) foreign import javascript unsafe "h$release" From 067a3441b30ee36e02e2d0bf7b8a0809078fee4c Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Mon, 5 Feb 2024 12:15:27 +1300 Subject: [PATCH 43/53] Fix text --- ghcjs-base.cabal | 3 ++- jsbits/text.js | 25 +++++-------------------- 2 files changed, 7 insertions(+), 21 deletions(-) diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index 526699f..c6da100 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -143,7 +143,8 @@ library ghc-prim, binary >= 0.8 && < 0.11, bytestring >= 0.10 && < 0.13, - text >= 1.1 && < 2.2, + -- text internals need to be utf8 (text <2.0 is utf16) + text >= 2.0 && < 2.2, aeson >= 0.8 && < 2.3, scientific >= 0.3.7 && < 0.4, vector >= 0.10 && < 0.14, diff --git a/jsbits/text.js b/jsbits/text.js index e55c952..e5ef45a 100644 --- a/jsbits/text.js +++ b/jsbits/text.js @@ -6,21 +6,7 @@ convert a Data.Text buffer with offset/length to a JavaScript string */ function h$textToString(arr, off, len) { - var a = []; - var end = off+len; - var k = 0; - var u1 = arr.u1; - var s = ''; - for(var i=off;i=0;i--) u1[i] = s.charCodeAt(i); - RETURN_UBX_TUP2(b, l); + var encoder = new TextEncoder("utf-8"); + u8 = encoder.encode(s); + b = h$wrapBuffer(u8.buffer, true, u8.byteOffset, u8.byteLength); + RETURN_UBX_TUP2(b, u8.byteLength); } function h$lazyTextToString(txt) { From 103014db72d4fb6448c52052addc2b1a6c1332d4 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 6 Feb 2024 00:24:11 +1300 Subject: [PATCH 44/53] Update version and set lower bound on base --- ghcjs-base.cabal | 39 +- jsbits-old/animationFrame.js | 18 - jsbits-old/array.js | 40 -- jsbits-old/export.js | 26 - jsbits-old/foreign.js | 8 - jsbits-old/json.js | 4 - jsbits-old/jsstring.js | 1181 ---------------------------------- jsbits-old/jsstringRaw.js | 21 - jsbits-old/object.js | 2 - jsbits-old/text.js | 53 -- jsbits-old/utils.js | 93 --- jsbits-old/websocket.js | 58 -- jsbits-old/xhr.js | 16 - 13 files changed, 13 insertions(+), 1546 deletions(-) delete mode 100644 jsbits-old/animationFrame.js delete mode 100644 jsbits-old/array.js delete mode 100644 jsbits-old/export.js delete mode 100644 jsbits-old/foreign.js delete mode 100644 jsbits-old/json.js delete mode 100644 jsbits-old/jsstring.js delete mode 100644 jsbits-old/jsstringRaw.js delete mode 100644 jsbits-old/object.js delete mode 100644 jsbits-old/text.js delete mode 100644 jsbits-old/utils.js delete mode 100644 jsbits-old/websocket.js delete mode 100644 jsbits-old/xhr.js diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index c6da100..165e15c 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ghcjs-base -version: 0.2.1.0 +version: 1.0.0.0 synopsis: base library for GHCJS homepage: http://github.com/ghcjs/ghcjs-base license: MIT @@ -15,33 +15,20 @@ source-repository head location: https://github.com/ghcjs/ghcjs-base library - if impl(ghc >= 8.10.1) - js-sources: jsbits/array.js - jsbits/animationFrame.js - jsbits/buffer.js - jsbits/export.js - jsbits/jsstring.js - jsbits/jsstringRaw.js - jsbits/foreign.js - jsbits/text.js - jsbits/utils.js - jsbits/xhr.js - jsbits/websocket.js - else - js-sources: jsbits-old/array.js - jsbits-old/animationFrame.js - jsbits-old/export.js - jsbits-old/jsstring.js - jsbits-old/jsstringRaw.js - jsbits-old/foreign.js - jsbits-old/text.js - jsbits-old/utils.js - jsbits-old/xhr.js - jsbits-old/websocket.js + js-sources: jsbits/array.js + jsbits/animationFrame.js + jsbits/buffer.js + jsbits/export.js + jsbits/jsstring.js + jsbits/jsstringRaw.js + jsbits/foreign.js + jsbits/text.js + jsbits/utils.js + jsbits/xhr.js + jsbits/websocket.js other-extensions: DeriveDataTypeable DeriveGeneric ForeignFunctionInterface --- JavaScriptFFI GHCForeignImportPrim MagicHash UnboxedTuples @@ -139,7 +126,7 @@ library JavaScript.TypedArray.Internal.Types JavaScript.TypedArray.ArrayBuffer.Internal JavaScript.TypedArray.DataView.Internal - build-depends: base >= 4.7 && < 5, + build-depends: base >= 4.18 && < 5, ghc-prim, binary >= 0.8 && < 0.11, bytestring >= 0.10 && < 0.13, diff --git a/jsbits-old/animationFrame.js b/jsbits-old/animationFrame.js deleted file mode 100644 index 7a3e942..0000000 --- a/jsbits-old/animationFrame.js +++ /dev/null @@ -1,18 +0,0 @@ -function h$animationFrameCancel(h) { - if(h.handle) window.cancelAnimationFrame(h.handle); - if(h.callback) { - h$release(h.callback) - h.callback = null; - } -} - -function h$animationFrameRequest(h) { - h.handle = window.requestAnimationFrame(function(ts) { - var cb = h.callback; - if(cb) { - h$release(cb); - h.callback = null; - cb(ts); - } - }); -} diff --git a/jsbits-old/array.js b/jsbits-old/array.js deleted file mode 100644 index 8230cdf..0000000 --- a/jsbits-old/array.js +++ /dev/null @@ -1,40 +0,0 @@ -#include - -/* - convert an array to a Haskell list, wrapping each element in a - JSVal constructor - */ -function h$fromArray(a) { - var r = HS_NIL; - for(var i=a.length-1;i>=0;i--) r = MK_CONS(MK_JSVAL(a[i]), r); - return a; -} - -/* - convert an array to a Haskell list. No additional wrapping of the - elements is performed. Only use this when the elements are directly - usable as Haskell heap objects (numbers, boolean) or when the - array elements have already been appropriately wrapped - */ -function h$fromArrayNoWrap(a) { - var r = HS_NIL; - for(var i=a.length-1;i>=0;i--) r = MK_CONS(a[i], r); - return a; -} - -/* - convert a list of JSVal to an array. the list must have been fully forced, - not just the spine. - */ -function h$listToArray(xs) { - var a = [], i = 0; - while(IS_CONS(xs)) { - a[i++] = JSVAL_VAL(CONS_HEAD(xs)); - xs = CONS_TAIL(xs); - } - return a; -} - -function h$listToArrayWrap(xs) { - return MK_JSVAL(h$listToArray(xs)); -} diff --git a/jsbits-old/export.js b/jsbits-old/export.js deleted file mode 100644 index cc3043a..0000000 --- a/jsbits-old/export.js +++ /dev/null @@ -1,26 +0,0 @@ -function h$exportValue(fp1a,fp1b,fp2a,fp2b,o) { - var e = { fp1a: fp1a - , fp1b: fp1b - , fp2a: fp2a - , fp2b: fp2b - , released: false - , root: o - , _key: -1 - }; - h$retain(e); - return e; -} - -function h$derefExport(fp1a,fp1b,fp2a,fp2b,e) { - if(!e || typeof e !== 'object') return null; - if(e.released) return null; - if(fp1a !== e.fp1a || fp1b !== e.fp1b || - fp2a !== e.fp2a || fp2b !== e.fp2b) return null; - return e.root; -} - -function h$releaseExport(e) { - h$release(e); - e.released = true; - e.root = null; -} diff --git a/jsbits-old/foreign.js b/jsbits-old/foreign.js deleted file mode 100644 index a4e4cf0..0000000 --- a/jsbits-old/foreign.js +++ /dev/null @@ -1,8 +0,0 @@ -function h$foreignListProps(o) { - var r = HS_NIL; - if(typeof o === 'undefined' || o === null) return null; - throw "h$foreignListProps"; -/* for(var p in o) { - - } */ -} diff --git a/jsbits-old/json.js b/jsbits-old/json.js deleted file mode 100644 index 15d2ee3..0000000 --- a/jsbits-old/json.js +++ /dev/null @@ -1,4 +0,0 @@ -#include - - - diff --git a/jsbits-old/jsstring.js b/jsbits-old/jsstring.js deleted file mode 100644 index e8a4ef9..0000000 --- a/jsbits-old/jsstring.js +++ /dev/null @@ -1,1181 +0,0 @@ -#include - -/* - * Support code for the Data.JSString module. This code presents a JSString - * as a sequence of code points and hides the underlying encoding ugliness of - * the JavaScript strings. - * - * Use Data.JSString.Raw for direct access to the JSThis makes the operations more expen - */ - -/* - * Some workarounds here for JS engines that do not support proper - * code point access - */ - -#ifdef GHCJS_TRACE_JSSTRING -#define TRACE_JSSTRING(args...) h$log("jsstring: ", args); -#else -#define TRACE_JSSTRING(args...) -#endif - -#define IS_ASTRAL(cp) ((cp)>=0x10000) -#define IS_HI_SURR(cp) ((cp|1023)===0xDBFF) -#define IS_LO_SURR(cp) ((cp|1023)===0xDFFF) -#define FROM_SURR(hi,lo) ((((hi)-0xD800)<<10)+(lo)-0xDC00+0x10000) -#define HI_SURR(cp) ((((cp)-0x10000)>>>10)+0xDC00) -#define LO_SURR(cp) (((cp)&0x3FF)+0xD800) - -var h$jsstringEmpty = MK_JSVAL(''); - -var h$jsstringHead, h$jsstringTail, h$jsstringCons, - h$jsstringSingleton, h$jsstringSnoc, h$jsstringUncons, - h$jsstringIndex, h$jsstringUncheckedIndex; - -var h$fromCodePoint; - -if(String.prototype.fromCodePoint) { - h$fromCodePoint = String.fromCodePoint; -} else { - // polyfill from https://github.com/mathiasbynens/String.fromCodePoint (MIT-license) - h$fromCodePoint = - (function() { - var stringFromCharCode = String.fromCharCode; - var floor = Math.floor; - return function(_) { - var MAX_SIZE = 0x4000; - var codeUnits = []; - var highSurrogate; - var lowSurrogate; - var index = -1; - var length = arguments.length; - if (!length) { - return ''; - } - var result = ''; - while (++index < length) { - var codePoint = Number(arguments[index]); - if ( - !isFinite(codePoint) || // `NaN`, `+Infinity`, or `-Infinity` - codePoint < 0 || // not a valid Unicode code point - codePoint > 0x10FFFF || // not a valid Unicode code point - floor(codePoint) != codePoint // not an integer - ) { - throw RangeError('Invalid code point: ' + codePoint); - } - if (codePoint <= 0xFFFF) { // BMP code point - codeUnits.push(codePoint); - } else { // Astral code point; split in surrogate halves - // https://mathiasbynens.be/notes/javascript-encoding#surrogate-formulae - codePoint -= 0x10000; - highSurrogate = (codePoint >> 10) + 0xD800; - lowSurrogate = (codePoint % 0x400) + 0xDC00; - codeUnits.push(highSurrogate, lowSurrogate); - } - if (index + 1 == length || codeUnits.length > MAX_SIZE) { - result += stringFromCharCode.apply(null, codeUnits); - codeUnits.length = 0; - } - } - return result; - } - })(); -} - -if(String.prototype.codePointAt) { - h$jsstringSingleton = function(ch) { - TRACE_JSSTRING("(codePointAt) singleton: " + ch); - return String.fromCodePoint(ch); - } - h$jsstringHead = function(str) { - TRACE_JSSTRING("(codePointAt) head: " + str); - var cp = str.codePointAt(0); - return (cp === undefined) ? -1 : (cp|0); - } - h$jsstringTail = function(str) { - TRACE_JSSTRING("(codePointAt) tail: " + str); - var l = str.length; - if(l===0) return null; - var ch = str.codePointAt(0); - if(ch === undefined) return null; - // string length is at least two if ch comes from a surrogate pair - return str.substr(IS_ASTRAL(ch)?2:1); - } - h$jsstringCons = function(ch, str) { - TRACE_JSSTRING("(codePointAt) cons: " + ch + " '" + str + "'"); - return String.fromCodePoint(ch)+str; - } - h$jsstringSnoc = function(str, ch) { - TRACE_JSSTRING("(codePointAt) snoc: '" + str + "' " + ch); - return str+String.fromCodePoint(ch); - } - h$jsstringUncons = function(str) { - TRACE_JSSTRING("(codePointAt) uncons: '" + str + "'"); - var l = str.length; - if(l===0) { - RETURN_UBX_TUP2(-1, null); - } - var ch = str.codePointAt(0); - if(ch === undefined) { - RETURN_UBX_TUP2(-1, null); - } - RETURN_UBX_TUP2(ch, str.substr(IS_ASTRAL(ch)?2:1)); - } - // index is the first part of the character - h$jsstringIndex = function(i, str) { - TRACE_JSSTRING("(codePointAt) index: " + i + " '" + str + "'"); - var ch = str.codePointAt(i); - if(ch === undefined) return -1; - return ch; - } - h$jsstringUncheckedIndex = function(i, str) { - TRACE_JSSTRING("(codePointAt) uncheckedIndex: " + i + " '" + str.length + "'"); - return str.codePointAt(i); - } -} else { - h$jsstringSingleton = function(ch) { - TRACE_JSSTRING("(no codePointAt) singleton: " + ch); - return (IS_ASTRAL(ch)) ? String.fromCharCode(HI_SURR(ch), LO_SURR(ch)) - : String.fromCharCode(ch); - } - h$jsstringHead = function(str) { - TRACE_JSSTRING("(no codePointAt) head: " + str); - var l = str.length; - if(l===0) return -1; - var ch = str.charCodeAt(0); - if(IS_HI_SURR(ch)) { - return (l>1) ? FROM_SURR(ch, str.charCodeAt(1)) : -1; - } else { - return ch; - } - } - h$jsstringTail = function(str) { - TRACE_JSSTRING("(no codePointAt) tail: " + str); - var l = str.length; - if(l===0) return null; - var ch = str.charCodeAt(0); - if(IS_HI_SURR(ch)) { - return (l>1)?str.substr(2):null; - } else return str.substr(1); - } - h$jsstringCons = function(ch, str) { - TRACE_JSSTRING("(no codePointAt) cons: " + ch + " '" + str + "'"); - return ((IS_ASTRAL(ch)) ? String.fromCharCode(HI_SURR(ch), LO_SURR(ch)) - : String.fromCharCode(ch)) - + str; - } - h$jsstringSnoc = function(str, ch) { - TRACE_JSSTRING("(no codePointAt) snoc: '" + str + "' " + ch); - return str + ((IS_ASTRAL(ch)) ? String.fromCharCode(HI_SURR(ch), LO_SURR(ch)) - : String.fromCharCode(ch)); - } - h$jsstringUncons = function(str) { - TRACE_JSSTRING("(no codePointAt) uncons: '" + str + "'"); - var l = str.length; - if(l===0) { - RETURN_UBX_TUP2(-1, null); - } - var ch = str.charCodeAt(0); - if(IS_HI_SURR(ch)) { - if(l > 1) { - RETURN_UBX_TUP2(FROM_SURR(ch, str.charCodeAt(1)), str.substr(2)); - } else { - RETURN_UBX_TUP2(-1, null); - } - } else { - RETURN_UBX_TUP2(ch, str.substr(1)); - } - } - // index is the first part of the character - h$jsstringIndex = function(i, str) { - // TRACE_JSSTRING("(no codePointAt) index: " + i + " '" + str + "'"); - var ch = str.charCodeAt(i); - if(ch != ch) return -1; // NaN test - return (IS_HI_SURR(ch)) ? FROM_SURR(ch, str.charCodeAt(i+1)) : ch; - } - h$jsstringUncheckedIndex = function(i, str) { - TRACE_JSSTRING("(no codePointAt) uncheckedIndex: " + i + " '" + str.length + "'"); - var ch = str.charCodeAt(i); - return (IS_HI_SURR(ch)) ? FROM_SURR(ch, str.charCodeAt(i+1)) : ch; - } -} - -function h$jsstringUnsnoc(str) { - TRACE_JSSTRING("unsnoc: '" + str + "'"); - var l = str.length; - if(l===0) { - RETURN_UBX_TUP2(-1, null); - } - var ch = str.charCodeAt(l-1); - if(IS_LO_SURR(ch)) { - if(l !== 1) { - RETURN_UBX_TUP2(FROM_SURR(str.charCodeAt(l-2),ch), str.substr(0,l-2)); - } else { - RETURN_UBX_TUP2(-1, null); - } - } else { - RETURN_UBX_TUP2(ch, str.substr(0,l-1)); - } -} - - -function h$jsstringPack(xs) { - var r = '', i = 0, a = [], c; - while(IS_CONS(xs)) { - c = CONS_HEAD(xs); - a[i++] = UNWRAP_NUMBER(c); - if(i >= 60000) { - r += h$fromCodePoint.apply(null, a); - a = []; - i = 0; - } - xs = CONS_TAIL(xs); - } - if(i > 0) r += h$fromCodePoint.apply(null, a); - TRACE_JSSTRING("pack: '" + r + "'"); - return r; -} - -function h$jsstringPackReverse(xs) { - var a = [], i = 0, c; - while(IS_CONS(xs)) { - c = CONS_HEAD(xs); - a[i++] = UNWRAP_NUMBER(c); - xs = CONS_TAIL(xs); - } - if(i===0) return ''; - var r = h$jsstringConvertArray(a.reverse()); - TRACE_JSSTRING("packReverse: '" + r + "'"); - return r; -} - -function h$jsstringPackArray(arr) { - TRACE_JSSTRING("pack array: " + arr); - return h$jsstringConvertArray(arr); -} - -function h$jsstringPackArrayReverse(arr) { - TRACE_JSSTRING("pack array reverse: " + arr); - return h$jsstringConvertArray(arr.reverse()); -} - -function h$jsstringConvertArray(arr) { - if(arr.length < 60000) { - return h$fromCodePoint.apply(null, arr); - } else { - var r = ''; - for(var i=0; i1) ? FROM_SURR(str.charCodeAt(l-2), ch) : -1; - - } else return ch; -} - -// index is the last part of the character -function h$jsstringIndexR(i, str) { - TRACE_JSSTRING("indexR: " + i + " '" + str + "'"); - if(i < 0 || i > str.length) return -1; - var ch = str.charCodeAt(i); - return (IS_LO_SURR(ch)) ? FROM_SURR(str.charCodeAt(i-1), ch) : ch; -} - -function h$jsstringNextIndex(i, str) { - TRACE_JSSTRING("nextIndex: " + i + " '" + str + "'"); - return i + (IS_HI_SURR(str.charCodeAt(i))?2:1); -} - -function h$jsstringTake(n, str) { - TRACE_JSSTRING("take: " + n + " '" + str + "'"); - if(n <= 0) return ''; - var i = 0, l = str.length, ch; - if(n >= l) return str; - while(n--) { - ch = str.charCodeAt(i++); - if(IS_HI_SURR(ch)) i++; - if(i >= l) return str; - } - return str.substr(0,i); -} - -function h$jsstringDrop(n, str) { - TRACE_JSSTRING("drop: " + n + " '" + str + "'"); - if(n <= 0) return str; - var i = 0, l = str.length, ch; - if(n >= l) return ''; - while(n--) { - ch = str.charCodeAt(i++); - if(IS_HI_SURR(ch)) i++; - if(i >= l) return ''; - } - return str.substr(i); -} - -function h$jsstringSplitAt(n, str) { - TRACE_JSSTRING("splitAt: " + n + " '" + str + "'"); - if(n <= 0) { - RETURN_UBX_TUP2("", str); - } else if(n >= str.length) { - RETURN_UBX_TUP2(str, ""); - } - var i = 0, l = str.length, ch; - while(n--) { - ch = str.charCodeAt(i++); - if(IS_HI_SURR(ch)) i++; - if(i >= l) { - RETURN_UBX_TUP2(str, ""); - } - } - RETURN_UBX_TUP2(str.substr(0,i),str.substr(i)); -} - -function h$jsstringTakeEnd(n, str) { - TRACE_JSSTRING("takeEnd: " + n + " '" + str + "'"); - if(n <= 0) return ''; - var l = str.length, i = l-1, ch; - if(n >= l) return str; - while(n-- && i > 0) { - ch = str.charCodeAt(i--); - if(IS_LO_SURR(ch)) i--; - } - return (i<0) ? str : str.substr(i+1); -} - -function h$jsstringDropEnd(n, str) { - TRACE_JSSTRING("dropEnd: " + n + " '" + str + "'"); - if(n <= 0) return str; - var l = str.length, i = l-1, ch; - if(n >= l) return ''; - while(n-- && i > 0) { - ch = str.charCodeAt(i--); - if(IS_LO_SURR(ch)) i--; - } - return (i<0) ? '' : str.substr(0,i+1); -} - -function h$jsstringIntercalate(x, ys) { - TRACE_JSSTRING("intercalate: '" + x + "'"); - var a = [], i = 0; - while(IS_CONS(ys)) { - if(i) a[i++] = x; - a[i++] = JSVAL_VAL(CONS_HEAD(ys)); - ys = CONS_TAIL(ys); - } - return a.join(''); -} - -function h$jsstringIntersperse(ch, ys) { - TRACE_JSSTRING("intersperse: " + ch + " '" + ys + "'"); - var i = 0, l = ys.length, j = 0, a = [], ych; - if(IS_ASTRAL(ch)) { - while(j < l) { - if(i) a[i++] = ch; - ych = ys.charCodeAt(j++); - a[i++] = ych; - if(IS_HI_SURR(ych)) a[i++] = ys.charCodeAt(j++); - } - } else { - while(j < l) { - if(i) a[i++] = ch; - ych = ys.charCodeAt(j++); - a[i++] = ych; - if(IS_HI_SURR(ych)) a[i++] = ys.charCodeAt(j++); - } - } - return h$jsstringConvertArray(a); -} - -function h$jsstringConcat(xs) { - TRACE_JSSTRING("concat"); - var a = [], i = 0; - while(IS_CONS(xs)) { - a[i++] = JSVAL_VAL(CONS_HEAD(xs)); - xs = CONS_TAIL(xs); - } - return a.join(''); -} - -var h$jsstringStripPrefix, h$jsstringStripSuffix, - h$jsstringIsPrefixOf, h$jsstringIsSuffixOf, - h$jsstringIsInfixOf; -if(String.prototype.startsWith) { - h$jsstringStripPrefix = function(p, x) { - TRACE_JSSTRING("(startsWith) stripPrefix: '" + p + "' '" + x + "'"); - if(x.startsWith(p)) { - return MK_JUST(MK_JSVAL(x.substr(p.length))); - } else { - return HS_NOTHING; - } - } - - h$jsstringIsPrefixOf = function(p, x) { - TRACE_JSSTRING("(startsWith) isPrefixOf: '" + p + "' '" + x + "'"); - return x.startsWith(p); - } - -} else { - h$jsstringStripPrefix = function(p, x) { - TRACE_JSSTRING("(no startsWith) stripPrefix: '" + p + "' '" + x + "'"); - if(x.indexOf(p) === 0) { // this has worse complexity than it should - return MK_JUST(MK_JSVAL(x.substr(p.length))); - } else { - return HS_NOTHING; - } - } - - h$jsstringIsPrefixOf = function(p, x) { - TRACE_JSSTRING("(no startsWith) isPrefixOf: '" + p + "' '" + x + "'"); - return x.indexOf(p) === 0; // this has worse complexity than it should - } -} - -if(String.prototype.endsWith) { - h$jsstringStripSuffix = function(s, x) { - TRACE_JSSTRING("(endsWith) stripSuffix: '" + s + "' '" + x + "'"); - if(x.endsWith(s)) { - return MK_JUST(MK_JSVAL(x.substr(0,x.length-s.length))); - } else { - return HS_NOTHING; - } - } - - h$jsstringIsSuffixOf = function(s, x) { - TRACE_JSSTRING("(endsWith) isSuffixOf: '" + s + "' '" + x + "'"); - return x.endsWith(s); - } -} else { - h$jsstringStripSuffix = function(s, x) { - TRACE_JSSTRING("(no endsWith) stripSuffix: '" + s + "' '" + x + "'"); - var i = x.lastIndexOf(s); // this has worse complexity than it should - var l = x.length - s.length; - if(i !== -1 && i === l) { - return MK_JUST(MK_JSVAL(x.substr(0,l))); - } else { - return HS_NOTHING; - } - } - - h$jsstringIsSuffixOf = function(s, x) { - TRACE_JSSTRING("(no endsWith) isSuffixOf: '" + s + "' '" + x + "'"); - var i = x.lastIndexOf(s); // this has worse complexity than it should - return i !== -1 && i === x.length - s.length; - } -} - -if(String.prototype.includes) { - h$jsstringIsInfixOf = function(i, x) { - TRACE_JSSTRING("(includes) isInfixOf: '" + i + "' '" + x + "'"); - return x.includes(i); - } -} else { - h$jsstringIsInfixOf = function(i, x) { - TRACE_JSSTRING("(no includes) isInfixOf: '" + i + "' '" + x + "'"); - return x.indexOf(i) !== -1; // this has worse complexity than it should - } -} - -function h$jsstringCommonPrefixes(x, y) { - TRACE_JSSTRING("commonPrefixes: '" + x + "' '" + y + "'"); - var lx = x.length, ly = y.length, i = 0, cx; - var l = lx <= ly ? lx : ly; - if(lx === 0 || ly === 0 || x.charCodeAt(0) !== y.charCodeAt(0)) { - return HS_NOTHING; - } - while(++i= 0) r = MK_CONS(a[i], r); - return r; -} - -function h$jsstringSplitOn1(n, p, x) { - TRACE_JSSTRING("splitOn1: " + n + " '" + p + "' '" + x + "'"); - var i = x.indexOf(p, n); - if(i === -1) { - RETURN_UBX_TUP2(-1, null); - } - var r1 = (i==n) ? "" : x.substr(n, i-n); - RETURN_UBX_TUP2(i + p.length, r1); -} - -function h$jsstringSplitOn(p, x) { - TRACE_JSSTRING("splitOn: '" + p + "' '" + x + "'"); - var a = x.split(p); - var r = HS_NIL, i = a.length; - while(--i>=0) r = MK_CONS(MK_JSVAL(a[i]), r); - return r; -} - -// returns -1 for end of input, start of next token otherwise -// word in h$ret1 -// this function assumes that there are no whitespace characters >= 0x10000 -function h$jsstringWords1(n, x) { - TRACE_JSSTRING("words1: " + n + " '" + x + "'"); - var m = n, s = n, l = x.length; - if(m >= l) return -1; - // skip leading spaces - do { - if(m >= l) return -1; - } while(h$isSpace(x.charCodeAt(m++))); - // found start of word - s = m - 1; - while(m < l) { - if(h$isSpace(x.charCodeAt(m++))) { - // found end of word - var r1 = (m-s<=1) ? "" : x.substr(s,m-s-1); - RETURN_UBX_TUP2(m, r1); - } - } - // end of string - if(s < l) { - var r1 = s === 0 ? x : x.substr(s); - RETURN_UBX_TUP2(m, r1); - } - RETURN_UBX_TUP2(-1, null); -} - -function h$jsstringWords(x) { - TRACE_JSSTRING("words: '" + x + "'"); - var a = null, i = 0, n, s = -1, m = 0, w, l = x.length, r = HS_NIL; - outer: - while(m < l) { - // skip leading spaces - do { - if(m >= l) { s = m; break outer; } - } while(h$isSpace(x.charCodeAt(m++))); - // found start of word - s = m - 1; - while(m < l) { - if(h$isSpace(x.charCodeAt(m++))) { - // found end of word - w = (m-s<=1) ? h$jsstringEmpty - : MK_JSVAL(x.substr(s,m-s-1)); - if(i) a[i++] = w; else { a = [w]; i = 1; } - s = m; - break; - } - } - } - // end of string - if(s !== -1 && s < l) { - w = MK_JSVAL(s === 0 ? x : x.substr(s)); - if(i) a[i++] = w; else { a = [w]; i = 1; } - } - // build resulting list - while(--i>=0) r = MK_CONS(a[i], r); - return r; -} - -// returns -1 for end of input, start of next token otherwise -// line in h$ret1 -function h$jsstringLines1(n, x) { - TRACE_JSSTRING("lines1: " + n + " '" + x + "'"); - var m = n, l = x.length; - if(n >= l) return -1; - while(m < l) { - if(x.charCodeAt(m++) === 10) { - // found newline - if(n > 0 && n === l-1) return -1; // it was the last character - var r1 = (m-n<=1) ? "" : x.substr(n,m-n-1); - RETURN_UBX_TUP2(m, r1); - } - } - // end of string - RETURN_UBX_TUP2(m, x.substr(n)); -} - -function h$jsstringLines(x) { - TRACE_JSSTRING("lines: '" + x + "'"); - var a = null, m = 0, i = 0, l = x.length, s = 0, r = HS_NIL, w; - if(l === 0) return HS_NIL; - outer: - while(true) { - s = m; - do { - if(m >= l) break outer; - } while(x.charCodeAt(m++) !== 10); - w = (m-s<=1) ? h$jsstringEmpty : MK_JSVAL(x.substr(s,m-s-1)); - if(i) a[i++] = w; else { a = [w]; i = 1; } - } - if(s < l) { - w = MK_JSVAL(x.substr(s)); - if(i) a[i++] = w; else { a = [w]; i = 1; } - } - while(--i>=0) r = MK_CONS(a[i], r); - return r; -} - -function h$jsstringGroup(x) { - TRACE_JSSTRING("group: '" + x + "'"); - var xl = x.length; - if(xl === 0) return HS_NIL; - var i = xl-1, si, ch, s=xl, r=HS_NIL; - var tch = x.charCodeAt(i--); - if(IS_LO_SURR(tch)) tch = FROM_SURR(x.charCodeAt(i--), tch); - while(i >= 0) { - si = i; - ch = x.charCodeAt(i--); - if(IS_LO_SURR(ch)) { - ch = FROM_SURR(x.charCodeAt(i--), ch); - } - if(ch != tch) { - tch = ch; - r = MK_CONS(MK_JSVAL(x.substr(si+1,s-si)), r); - s = si; - } - } - return MK_CONS(MK_JSVAL(x.substr(0,s+1)), r); -} - -function h$jsstringChunksOf1(n, s, x) { - TRACE_JSSTRING("chunksOf1: " + n + " " + s + " '" + x + "'"); - var m = s, c = 0, l = x.length, ch; - if(n <= 0 || l === 0 || s >= l) return -1 - while(++m < l) { - ch = x.charCodeAt(m - 1); - if(IS_HI_SURR(ch)) ++m; - if(++c >= n) break; - } - var r1 = (m >= l && s === c) ? x : x.substr(s,m-s); - RETURN_UBX_TUP2(m, r1); -} - -function h$jsstringChunksOf(n, x) { - TRACE_JSSTRING("chunksOf: " + n + " '" + x + "'"); - var l = x.length; - if(l===0 || n <= 0) return HS_NIL; - if(l <= n) return MK_CONS(MK_JSVAL(x), HS_NIL); - var a = [], i = 0, s = 0, ch, m = 0, c, r = HS_NIL; - while(m < l) { - s = m; - c = 0; - while(m < l && ++c <= n) { - ch = x.charCodeAt(m++); - if(IS_HI_SURR(ch)) ++m; - } - if(c) a[i++] = x.substr(s, m-s); - } - while(--i>=0) r = MK_CONS(MK_JSVAL(a[i]), r); - return r; -} - -function h$jsstringCount(pat, src) { - TRACE_JSSTRING("count: '" + pat + "' '" + src + "'"); - var i = 0, n = 0, pl = pat.length, sl = src.length; - while(i>= 1; - } while(n > 1); - return r+str; -} - -// this does not deal with combining diacritics, Data.Text does not either -var h$jsstringReverse; -if(Array.from) { - h$jsstringReverse = function(str) { - TRACE_JSSTRING("(Array.from) reverse: '" + str + "'"); - return Array.from(str).reverse().join(''); - } -} else { - h$jsstringReverse = function(str) { - TRACE_JSSTRING("(no Array.from) reverse: '" + str + "'"); - var l = str.length, a = [], o = 0, i = 0, c, c1, s = ''; - while(i < l) { - c = str.charCodeAt(i); - if(IS_HI_SURR(c)) { - a[i] = str.charCodeAt(i+1); - a[i+1] = c; - i += 2; - } else a[i++] = c; - if(i-o > 60000) { - s = String.fromCharCode.apply(null, a.reverse()) + s; - o = -i; - a = []; - } - } - return (i===0) ? s : String.fromCharCode.apply(null,a.reverse()) + s; - } -} - -function h$jsstringUnpack(str) { - TRACE_JSSTRING("unpack: '" + str + "'"); - var r = HS_NIL, i = str.length-1, c; - while(i >= 0) { - c = str.charCodeAt(i--); - if(IS_LO_SURR(c)) c = FROM_SURR(str.charCodeAt(i--), c) - r = MK_CONS(c, r); - } - return r; -} - - - -#if __GLASGOW_HASKELL__ >= 800 -function h$jsstringDecInteger(val) { - TRACE_JSSTRING("decInteger"); - if(IS_INTEGER_S(val)) { - return '' + INTEGER_S_DATA(val); - } else if(IS_INTEGER_Jp(val)) { - return h$ghcjsbn_showBase(INTEGER_J_DATA(val), 10); - } else { - return '-' + h$ghcjsbn_showBase(INTEGER_J_DATA(val), 10); - } -} -#else -function h$jsstringDecInteger(val) { - TRACE_JSSTRING("decInteger"); - if(IS_INTEGER_S(val)) { - return '' + INTEGER_S_DATA(val); - } else { - return INTEGER_J_DATA(val).toString(); - } -} -#endif - -function h$jsstringDecI64(hi,lo) { - TRACE_JSSTRING("decI64: " + hi + " " + lo); - var lo0 = (lo < 0) ? lo+4294967296:lo; - if(hi < 0) { - if(hi === -1) return ''+(lo0-4294967296); - lo0 = 4294967296 - lo0; - var hi0 = -1 - hi; - var x0 = hi0 * 967296; - var x1 = (lo0 + x0) % 1000000; - var x2 = hi0*4294+Math.floor((x0+lo0-x1)/1000000); - return '-' + x2 + h$jsstringDecIPadded6(x1); - } else { - if(hi === 0) return ''+lo0; - var x0 = hi * 967296; - var x1 = (lo0 + x0) % 1000000; - var x2 = hi*4294+Math.floor((x0+lo0-x1)/1000000); - return '' + x2 + h$jsstringDecIPadded6(x1); - } -} - -function h$jsstringDecW64(hi,lo) { - TRACE_JSSTRING("decW64: " + hi + " " + lo); - var lo0 = (lo < 0) ? lo+4294967296 : lo; - if(hi === 0) return ''+lo0; - var hi0 = (hi < 0) ? hi+4294967296 : hi; - var x0 = hi0 * 967296; - var x1 = (lo0 + x0) % 1000000; - var x2 = hi0*4294+Math.floor((x0+lo0-x1)/1000000); - return '' + x2 + h$jsstringDecIPadded6(x1); -} - -#if __GLASGOW_HASKELL__ >= 800 -function h$jsstringHexInteger(val) { - TRACE_JSSTRING("hexInteger"); - if(IS_INTEGER_S(val)) { - return '' + INTEGER_S_DATA(val); - } else { - // we assume it's nonnegative. this condition is checked by the Haskell code - return h$ghcjsbn_showBase(INTEGER_J_DATA(val), 16); - } -} -#else -function h$jsstringHexInteger(val) { - TRACE_JSSTRING("hexInteger"); - if(IS_INTEGER_S(val)) { - return '' + INTEGER_S_DATA(val); - } else { - return INTEGER_J_DATA(val).toRadix(16); - } -} -#endif - -function h$jsstringHexI64(hi,lo) { - var lo0 = lo<0 ? lo+4294967296 : lo; - if(hi === 0) return lo0.toString(16); - return ((hi<0)?hi+4294967296:hi).toString(16) + h$jsstringHexIPadded8(lo0); -} - -function h$jsstringHexW64(hi,lo) { - var lo0 = lo<0 ? lo+4294967296 : lo; - if(hi === 0) return lo0.toString(16); - return ((hi<0)?hi+4294967296:hi).toString(16) + h$jsstringHexIPadded8(lo0); -} - -// n in [0, 1000000000) -function h$jsstringDecIPadded9(n) { - TRACE_JSSTRING("decIPadded9: " + n); - if(n === 0) return '000000000'; - var pad = (n>=100000000)?'': - (n>=10000000)?'0': - (n>=1000000)?'00': - (n>=100000)?'000': - (n>=10000)?'0000': - (n>=1000)?'00000': - (n>=100)?'000000': - (n>=10)?'0000000': - '00000000'; - return pad+n; -} - -// n in [0, 1000000) -function h$jsstringDecIPadded6(n) { - TRACE_JSSTRING("decIPadded6: " + n); - if(n === 0) return '000000'; - var pad = (n>=100000)?'': - (n>=10000)?'0': - (n>=1000)?'00': - (n>=100)?'000': - (n>=10)?'0000': - '00000'; - return pad+n; -} - -// n in [0, 2147483648) -function h$jsstringHexIPadded8(n) { - TRACE_JSSTRING("hexIPadded8: " + n); - if(n === 0) return '00000000'; - var pad = (n>=0x10000000)?'': - (n>=0x1000000)?'0': - (n>=0x100000)?'00': - (n>=0x10000)?'000': - (n>=0x1000)?'0000': - (n>=0x100)?'00000': - (n>=0x10)?'000000': - '0000000'; - return pad+n.toString(16); -} - -function h$jsstringZeroes(n) { - var r; - switch(n&7) { - case 0: r = ''; break; - case 1: r = '0'; break; - case 2: r = '00'; break; - case 3: r = '000'; break; - case 4: r = '0000'; break; - case 5: r = '00000'; break; - case 6: r = '000000'; break; - case 7: r = '0000000'; - } - for(var i=n>>3;i>0;i--) r = r + '00000000'; - return r; -} - -function h$jsstringDoubleToFixed(decs, d) { - if(decs >= 0) { - if(Math.abs(d) < 1e21) { - var r = d.toFixed(Math.min(20,decs)); - if(decs > 20) r = r + h$jsstringZeroes(decs-20); - return r; - } else { - var r = d.toExponential(); - var ei = r.indexOf('e'); - var di = r.indexOf('.'); - var e = parseInt(r.substr(ei+1)); - return r.substring(0,di) + r.substring(di,ei) + h$jsstringZeroes(di-ei+e) + - ((decs > 0) ? ('.' + h$jsstringZeroes(decs)) : ''); - } - } - var r = Math.abs(d).toExponential(); - var ei = r.indexOf('e'); - var e = parseInt(r.substr(ei+1)); - var m = d < 0 ? '-' : ''; - r = r.substr(0,1) + r.substring(2,ei); - if(e >= 0) { - return (e > r.length) ? m + r + h$jsstringZeroes(r.length-e-1) + '.0' - : m + r.substr(0,e+1) + '.' + r.substr(e+1); - } else { - return m + '0.' + h$jsstringZeroes(-e-1) + r; - } -} - -function h$jsstringDoubleToExponent(decs, d) { - var r; - if(decs ===-1) { - r = d.toExponential().replace('+',''); - } else { - r = d.toExponential(Math.max(1, Math.min(20,decs))).replace('+',''); - } - if(r.indexOf('.') === -1) { - r = r.replace('e', '.0e'); - } - if(decs > 20) r = r.replace('e', h$jsstringZeroes(decs-20)+'e'); - return r; -} - -function h$jsstringDoubleGeneric(decs, d) { - var r; - if(decs === -1) { - r = d.toString(10).replace('+',''); - } else { - r = d.toPrecision(Math.max(decs+1,1)).replace('+',''); - } - if(decs !== 0 && r.indexOf('.') === -1) { - if(r.indexOf('e') !== -1) { - r = r.replace('e', '.0e'); - } else { - r = r + '.0'; - } - } - return r; -} - -function h$jsstringAppend(x, y) { - TRACE_JSSTRING("append: '" + x + "' '" + y + "'"); - return x+y; -} - -function h$jsstringCompare(x, y) { - TRACE_JSSTRING("compare: '" + x + "' '" + y + "'"); - return (xy)?1:0); -} - -function h$jsstringUnlines(xs) { - var r = ''; - while(IS_CONS(xs)) { - r = r + JSVAL_VAL(CONS_HEAD(xs)) + '\n'; - xs = CONS_TAIL(xs); - } - return r; -} - -function h$jsstringUnwords(xs) { - if(IS_NIL(xs)) return ''; - var r = JSVAL_VAL(CONS_HEAD(xs)); - xs = CONS_TAIL(xs); - while(IS_CONS(xs)) { - r = r + ' ' + JSVAL_VAL(CONS_HEAD(xs)); - xs = CONS_TAIL(xs); - } - return r; -} - -function h$jsstringReplace(pat, rep, src) { - TRACE_JSSTRING("replace: '" + pat + "' '" + rep + "' '" + src + "'"); - var r = src.replace(pat, rep, 'g'); - // the 'g' flag is not supported everywhere, check and fall back if necessary - if(r.indexOf(pat) !== -1) { - r = src.split(pat).join(rep); - } - return r; -} - -function h$jsstringReplicateChar(n, ch) { - TRACE_JSSTRING("replicateChar: " + n + " " + ch); - return h$jsstringReplicate(n, h$jsstringSingleton(ch)); -} - -function h$jsstringIsInteger(str) { - return /^-?\d+$/.test(str); -} - -function h$jsstringIsNatural(str) { - return /^\d+$/.test(str); -} - -function h$jsstringReadInt(str) { - if(!/^-?\d+/.test(str)) return null; - var x = parseInt(str, 10); - var x0 = x|0; - return (x===x0) ? x0 : null; -} - -function h$jsstringLenientReadInt(str) { - var x = parseInt(str, 10); - var x0 = x|0; - return (x===x0) ? x0 : null; -} - -function h$jsstringReadWord(str) { - if(!/^\d+/.test(str)) return null; - var x = parseInt(str, 10); - var x0 = x|0; - if(x0<0) return (x===x0+2147483648) ? x0 : null; - else return (x===x0) ? x0 : null; -} - -function h$jsstringReadDouble(str) { - return parseFloat(str, 10); -} - -function h$jsstringLenientReadDouble(str) { - return parseFloat(str, 10); -} - -function h$jsstringReadInteger(str) { - TRACE_JSSTRING("readInteger: " + str); - if(!/^(-)?\d+$/.test(str)) { - return null; - } else if(str.length <= 9) { - return MK_INTEGER_S(parseInt(str, 10)); - } else { -#if __GLASGOW_HASKELL__ >= 800 - return h$ghcjsbn_readInteger(str); -#else - return MK_INTEGER_J(new BigInteger(str, 10)); -#endif - } -} - -function h$jsstringReadInt64(str) { - if(!/^(-)?\d+$/.test(str)) { - RETURN_UBX_TUP3(0, 0, 0); - } - if(str.charCodeAt(0) === 45) { // '-' - return h$jsstringReadValue64(str, 1, true); - } else { - return h$jsstringReadValue64(str, 0, false); - } -} - -function h$jsstringReadWord64(str) { - if(!/^\d+$/.test(str)) { - RETURN_UBX_TUP3(0, 0, 0); - } - return h$jsstringReadValue64(str, 0, false); -} - -var h$jsstringLongs = null; - -function h$jsstringReadValue64(str, start, negate) { - var l = str.length, i = start; - while(i < l) { - if(str.charCodeAt(i) !== 48) break; - i++; - } - if(i >= l) RETURN_UBX_TUP3(1, 0, 0); // only zeroes - if(h$jsstringLongs === null) { - h$jsstringLongs = []; - for(var t=10; t<=1000000000; t*=10) { - h$jsstringLongs.push(goog.math.Long.fromInt(t)); - } - } - var li = l-i; - if(li < 10 && !negate) { - RETURN_UBX_TUP3(1, 0, parseInt(str.substr(i), 10)); - } - var r = goog.math.Long.fromInt(parseInt(str.substr(li,9),10)); - li += 9; - while(li < l) { - r = r.multiply(h$jsstringLongs[Math.min(l-li-1,8)]) - .add(goog.math.Long.fromInt(parseInt(str.substr(li,9), 10))); - li += 9; - } - if(negate) { - r = r.negate(); - } - RETURN_UBX_TUP3(1, r.getHighBits(), r.getLowBits()); -} - -function h$jsstringExecRE(i, str, re) { - re.lastIndex = i; - var m = re.exec(str); - if(m === null) return -1; - var a = [], x, j = 1, r = HS_NIL; - while(true) { - x = m[j]; - if(typeof x === 'undefined') break; - a[j-1] = x; - j++; - } - j-=1; - while(--j>=0) r = MK_CONS(MK_JSVAL(a[j]), r); - RETURN_UBX_TUP3(m.index, m[0], r); -} - -function h$jsstringReplaceRE(pat, replacement, str) { - return str.replace(pat, replacement); -} - -function h$jsstringSplitRE(limit, re, str) { - re.lastIndex = i; - var s = (limit < 0) ? str.split(re) : str.split(re, limit); - var i = s.length, r = HS_NIL; - while(--i>=0) r = MK_CONS(MK_JSVAL(a[i]), r); - return r; -} diff --git a/jsbits-old/jsstringRaw.js b/jsbits-old/jsstringRaw.js deleted file mode 100644 index 4d31c3c..0000000 --- a/jsbits-old/jsstringRaw.js +++ /dev/null @@ -1,21 +0,0 @@ -#include - -/* - * Functions that directly access JavaScript strings, ignoring character - * widths and surrogate pairs. - */ - -function h$jsstringRawChunksOf(k, x) { - var l = x.length; - if(l === 0) return HS_NIL; - if(l <= k) return MK_CONS(MK_JSVAL(x), HS_NIL); - var r=HS_NIL; - for(var i=ls-k;i>=0;i-=k) r = MK_CONS(MK_JSVAL(x.substr(i,i+k)),r); - return r; -} - -function h$jsstringRawSplitAt(k, x) { - if(k === 0) return MK_TUP2(h$jsstringEmpty, MK_JSVAL(x)); - if(k >= x.length) return MK_TUP2(MK_JSVAL(x), h$jsstringEmpty); - return MK_TUP2(MK_JSVAL(x.substr(0,k)), MK_JSVAL(x.substr(k))); -} diff --git a/jsbits-old/object.js b/jsbits-old/object.js deleted file mode 100644 index 44e0ca3..0000000 --- a/jsbits-old/object.js +++ /dev/null @@ -1,2 +0,0 @@ -// object manipulation - diff --git a/jsbits-old/text.js b/jsbits-old/text.js deleted file mode 100644 index 7046d36..0000000 --- a/jsbits-old/text.js +++ /dev/null @@ -1,53 +0,0 @@ -// conversion between JavaScript string and Data.Text -#include - - -/* - convert a Data.Text buffer with offset/length to a JavaScript string - */ -function h$textToString(arr, off, len) { - var a = []; - var end = off+len; - var k = 0; - var u1 = arr.u1; - var s = ''; - for(var i=off;i=0;i--) u1[i] = s.charCodeAt(i); - RETURN_UBX_TUP2(b, l); -} - -function h$lazyTextToString(txt) { - var s = ''; - while(LAZY_TEXT_IS_CHUNK(txt)) { - var head = LAZY_TEXT_CHUNK_HEAD(txt); - s += h$textToString(DATA_TEXT_ARRAY(head), DATA_TEXT_OFFSET(head), DATA_TEXT_LENGTH(head)); - txt = LAZY_TEXT_CHUNK_TAIL(txt); - } - return s; -} - -function h$safeTextFromString(x) { - if(typeof x !== 'string') { - RETURN_UBX_TUP2(null, 0); - } - return h$textFromString(x); -} diff --git a/jsbits-old/utils.js b/jsbits-old/utils.js deleted file mode 100644 index 722b793..0000000 --- a/jsbits-old/utils.js +++ /dev/null @@ -1,93 +0,0 @@ -#include - -function h$allProps(o) { - var a = [], i = 0; - for(var p in o) a[i++] = p; - return a; -} - -function h$listProps(o) { - var r = HS_NIL; - for(var p in o) { r = MK_CONS(MK_JSVAL(p), r); } - return r; -} - -function h$listAssocs(o) { - var r = HS_NIL; - for(var p in o) { r = MK_CONS(MK_TUP2(MK_JSVAL(p), MK_JSVAL(o[p])), r); } - return r; -} - -function h$isNumber(o) { - return typeof(o) === 'number'; -} - -// returns true for null, but not for functions and host objects -function h$isObject(o) { - return typeof(o) === 'object'; -} - -function h$isString(o) { - return typeof(o) === 'string'; -} - -function h$isSymbol(o) { - return typeof(o) === 'symbol'; -} - -function h$isBoolean(o) { - return typeof(o) === 'boolean'; -} - -function h$isFunction(o) { - return typeof(o) === 'function'; -} - -function h$jsTypeOf(o) { - var t = typeof(o); - if(t === 'undefined') return 0; - if(t === 'object') return 1; - if(t === 'boolean') return 2; - if(t === 'number') return 3; - if(t === 'string') return 4; - if(t === 'symbol') return 5; - if(t === 'function') return 6; - return 7; // other, host object etc -} - -/* - -- 0 - null, 1 - integer, - -- 2 - float, 3 - bool, - -- 4 - string, 5 - array - -- 6 - object -*/ -function h$jsonTypeOf(o) { - if (!(o instanceof Object)) { - if (o == null) { - return 0; - } else if (typeof o == 'number') { - if (h$isInteger(o)) { - return 1; - } else { - return 2; - } - } else if (typeof o == 'boolean') { - return 3; - } else { - return 4; - } - } else { - if (Object.prototype.toString.call(o) == '[object Array]') { - // it's an array - return 5; - } else if (!o) { - // null - return 0; - } else { - // it's an object - return 6; - } - } - -} - diff --git a/jsbits-old/websocket.js b/jsbits-old/websocket.js deleted file mode 100644 index 25df07b..0000000 --- a/jsbits-old/websocket.js +++ /dev/null @@ -1,58 +0,0 @@ -#include - -function h$createWebSocket(url, protocols) { - return new WebSocket(url, protocols); -} - -/* - this must be called before the websocket has connected, - typically synchronously after creating the socket - */ -function h$openWebSocket(ws, mcb, ccb, c) { - if(ws.readyState !== 0) { - throw new Error("h$openWebSocket: unexpected readyState, socket must be CONNECTING"); - } - ws.lastError = null; - ws.onopen = function() { - if(mcb) { - ws.onmessage = mcb; - } - if(ccb || mcb) { - ws.onclose = function(ce) { - if(ws.onmessage) { - h$release(ws.onmessage); - ws.onmessage = null; - } - if(ccb) { - h$release(ccb); - ccb(ce); - } - }; - }; - ws.onerror = function(err) { - ws.lastError = err; - if(ws.onmessage) { - h$release(ws.onmessage); - ws.onmessage = null; - } - ws.close(); - }; - c(null); - }; - ws.onerror = function(err) { - if(ccb) h$release(ccb); - if(mcb) h$release(mcb); - ws.onmessage = null; - ws.close(); - c(err); - }; -} - -function h$closeWebSocket(status, reason, ws) { - ws.onerror = null; - if(ws.onmessage) { - h$release(ws.onmessage); - ws.onmessage = null; - } - ws.close(status, reason); -} diff --git a/jsbits-old/xhr.js b/jsbits-old/xhr.js deleted file mode 100644 index 419cfe7..0000000 --- a/jsbits-old/xhr.js +++ /dev/null @@ -1,16 +0,0 @@ -function h$sendXHR(xhr, d, cont) { - xhr.addEventListener('error', function () { - cont(2); - }); - xhr.addEventListener('abort', function() { - cont(1); - }); - xhr.addEventListener('load', function() { - cont(0); - }); - if(d) { - xhr.send(d); - } else { - xhr.send(); - } -} From 1be96e618e9a24cea80f7add3e6d588d71b9a1e4 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 6 Feb 2024 01:09:02 +1300 Subject: [PATCH 45/53] Remove callback module as it is in base --- GHCJS/Foreign/Callback.hs | 161 ----------------------------- GHCJS/Foreign/Callback/Internal.hs | 12 --- ghcjs-base.cabal | 2 - 3 files changed, 175 deletions(-) delete mode 100644 GHCJS/Foreign/Callback.hs delete mode 100644 GHCJS/Foreign/Callback/Internal.hs diff --git a/GHCJS/Foreign/Callback.hs b/GHCJS/Foreign/Callback.hs deleted file mode 100644 index aca8170..0000000 --- a/GHCJS/Foreign/Callback.hs +++ /dev/null @@ -1,161 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, UnliftedFFITypes, - GHCForeignImportPrim, DeriveDataTypeable, GHCForeignImportPrim #-} -module GHCJS.Foreign.Callback - ( Callback - , OnBlocked(..) - , releaseCallback - -- * asynchronous callbacks - , asyncCallback - , asyncCallback1 - , asyncCallback2 - , asyncCallback3 - -- * synchronous callbacks - , syncCallback - , syncCallback1 - , syncCallback2 - , syncCallback3 - -- * synchronous callbacks that return a value - , syncCallback' - , syncCallback1' - , syncCallback2' - , syncCallback3' - ) where - -import GHCJS.Concurrent -import GHCJS.Marshal -import GHCJS.Marshal.Pure -import GHCJS.Foreign.Callback.Internal -import GHC.JS.Prim -import GHCJS.Types - -import qualified GHC.Exts as Exts - -import Data.Typeable - -import Unsafe.Coerce - -{- | - When you create a callback, the Haskell runtime stores a reference to - the exported IO action or function. This means that all data referenced by the - exported value stays in memory, even if nothing outside the Haskell runtime - holds a reference to to callback. - - Use 'releaseCallback' to free the reference. Subsequent calls from JavaScript - to the callback will result in an exception. - -} -releaseCallback :: Callback a -> IO () -releaseCallback x = js_release x - -{- | Make a callback (JavaScript function) that runs the supplied IO action in a synchronous - thread when called. - - Call 'releaseCallback' when done with the callback, freeing memory referenced - by the IO action. - -} -syncCallback :: OnBlocked -- ^ what to do when the thread blocks - -> IO () -- ^ the Haskell action - -> IO (Callback (IO ())) -- ^ the callback -syncCallback onBlocked x = js_syncCallback (onBlocked == ContinueAsync) (unsafeCoerce x) - - -{- | Make a callback (JavaScript function) that runs the supplied IO function in a synchronous - thread when called. The callback takes one argument that it passes as a JSVal value to - the Haskell function. - - Call 'releaseCallback' when done with the callback, freeing data referenced - by the function. - -} -syncCallback1 :: OnBlocked -- ^ what to do when the thread blocks - -> (JSVal -> IO ()) -- ^ the Haskell function - -> IO (Callback (JSVal -> IO ())) -- ^ the callback -syncCallback1 onBlocked x = js_syncCallbackApply (onBlocked == ContinueAsync) 1 (unsafeCoerce x) - - -{- | Make a callback (JavaScript function) that runs the supplied IO function in a synchronous - thread when called. The callback takes two arguments that it passes as JSVal values to - the Haskell function. - - Call 'releaseCallback' when done with the callback, freeing data referenced - by the function. - -} -syncCallback2 :: OnBlocked -- ^ what to do when the thread blocks - -> (JSVal -> JSVal -> IO ()) -- ^ the Haskell function - -> IO (Callback (JSVal -> JSVal -> IO ())) -- ^ the callback -syncCallback2 onBlocked x = js_syncCallbackApply (onBlocked == ContinueAsync) 2 (unsafeCoerce x) - -{- | Make a callback (JavaScript function) that runs the supplied IO function in a synchronous - thread when called. The callback takes three arguments that it passes as JSVal values to - the Haskell function. - - Call 'releaseCallback' when done with the callback, freeing data referenced - by the function. - -} -syncCallback3 :: OnBlocked -- ^ what to do when the thread blocks - -> (JSVal -> JSVal -> JSVal -> IO ()) -- ^ the Haskell function - -> IO (Callback (JSVal -> JSVal -> JSVal -> IO ())) -- ^ the callback -syncCallback3 onBlocked x = js_syncCallbackApply (onBlocked == ContinueAsync) 3 (unsafeCoerce x) - -{- | Make a callback (JavaScript function) that runs the supplied IO action in a synchronous - thread when called. - - Call 'releaseCallback' when done with the callback, freeing memory referenced - by the IO action. - -} -syncCallback' :: IO JSVal - -> IO (Callback (IO JSVal)) -syncCallback' x = js_syncCallbackReturn (unsafeCoerce x) - -syncCallback1' :: (JSVal -> IO JSVal) - -> IO (Callback (JSVal -> IO JSVal)) -syncCallback1' x = js_syncCallbackApplyReturn 1 (unsafeCoerce x) - -syncCallback2' :: (JSVal -> JSVal -> IO JSVal) - -> IO (Callback (JSVal -> JSVal -> IO JSVal)) -syncCallback2' x = js_syncCallbackApplyReturn 2 (unsafeCoerce x) - -syncCallback3' :: (JSVal -> JSVal -> JSVal -> IO JSVal) - -> IO (Callback (JSVal -> JSVal -> JSVal -> IO JSVal)) -syncCallback3' x = js_syncCallbackApplyReturn 3 (unsafeCoerce x) - -{- | Make a callback (JavaScript function) that runs the supplied IO action in an asynchronous - thread when called. - - Call 'releaseCallback' when done with the callback, freeing data referenced - by the IO action. - -} -asyncCallback :: IO () -- ^ the action that the callback runs - -> IO (Callback (IO ())) -- ^ the callback -asyncCallback x = js_asyncCallback (unsafeCoerce x) - -asyncCallback1 :: (JSVal -> IO ()) -- ^ the function that the callback calls - -> IO (Callback (JSVal -> IO ())) -- ^ the calback -asyncCallback1 x = js_asyncCallbackApply 1 (unsafeCoerce x) - -asyncCallback2 :: (JSVal -> JSVal -> IO ()) -- ^ the Haskell function that the callback calls - -> IO (Callback (JSVal -> JSVal -> IO ())) -- ^ the callback -asyncCallback2 x = js_asyncCallbackApply 2 (unsafeCoerce x) - -asyncCallback3 :: (JSVal -> JSVal -> JSVal -> IO ()) -- ^ the Haskell function that the callback calls - -> IO (Callback (JSVal -> JSVal -> JSVal -> IO ())) -- ^ the callback -asyncCallback3 x = js_asyncCallbackApply 3 (unsafeCoerce x) - --- ---------------------------------------------------------------------------- - -foreign import javascript unsafe "(($1,$2) => { return h$makeCallback(h$runSync, [$1], $2)); })" - js_syncCallback :: Bool -> Exts.Any -> IO (Callback (IO b)) -foreign import javascript unsafe "(($1) => { return h$makeCallback(h$run, [], $1); })" - js_asyncCallback :: Exts.Any -> IO (Callback (IO b)) -foreign import javascript unsafe "(($1) => { return h$makeCallback(h$runSyncReturn, [false], $1); })" - js_syncCallbackReturn :: Exts.Any -> IO (Callback (IO JSVal)) - -foreign import javascript unsafe "(($1,$2,$3) => { return h$makeCallbackApply($2, h$runSync, [$1], $3); })" - js_syncCallbackApply :: Bool -> Int -> Exts.Any -> IO (Callback b) -foreign import javascript unsafe "(($1,$2) => { return h$makeCallbackApply($1, h$run, [], $2); })" - js_asyncCallbackApply :: Int -> Exts.Any -> IO (Callback b) -foreign import javascript unsafe - "(($1,$2) => { return h$makeCallbackApply($1, h$runSyncReturn, [false], $2); })" - js_syncCallbackApplyReturn :: Int -> Exts.Any -> IO (Callback b) - -foreign import javascript unsafe "h$release" - js_release :: Callback a -> IO () - diff --git a/GHCJS/Foreign/Callback/Internal.hs b/GHCJS/Foreign/Callback/Internal.hs deleted file mode 100644 index ab6dc45..0000000 --- a/GHCJS/Foreign/Callback/Internal.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} - -module GHCJS.Foreign.Callback.Internal where - -import GHCJS.Types -import GHCJS.Marshal.Internal - -import Data.Typeable - -newtype Callback a = Callback JSVal deriving Typeable -instance IsJSVal (Callback a) - diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index 165e15c..462743b 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -68,8 +68,6 @@ library GHCJS.Buffer.Types GHCJS.Concurrent GHCJS.Foreign - GHCJS.Foreign.Callback - GHCJS.Foreign.Callback.Internal GHCJS.Foreign.Export GHCJS.Foreign.Internal GHCJS.Marshal From b23aa441276dad94406dcc36dd423dbad0223a34 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 6 Feb 2024 10:09:04 +1300 Subject: [PATCH 46/53] Fix callback code --- GHCJS/Internal/Types.hs | 4 ++++ JavaScript/Web/AnimationFrame.hs | 2 +- JavaScript/Web/Performance.hs | 2 +- JavaScript/Web/WebSocket.hs | 9 +++++---- 4 files changed, 11 insertions(+), 6 deletions(-) diff --git a/GHCJS/Internal/Types.hs b/GHCJS/Internal/Types.hs index 4965719..2a1ecb8 100644 --- a/GHCJS/Internal/Types.hs +++ b/GHCJS/Internal/Types.hs @@ -14,6 +14,7 @@ import Unsafe.Coerce import Control.DeepSeq import GHC.JS.Prim (JSVal) +import GHC.JS.Foreign.Callback (Callback) instance NFData JSVal where rnf x = x `seq` () @@ -25,6 +26,9 @@ class IsJSVal a where jsval_ = coerce {-# INLINE jsval_ #-} +instance IsJSVal (Callback a) where + jsval_ = unsafeCoerce + jsval :: IsJSVal a => a -> JSVal jsval = jsval_ {-# INLINE jsval #-} diff --git a/JavaScript/Web/AnimationFrame.hs b/JavaScript/Web/AnimationFrame.hs index cb61717..a2d62f9 100644 --- a/JavaScript/Web/AnimationFrame.hs +++ b/JavaScript/Web/AnimationFrame.hs @@ -21,7 +21,7 @@ module JavaScript.Web.AnimationFrame , AnimationFrameHandle ) where -import GHCJS.Foreign.Callback +import GHC.JS.Foreign.Callback import GHCJS.Marshal.Pure import GHCJS.Types diff --git a/JavaScript/Web/Performance.hs b/JavaScript/Web/Performance.hs index 633a271..4cd447a 100644 --- a/JavaScript/Web/Performance.hs +++ b/JavaScript/Web/Performance.hs @@ -7,7 +7,7 @@ module JavaScript.Web.Performance ( now ) where -import GHCJS.Foreign.Callback +import GHC.JS.Foreign.Callback import GHCJS.Marshal.Pure import GHCJS.Types diff --git a/JavaScript/Web/WebSocket.hs b/JavaScript/Web/WebSocket.hs index ae6826d..0ac3e66 100644 --- a/JavaScript/Web/WebSocket.hs +++ b/JavaScript/Web/WebSocket.hs @@ -27,9 +27,10 @@ module JavaScript.Web.WebSocket ( WebSocket ) where import GHCJS.Concurrent +import GHCJS.Types import GHC.JS.Prim -import GHCJS.Foreign.Callback.Internal (Callback(..)) -import qualified GHCJS.Foreign.Callback as CB +import GHC.JS.Foreign.Callback (Callback) +import qualified GHC.JS.Foreign.Callback as CB import GHC.Exts @@ -88,8 +89,8 @@ connect req = do maybeCallback :: (JSVal -> a) -> Maybe (a -> IO ()) -> IO JSVal maybeCallback _ Nothing = return jsNull maybeCallback f (Just g) = do - Callback cb <- CB.syncCallback1 CB.ContinueAsync (g . f) - return cb + cb <- CB.syncCallback1 CB.ContinueAsync (g . f) + return (jsval cb) handleOpenErr :: JSVal -> IO () handleOpenErr r From 6e0b97846169f47d9c1c60a11adf26392081f43a Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 6 Feb 2024 10:49:17 +1300 Subject: [PATCH 47/53] Get OnBlocked from `base` --- GHCJS/Concurrent.hs | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/GHCJS/Concurrent.hs b/GHCJS/Concurrent.hs index 9f113eb..f863993 100644 --- a/GHCJS/Concurrent.hs +++ b/GHCJS/Concurrent.hs @@ -34,6 +34,7 @@ module GHCJS.Concurrent ( isThreadSynchronous ) where import GHC.JS.Prim +import GHC.JS.Foreign.Callback (OnBlocked(..)) import Control.Applicative import Control.Concurrent @@ -48,18 +49,6 @@ import Data.Typeable import Unsafe.Coerce -{- | - The runtime tries to run synchronous threads to completion. Sometimes it's - not possible to continue running a thread, for example when the thread - tries to take an empty 'MVar'. The runtime can then either throw a - 'WouldBlockException', aborting the blocking action, or continue the - thread asynchronously. - -} - -data OnBlocked = ContinueAsync -- ^ continue the thread asynchronously if blocked - | ThrowWouldBlock -- ^ throw 'WouldBlockException' if blocked - deriving (Data, Typeable, Enum, Show, Eq, Ord) - {- | Run the action without the scheduler preempting the thread. When a blocking action is encountered, the thread is still suspended and will continue From 1f9da3d5706a76735859b55e0d809b41daf714a5 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Thu, 8 Feb 2024 11:02:15 +1300 Subject: [PATCH 48/53] Remove unused code --- test/Tests/QuickCheckUtils.hs | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/test/Tests/QuickCheckUtils.hs b/test/Tests/QuickCheckUtils.hs index 4a9c4b6..0653092 100644 --- a/test/Tests/QuickCheckUtils.hs +++ b/test/Tests/QuickCheckUtils.hs @@ -271,19 +271,6 @@ instance Arbitrary Encoding where , E "32le" IO.utf32le, E "32be" IO.utf32be ] -windowsNewlineMode :: IO.NewlineMode -windowsNewlineMode = IO.NewlineMode - { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF - } - -{- -instance Arbitrary IO.NewlineMode where - arbitrary = oneof . map return $ - [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode - , windowsNewlineMode - ] --} - instance Arbitrary IO.BufferMode where arbitrary = oneof [ return IO.NoBuffering, return IO.LineBuffering, From c37df4beb84c0af78763611d41f3bf122927946f Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Thu, 8 Feb 2024 11:04:51 +1300 Subject: [PATCH 49/53] Fix missing return --- JavaScript/Array/Internal.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/JavaScript/Array/Internal.hs b/JavaScript/Array/Internal.hs index f0be42e..ec4db12 100644 --- a/JavaScript/Array/Internal.hs +++ b/JavaScript/Array/Internal.hs @@ -150,7 +150,7 @@ foreign import javascript unsafe "((x,y) => { return y[x]; })" foreign import javascript unsafe "((x,y) => { return y[x]; })" js_indexPure :: Int -> JSArray -> JSVal -foreign import javascript unsafe "((x) => { x.length; })" +foreign import javascript unsafe "((x) => { return x.length; })" js_lengthPure :: JSArray -> Int foreign import javascript unsafe "((x,y,z) => { z[x] = y; })" @@ -178,7 +178,7 @@ foreign import javascript unsafe "((x,y) => { y.unshift(x); })" foreign import javascript unsafe "((x) => { return x.shift(); })" js_shift :: SomeJSArray m -> State# s -> (# State# s, JSVal #) -foreign import javascript unsafe "((x) => { x.reverse(); })" +foreign import javascript unsafe "((x) => { return x.reverse(); })" js_reverse :: SomeJSArray m -> State# s -> (# State# s, () #) foreign import javascript unsafe "h$toHsListJSVal" From 069c781d6047850d649c9da1c03ff1ae569be32b Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Thu, 8 Feb 2024 11:06:18 +1300 Subject: [PATCH 50/53] Bump containers upper bound --- ghcjs-base.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index 462743b..0f5b2cc 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -133,7 +133,7 @@ library aeson >= 0.8 && < 2.3, scientific >= 0.3.7 && < 0.4, vector >= 0.10 && < 0.14, - containers >= 0.5 && < 0.7, + containers >= 0.5 && < 0.8, time >= 1.5 && < 1.13, hashable >= 1.2 && < 1.5, unordered-containers >= 0.2 && < 0.3, From dc9599b5a86247ed188b4bbd42618aad4d2c203d Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Tue, 13 Feb 2024 00:37:22 +1100 Subject: [PATCH 51/53] Reenable j_snoc and fix unbound variable in FFI import --- JavaScript/Web/MessageEvent.hs | 2 +- test/Tests/Properties.hs | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/JavaScript/Web/MessageEvent.hs b/JavaScript/Web/MessageEvent.hs index faa7e10..0066d3c 100644 --- a/JavaScript/Web/MessageEvent.hs +++ b/JavaScript/Web/MessageEvent.hs @@ -39,6 +39,6 @@ getData me = case js_getData me of foreign import javascript unsafe "((x) => { var r2 = x.data;\ - \ var r1 = typeof r === 'string' ? 1 : (r instanceof ArrayBuffer ? 3 : 2);\ + \ var r1 = typeof r2 === 'string' ? 1 : (r2 instanceof ArrayBuffer ? 3 : 2);\ \ h$ret1 = r2; return r1; })" js_getData :: MessageEvent -> (# Int#, JSVal #) diff --git a/test/Tests/Properties.hs b/test/Tests/Properties.hs index 0aac378..5e297c5 100644 --- a/test/Tests/Properties.hs +++ b/test/Tests/Properties.hs @@ -521,7 +521,7 @@ tests = testProperty "sf_cons" sf_cons, testProperty "j_cons" j_cons, testProperty "s_snoc" s_snoc, --- testProperty "j_snoc" j_snoc, -- property `.f` + testProperty "j_snoc" j_snoc, testProperty "s_append" s_append, testProperty "s_append_s" s_append_s, testProperty "sf_append" sf_append, @@ -752,7 +752,7 @@ tests = testGroup "numeric conversion" [ testGroup "integral" [ - testProperty "j_decimal_integer" j_decimal_integer, -- IS_INTEGER_S + testProperty "j_decimal_integer" j_decimal_integer, testProperty "j_decimal_int" j_decimal_int, testProperty "j_decimal_int8" j_decimal_int8, testProperty "j_decimal_int16" j_decimal_int16, @@ -765,13 +765,13 @@ tests = testProperty "j_decimal_word32" j_decimal_word32, testProperty "j_decimal_word64" j_decimal_word64, - testProperty "j_decimal_integer_big" j_decimal_integer_big, -- IS_INTEGER_S + testProperty "j_decimal_integer_big" j_decimal_integer_big, testProperty "j_decimal_int_big" j_decimal_int_big, testProperty "j_decimal_int64_big" j_decimal_int64_big, testProperty "j_decimal_word_big" j_decimal_word_big, testProperty "j_decimal_word64_big" j_decimal_word64_big, - testProperty "j_hexadecimal_integer" j_hexadecimal_integer, -- IS_INTEGER_S + testProperty "j_hexadecimal_integer" j_hexadecimal_integer, testProperty "j_hexadecimal_int" j_hexadecimal_int, testProperty "j_hexadecimal_int8" j_hexadecimal_int8, testProperty "j_hexadecimal_int16" j_hexadecimal_int16, From ca5d47842cdc947da68b6ffe01982686f6f75f0d Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Tue, 13 Feb 2024 00:38:34 +1100 Subject: [PATCH 52/53] Update jsbits/jsstring.js Co-authored-by: Jeffrey Young --- jsbits/jsstring.js | 1 + 1 file changed, 1 insertion(+) diff --git a/jsbits/jsstring.js b/jsbits/jsstring.js index b29522e..bdf8d5c 100644 --- a/jsbits/jsstring.js +++ b/jsbits/jsstring.js @@ -859,6 +859,7 @@ function h$jsstringHexBigNat(positive,x) { function h$jsstringHexI64(hi,lo) { TRACE_JSSTRING("hexI64: " + hi + " " + lo); var sign = (hi >>> 31) ? '-' : ''; + // unsigned right bitshift by zero to convert to UInt32 var lo0 = sign ? ~(lo - 1) >>> 0 : lo; if(hi === 0 || hi === -1) return sign + lo0.toString(16); var hi0 = sign ? ~hi >>> 0 : hi; From a684c4ef9329d3ec509fa5ed4b7f4a4687e7ead6 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Wed, 14 Feb 2024 12:26:57 +1300 Subject: [PATCH 53/53] Set version to 0.8.0.0 so it does not look like stable release --- ghcjs-base.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcjs-base.cabal b/ghcjs-base.cabal index 0f5b2cc..8ba267d 100644 --- a/ghcjs-base.cabal +++ b/ghcjs-base.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ghcjs-base -version: 1.0.0.0 +version: 0.8.0.0 synopsis: base library for GHCJS homepage: http://github.com/ghcjs/ghcjs-base license: MIT