ghcjs-base 0.2.1.0 → 0.8.0.4
raw patch · 88 files changed
Files
- Data/JSString.hs +17/−15
- Data/JSString/Int.hs +59/−55
- Data/JSString/Internal/Fusion.hs +4/−4
- Data/JSString/Internal/Search.hs +6/−7
- Data/JSString/Internal/Type.hs +2/−2
- Data/JSString/Raw.hs +11/−11
- Data/JSString/Read.hs +2/−2
- Data/JSString/RealFloat.hs +4/−8
- Data/JSString/RegExp.hs +6/−6
- Data/JSString/Text.hs +5/−5
- GHCJS/Buffer.hs +19/−18
- GHCJS/Concurrent.hs +5/−18
- GHCJS/Foreign/Callback.hs +0/−161
- GHCJS/Foreign/Callback/Internal.hs +0/−12
- GHCJS/Foreign/Export.hs +2/−2
- GHCJS/Foreign/Internal.hs +13/−13
- GHCJS/Internal/Types.hs +5/−1
- GHCJS/Marshal.hs +14/−8
- GHCJS/Marshal/Internal.hs +1/−1
- GHCJS/Marshal/Pure.hs +27/−23
- GHCJS/Nullable.hs +1/−1
- GHCJS/Types.hs +4/−4
- JavaScript/Array.hs +1/−1
- JavaScript/Array/Internal.hs +21/−21
- JavaScript/Cast.hs +2/−2
- JavaScript/JSON/Types/Generic.hs +9/−8
- JavaScript/JSON/Types/Instances.hs +5/−15
- JavaScript/JSON/Types/Internal.hs +15/−16
- JavaScript/Object/Internal.hs +7/−7
- JavaScript/TypedArray/ArrayBuffer/Internal.hs +5/−5
- JavaScript/TypedArray/DataView.hs +1/−1
- JavaScript/TypedArray/DataView/Internal.hs +91/−91
- JavaScript/TypedArray/DataView/ST.hs +1/−1
- JavaScript/TypedArray/Internal.hs +76/−75
- JavaScript/TypedArray/Internal/Types.hs +1/−11
- JavaScript/TypedArray/ST.hs +5/−5
- JavaScript/Web/AnimationFrame.hs +4/−4
- JavaScript/Web/Blob/Internal.hs +5/−5
- JavaScript/Web/Canvas.hs +48/−49
- JavaScript/Web/Canvas/ImageData.hs +3/−3
- JavaScript/Web/Canvas/TextMetrics.hs +12/−12
- JavaScript/Web/CloseEvent.hs +3/−3
- JavaScript/Web/ErrorEvent.hs +5/−5
- JavaScript/Web/File.hs +2/−2
- JavaScript/Web/Location.hs +24/−24
- JavaScript/Web/MessageEvent.hs +3/−2
- JavaScript/Web/Performance.hs +2/−2
- JavaScript/Web/Storage.hs +8/−8
- JavaScript/Web/StorageEvent.hs +5/−5
- JavaScript/Web/WebSocket.hs +22/−21
- JavaScript/Web/Worker.hs +4/−4
- JavaScript/Web/XMLHttpRequest.hs +19/−18
- ghcjs-base.cabal +28/−43
- jsbits-old/animationFrame.js +0/−18
- jsbits-old/array.js +0/−40
- jsbits-old/export.js +0/−26
- jsbits-old/foreign.js +0/−8
- jsbits-old/jsstring.js +0/−1181
- jsbits-old/jsstringRaw.js +0/−21
- jsbits-old/text.js +0/−53
- jsbits-old/utils.js +0/−93
- jsbits-old/websocket.js +0/−58
- jsbits-old/xhr.js +0/−16
- jsbits/animationFrame.js +19/−0
- jsbits/animationFrame.js.pp +0/−18
- jsbits/array.js +40/−0
- jsbits/array.js.pp +0/−40
- jsbits/buffer.js +9/−0
- jsbits/export.js +27/−0
- jsbits/export.js.pp +0/−26
- jsbits/foreign.js +9/−0
- jsbits/foreign.js.pp +0/−8
- jsbits/jsstring.js +1180/−0
- jsbits/jsstring.js.pp +0/−1181
- jsbits/jsstringRaw.js +21/−0
- jsbits/jsstringRaw.js.pp +0/−21
- jsbits/text.js +38/−0
- jsbits/text.js.pp +0/−53
- jsbits/utils.js +93/−0
- jsbits/utils.js.pp +0/−93
- jsbits/websocket.js +58/−0
- jsbits/websocket.js.pp +0/−58
- jsbits/xhr.js +17/−0
- jsbits/xhr.js.pp +0/−16
- test/Tests/Buffer.hs +80/−0
- test/Tests/Properties.hs +4/−3
- test/Tests/Properties/Numeric.hs +4/−1
- test/Tests/QuickCheckUtils.hs +0/−11
Data/JSString.hs view
@@ -167,8 +167,8 @@ 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 @@ 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.@@ -1813,16 +1815,16 @@ -- ----------------------------------------------------------------------------- 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#@@ -1839,15 +1841,15 @@ 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#@@ -1949,7 +1951,7 @@ 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"@@ -1958,6 +1960,6 @@ "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
Data/JSString/Int.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE GHCForeignImportPrim #-}+{-# LANGUAGE LambdaCase #-} module Data.JSString.Int ( decimal@@ -16,14 +17,11 @@ 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 GHC.Num.Natural import Unsafe.Coerce-import GHCJS.Prim+import GHC.JS.Prim decimal :: Integral a => a -> JSString decimal i = decimal' i@@ -38,7 +36,9 @@ {-# 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 #-}@@ -56,15 +56,15 @@ {-# 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,11 +72,11 @@ {-# 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@@ -88,16 +88,25 @@ {-# 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' #-}@@ -130,7 +139,9 @@ {-# 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 #-}@@ -150,55 +161,48 @@ {-# 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# (x <# 0#)- then error hexErrMsg- else js_hexI x+hexI8 (I8# x) = js_hexI (int8ToInt# x) {-# INLINE hexI8 #-} hexI16 :: Int16 -> JSString-hexI16 (I16# x) =- if isTrue# (x <# 0#)- then error hexErrMsg- else js_hexI x+hexI16 (I16# x) = js_hexI (int16ToInt# x) {-# INLINE hexI16 #-} hexI32 :: Int32 -> JSString-hexI32 (I32# x) =- if isTrue# (x <# 0#)- then error hexErrMsg- else js_hexI 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-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@@ -215,50 +219,50 @@ -- ---------------------------------------------------------------------------- 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))"- js_decW32 :: Word# -> JSString+ "((x) => { return '' + x; })"+ js_decW32 :: Word32# -> JSString foreign import javascript unsafe- "h$jsstringDecW64($1_1, $1_2)"+ "h$jsstringDecW64" js_decW64 :: Word64# -> JSString foreign import javascript unsafe- "h$jsstringDecInteger($1)"- 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- "$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)"- js_hexW32 :: Word# -> JSString+ "((x) => { return x.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)"- js_hexInteger :: Any -> JSString+ "h$jsstringHexBigNat"+ js_hexBigNat :: Bool -> ByteArray# -> 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 --
Data/JSString/Internal/Fusion.hs view
@@ -43,7 +43,7 @@ import System.IO.Unsafe -import GHCJS.Prim+import GHC.JS.Prim default (Int) @@ -183,11 +183,11 @@ 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 [x]; })" 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
Data/JSString/Internal/Search.hs view
@@ -9,14 +9,13 @@ 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- "$3.indexOf($1,$2)"- js_indexOf :: JSString -> Int# -> JSString -> Int#+ "h$jsstringIndices"+ js_indexOf :: JSString -> Int# -> Int# -> JSString -> (# Int#, Int# #)
Data/JSString/Internal/Type.hs view
@@ -36,7 +36,7 @@ import Data.Typeable (Typeable) import GHC.Exts (Char(..), ord#, andI#, (/=#), isTrue#) -import GHCJS.Prim (JSVal)+import GHC.JS.Prim (JSVal) import GHCJS.Internal.Types @@ -47,7 +47,7 @@ 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
Data/JSString/Raw.hs view
@@ -25,7 +25,7 @@ , (+#), (-#), (>=#), (<#) , isTrue#, chr#) import qualified GHC.Exts as Exts-import GHCJS.Prim (JSVal)+import GHC.JS.Prim (JSVal) import Unsafe.Coerce @@ -127,25 +127,25 @@ -- ----------------------------------------------------------------------------- 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
Data/JSString/Read.hs view
@@ -150,9 +150,9 @@ -- ---------------------------------------------------------------------------- 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
Data/JSString/RealFloat.hs view
@@ -26,8 +26,6 @@ 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 = 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@@ -85,15 +81,15 @@ 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
Data/JSString/RegExp.hs view
@@ -18,7 +18,7 @@ , execNext ) where -import GHCJS.Prim+import GHC.JS.Prim import GHC.Exts (Any, Int#, Int(..)) import Unsafe.Coerce (unsafeCoerce)@@ -94,9 +94,9 @@ -- ---------------------------------------------------------------------------- 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 "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
Data/JSString/Text.hs view
@@ -15,7 +15,7 @@ , lazyTextFromJSVal ) where -import GHCJS.Prim+import GHC.JS.Prim import GHC.Exts (ByteArray#, Int(..), Int#, Any) @@ -31,7 +31,7 @@ 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 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 @@ 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@@ -65,7 +65,7 @@ -- ---------------------------------------------------------------------------- foreign import javascript unsafe- "h$textToString($1,$2,$3)"+ "h$textToString" js_toString :: ByteArray# -> Int# -> Int# -> JSString foreign import javascript unsafe "h$textFromString"
GHCJS/Buffer.hs view
@@ -41,7 +41,7 @@ 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@@ -146,13 +146,14 @@ -- 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@@ -191,38 +192,38 @@ foreign import javascript unsafe "h$wrapBuffer" js_wrapBuffer :: SomeArrayBuffer any -> SomeBuffer any foreign import javascript unsafe- "h$wrapBuffer($1.buf.slice($1.u8.byteOffset, $1.len))"+ "((x) => { return h$wrapBuffer(x.buf.slice(x.u8.byteOffset, x.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#+ "h$toAddr" js_toAddr :: SomeBuffer any -> Addr# foreign import javascript unsafe- "$r = $1;" js_fromAddr :: Addr# -> SomeBuffer any+ "h$fromAddr" js_fromAddr :: Addr# -> (SomeBuffer any, Int)
GHCJS/Concurrent.hs view
@@ -33,7 +33,8 @@ , synchronously ) where -import GHCJS.Prim+import GHC.JS.Prim+import GHC.JS.Foreign.Callback (OnBlocked(..)) import Control.Applicative import Control.Concurrent@@ -49,18 +50,6 @@ 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 without preemption when it's woken up again.@@ -118,15 +107,13 @@ -- ---------------------------------------------------------------------------- -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
− GHCJS/Foreign/Callback.hs
@@ -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 GHCJS.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 "h$makeCallback(h$runSync, [$1], $2)"- js_syncCallback :: Bool -> Exts.Any -> IO (Callback (IO b))-foreign import javascript unsafe "h$makeCallback(h$run, [], $1)"- js_asyncCallback :: Exts.Any -> IO (Callback (IO b))-foreign import javascript unsafe "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)"- js_syncCallbackApply :: Bool -> Int -> Exts.Any -> IO (Callback b)-foreign import javascript unsafe "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)"- js_syncCallbackApplyReturn :: Int -> Exts.Any -> IO (Callback b)--foreign import javascript unsafe "h$release"- js_release :: Callback a -> IO ()-
− GHCJS/Foreign/Callback/Internal.hs
@@ -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)-
GHCJS/Foreign/Export.hs view
@@ -27,7 +27,7 @@ import Unsafe.Coerce import qualified GHC.Exts as Exts -import GHCJS.Prim+import GHC.JS.Prim import GHCJS.Types newtype Export a = Export JSVal@@ -84,7 +84,7 @@ "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 ()
GHCJS/Foreign/Internal.hs view
@@ -80,7 +80,7 @@ ) where import GHCJS.Types-import qualified GHCJS.Prim as Prim+import qualified GHC.JS.Prim as Prim import GHC.Prim import GHC.Exts@@ -90,7 +90,7 @@ import Control.DeepSeq (force) import Control.Exception (evaluate, Exception) -import Foreign.ForeignPtr.Safe+import Foreign.ForeignPtr import Foreign.Ptr import Data.Primitive.ByteArray@@ -317,7 +317,7 @@ 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 @@ -- ----------------------------------------------------------------------------- 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 @@ -- 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)
GHCJS/Internal/Types.hs view
@@ -13,7 +13,8 @@ import Control.DeepSeq -import GHCJS.Prim (JSVal)+import GHC.JS.Prim (JSVal)+import GHC.JS.Foreign.Callback (Callback) instance NFData JSVal where rnf x = x `seq` ()@@ -24,6 +25,9 @@ default jsval_ :: Coercible a JSVal => a -> JSVal jsval_ = coerce {-# INLINE jsval_ #-}++instance IsJSVal (Callback a) where+ jsval_ = unsafeCoerce jsval :: IsJSVal a => a -> JSVal jsval = jsval_
GHCJS/Marshal.hs view
@@ -25,7 +25,6 @@ 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)@@ -286,13 +285,20 @@ 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)
GHCJS/Marshal/Internal.hs view
@@ -23,7 +23,7 @@ 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
GHCJS/Marshal/Pure.hs view
@@ -21,6 +21,8 @@ -} module GHCJS.Marshal.Pure ( PFromJSVal(..) , PToJSVal(..)+ , jsvalToChar+ , charToJSVal ) where import Data.Char (chr, ord)@@ -42,7 +44,7 @@ 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 +79,7 @@ {-# 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 +87,7 @@ {-# 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 = (jsvalToWord32 x) {-# INLINE pFromJSVal #-} instance PFromJSVal Float where pFromJSVal x = F# (jsvalToFloat x) {-# INLINE pFromJSVal #-}@@ -112,19 +114,19 @@ {-# 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 #-}@@ -136,19 +138,21 @@ 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 -> Word#-foreign import javascript unsafe "$r = $1&0xffff;" jsvalToWord16 :: JSVal -> Word#-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;" 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
GHCJS/Nullable.hs view
@@ -3,7 +3,7 @@ , maybeToNullable ) where -import GHCJS.Prim (JSVal(..))+import GHC.JS.Prim (JSVal(..)) import GHCJS.Marshal.Pure (PToJSVal(..), PFromJSVal(..)) newtype Nullable a = Nullable JSVal
GHCJS/Types.hs view
@@ -24,7 +24,7 @@ import Data.JSString.Internal.Type (JSString) import GHCJS.Internal.Types -import GHCJS.Prim+import GHC.JS.Prim import GHC.Int import GHC.Types@@ -50,13 +50,13 @@ 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) => { h$ret1 = 0; return x; })" js_mkPtr :: JSVal -> Ptr a -- | This is a deprecated copmatibility wrapper for the old JSRef type.
JavaScript/Array.hs view
@@ -33,7 +33,7 @@ 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(..))
JavaScript/Array/Internal.hs view
@@ -16,7 +16,7 @@ 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@@ -140,54 +140,54 @@ -- ----------------------------------------------------------------------------- -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) => { return 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) => { return 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
JavaScript/Cast.hs view
@@ -5,7 +5,7 @@ , 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)@@ -23,4 +23,4 @@ -- ----------------------------------------------------------------------------- foreign import javascript unsafe - "$1 instanceof $2" js_checkCast :: JSVal -> JSVal -> Bool+ "((x,y) => { return x instanceof y; })" js_checkCast :: JSVal -> JSVal -> Bool
JavaScript/JSON/Types/Generic.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP, DefaultSignatures, EmptyDataDecls, FlexibleInstances,- FunctionalDependencies, KindSignatures, OverlappingInstances,+ FunctionalDependencies, KindSignatures, MonoLocalBinds, ScopedTypeVariables, TypeOperators, UndecidableInstances, ViewPatterns, NamedFieldPuns, FlexibleContexts, PatternGuards, RecordWildCards, DataKinds #-}@@ -28,7 +28,7 @@ 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) @@ -39,6 +39,7 @@ -- import Data.Text (Text, pack, unpack) import GHC.Generics+import Data.Kind {- import qualified Data.HashMap.Strict as H@@ -63,7 +64,7 @@ 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 @@ 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 @@ | 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 @@ -------------------------------------------------------------------------------- -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 @@ -------------------------------------------------------------------------------- -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 @@ newtype Tagged s b = Tagged {unTagged :: b} -newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b}+newtype Tagged2 (s :: Type -> Type) b = Tagged2 {unTagged2 :: b} --------------------------------------------------------------------------------
JavaScript/JSON/Types/Instances.hs view
@@ -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 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)@@ -77,7 +76,7 @@ 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 +490,7 @@ 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 +512,7 @@ <|> 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 +535,7 @@ 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 #-}@@ -1063,15 +1062,6 @@ | isNaN d || isInfinite d = nullValue | 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
JavaScript/JSON/Types/Internal.hs view
@@ -8,7 +8,6 @@ ( -- * Core JSON types SomeValue(..), Value, MutableValue , SomeValue'(..), Value', MutableValue'- , MutableValue, MutableValue' , emptyArray, isEmptyArray , Pair , Object, MutableObject@@ -72,7 +71,7 @@ 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@@ -264,47 +263,47 @@ -- ----------------------------------------------------------------------------- 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 +323,5 @@ 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
JavaScript/Object/Internal.hs view
@@ -21,7 +21,7 @@ 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@@ -73,17 +73,17 @@ -- ----------------------------------------------------------------------------- -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
JavaScript/TypedArray/ArrayBuffer/Internal.hs view
@@ -38,16 +38,16 @@ -- ---------------------------------------------------------------------------- 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
JavaScript/TypedArray/DataView.hs view
@@ -40,7 +40,7 @@ import Data.Int import Data.Word -import GHCJS.Prim+import GHC.JS.Prim import JavaScript.TypedArray.ArrayBuffer.Internal ( SomeArrayBuffer(..), ArrayBuffer, MutableArrayBuffer )
JavaScript/TypedArray/DataView/Internal.hs view
@@ -18,7 +18,7 @@ import GHC.Exts ( State# ) -import GHCJS.Prim+import GHC.JS.Prim import GHCJS.Internal.Types import JavaScript.TypedArray.ArrayBuffer.Internal@@ -33,115 +33,115 @@ #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+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 "$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+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 #)+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 "$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 #)+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, () #)+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 "$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, () #)+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, () #)
JavaScript/TypedArray/DataView/ST.hs view
@@ -28,7 +28,7 @@ import GHC.ST -import GHCJS.Prim+import GHC.JS.Prim import JavaScript.TypedArray.ArrayBuffer.ST import JavaScript.TypedArray.ArrayBuffer.Internal as AI
JavaScript/TypedArray/Internal.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-}@@ -48,10 +49,10 @@ 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 +60,10 @@ 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 +82,10 @@ 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 +93,10 @@ 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 +104,10 @@ 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 +164,11 @@ {-# 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 +176,11 @@ {-# 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 +194,11 @@ {-# 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 +206,11 @@ {-# 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 #)@@ -351,70 +352,70 @@ -- ----------------------------------------------------------------------------- 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 +444,94 @@ -- 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
JavaScript/TypedArray/Internal/Types.hs view
@@ -98,7 +98,7 @@ -- ----------------------------------------------------------------------------- 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 @@ 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-
JavaScript/TypedArray/ST.hs view
@@ -24,7 +24,7 @@ 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 @@ 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) -- ---------------------------------------------------------------------------
JavaScript/Web/AnimationFrame.hs view
@@ -21,7 +21,7 @@ , AnimationFrameHandle ) where -import GHCJS.Foreign.Callback+import GHC.JS.Foreign.Callback import GHCJS.Marshal.Pure import GHCJS.Types @@ -62,14 +62,14 @@ -- ----------------------------------------------------------------------------- -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 "(($1) => { 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 = requestAnimationFrame(c); })" js_waitForAnimationFrame :: AnimationFrameHandle -> IO Double foreign import javascript unsafe "h$animationFrameRequest" js_requestAnimationFrame :: AnimationFrameHandle -> IO ()
JavaScript/Web/Blob/Internal.hs view
@@ -42,14 +42,14 @@ -- ----------------------------------------------------------------------------- -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 ()
JavaScript/Web/Canvas.hs view
@@ -332,102 +332,101 @@ -- ---------------------------------------------------------------------------- -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) => { return 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) => { z.scale(x,y); })" js_scale :: Double -> Double -> Context -> IO ()-foreign import javascript unsafe "$3.translate($1,$2)"+foreign import javascript unsafe "((x,y,z) => { z.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) => { z.moveTo(x,y); })" js_moveTo :: Double -> Double -> Context -> IO ()-foreign import javascript unsafe "$3.lineTo($1,$2)"+foreign import javascript unsafe "((x,y,z) => { z.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) => { z.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) => { return 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 z.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 ()
JavaScript/Web/Canvas/ImageData.hs view
@@ -25,9 +25,9 @@ -- ----------------------------------------------------------------------------- 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
JavaScript/Web/Canvas/TextMetrics.hs view
@@ -67,28 +67,28 @@ -- ----------------------------------------------------------------------------- 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
JavaScript/Web/CloseEvent.hs view
@@ -25,8 +25,8 @@ -- ----------------------------------------------------------------------------- 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
JavaScript/Web/ErrorEvent.hs view
@@ -39,13 +39,13 @@ -- ----------------------------------------------------------------------------- -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
JavaScript/Web/File.hs view
@@ -26,6 +26,6 @@ -- ----------------------------------------------------------------------------- -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
JavaScript/Web/Location.hs view
@@ -144,29 +144,29 @@ 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 ()-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 "((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 "$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 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 ()
JavaScript/Web/MessageEvent.hs view
@@ -38,6 +38,7 @@ -- ----------------------------------------------------------------------------- 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 r2 === 'string' ? 1 : (r2 instanceof ArrayBuffer ? 3 : 2);\+ \ h$ret1 = r2; return r1; })" js_getData :: MessageEvent -> (# Int#, JSVal #)
JavaScript/Web/Performance.hs view
@@ -7,7 +7,7 @@ ( now ) where -import GHCJS.Foreign.Callback+import GHC.JS.Foreign.Callback import GHCJS.Marshal.Pure import GHCJS.Types @@ -27,5 +27,5 @@ -- ----------------------------------------------------------------------------- -foreign import javascript unsafe "performance.now()"+foreign import javascript unsafe "(() => { return performance.now(); })" js_performanceNow :: IO Double
JavaScript/Web/Storage.hs view
@@ -57,18 +57,18 @@ -- ----------------------------------------------------------------------------- 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) => { return y.key(x); })" js_getIndex :: Int -> Storage -> IO JSVal foreign import javascript unsafe- "$2.getItem($1)" js_getItem :: JSString -> Storage -> IO JSVal+ "((x,y) => { return 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 ()
JavaScript/Web/StorageEvent.hs view
@@ -51,12 +51,12 @@ -- ----------------------------------------------------------------------------- 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
JavaScript/Web/WebSocket.hs view
@@ -27,9 +27,10 @@ ) where import GHCJS.Concurrent-import GHCJS.Prim-import GHCJS.Foreign.Callback.Internal (Callback(..))-import qualified GHCJS.Foreign.Callback as CB+import GHCJS.Types+import GHC.JS.Prim+import GHC.JS.Foreign.Callback (Callback)+import qualified GHC.JS.Foreign.Callback as CB import GHC.Exts @@ -88,8 +89,8 @@ 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@@ -151,40 +152,40 @@ -- ----------------------------------------------------------------------------- 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 ()
JavaScript/Web/Worker.hs view
@@ -6,7 +6,7 @@ , terminate ) where -import GHCJS.Prim+import GHC.JS.Prim import Data.JSString import Data.Typeable@@ -28,8 +28,8 @@ -- ----------------------------------------------------------------------------- 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 ()
JavaScript/Web/XMLHttpRequest.hs view
@@ -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@@ -22,7 +23,7 @@ import Control.Monad import GHCJS.Types-import GHCJS.Prim+import GHC.JS.Prim import GHCJS.Marshal import GHCJS.Marshal.Pure import GHCJS.Internal.Types@@ -201,57 +202,57 @@ -- ----------------------------------------------------------------------------- foreign import javascript unsafe- "$1.withCredentials = true;"+ "((x) => { 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) => { z.setRequestHeader(x,y); })" js_setRequestHeader :: JSString -> JSString -> XHR -> IO () foreign import javascript unsafe- "$3.open($1,$2)"+ "((x,y,z) => { z.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,$3,$4); })" 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);"+ "((x,c) => { return h$sendXHR(x, null, c); })" js_send0 :: XHR -> IO Int foreign import javascript interruptible- "h$sendXHR($2, $1, $c);"+ "((x,y,c) => { return h$sendXHR(y, x, c); })" js_send1 :: JSVal -> XHR -> IO Int
ghcjs-base.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: ghcjs-base-version: 0.2.1.0+version: 0.8.0.4 synopsis: base library for GHCJS homepage: http://github.com/ghcjs/ghcjs-base license: MIT@@ -15,32 +15,20 @@ location: https://github.com/ghcjs/ghcjs-base 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- 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@@ -80,8 +68,6 @@ GHCJS.Buffer.Types GHCJS.Concurrent GHCJS.Foreign- GHCJS.Foreign.Callback- GHCJS.Foreign.Callback.Internal GHCJS.Foreign.Export GHCJS.Foreign.Internal GHCJS.Marshal@@ -138,27 +124,26 @@ 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,- ghcjs-prim,- integer-gmp, 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,- vector >= 0.10 && < 0.13,- containers >= 0.5 && < 0.7,- time >= 1.5 && < 1.10,- hashable >= 1.2 && < 1.5,+ bytestring >= 0.10 && < 0.13,+ -- 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,+ containers >= 0.5 && < 0.9,+ time >= 1.5 && < 1.15,+ hashable >= 1.2 && < 1.6, 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 !impl(ghcjs) && !os(ghcjs)+ if !arch(javascript) buildable: False test-suite tests@@ -172,8 +157,9 @@ Tests.QuickCheckUtils Tests.Regressions Tests.Utils+ Tests.Buffer ghc-options:- -Wall -rtsopts+ -Wall -rtsopts test/compat.js build-depends: HUnit >= 1.2, QuickCheck >= 2.7,@@ -184,7 +170,6 @@ deepseq, directory, ghc-prim,- ghcjs-prim, ghcjs-base, primitive, quickcheck-unicode,@@ -193,5 +178,5 @@ test-framework-hunit >= 0.2, test-framework-quickcheck2 >= 0.2 default-language: Haskell2010- if !impl(ghcjs) && !os(ghcjs)+ if !arch(javascript) buildable: False
− jsbits-old/animationFrame.js
@@ -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);- }- });-}
− jsbits-old/array.js
@@ -1,40 +0,0 @@-#include <ghcjs/rts.h>--/*- 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));-}
− jsbits-old/export.js
@@ -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;-}
− jsbits-old/foreign.js
@@ -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) {-- } */-}
− jsbits-old/jsstring.js
@@ -1,1181 +0,0 @@-#include <ghcjs/rts.h>--/*- * 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; i<arr.length; i+=60000) {- r += h$fromCodePoint.apply(null, arr.slice(i, i+60000));- }- return r;- }-}--function h$jsstringInit(str) {- TRACE_JSSTRING("init: '" + str + "'");- var l = str.length;- if(l===0) return null;- var ch = str.charCodeAt(l-1);- var o = IS_LO_SURR(ch)?2:1;- var r = str.substr(0, l-o);- return r;-}--function h$jsstringLast(str) {- TRACE_JSSTRING("last: '" + str + "'");- var l = str.length;- if(l===0) return -1;- var ch = str.charCodeAt(l-1);- if(IS_LO_SURR(ch)) {- return (l>1) ? 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<l) {- cx = x.charCodeAt(i);- if(cx !== y.charCodeAt(i)) {- if(IS_LO_SURR(cx)) i--;- break;- }- }- if(i===0) return HS_NOTHING;- return MK_JUST(MK_TUP3( MK_JSVAL((i===lx)?x:((i===ly)?y:x.substr(0,i)))- , (i===lx) ? h$jsstringEmpty : MK_JSVAL(x.substr(i))- , (i===ly) ? h$jsstringEmpty : MK_JSVAL(y.substr(i))- ));-}--function h$jsstringBreakOn(b, x) {- TRACE_JSSTRING("breakOn: '" + b + "' '" + x + "'");- var i = x.indexOf(b);- if(i===-1) {- RETURN_UBX_TUP2(x, "");- }- if(i===0) {- RETURN_UBX_TUP2("", x);- }- RETURN_UBX_TUP2(x.substr(0,i), x.substr(i));-}--function h$jsstringBreakOnEnd(b, x) {- TRACE_JSSTRING("breakOnEnd: '" + b + "' '" + x + "'");- var i = x.lastIndexOf(b);- if(i===-1) {- RETURN_UBX_TUP2("", x);-- }- i += b.length;- RETURN_UBX_TUP2(x.substr(0,i), x.substr(i));-}--function h$jsstringBreakOnAll1(n, b, x) {- TRACE_JSSTRING("breakOnAll1: " + n + " '" + b + "' '" + x + "'");- var i = x.indexOf(b, n);- if(i===0) {- RETURN_UBX_TUP3(b.length, "", x);- }- if(i===-1) {- RETURN_UBX_TUP3(-1, null, null);- }- RETURN_UBX_TUP3(i+b.length, x.substr(0,i), x.substr(i));-}--function h$jsstringBreakOnAll(pat, src) {- TRACE_JSSTRING("breakOnAll");- var a = [], i = 0, n = 0, r = HS_NIL, pl = pat.length;- while(true) {- var x = src.indexOf(pat, n);- if(x === -1) break;- a[i++] = MK_TUP2(MK_JSVAL(src.substr(0,x)), MK_JSVAL(src.substr(x)));- n = x + pl;- }- 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<sl) {- i = src.indexOf(pat, i);- if(i===-1) break;- n++;- i += pl;- }- return n;-}--function h$jsstringReplicate(n, str) {- TRACE_JSSTRING("replicate: " + n + " '" + str + "'");- if(n === 0 || str == '') return '';- if(n === 1) return str;- var r = '';- do {- if(n&1) r+=str;- str+=str;- n >>= 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 (x<y)?-1:((x>y)?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;-}
− jsbits-old/jsstringRaw.js
@@ -1,21 +0,0 @@-#include <ghcjs/rts.h>--/*- * 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)));-}
− jsbits-old/text.js
@@ -1,53 +0,0 @@-// conversion between JavaScript string and Data.Text-#include <ghcjs/rts.h>---/*- 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<end;i++) {- var cc = u1[i];- a[k++] = cc;- if(k === 60000) {- s += String.fromCharCode.apply(this, a);- k = 0;- a = [];- }- }- return s + String.fromCharCode.apply(this, a);-}--/*- convert a JavaScript string to a Data.Text buffer, second return- value is length- */-function h$textFromString(s) {- var l = s.length;- var b = h$newByteArray(l * 2);- var u1 = b.u1;- for(var i=l-1;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);-}
− jsbits-old/utils.js
@@ -1,93 +0,0 @@-#include <ghcjs/rts.h>--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;- }- }--}-
− jsbits-old/websocket.js
@@ -1,58 +0,0 @@-#include <ghcjs/rts.h>--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);-}
− jsbits-old/xhr.js
@@ -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();- }-}
+ jsbits/animationFrame.js view
@@ -0,0 +1,19 @@+//#OPTIONS: CPP+function h$animationFrameCancel(h) {+ if(h.handle) cancelAnimationFrame(h.handle);+ if(h.callback) {+ h$release(h.callback)+ h.callback = null;+ }+}++function h$animationFrameRequest(h) {+ h.handle = requestAnimationFrame(function(ts) {+ var cb = h.callback;+ if(cb) {+ h$release(cb);+ h.callback = null;+ cb(ts);+ }+ });+}
− jsbits/animationFrame.js.pp
@@ -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);- }- });-}
+ jsbits/array.js view
@@ -0,0 +1,40 @@+//#OPTIONS: CPP++/*+ 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));+}
− jsbits/array.js.pp
@@ -1,40 +0,0 @@-#include <ghcjs/rts.h>--/*- 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));-}
+ jsbits/buffer.js view
@@ -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);+}
+ jsbits/export.js view
@@ -0,0 +1,27 @@+//#OPTIONS: CPP+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;+}
− jsbits/export.js.pp
@@ -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;-}
+ jsbits/foreign.js view
@@ -0,0 +1,9 @@+//#OPTIONS: CPP+function h$foreignListProps(o) {+ var r = HS_NIL;+ if(typeof o === 'undefined' || o === null) return null;+ throw "h$foreignListProps";+/* for(var p in o) {++ } */+}
− jsbits/foreign.js.pp
@@ -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) {-- } */-}
+ jsbits/jsstring.js view
@@ -0,0 +1,1180 @@+//#OPTIONS: CPP++/*+ * 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; i<arr.length; i+=60000) {+ r += h$fromCodePoint.apply(null, arr.slice(i, i+60000));+ }+ return r;+ }+}++function h$jsstringInit(str) {+ TRACE_JSSTRING("init: '" + str + "'");+ var l = str.length;+ if(l===0) return null;+ var ch = str.charCodeAt(l-1);+ var o = IS_LO_SURR(ch)?2:1;+ var r = str.substr(0, l-o);+ return r;+}++function h$jsstringLast(str) {+ TRACE_JSSTRING("last: '" + str + "'");+ var l = str.length;+ if(l===0) return -1;+ var ch = str.charCodeAt(l-1);+ if(IS_LO_SURR(ch)) {+ return (l>1) ? 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<l) {+ cx = x.charCodeAt(i);+ if(cx !== y.charCodeAt(i)) {+ if(IS_LO_SURR(cx)) i--;+ break;+ }+ }+ if(i===0) return HS_NOTHING;+ return MK_JUST(MK_TUP3( MK_JSVAL((i===lx)?x:((i===ly)?y:x.substr(0,i)))+ , (i===lx) ? h$jsstringEmpty : MK_JSVAL(x.substr(i))+ , (i===ly) ? h$jsstringEmpty : MK_JSVAL(y.substr(i))+ ));+}++function h$jsstringBreakOn(b, x) {+ TRACE_JSSTRING("breakOn: '" + b + "' '" + x + "'");+ var i = x.indexOf(b);+ if(i===-1) {+ RETURN_UBX_TUP2(x, "");+ }+ if(i===0) {+ RETURN_UBX_TUP2("", x);+ }+ RETURN_UBX_TUP2(x.substr(0,i), x.substr(i));+}++function h$jsstringBreakOnEnd(b, x) {+ TRACE_JSSTRING("breakOnEnd: '" + b + "' '" + x + "'");+ var i = x.lastIndexOf(b);+ if(i===-1) {+ RETURN_UBX_TUP2("", x);++ }+ i += b.length;+ RETURN_UBX_TUP2(x.substr(0,i), x.substr(i));+}++function h$jsstringBreakOnAll1(n, b, x) {+ TRACE_JSSTRING("breakOnAll1: " + n + " '" + b + "' '" + x + "'");+ var i = x.indexOf(b, n);+ if(i===0) {+ RETURN_UBX_TUP3(b.length, "", x);+ }+ if(i===-1) {+ RETURN_UBX_TUP3(-1, null, null);+ }+ RETURN_UBX_TUP3(i+b.length, x.substr(0,i), x.substr(i));+}++function h$jsstringBreakOnAll(pat, src) {+ TRACE_JSSTRING("breakOnAll");+ var a = [], i = 0, n = 0, r = HS_NIL, pl = pat.length;+ while(true) {+ var x = src.indexOf(pat, n);+ if(x === -1) break;+ a[i++] = MK_TUP2(MK_JSVAL(src.substr(0,x)), MK_JSVAL(src.substr(x)));+ n = x + pl;+ }+ 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<sl) {+ i = src.indexOf(pat, i);+ if(i===-1) break;+ n++;+ i += pl;+ }+ return n;+}++function h$jsstringReplicate(n, str) {+ TRACE_JSSTRING("replicate: " + n + " '" + str + "'");+ if(n === 0 || str == '') return '';+ if(n === 1) return str;+ var r = '';+ do {+ if(n&1) r+=str;+ str+=str;+ n >>= 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;+}++function h$jsstringDecBigNat(positive,x) {+ TRACE_JSSTRING("decBigNat");+ const y = BigInt("0x" + h$jsstringHexBigNat(positive,x)).toString();+ return positive ? y : "-"+y;+}++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);+}++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--;+ }+ }+ 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;+}++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;+ return sign + hi0.toString(16) + lo0.toString(16).padStart(8, '0');+}++function h$jsstringHexW64(hi,lo) {+ if (hi === 0) return lo.toString(16);+ return hi.toString(16) + lo.toString(16).padStart(8, '0');+}++// 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 (x<y)?-1:((x>y)?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;+}++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);+}
− jsbits/jsstring.js.pp
@@ -1,1181 +0,0 @@-#include <ghcjs/rts.h>--/*- * 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; i<arr.length; i+=60000) {- r += h$fromCodePoint.apply(null, arr.slice(i, i+60000));- }- return r;- }-}--function h$jsstringInit(str) {- TRACE_JSSTRING("init: '" + str + "'");- var l = str.length;- if(l===0) return null;- var ch = str.charCodeAt(l-1);- var o = IS_LO_SURR(ch)?2:1;- var r = str.substr(0, l-o);- return r;-}--function h$jsstringLast(str) {- TRACE_JSSTRING("last: '" + str + "'");- var l = str.length;- if(l===0) return -1;- var ch = str.charCodeAt(l-1);- if(IS_LO_SURR(ch)) {- return (l>1) ? 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<l) {- cx = x.charCodeAt(i);- if(cx !== y.charCodeAt(i)) {- if(IS_LO_SURR(cx)) i--;- break;- }- }- if(i===0) return HS_NOTHING;- return MK_JUST(MK_TUP3( MK_JSVAL((i===lx)?x:((i===ly)?y:x.substr(0,i)))- , (i===lx) ? h$jsstringEmpty : MK_JSVAL(x.substr(i))- , (i===ly) ? h$jsstringEmpty : MK_JSVAL(y.substr(i))- ));-}--function h$jsstringBreakOn(b, x) {- TRACE_JSSTRING("breakOn: '" + b + "' '" + x + "'");- var i = x.indexOf(b);- if(i===-1) {- RETURN_UBX_TUP2(x, "");- }- if(i===0) {- RETURN_UBX_TUP2("", x);- }- RETURN_UBX_TUP2(x.substr(0,i), x.substr(i));-}--function h$jsstringBreakOnEnd(b, x) {- TRACE_JSSTRING("breakOnEnd: '" + b + "' '" + x + "'");- var i = x.lastIndexOf(b);- if(i===-1) {- RETURN_UBX_TUP2("", x);-- }- i += b.length;- RETURN_UBX_TUP2(x.substr(0,i), x.substr(i));-}--function h$jsstringBreakOnAll1(n, b, x) {- TRACE_JSSTRING("breakOnAll1: " + n + " '" + b + "' '" + x + "'");- var i = x.indexOf(b, n);- if(i===0) {- RETURN_UBX_TUP3(b.length, "", x);- }- if(i===-1) {- RETURN_UBX_TUP3(-1, null, null);- }- RETURN_UBX_TUP3(i+b.length, x.substr(0,i), x.substr(i));-}--function h$jsstringBreakOnAll(pat, src) {- TRACE_JSSTRING("breakOnAll");- var a = [], i = 0, n = 0, r = HS_NIL, pl = pat.length;- while(true) {- var x = src.indexOf(pat, n);- if(x === -1) break;- a[i++] = MK_TUP2(MK_JSVAL(src.substr(0,x)), MK_JSVAL(src.substr(x)));- n = x + pl;- }- 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<sl) {- i = src.indexOf(pat, i);- if(i===-1) break;- n++;- i += pl;- }- return n;-}--function h$jsstringReplicate(n, str) {- TRACE_JSSTRING("replicate: " + n + " '" + str + "'");- if(n === 0 || str == '') return '';- if(n === 1) return str;- var r = '';- do {- if(n&1) r+=str;- str+=str;- n >>= 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 (x<y)?-1:((x>y)?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;-}
+ jsbits/jsstringRaw.js view
@@ -0,0 +1,21 @@+//#OPTIONS: CPP++/*+ * 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)));+}
− jsbits/jsstringRaw.js.pp
@@ -1,21 +0,0 @@-#include <ghcjs/rts.h>--/*- * 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)));-}
+ jsbits/text.js view
@@ -0,0 +1,38 @@+//#OPTIONS: CPP+// conversion between JavaScript string and Data.Text+++/*+ convert a Data.Text buffer with offset/length to a JavaScript string+ */+function h$textToString(arr, off, len) {+ return new TextDecoder().decode(arr.u8.subarray(off, off+len));+}++/*+ convert a JavaScript string to a Data.Text buffer, second return+ value is length+ */+function h$textFromString(s) {+ var encoder = new TextEncoder("utf-8");+ var u8 = encoder.encode(s);+ var b = h$wrapBuffer(u8.buffer, true, u8.byteOffset, u8.byteLength);+ RETURN_UBX_TUP2(b, u8.byteLength);+}++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);+}
− jsbits/text.js.pp
@@ -1,53 +0,0 @@-// conversion between JavaScript string and Data.Text-#include <ghcjs/rts.h>---/*- 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<end;i++) {- var cc = u1[i];- a[k++] = cc;- if(k === 60000) {- s += String.fromCharCode.apply(this, a);- k = 0;- a = [];- }- }- return s + String.fromCharCode.apply(this, a);-}--/*- convert a JavaScript string to a Data.Text buffer, second return- value is length- */-function h$textFromString(s) {- var l = s.length;- var b = h$newByteArray(l * 2);- var u1 = b.u1;- for(var i=l-1;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);-}
+ jsbits/utils.js view
@@ -0,0 +1,93 @@+//#OPTIONS: CPP++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;+ }+ }++}+
− jsbits/utils.js.pp
@@ -1,93 +0,0 @@-#include <ghcjs/rts.h>--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;- }- }--}-
+ jsbits/websocket.js view
@@ -0,0 +1,58 @@+//#OPTIONS: CPP++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);+}
− jsbits/websocket.js.pp
@@ -1,58 +0,0 @@-#include <ghcjs/rts.h>--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);-}
+ jsbits/xhr.js view
@@ -0,0 +1,17 @@+//#OPTIONS: CPP+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();+ }+}
− jsbits/xhr.js.pp
@@ -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();- }-}
+ test/Tests/Buffer.hs view
@@ -0,0 +1,80 @@+module Tests.Buffer (+ tests+) where++import Control.Exception (ErrorCall(..), catch)+import Control.Monad (forM_)+import Data.Primitive.ByteArray+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Data.Word (Word8)+import Test.Framework.Providers.HUnit (testCase)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck (Property, ioProperty, (==>))+import Test.Framework (Test, testGroup)+import Test.HUnit ((@=?), assertFailure)++import GHCJS.Buffer++byteLengthWorks :: Int -> Property+byteLengthWorks i = (i >= 0) ==> (ioProperty $ do+ buf <- create i+ return (i == byteLength buf))++fromByteStringNoOffset :: IO ()+fromByteStringNoOffset = do+ let bs = BS8.pack ['a'..'z']+ (buf, offset, len) = fromByteString bs+ 0 @=? offset+ 26 @=? len+ 26 @=? byteLength buf+ let ba = toByteArray buf+ forM_ [0..25] $ \i -> do+ BS.index bs i @=? indexByteArray ba i++fromByteStringWithOffset :: IO ()+fromByteStringWithOffset = do+ let bs = BS8.pack ['a'..'z']+ sliced = BS.take 10 . BS.drop 5 $ bs+ (buf, offset, len) = fromByteString sliced+ 5 @=? offset+ 10 @=? len+ 26 @=? byteLength buf+ let ba = toByteArray buf+ forM_ [0..25] $ \i -> do+ BS.index bs i @=? indexByteArray ba i++atoz :: IO ByteArray+atoz = do+ ba <- newByteArray 26+ forM_ [0..25] $ \i -> writeByteArray ba i (fromIntegral i + 65 :: Word8)+ unsafeFreezeByteArray ba++wrapIntoByteString :: IO ()+wrapIntoByteString = do+ buf <- fromByteArray `fmap` atoz+ BS8.pack ['A'..'Z'] @=? toByteString 0 Nothing buf+ BS8.pack ['K'..'Z'] @=? toByteString 10 Nothing buf+ BS8.pack ['K'..'O'] @=? toByteString 10 (Just 5) buf++toByteStringOffset :: IO ()+toByteStringOffset = do+ buf <- fromByteArray `fmap` atoz+ tst (toByteString (-1) Nothing buf) "toByteString: negative offset"+ tst (toByteString 100 Nothing buf) "toByteString: offset past end of buffer"+ tst (toByteString 0 (Just (-1)) buf) "toByteString: negative length"+ tst (toByteString 0 (Just (-1)) buf) "toByteString: negative length"+ tst (toByteString 0 (Just 27) buf) "toByteString: length past end of buffer"+ tst (toByteString 20 (Just 7) buf) "toByteString: length past end of buffer"+ where tst expr expected = ign expr expected `catch` \(ErrorCall msg) -> expected @=? msg+ ign expr expected = seq expr $ assertFailure ("Expected error " ++ show expected ++ " but got nothing")++tests :: Test+tests =+ testGroup "Buffer" [+ testProperty "byte length works" byteLengthWorks,+ testCase "fromByteString - no offset" fromByteStringNoOffset,+ testCase "fromByteString - offset" fromByteStringWithOffset,+ testCase "toByteString" wrapIntoByteString,+ testCase "toByteString - offset" toByteStringOffset+ ]
test/Tests/Properties.hs view
@@ -758,6 +758,7 @@ 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,@@ -783,9 +784,9 @@ 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 ] ],
test/Tests/Properties/Numeric.hs view
@@ -40,7 +40,10 @@ 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
test/Tests/QuickCheckUtils.hs view
@@ -271,17 +271,6 @@ , 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,