[Git][ghc/ghc][master] Base/JS: GHC.JS.Foreign.Callback module (issue 23126)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Apr 13 12:51:30 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00
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 changed files:
- docs/users_guide/index.rst
- + docs/users_guide/javascript.rst
- + libraries/base/GHC/JS/Foreign/Callback.hs
- libraries/base/GHC/JS/Prim.hs
- libraries/base/base.cabal
- testsuite/tests/javascript/all.T
- + testsuite/tests/javascript/js-callback01.hs
- + testsuite/tests/javascript/js-callback01.stdout
- + testsuite/tests/javascript/js-callback02.hs
- + testsuite/tests/javascript/js-callback02.stdout
- + testsuite/tests/javascript/js-callback03.hs
- + testsuite/tests/javascript/js-callback03.stdout
- + testsuite/tests/javascript/js-callback04.hs
- + testsuite/tests/javascript/js-callback04.stdout
- + testsuite/tests/javascript/js-callback05.hs
- + testsuite/tests/javascript/js-callback05.stdout
- + testsuite/tests/javascript/js-ffi-array.hs
- + testsuite/tests/javascript/js-ffi-array.stdout
- + testsuite/tests/javascript/js-ffi-int.hs
- + testsuite/tests/javascript/js-ffi-int.stdout
- + testsuite/tests/javascript/js-ffi-isNull.hs
- + testsuite/tests/javascript/js-ffi-isNull.stdout
- + testsuite/tests/javascript/js-ffi-isUndefined.hs
- + testsuite/tests/javascript/js-ffi-isUndefined.stdout
- + testsuite/tests/javascript/js-ffi-null.hs
- + testsuite/tests/javascript/js-ffi-null.stdout
- + testsuite/tests/javascript/js-ffi-string.hs
- + testsuite/tests/javascript/js-ffi-string.stdout
Changes:
=====================================
docs/users_guide/index.rst
=====================================
@@ -23,6 +23,7 @@ Contents:
hints
utils
win32-dlls
+ javascript
wasm
bugs
eventlog-formats
=====================================
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.
+
=====================================
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 ()
=====================================
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#
=====================================
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.
=====================================
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, [''])
=====================================
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
=====================================
testsuite/tests/javascript/js-callback01.stdout
=====================================
@@ -0,0 +1,14 @@
+test
+test1x
+test2x
+test2y
+test3x
+test3y
+test3z
+test
+test
+test
+test
+test
+test
+test
=====================================
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)
+
=====================================
testsuite/tests/javascript/js-callback02.stdout
=====================================
@@ -0,0 +1,4 @@
+1
+3
+6
+10
=====================================
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)
=====================================
testsuite/tests/javascript/js-callback03.stdout
=====================================
@@ -0,0 +1,4 @@
+test
+isNull
+isNotNull
+3
=====================================
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
=====================================
testsuite/tests/javascript/js-callback04.stdout
=====================================
@@ -0,0 +1,2 @@
+haskell
+javascript
=====================================
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
=====================================
testsuite/tests/javascript/js-callback05.stdout
=====================================
@@ -0,0 +1,5 @@
+test
+test
+test1
+test2
+test3
=====================================
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
=====================================
testsuite/tests/javascript/js-ffi-array.stdout
=====================================
@@ -0,0 +1,7 @@
+[]
+[ null, 0, '', 1, 'test', 2 ]
+4
+t
+e
+s
+t
=====================================
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)
=====================================
testsuite/tests/javascript/js-ffi-int.stdout
=====================================
@@ -0,0 +1,6 @@
+0
+1
+2
+3
+3
+4
=====================================
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)
=====================================
testsuite/tests/javascript/js-ffi-isNull.stdout
=====================================
@@ -0,0 +1,6 @@
+True
+False
+False
+False
+False
+False
=====================================
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)
=====================================
testsuite/tests/javascript/js-ffi-isUndefined.stdout
=====================================
@@ -0,0 +1,6 @@
+True
+False
+False
+False
+False
+False
=====================================
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
=====================================
testsuite/tests/javascript/js-ffi-null.stdout
=====================================
@@ -0,0 +1 @@
+null
=====================================
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")
=====================================
testsuite/tests/javascript/js-ffi-string.stdout
=====================================
@@ -0,0 +1,3 @@
+test
+a string
+test
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/27d2978e5412f2bef4448e208182a03137dd5ee8
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/27d2978e5412f2bef4448e208182a03137dd5ee8
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230413/6d7a53fd/attachment-0001.html>
More information about the ghc-commits
mailing list