Merge pull request #142 from ghcjs/wip/js-backend

Support GHC JS backend
ghcjs · Apr 7, 2024 · 1cb201e · 1cb201e
2 parents 548c783 + fab7b70
commit 1cb201e
Show file tree

Hide file tree

Showing 10 changed files with 147 additions and 35 deletions.
diff --git 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
@@ -21,15 +21,15 @@ source-repository head
 
 library
 
-    if !impl(ghcjs -any)
+    if !impl(ghcjs -any) && !arch(javascript)
         exposed-modules:
             Language.Javascript.JSaddle.WebSockets
         other-modules:
             Language.Javascript.JSaddle.WebSockets.Compat
         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,
@@ -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
+  default-language: Haskell2010
diff --git 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
@@ -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/jsaddle.cabal b/jsaddle/jsaddle.cabal
@@ -29,14 +29,17 @@ 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,
-            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,
@@ -114,7 +117,7 @@ library
         bytestring >=0.10.6.0 && <0.13,
         exceptions >=0.8 && <0.11,
         lens >=3.8.5 && <5.3,
-        primitive >=0.6.1.0 && <0.9,
+        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

diff --git 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
@@ -19,7 +19,11 @@ 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

diff --git 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)
@@ -440,7 +444,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 +537,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 +571,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 +596,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 +620,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
@@ -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
@@ -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