From 032e5c3be36474ca261ddda54cd550d3f8c60e65 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Mon, 31 Jul 2023 15:05:22 +1000 Subject: [PATCH 1/5] WIP js backend --- jsaddle/jsaddle.cabal | 11 +++++++---- jsaddle/src/Language/Javascript/JSaddle/Exception.hs | 2 +- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/jsaddle/jsaddle.cabal b/jsaddle/jsaddle.cabal index 1ee07b91..620447da 100644 --- a/jsaddle/jsaddle.cabal +++ b/jsaddle/jsaddle.cabal @@ -29,10 +29,13 @@ flag check-unchecked library - if impl(ghcjs -any) + if impl(ghcjs -any) || arch(javascript) build-depends: - ghcjs-base -any, - ghcjs-prim -any + ghcjs-base -any + -- GHC includes GHC.JS.Prim in base + if impl(ghcjs -any) + build-depends: + ghcjs-prim -any else build-depends: attoparsec >=0.11 && <0.15, @@ -109,7 +112,7 @@ library build-depends: aeson >=0.11.3.0 && <2.2, base >=4.9 && <5, - base-compat >=0.9.0 && <0.13, + base-compat >=0.9.0 && <0.14, base64-bytestring >=1.0.0.1 && <1.3, bytestring >=0.10.6.0 && <0.12, exceptions >=0.8 && <0.11, diff --git a/jsaddle/src/Language/Javascript/JSaddle/Exception.hs b/jsaddle/src/Language/Javascript/JSaddle/Exception.hs index fe9154d8..4f48f566 100644 --- a/jsaddle/src/Language/Javascript/JSaddle/Exception.hs +++ b/jsaddle/src/Language/Javascript/JSaddle/Exception.hs @@ -19,7 +19,7 @@ module Language.Javascript.JSaddle.Exception ( import qualified Control.Exception as E (Exception) #ifdef ghcjs_HOST_OS -import GHCJS.Prim (JSVal) +import GHC.JS.Prim (JSVal) #else import GHCJS.Prim.Internal (JSVal) #endif From e456b7f5c7d1ec5b96fe4735f50c485b3deebce1 Mon Sep 17 00:00:00 2001 From: Josh Meredith Date: Mon, 6 Nov 2023 21:50:48 +1100 Subject: [PATCH 2/5] Update to the JavaScript backend --- jsaddle/jsaddle.cabal | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/jsaddle/jsaddle.cabal b/jsaddle/jsaddle.cabal index 620447da..fb9f92a0 100644 --- a/jsaddle/jsaddle.cabal +++ b/jsaddle/jsaddle.cabal @@ -110,15 +110,15 @@ library Language.Javascript.JSaddle.Value Language.Javascript.JSaddle.Types build-depends: - aeson >=0.11.3.0 && <2.2, + aeson >=0.11.3.0 && <2.3, base >=4.9 && <5, base-compat >=0.9.0 && <0.14, base64-bytestring >=1.0.0.1 && <1.3, - bytestring >=0.10.6.0 && <0.12, + bytestring >=0.10.6.0 && <0.13, exceptions >=0.8 && <0.11, lens >=3.8.5 && <5.3, - primitive >=0.6.1.0 && <0.8, - text >=1.2.1.3 && <1.3 || >= 2.0 && < 2.1, + primitive >=0.6.1.0 && <0.10, + text >=1.2.1.3 && <1.3 || >= 2.0 && < 2.2, transformers >=0.4.2.0 && <0.7 default-language: Haskell2010 hs-source-dirs: src From 12bb1129531aeab5e404857087ca9a65a27df3c3 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 6 Feb 2024 00:27:13 +1300 Subject: [PATCH 3/5] Support ghcjs 8.10.7 and ghc 9.8.1 javascript backend --- jsaddle-clib/jsaddle-clib.cabal | 2 +- jsaddle-warp/jsaddle-warp.cabal | 9 ++- jsaddle-webkit2gtk/jsaddle-webkit2gtk.cabal | 2 +- jsaddle-wkwebview/jsaddle-wkwebview.cabal | 12 ++-- .../TypedArray/DataView/Internal.hs | 1 - .../Language/Javascript/JSaddle/Evaluate.hs | 7 ++- .../Language/Javascript/JSaddle/Exception.hs | 4 ++ .../src/Language/Javascript/JSaddle/Object.hs | 52 ++++++++++++++-- .../Language/Javascript/JSaddle/Properties.hs | 14 ++++- .../src/Language/Javascript/JSaddle/Value.hs | 61 +++++++++++++++---- 10 files changed, 134 insertions(+), 30 deletions(-) diff --git a/jsaddle-clib/jsaddle-clib.cabal b/jsaddle-clib/jsaddle-clib.cabal index 2af1d921..a7b44735 100644 --- a/jsaddle-clib/jsaddle-clib.cabal +++ b/jsaddle-clib/jsaddle-clib.cabal @@ -34,7 +34,7 @@ library Includes: jsaddle.h Install-includes: jsaddle.h ghc-options: -ferror-spans -Wall - if impl(ghcjs) + if impl(ghcjs) || arch(javascript) hs-source-dirs: src-ghcjs else hs-source-dirs: src-ghc diff --git a/jsaddle-warp/jsaddle-warp.cabal b/jsaddle-warp/jsaddle-warp.cabal index f4317203..99541860 100644 --- a/jsaddle-warp/jsaddle-warp.cabal +++ b/jsaddle-warp/jsaddle-warp.cabal @@ -21,7 +21,7 @@ source-repository head library - if !impl(ghcjs -any) + if !impl(ghcjs -any) && !arch(javascript) exposed-modules: Language.Javascript.JSaddle.WebSockets other-modules: @@ -40,7 +40,7 @@ library wai >=3.0.3.0 && <3.3, wai-websockets >=3.0.0.6 && <3.1, warp >=3.1.2 && <3.4, - websockets >=0.9.5.0 && <0.13 + websockets >=0.9.5.0 && <0.14 exposed-modules: Language.Javascript.JSaddle.Warp build-depends: @@ -93,6 +93,9 @@ test-suite test-tool ghc-options: -ferror-spans -threaded test-suite spec + if impl(ghcjs -any) || arch(javascript) + buildable: False + type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: @@ -116,4 +119,4 @@ test-suite spec , warp , websockets other-modules: - default-language: Haskell2010 \ No newline at end of file + default-language: Haskell2010 diff --git a/jsaddle-webkit2gtk/jsaddle-webkit2gtk.cabal b/jsaddle-webkit2gtk/jsaddle-webkit2gtk.cabal index f8d7ffb9..ee4f492c 100644 --- a/jsaddle-webkit2gtk/jsaddle-webkit2gtk.cabal +++ b/jsaddle-webkit2gtk/jsaddle-webkit2gtk.cabal @@ -24,7 +24,7 @@ library Language.Javascript.JSaddle.WebKitGTK build-depends: base <5 - if !impl(ghcjs -any) + if !impl(ghcjs -any) && !arch(javascript) build-depends: aeson >=0.8.0.2 && <2.3, base <5, diff --git a/jsaddle-wkwebview/jsaddle-wkwebview.cabal b/jsaddle-wkwebview/jsaddle-wkwebview.cabal index a9b4b51c..c69194eb 100644 --- a/jsaddle-wkwebview/jsaddle-wkwebview.cabal +++ b/jsaddle-wkwebview/jsaddle-wkwebview.cabal @@ -1,6 +1,6 @@ +cabal-version: 3.0 name: jsaddle-wkwebview -version: 0.9.8.3 -cabal-version: >=1.10 +version: 0.9.8.4 build-type: Simple license: MIT license-file: LICENSE @@ -32,7 +32,7 @@ library ghc-options: -ferror-spans -Wall if os(linux) buildable: False - if impl(ghcjs) + if impl(ghcjs) || arch(javascript) hs-source-dirs: src-ghcjs else frameworks: Foundation, WebKit @@ -47,19 +47,19 @@ library exposed-modules: Language.Javascript.JSaddle.WKWebView.Internal hs-source-dirs: src-ghc - c-sources: + cxx-sources: cbits/WKWebView.m cc-options: -Wno-everything if os(ios) frameworks: UIKit, UserNotifications if flag(include-app-delegate) - c-sources: + cxx-sources: cbits-uikit/AppDelegate.m cbits-uikit/ViewController.m cpp-options: -DUSE_UIKIT else frameworks: Cocoa if flag(include-app-delegate) - c-sources: + cxx-sources: cbits-cocoa/AppDelegate.m cpp-options: -DUSE_COCOA diff --git a/jsaddle/src-ghc/JavaScript/TypedArray/DataView/Internal.hs b/jsaddle/src-ghc/JavaScript/TypedArray/DataView/Internal.hs index 76c757a7..33fe2bd2 100644 --- a/jsaddle/src-ghc/JavaScript/TypedArray/DataView/Internal.hs +++ b/jsaddle/src-ghc/JavaScript/TypedArray/DataView/Internal.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE JavaScriptFFI #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE GHCForeignImportPrim #-} diff --git a/jsaddle/src/Language/Javascript/JSaddle/Evaluate.hs b/jsaddle/src/Language/Javascript/JSaddle/Evaluate.hs index b34ca098..172b4c51 100644 --- a/jsaddle/src/Language/Javascript/JSaddle/Evaluate.hs +++ b/jsaddle/src/Language/Javascript/JSaddle/Evaluate.hs @@ -50,7 +50,12 @@ eval :: (ToJSString script) -> JSM JSVal #ifdef ghcjs_HOST_OS eval script = liftIO $ js_eval (toJSString script) -foreign import javascript safe "$r = eval($1);" +foreign import javascript safe +#if __GLASGOW_HASKELL__ >= 900 + "(($1) => { return eval($1); })" +#else + "$r = eval($1);" +#endif js_eval :: JSString -> IO JSVal #else eval = evaluateScript . toJSString diff --git a/jsaddle/src/Language/Javascript/JSaddle/Exception.hs b/jsaddle/src/Language/Javascript/JSaddle/Exception.hs index 4f48f566..b4e8d5f2 100644 --- a/jsaddle/src/Language/Javascript/JSaddle/Exception.hs +++ b/jsaddle/src/Language/Javascript/JSaddle/Exception.hs @@ -19,8 +19,12 @@ module Language.Javascript.JSaddle.Exception ( import qualified Control.Exception as E (Exception) #ifdef ghcjs_HOST_OS +#if __GLASGOW_HASKELL__ >= 900 import GHC.JS.Prim (JSVal) #else +import GHCJS.Prim (JSVal) +#endif +#else import GHCJS.Prim.Internal (JSVal) #endif import Data.Typeable (Typeable) diff --git a/jsaddle/src/Language/Javascript/JSaddle/Object.hs b/jsaddle/src/Language/Javascript/JSaddle/Object.hs index 8377f1ed..74c4572f 100644 --- a/jsaddle/src/Language/Javascript/JSaddle/Object.hs +++ b/jsaddle/src/Language/Javascript/JSaddle/Object.hs @@ -440,7 +440,13 @@ newtype Function = Function {functionObject :: Object} #ifdef ghcjs_HOST_OS -foreign import javascript unsafe "$r = function () { $1(this, arguments); }" +-- Do not replace `function ()` with `=>` as `arguments` will not work +foreign import javascript unsafe +#if __GLASGOW_HASKELL__ >= 900 + "(($1) => { return function () { $1(this, arguments); }; })" +#else + "$r = function () { $1(this, arguments); }" +#endif makeFunctionWithCallback :: Callback (JSVal -> JSVal -> IO ()) -> IO Object #endif @@ -527,7 +533,12 @@ array args = do -- | JavaScript's global object #ifdef ghcjs_HOST_OS -foreign import javascript unsafe "$r = globalThis" +foreign import javascript unsafe +#if __GLASGOW_HASKELL__ >= 900 + "(() => { return globalThis; })" +#else + "$r = globalThis" +#endif global :: Object #else global :: Object @@ -556,7 +567,12 @@ objCallAsFunction :: MakeArgs args objCallAsFunction f this args = do rargs <- makeArgs args >>= liftIO . Array.fromListIO liftIO $ js_apply f this rargs -foreign import javascript safe "$r = $1.apply($2, $3)" +foreign import javascript safe +#if __GLASGOW_HASKELL__ >= 900 + "(($1,$2,$3) => { return $1.apply($2, $3); })" +#else + "$r = $1.apply($2, $3)" +#endif js_apply :: Object -> Object -> MutableJSArray -> IO JSVal #else objCallAsFunction f this args = do @@ -576,7 +592,9 @@ objCallAsConstructor :: MakeArgs args objCallAsConstructor f args = do rargs <- makeArgs args >>= liftIO . Array.fromListIO liftIO $ js_new f rargs -foreign import javascript safe "\ +foreign import javascript safe +#if __GLASGOW_HASKELL__ >= 900 + "(($1,$2) => {\ switch($2.length) {\ case 0 : $r = new $1(); break;\ case 1 : $r = new $1($2[0]); break;\ @@ -598,7 +616,33 @@ foreign import javascript safe "\ i.constructor = $1;\ $r = i;\ }\ + }\ + return $r;\ + })" +#else + "switch($2.length) {\ + case 0 : $r = new $1(); break;\ + case 1 : $r = new $1($2[0]); break;\ + case 2 : $r = new $1($2[0],$2[1]); break;\ + case 3 : $r = new $1($2[0],$2[1],$2[2]); break;\ + case 4 : $r = new $1($2[0],$2[1],$2[2],$2[3]); break;\ + case 5 : $r = new $1($2[0],$2[1],$2[2],$2[3],$2[4]); break;\ + case 6 : $r = new $1($2[0],$2[1],$2[2],$2[3],$2[4],$2[5]); break;\ + case 7 : $r = new $1($2[0],$2[1],$2[2],$2[3],$2[4],$2[5],$2[6]); break;\ + default:\ + var temp = function() {\ + ret = $1.apply(this, $2);\ + };\ + temp.prototype = $1.prototype;\ + var i = new temp();\ + if(ret instanceof Object) {\ + $r = ret;\ + } else {\ + i.constructor = $1;\ + $r = i;\ + }\ }" +#endif js_new :: Object -> MutableJSArray -> IO JSVal #else objCallAsConstructor f args = do diff --git a/jsaddle/src/Language/Javascript/JSaddle/Properties.hs b/jsaddle/src/Language/Javascript/JSaddle/Properties.hs index 5ab0c9a0..8140f1d3 100644 --- a/jsaddle/src/Language/Javascript/JSaddle/Properties.hs +++ b/jsaddle/src/Language/Javascript/JSaddle/Properties.hs @@ -60,7 +60,12 @@ objGetPropertyAtIndex :: Object -- ^ object to find the property on. -> JSM JSVal -- ^ returns the property value. #ifdef ghcjs_HOST_OS objGetPropertyAtIndex this index = js_tryIndex index this -foreign import javascript unsafe "$r=$2[$1]" +foreign import javascript unsafe +#if __GLASGOW_HASKELL__ >= 900 + "(($1,$2) => { return $2[$1]; })" +#else + "$r=$2[$1]" +#endif js_tryIndex :: Int -> Object -> IO JSVal #else objGetPropertyAtIndex this index = @@ -87,7 +92,12 @@ objSetPropertyAtIndex :: (ToJSVal val) objSetPropertyAtIndex this index val = do vref <- toJSVal val js_trySetAtIndex index this vref -foreign import javascript unsafe "$2[$1]=$3" +foreign import javascript unsafe +#if __GLASGOW_HASKELL__ >= 900 + "(($1,$2,$3) => { return $2[$1]=$3; })" +#else + "$2[$1]=$3" +#endif js_trySetAtIndex :: Int -> Object -> JSVal -> IO () #else objSetPropertyAtIndex this index val = diff --git a/jsaddle/src/Language/Javascript/JSaddle/Value.hs b/jsaddle/src/Language/Javascript/JSaddle/Value.hs index 6ead633b..169c10d9 100644 --- a/jsaddle/src/Language/Javascript/JSaddle/Value.hs +++ b/jsaddle/src/Language/Javascript/JSaddle/Value.hs @@ -189,7 +189,13 @@ valToBool value = toJSVal value >>= ghcjsPure . isTruthy valToNumber :: ToJSVal value => value -> JSM Double #ifdef ghcjs_HOST_OS valToNumber value = jsrefToNumber <$> toJSVal value -foreign import javascript unsafe "$r = Number($1);" jsrefToNumber :: JSVal -> Double +foreign import javascript unsafe +#if __GLASGOW_HASKELL__ >= 900 + "(($1) => { return Number($1); })" +#else + "$r = Number($1);" +#endif + jsrefToNumber :: JSVal -> Double #else valToNumber value = toJSVal value >>= valueToNumber #endif @@ -216,7 +222,13 @@ valToNumber value = toJSVal value >>= valueToNumber valToStr :: ToJSVal value => value -> JSM JSString #ifdef ghcjs_HOST_OS valToStr value = jsrefToString <$> toJSVal value -foreign import javascript unsafe "$r = $1.toString();" jsrefToString :: JSVal -> JSString +foreign import javascript unsafe +#if __GLASGOW_HASKELL__ >= 900 + "(($1) => { return $1.toString(); })" +#else + "$r = $1.toString();" +#endif + jsrefToString :: JSVal -> JSString #else valToStr value = toJSVal value >>= valueToString #endif @@ -267,7 +279,13 @@ valToText jsvar = strToText <$> valToStr jsvar valToJSON :: ToJSVal value => value -> JSM JSString #ifdef ghcjs_HOST_OS valToJSON value = jsrefToJSON <$> toJSVal value -foreign import javascript unsafe "$r = $1 === undefined ? \"\" : JSON.stringify($1);" jsrefToJSON :: JSVal -> JSString +foreign import javascript unsafe +#if __GLASGOW_HASKELL__ >= 900 + "(($1) => { return $1 === undefined ? \"\" : JSON.stringify($1); })" +#else + "$r = $1 === undefined ? \"\" : JSON.stringify($1);" +#endif + jsrefToJSON :: JSVal -> JSString #else valToJSON value = toJSVal value >>= valueToJSON #endif @@ -611,12 +629,23 @@ deRefVal value = do 4 -> ValString <$> valToText valref 5 -> ValObject <$> valToObject valref _ -> error "Unexpected result dereferencing JSaddle value" -foreign import javascript unsafe "$r = ($1 === undefined)?0:\ - ($1===null)?1:\ - (typeof $1===\"boolean\")?2:\ - (typeof $1===\"number\")?3:\ - (typeof $1===\"string\")?4:\ - (typeof $1===\"object\")?5:-1;" jsrefGetType :: JSVal -> Int +foreign import javascript unsafe +#if __GLASGOW_HASKELL__ >= 900 + "(($1) => { return ($1 === undefined)?0:\ + ($1===null)?1:\ + (typeof $1===\"boolean\")?2:\ + (typeof $1===\"number\")?3:\ + (typeof $1===\"string\")?4:\ + (typeof $1===\"object\")?5:-1; })" +#else + "$r = ($1 === undefined)?0:\ + ($1===null)?1:\ + (typeof $1===\"boolean\")?2:\ + (typeof $1===\"number\")?3:\ + (typeof $1===\"string\")?4:\ + (typeof $1===\"object\")?5:-1;" +#endif + jsrefGetType :: JSVal -> Int #else deRefVal value = do v <- toJSVal value @@ -669,7 +698,12 @@ instance MakeArgs JSValue where #ifdef ghcjs_HOST_OS foreign import javascript unsafe - "$1===$2" jsvalueisstrictequal :: JSVal -> JSVal -> Bool +#if __GLASGOW_HASKELL__ >= 900 + "(($1,$2) => { return $1===$2; })" +#else + "$1===$2" +#endif + jsvalueisstrictequal :: JSVal -> JSVal -> Bool #endif -- | Determine if two values are equal (JavaScripts ===) @@ -692,7 +726,12 @@ strictEqual a b = do #endif #ifdef ghcjs_HOST_OS -foreign import javascript unsafe "$1 instanceof $2" +foreign import javascript unsafe +#if __GLASGOW_HASKELL__ >= 900 + "(($1,$2) => { return $1 instanceof $2; })" +#else + "$1 instanceof $2" +#endif js_isInstanceOf :: JSVal -> Object -> Bool #endif From 16e675a9f94103ada1bd4b2bff71d64044fce365 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 6 Feb 2024 01:08:21 +1300 Subject: [PATCH 4/5] Use callback module from `base` for js backend --- jsaddle/src/Language/Javascript/JSaddle/Object.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/jsaddle/src/Language/Javascript/JSaddle/Object.hs b/jsaddle/src/Language/Javascript/JSaddle/Object.hs index 74c4572f..9472d029 100644 --- a/jsaddle/src/Language/Javascript/JSaddle/Object.hs +++ b/jsaddle/src/Language/Javascript/JSaddle/Object.hs @@ -102,7 +102,11 @@ import Prelude hiding ((!!)) import Data.Coerce (coerce) #ifdef ghcjs_HOST_OS import GHCJS.Types (nullRef) +#if __GLASGOW_HASKELL__ >= 900 +import GHC.JS.Foreign.Callback +#else import GHCJS.Foreign.Callback +#endif (releaseCallback, syncCallback2, asyncCallback2, OnBlocked(..), Callback) import GHCJS.Marshal (ToJSVal(..)) import JavaScript.Array (MutableJSArray) From fab7b70b4f37664a65c5136cb6554276853d47bc Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Tue, 13 Feb 2024 17:36:47 +1300 Subject: [PATCH 5/5] Update containers upper bound --- jsaddle-warp/jsaddle-warp.cabal | 2 +- jsaddle/jsaddle.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/jsaddle-warp/jsaddle-warp.cabal b/jsaddle-warp/jsaddle-warp.cabal index 99541860..96cb4047 100644 --- a/jsaddle-warp/jsaddle-warp.cabal +++ b/jsaddle-warp/jsaddle-warp.cabal @@ -29,7 +29,7 @@ library build-depends: aeson >=0.8.0.2 && <2.3, bytestring >=0.10.6.0 && <0.13, - containers >=0.5.6.2 && <0.7, + containers >=0.5.6.2 && <0.8, foreign-store >=0.2 && <0.3, http-types >=0.8.6 && <0.13, jsaddle >=0.9.4.0 && <0.10, diff --git a/jsaddle/jsaddle.cabal b/jsaddle/jsaddle.cabal index cb1f21db..e51be11f 100644 --- a/jsaddle/jsaddle.cabal +++ b/jsaddle/jsaddle.cabal @@ -39,7 +39,7 @@ library else build-depends: attoparsec >=0.11 && <0.15, - containers >=0.5.6.2 && <0.7, + containers >=0.5.6.2 && <0.8, deepseq >=1.3 && < 1.6, filepath >=1.4.0.0 && <1.5, ghc-prim,