diff options
author | Josh Meredith <joshmeredith2008@gmail.com> | 2023-03-06 09:18:03 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-04-13 08:51:09 -0400 |
commit | 27d2978e5412f2bef4448e208182a03137dd5ee8 (patch) | |
tree | 0e98a70f487c9c06061d92338de6fd9da593d3f6 | |
parent | 8af401ccfbe28d7bbfc493c0097834e9c66a36b0 (diff) | |
download | haskell-27d2978e5412f2bef4448e208182a03137dd5ee8.tar.gz |
Base/JS: GHC.JS.Foreign.Callback module (issue 23126)
* Add the Callback module for "exporting" Haskell functions
to be available to plain JavaScript code
* Fix some primitives defined in GHC.JS.Prim
* Add a JavaScript section to the user guide with instructions
on how to use the JavaScript FFI, building up to using Callbacks
to interact with the browser
* Add tests for the JavaScript FFI and Callbacks
28 files changed, 638 insertions, 4 deletions
diff --git a/docs/users_guide/index.rst b/docs/users_guide/index.rst index 56354e36bb..15274dcc71 100644 --- a/docs/users_guide/index.rst +++ b/docs/users_guide/index.rst @@ -23,6 +23,7 @@ Contents: hints utils win32-dlls + javascript wasm bugs eventlog-formats diff --git a/docs/users_guide/javascript.rst b/docs/users_guide/javascript.rst new file mode 100644 index 0000000000..f33c146f87 --- /dev/null +++ b/docs/users_guide/javascript.rst @@ -0,0 +1,175 @@ +.. _ffi-javascript + +FFI and the JavaScript Backend +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +.. index:: + single: FFI and the JavaScript Backend + +GHC's JavaScript backend supports its own calling convention for +JavaScript-specific foreign imports. Any unapplied function is +supported, including function names. Commonly, JavaScript foreign +imports are written as an unapplied JavaScript `arrow function +<https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Functions/Arrow_functions>`_, +but ``function`` keyword anonymous functions are also supported. + +By treating an import string as an unapplied function, arbitrary +JavaScript can be included in an import, so a simple example might +look like: + +.. code-block:: haskell + + foreign import javascript "((x,y) => { return x + y; })" + js_add :: Int -> Int -> Int + +JSVal +^^^^^ + +The JavaScript backend has a concept of an untyped 'plain' JavaScript +value, under the guise of the type ``JSVal``. Values having this type +are mostly opaque to Haskell codes: you can think of `JSVal` as a data type whose +data constructors aren't exposed. Its main use case is to pass opaque +JavaScript values from one FFI call to another. + +Nevertheless the module ``GHC.JS.Prim`` from ``base`` contains functions for +working with foreign ``JSVal`` objects. Currently, it provides the following +conversions: + +* ``Int`` <-> ``JSVal`` (``toJSInt``, ``fromJSInt``) +* ``String`` <-> ``JSVal`` (``toJSString``, ``fromJSString``) +* ``[JSVal]`` <-> ``JSVal`` (``toJSArray``, ``fromJSArray``) + +It also contains functions for working with objects: + +* ``jsNull :: JSVal`` - the JavaScript ``null`` +* ``isNull :: JSVal -> Bool`` - test for the JavaScript ``null`` +* ``isUndefined :: JSVal -> Bool`` - test for the JavaScript ``undefined`` +* ``getProp :: JSVal -> String -> JSVal`` - object field access + +JavaScript FFI Types +^^^^^^^^^^^^^^^^^^^^ + +Some types are able to be used directly in the type signatures of foreign +exports, without conversion to a ``JSVal``. We saw in the first example +that ``Int`` is one of these. + +The supported types are those with primitive JavaScript representations +that match the Haskell type. This means types such as the Haskell ``String`` +type aren't supported directly, because they're lists - which don't have +a primitive JavaScript representation, and so are incompatible with each +other. + +The following types are supported in this way: + +* ``Int`` +* ``Bool`` +* ``Char`` + +As in the C FFI, types in the JavaScript FFI can't be type checked against the foreign code, so +the following example would compile successfully - despite `5` not being a valid JavaScript value +for the Haskell `Bool` type: + +.. code-block:: haskell + + foreign import javascript "((x) => { return 5; })" + type_error :: Bool -> Bool + +JavaScript Callbacks +^^^^^^^^^^^^^^^^^^^^ + +The JavaScript execution model is based around callback functions, and +GHC's JavaScript backend implements these as a type in order to support +useful browser programs, and programs interacting with JavaScript libraries. + +The module ``GHC.JS.Foreign.Callback`` in ``base`` defines the type ``Callback a``, +as well as several functions to construct callbacks from Haskell functions +of up to three ``JSVal`` arguments. Unlike a regular function, a ``Callback`` +function is passed in the FFI as a plain JavaScript function - enabling us to call +these functions from within JavaScript: + +.. code-block:: haskell + + foreign import javascript "((f) => { f('Example!'); })" + callback_example :: Callback (JSVal -> IO ()) -> IO () + + printJSValAsString :: JSVal -> IO () + printJSValAsString = putStrLn . fromJSString + + main :: IO () + main = do + printJS <- syncCallback1 ThrowWouldBlock printJSValAsString + callback_example printJS + releaseCallback printJS + +This example will call our ``printJSValAsString`` function, via JavaScript, +with the JavaScript string ``Example!`` as an argument. On the last line, +the callback memory is freed. Since there's no way for the Haskell JS runtime +to know if a function is still being referenced by JavaScript code, the memory +must be manually released when no longer needed. + +On the first line of ``main``, we see where the ``Callback`` is actually +created, by ``syncCallback1``. ``syncCallback`` has versions up to three, +including a zero-argument version with no suffix. To use callbacks with more +than three pieces of data, it's recommended to package data into JavaScript +objects or arrays as required. + +There are three categories of functions that create callbacks, with the +arity-1 type signatures shown here for demonstration: + +* ``syncCallback1 :: (JSVal -> IO ()) -> OnBlocked -> IO (Callback (JSVal -> IO ()))``: + Synchronous callbacks that don't return a value. These take an additional + ``data OnBlocked = ThrowWouldBlock | ContinueAsync`` argument for use in the + case that the thread becomes blocked on e.g. an ``MVar`` transaction. + +* ``syncCallback' :: (JSVal -> IO JSVal) -> IO (Callback (JSVal -> IO ()))``: + Synchronous callbacks that return a value. Because of the return value, there + is no possibility of continuing asynchronously, so no ``OnBlocked`` argument + is taken. + +* ``asyncCallback :: (JSVal -> IO ()) -> IO (Callback (JSVal -> IO ()))``: + Asynchronous callbacks that immediately start in a new thread. Cannot return a + value. + +There is no checking that the passed arguments match the callback, so the +following example compiles and correctly prints 10, despite the argument being +passed as an ``Int`` to a ``Callback`` that accepts a ``JSVal``: + +.. code-block:: haskell + + foreign import javascript "((f,x) => { return f(x); })" + apply_int :: Callback (JSVal -> IO JSVal) -> Int -> IO Int + + main :: IO () + main = do + add3 <- syncCallback1' (return . (+3)) + print =<< apply_int add3 7 + releaseCallback add3 + +Callbacks as Foreign Exports +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +JavaScript callbacks allow for a sort of FFI exports via FFI imports. To do +this, a global JavaScript variable is set, and that global variable can then +be called from use cases that access plain JavaScript functions - such as +interactive HTML elements. This would look like: + +.. code-block:: haskell + + foreign import javascript "((f) => { globalF = f })" + setF :: Callback (JSVal -> IO ()) -> IO () + + main :: IO () + main = do + log <- syncCallback1 ThrowWouldBlock (print . fromJSString) + setF log + -- don't releaseCallback log + + +.. code-block:: html + + <button onClick="globalF('Button pressed!")>Example</button> + +We have to make sure not to use ``releaseCallback`` on any functions that +are to be available in HTML, because we want these functions to be in +memory indefinitely. + diff --git a/libraries/base/GHC/JS/Foreign/Callback.hs b/libraries/base/GHC/JS/Foreign/Callback.hs new file mode 100644 index 0000000000..e40c9257b4 --- /dev/null +++ b/libraries/base/GHC/JS/Foreign/Callback.hs @@ -0,0 +1,149 @@ +module GHC.JS.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 GHC.JS.Prim + +import qualified GHC.Exts as Exts + +import Data.Typeable + +import Unsafe.Coerce + +data OnBlocked = ContinueAsync | ThrowWouldBlock deriving (Eq) + +newtype Callback a = Callback JSVal deriving Typeable + +{- | + When you create a callback, the Haskell runtime stores a reference to + the exported IO action or function. This means that all data referenced by the + exported value stays in memory, even if nothing outside the Haskell runtime + holds a reference to to callback. + Use 'releaseCallback' to free the reference. Subsequent calls from JavaScript + to the callback will result in an exception. + -} +releaseCallback :: Callback a -> IO () +releaseCallback x = js_release x + +{- | Make a callback (JavaScript function) that runs the supplied IO action in a synchronous + thread when called. + Call 'releaseCallback' when done with the callback, freeing memory referenced + by the IO action. + -} +syncCallback :: OnBlocked -- ^ what to do when the thread blocks + -> IO () -- ^ the Haskell action + -> IO (Callback (IO ())) -- ^ the callback +syncCallback onBlocked x = js_syncCallback (onBlocked == ContinueAsync) (unsafeCoerce x) + + +{- | Make a callback (JavaScript function) that runs the supplied IO function in a synchronous + thread when called. The callback takes one argument that it passes as a JSVal value to + the Haskell function. + Call 'releaseCallback' when done with the callback, freeing data referenced + by the function. + -} +syncCallback1 :: OnBlocked -- ^ what to do when the thread blocks + -> (JSVal -> IO ()) -- ^ the Haskell function + -> IO (Callback (JSVal -> IO ())) -- ^ the callback +syncCallback1 onBlocked x = js_syncCallbackApply (onBlocked == ContinueAsync) 1 (unsafeCoerce x) + + +{- | Make a callback (JavaScript function) that runs the supplied IO function in a synchronous + thread when called. The callback takes two arguments that it passes as JSVal values to + the Haskell function. + Call 'releaseCallback' when done with the callback, freeing data referenced + by the function. + -} +syncCallback2 :: OnBlocked -- ^ what to do when the thread blocks + -> (JSVal -> JSVal -> IO ()) -- ^ the Haskell function + -> IO (Callback (JSVal -> JSVal -> IO ())) -- ^ the callback +syncCallback2 onBlocked x = js_syncCallbackApply (onBlocked == ContinueAsync) 2 (unsafeCoerce x) + +{- | Make a callback (JavaScript function) that runs the supplied IO function in a synchronous + thread when called. The callback takes three arguments that it passes as JSVal values to + the Haskell function. + Call 'releaseCallback' when done with the callback, freeing data referenced + by the function. + -} +syncCallback3 :: OnBlocked -- ^ what to do when the thread blocks + -> (JSVal -> JSVal -> JSVal -> IO ()) -- ^ the Haskell function + -> IO (Callback (JSVal -> JSVal -> JSVal -> IO ())) -- ^ the callback +syncCallback3 onBlocked x = js_syncCallbackApply (onBlocked == ContinueAsync) 3 (unsafeCoerce x) + +{- | Make a callback (JavaScript function) that runs the supplied IO action in a synchronous + thread when called. + Call 'releaseCallback' when done with the callback, freeing memory referenced + by the IO action. + -} +syncCallback' :: IO JSVal + -> IO (Callback (IO JSVal)) +syncCallback' x = js_syncCallbackReturn (unsafeCoerce x) + +syncCallback1' :: (JSVal -> IO JSVal) + -> IO (Callback (JSVal -> IO JSVal)) +syncCallback1' x = js_syncCallbackApplyReturn 1 (unsafeCoerce x) + +syncCallback2' :: (JSVal -> JSVal -> IO JSVal) + -> IO (Callback (JSVal -> JSVal -> IO JSVal)) +syncCallback2' x = js_syncCallbackApplyReturn 2 (unsafeCoerce x) + +syncCallback3' :: (JSVal -> JSVal -> JSVal -> IO JSVal) + -> IO (Callback (JSVal -> JSVal -> JSVal -> IO JSVal)) +syncCallback3' x = js_syncCallbackApplyReturn 3 (unsafeCoerce x) + +{- | Make a callback (JavaScript function) that runs the supplied IO action in an asynchronous + thread when called. + Call 'releaseCallback' when done with the callback, freeing data referenced + by the IO action. + -} +asyncCallback :: IO () -- ^ the action that the callback runs + -> IO (Callback (IO ())) -- ^ the callback +asyncCallback x = js_asyncCallback (unsafeCoerce x) + +asyncCallback1 :: (JSVal -> IO ()) -- ^ the function that the callback calls + -> IO (Callback (JSVal -> IO ())) -- ^ the calback +asyncCallback1 x = js_asyncCallbackApply 1 (unsafeCoerce x) + +asyncCallback2 :: (JSVal -> JSVal -> IO ()) -- ^ the Haskell function that the callback calls + -> IO (Callback (JSVal -> JSVal -> IO ())) -- ^ the callback +asyncCallback2 x = js_asyncCallbackApply 2 (unsafeCoerce x) + +asyncCallback3 :: (JSVal -> JSVal -> JSVal -> IO ()) -- ^ the Haskell function that the callback calls + -> IO (Callback (JSVal -> JSVal -> JSVal -> IO ())) -- ^ the callback +asyncCallback3 x = js_asyncCallbackApply 3 (unsafeCoerce x) + +-- ---------------------------------------------------------------------------- + +foreign import javascript unsafe "(($1, $2) => { return h$makeCallback(h$runSync, [$1], $2); })" + js_syncCallback :: Bool -> Exts.Any -> IO (Callback (IO b)) +foreign import javascript unsafe "(($1) => { return h$makeCallback(h$run, [], $1); })" + js_asyncCallback :: Exts.Any -> IO (Callback (IO b)) +foreign import javascript unsafe "(($1) => { return h$makeCallback(h$runSyncReturn, [false], $1); })" + js_syncCallbackReturn :: Exts.Any -> IO (Callback (IO JSVal)) + +foreign import javascript unsafe "(($1, $2, $3) => { return h$makeCallbackApply($2, h$runSync, [$1], $3); })" + js_syncCallbackApply :: Bool -> Int -> Exts.Any -> IO (Callback b) +foreign import javascript unsafe "(($1, $2) => { return h$makeCallbackApply($1, h$run, [], $2); })" + js_asyncCallbackApply :: Int -> Exts.Any -> IO (Callback b) +foreign import javascript unsafe "(($1, $2) => { return h$makeCallbackApply($1, h$runSyncReturn, [false], $2); })" + js_syncCallbackApplyReturn :: Int -> Exts.Any -> IO (Callback b) + +foreign import javascript unsafe "(($1) => { return h$release($1); })" + js_release :: Callback a -> IO () diff --git a/libraries/base/GHC/JS/Prim.hs b/libraries/base/GHC/JS/Prim.hs index 955cadf328..c8160a93c8 100644 --- a/libraries/base/GHC/JS/Prim.hs +++ b/libraries/base/GHC/JS/Prim.hs @@ -277,13 +277,13 @@ foreign import javascript unsafe "(($1) => { return ($1 === null); })" foreign import javascript unsafe "(($1) => { return ($1 === undefined); })" js_isUndefined :: JSVal -> Bool -foreign import javascript unsafe "(($1) => { return ($r = typeof($1) === 'number' ? ($1|0) : 0;); })" +foreign import javascript unsafe "(($1) => { return (typeof($1) === 'number' ? ($1|0) : 0); })" js_fromJSInt :: JSVal -> Int -foreign import javascript unsafe "(($1) => { return ($r = $1;); })" +foreign import javascript unsafe "(($1) => { return $1; })" js_toJSInt :: Int -> JSVal -foreign import javascript unsafe "$r = null;" +foreign import javascript unsafe "(() => { return null; })" js_null :: JSVal foreign import javascript unsafe "(($1,$2) => { return $1[h$fromHsString($2)]; })" @@ -307,7 +307,6 @@ foreign import javascript unsafe "(($1,$2_1,$2_2) => { return $1[h$decodeUtf8z($ foreign import javascript unsafe "(($1_1,$1_2) => { return h$decodeUtf8z($1_1, $1_2); })" js_unpackJSStringUtf8## :: Addr# -> State# s -> (# State# s, JSVal# #) - foreign import javascript unsafe "(($1_1, $1_2) => { return h$decodeUtf8z($1_1,$1_2); })" js_unsafeUnpackJSStringUtf8## :: Addr# -> JSVal# diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index fa329b9213..2cde69b3df 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -475,6 +475,7 @@ Library GHC.JS.Prim GHC.JS.Prim.Internal GHC.JS.Prim.Internal.Build + GHC.JS.Foreign.Callback -- We need to set the unit id to base (without a version number) -- as it's magic. diff --git a/testsuite/tests/javascript/all.T b/testsuite/tests/javascript/all.T index 6ff2a7818a..3da7759da5 100644 --- a/testsuite/tests/javascript/all.T +++ b/testsuite/tests/javascript/all.T @@ -2,3 +2,16 @@ setTestOpts(when(not(js_arch()),skip)) test('T23101', normal, compile_and_run, ['']) + +test('js-ffi-int', normal, compile_and_run, ['']) +test('js-ffi-string', normal, compile_and_run, ['']) +test('js-ffi-null', normal, compile_and_run, ['']) +test('js-ffi-isNull', normal, compile_and_run, ['']) +test('js-ffi-isUndefined', normal, compile_and_run, ['']) +test('js-ffi-array', normal, compile_and_run, ['']) + +test('js-callback01', normal, compile_and_run, ['']) +test('js-callback02', normal, compile_and_run, ['']) +test('js-callback03', normal, compile_and_run, ['']) +test('js-callback04', js_skip, compile_and_run, ['']) +test('js-callback05', js_skip, compile_and_run, ['']) diff --git a/testsuite/tests/javascript/js-callback01.hs b/testsuite/tests/javascript/js-callback01.hs new file mode 100644 index 0000000000..df5c990e07 --- /dev/null +++ b/testsuite/tests/javascript/js-callback01.hs @@ -0,0 +1,51 @@ +import GHC.JS.Prim +import GHC.JS.Foreign.Callback +import Control.Concurrent + +foreign import javascript "(() => { console.log('test'); })" + js_log0 :: IO () + +foreign import javascript "((x) => { console.log(x); })" + js_log1 :: JSVal -> IO () + +foreign import javascript "((x,y) => { console.log(x); console.log(y); })" + js_log2 :: JSVal -> JSVal -> IO () + +foreign import javascript "((x,y,z) => { console.log(x); console.log(y); console.log(z); })" + js_log3 :: JSVal -> JSVal -> JSVal -> IO () + +foreign import javascript "((f) => { f(); })" + js_apply0_ :: Callback (IO ()) -> IO () + +foreign import javascript "((f,x) => { f(x); })" + js_apply1_ :: Callback (JSVal -> IO ()) -> JSVal -> IO () + +foreign import javascript "((f,x,y) => { f(x,y); })" + js_apply2_ :: Callback (JSVal -> JSVal -> IO ()) -> JSVal -> JSVal -> IO () + +foreign import javascript "((f,x,y,z) => { f(x,y,z); })" + js_apply3_ :: Callback (JSVal -> JSVal -> JSVal -> IO ()) -> JSVal -> JSVal -> JSVal -> IO () + +main :: IO () +main = do + log0 <- syncCallback ThrowWouldBlock js_log0 + log1 <- syncCallback1 ThrowWouldBlock js_log1 + log2 <- syncCallback2 ThrowWouldBlock js_log2 + log3 <- syncCallback3 ThrowWouldBlock js_log3 + + js_apply0_ log0 + js_apply1_ log1 (toJSString "test1x") + js_apply2_ log2 (toJSString "test2x") (toJSString "test2y") + js_apply3_ log3 (toJSString "test3x") (toJSString "test3y") (toJSString "test3z") + + log0' <- asyncCallback js_log0 + log1' <- asyncCallback1 js_log1 + log2' <- asyncCallback2 js_log2 + log3' <- asyncCallback3 js_log3 + + js_apply0_ log0' + js_apply1_ log1' (toJSString "test") + js_apply2_ log2' (toJSString "test") (toJSString "test") + js_apply3_ log3' (toJSString "test") (toJSString "test") (toJSString "test") + + threadDelay 1000000 -- Wait long enough for the async actions to complete diff --git a/testsuite/tests/javascript/js-callback01.stdout b/testsuite/tests/javascript/js-callback01.stdout new file mode 100644 index 0000000000..7726baf6a4 --- /dev/null +++ b/testsuite/tests/javascript/js-callback01.stdout @@ -0,0 +1,14 @@ +test +test1x +test2x +test2y +test3x +test3y +test3z +test +test +test +test +test +test +test diff --git a/testsuite/tests/javascript/js-callback02.hs b/testsuite/tests/javascript/js-callback02.hs new file mode 100644 index 0000000000..3fc8896f54 --- /dev/null +++ b/testsuite/tests/javascript/js-callback02.hs @@ -0,0 +1,42 @@ +import GHC.JS.Prim +import GHC.JS.Foreign.Callback + +foreign import javascript "(() => { return 1; })" + plus_one0 :: IO JSVal + +foreign import javascript "((x) => { return x + 1; })" + plus_one1 :: JSVal -> IO JSVal + +foreign import javascript "((x,y) => { return x + y + 1; })" + plus_one2 :: JSVal -> JSVal -> IO JSVal + +foreign import javascript "((x,y,z) => { return x + y + z + 1; })" + plus_one3 :: JSVal -> JSVal -> JSVal -> IO JSVal + +foreign import javascript "((f) => { return f(); })" + js_apply0 :: Callback (IO JSVal) -> IO JSVal + +foreign import javascript "((f,x) => { return f(x); })" + js_apply1 :: Callback (JSVal -> IO JSVal) -> JSVal -> IO JSVal + +foreign import javascript "((f,x,y) => { return f(x,y); })" + js_apply2 :: Callback (JSVal -> JSVal -> IO JSVal) -> JSVal -> JSVal -> IO JSVal + +foreign import javascript "((f,x,y,z) => { return f(x,y,z); })" + js_apply3 :: Callback (JSVal -> JSVal -> JSVal -> IO JSVal) -> JSVal -> JSVal -> JSVal -> IO JSVal + +logJSInt :: JSVal -> IO () +logJSInt = print . fromJSInt + +main :: IO () +main = do + plusOne0 <- syncCallback' plus_one0 + plusOne1 <- syncCallback1' plus_one1 + plusOne2 <- syncCallback2' plus_one2 + plusOne3 <- syncCallback3' plus_one3 + + logJSInt =<< js_apply0 plusOne0 + logJSInt =<< js_apply1 plusOne1 (toJSInt 2) + logJSInt =<< js_apply2 plusOne2 (toJSInt 2) (toJSInt 3) + logJSInt =<< js_apply3 plusOne3 (toJSInt 2) (toJSInt 3) (toJSInt 4) + diff --git a/testsuite/tests/javascript/js-callback02.stdout b/testsuite/tests/javascript/js-callback02.stdout new file mode 100644 index 0000000000..a49c6e7eba --- /dev/null +++ b/testsuite/tests/javascript/js-callback02.stdout @@ -0,0 +1,4 @@ +1 +3 +6 +10 diff --git a/testsuite/tests/javascript/js-callback03.hs b/testsuite/tests/javascript/js-callback03.hs new file mode 100644 index 0000000000..311c2634f4 --- /dev/null +++ b/testsuite/tests/javascript/js-callback03.hs @@ -0,0 +1,33 @@ +import GHC.JS.Prim +import GHC.JS.Foreign.Callback + +foreign import javascript "((f) => { globalF = f; })" + setF :: Callback (JSVal -> IO ()) -> IO () + +foreign import javascript "((x) => { globalF(x); })" + callF :: JSVal -> IO () + +foreign import javascript "((x,y) => { return x + y })" + js_plus :: JSVal -> JSVal -> IO JSVal + +foreign import javascript "((g) => { globalG = g; })" + setG :: Callback (JSVal -> JSVal -> IO JSVal) -> IO () + +foreign import javascript "((x,y) => { return globalG(x,y); })" + callG :: JSVal -> JSVal -> IO JSVal + +main :: IO () +main = do + -- Set functions globally on the JavaScript side, to be accessed in regular JavaScript code + f <- syncCallback1 ThrowWouldBlock (\x -> if isNull x then putStrLn "isNull" else putStrLn "isNotNull") + g <- syncCallback2' js_plus + setF f + setG g + + -- Do other things before using the globally-set functions + putStrLn "test" + + -- Use the globally-set functions + callF jsNull + callF $ toJSString "" + print . fromJSInt =<< callG (toJSInt 1) (toJSInt 2) diff --git a/testsuite/tests/javascript/js-callback03.stdout b/testsuite/tests/javascript/js-callback03.stdout new file mode 100644 index 0000000000..cbce6a410b --- /dev/null +++ b/testsuite/tests/javascript/js-callback03.stdout @@ -0,0 +1,4 @@ +test +isNull +isNotNull +3 diff --git a/testsuite/tests/javascript/js-callback04.hs b/testsuite/tests/javascript/js-callback04.hs new file mode 100644 index 0000000000..0aaffabc19 --- /dev/null +++ b/testsuite/tests/javascript/js-callback04.hs @@ -0,0 +1,16 @@ +import GHC.JS.Prim +import GHC.JS.Foreign.Callback + +foreign import javascript "(() => { console.log('javascript'); })" + js_log :: IO () + +foreign import javascript "((f) => { f(); })" + js_apply0_ :: Callback (IO ()) -> IO () + +main :: IO () +main = do + logH <- syncCallback ThrowWouldBlock (putStrLn "haskell") + logJ <- syncCallback ThrowWouldBlock js_log + + js_apply0_ logH + js_apply0_ logJ diff --git a/testsuite/tests/javascript/js-callback04.stdout b/testsuite/tests/javascript/js-callback04.stdout new file mode 100644 index 0000000000..175b931a71 --- /dev/null +++ b/testsuite/tests/javascript/js-callback04.stdout @@ -0,0 +1,2 @@ +haskell +javascript diff --git a/testsuite/tests/javascript/js-callback05.hs b/testsuite/tests/javascript/js-callback05.hs new file mode 100644 index 0000000000..075b151b5c --- /dev/null +++ b/testsuite/tests/javascript/js-callback05.hs @@ -0,0 +1,19 @@ +import GHC.JS.Prim +import GHC.JS.Foreign.Callback +import System.IO + +foreign import javascript "((f) => { f(); })" + js_apply0_ :: Callback (IO ()) -> IO () + +main :: IO () +main = do + log <- syncCallback ThrowWouldBlock (putStrLn "test" >> hFlush stdout) + js_apply0_ log + js_apply0_ log + + log <- syncCallback ThrowWouldBlock (putStrLn "test1" >> hFlush stdout) + log <- syncCallback ThrowWouldBlock (putStrLn "test2" >> hFlush stdout) + log <- syncCallback ThrowWouldBlock (putStrLn "test3" >> hFlush stdout) + js_apply0_ log1 + js_apply0_ log2 + js_apply0_ log3 diff --git a/testsuite/tests/javascript/js-callback05.stdout b/testsuite/tests/javascript/js-callback05.stdout new file mode 100644 index 0000000000..105f88e833 --- /dev/null +++ b/testsuite/tests/javascript/js-callback05.stdout @@ -0,0 +1,5 @@ +test +test +test1 +test2 +test3 diff --git a/testsuite/tests/javascript/js-ffi-array.hs b/testsuite/tests/javascript/js-ffi-array.hs new file mode 100644 index 0000000000..00e1e80383 --- /dev/null +++ b/testsuite/tests/javascript/js-ffi-array.hs @@ -0,0 +1,18 @@ +import GHC.JS.Prim + +foreign import javascript "((xs) => { console.log(xs) })" + log_js :: JSVal -> IO () + +foreign import javascript "((xs,i) => { return xs[i]; })" + js_index :: JSVal -> JSVal -> JSVal + +foreign import javascript "(() => { return ['t','e','s','t']; })" + an_array :: JSVal + +main :: IO () +main = do + log_js =<< toJSArray [] + log_js =<< toJSArray [jsNull, toJSInt 0, toJSString "", toJSInt 1, toJSString "test", toJSInt 2] + xs <- toJSArray $ map toJSInt [1..10] + log_js $ js_index xs (toJSInt 3) + mapM_ log_js =<< fromJSArray an_array diff --git a/testsuite/tests/javascript/js-ffi-array.stdout b/testsuite/tests/javascript/js-ffi-array.stdout new file mode 100644 index 0000000000..463db3f694 --- /dev/null +++ b/testsuite/tests/javascript/js-ffi-array.stdout @@ -0,0 +1,7 @@ +[] +[ null, 0, '', 1, 'test', 2 ] +4 +t +e +s +t diff --git a/testsuite/tests/javascript/js-ffi-int.hs b/testsuite/tests/javascript/js-ffi-int.hs new file mode 100644 index 0000000000..bb2effce98 --- /dev/null +++ b/testsuite/tests/javascript/js-ffi-int.hs @@ -0,0 +1,16 @@ +import GHC.JS.Prim + +foreign import javascript "((x) => { console.log(x); })" + log_js_int :: JSVal -> IO () + +foreign import javascript "(() => { return 3; })" + an_int :: JSVal + +main :: IO () +main = do + log_js_int (toJSInt 0) + log_js_int (toJSInt 1) + log_js_int (toJSInt 2) + log_js_int an_int + print (fromJSInt an_int) + print (fromJSInt $ toJSInt 4) diff --git a/testsuite/tests/javascript/js-ffi-int.stdout b/testsuite/tests/javascript/js-ffi-int.stdout new file mode 100644 index 0000000000..ccbe3cc6c8 --- /dev/null +++ b/testsuite/tests/javascript/js-ffi-int.stdout @@ -0,0 +1,6 @@ +0 +1 +2 +3 +3 +4 diff --git a/testsuite/tests/javascript/js-ffi-isNull.hs b/testsuite/tests/javascript/js-ffi-isNull.hs new file mode 100644 index 0000000000..cfc6329ca0 --- /dev/null +++ b/testsuite/tests/javascript/js-ffi-isNull.hs @@ -0,0 +1,10 @@ +import GHC.JS.Prim + +main :: IO () +main = do + print (isNull jsNull) + print (isNull $ toJSString "") + print (isNull $ toJSString "test") + print (isNull $ toJSInt 0) + print (isNull $ toJSInt 1) + print (isNull $ toJSInt 2) diff --git a/testsuite/tests/javascript/js-ffi-isNull.stdout b/testsuite/tests/javascript/js-ffi-isNull.stdout new file mode 100644 index 0000000000..6928e2fc8f --- /dev/null +++ b/testsuite/tests/javascript/js-ffi-isNull.stdout @@ -0,0 +1,6 @@ +True +False +False +False +False +False diff --git a/testsuite/tests/javascript/js-ffi-isUndefined.hs b/testsuite/tests/javascript/js-ffi-isUndefined.hs new file mode 100644 index 0000000000..29511d0276 --- /dev/null +++ b/testsuite/tests/javascript/js-ffi-isUndefined.hs @@ -0,0 +1,13 @@ +import GHC.JS.Prim + +foreign import javascript "((x) => { return undefined; })" + js_undefined :: JSVal + +main :: IO () +main = do + print (isUndefined js_undefined) + print (isUndefined $ toJSString "") + print (isUndefined $ toJSString "test") + print (isUndefined $ toJSInt 0) + print (isUndefined $ toJSInt 1) + print (isUndefined $ toJSInt 2) diff --git a/testsuite/tests/javascript/js-ffi-isUndefined.stdout b/testsuite/tests/javascript/js-ffi-isUndefined.stdout new file mode 100644 index 0000000000..6928e2fc8f --- /dev/null +++ b/testsuite/tests/javascript/js-ffi-isUndefined.stdout @@ -0,0 +1,6 @@ +True +False +False +False +False +False diff --git a/testsuite/tests/javascript/js-ffi-null.hs b/testsuite/tests/javascript/js-ffi-null.hs new file mode 100644 index 0000000000..3724ef7e44 --- /dev/null +++ b/testsuite/tests/javascript/js-ffi-null.hs @@ -0,0 +1,7 @@ +import GHC.JS.Prim + +foreign import javascript "((x) => { console.log(x); })" + log_null :: JSVal -> IO () + +main :: IO () +main = log_null jsNull diff --git a/testsuite/tests/javascript/js-ffi-null.stdout b/testsuite/tests/javascript/js-ffi-null.stdout new file mode 100644 index 0000000000..19765bd501 --- /dev/null +++ b/testsuite/tests/javascript/js-ffi-null.stdout @@ -0,0 +1 @@ +null diff --git a/testsuite/tests/javascript/js-ffi-string.hs b/testsuite/tests/javascript/js-ffi-string.hs new file mode 100644 index 0000000000..9e9931e85f --- /dev/null +++ b/testsuite/tests/javascript/js-ffi-string.hs @@ -0,0 +1,13 @@ +import GHC.JS.Prim + +foreign import javascript "((x) => { console.log(x); })" + log_js_string :: JSVal -> IO () + +foreign import javascript "(() => { return 'a string'; })" + a_string :: JSVal + +main :: IO () +main = do + log_js_string (toJSString "test") + putStrLn (fromJSString a_string) + putStrLn (fromJSString $ toJSString "test") diff --git a/testsuite/tests/javascript/js-ffi-string.stdout b/testsuite/tests/javascript/js-ffi-string.stdout new file mode 100644 index 0000000000..9e68839698 --- /dev/null +++ b/testsuite/tests/javascript/js-ffi-string.stdout @@ -0,0 +1,3 @@ +test +a string +test |