Skip to content

New syntax support, backwards compat cpp for ghcjs #757

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
dmjio merged 5 commits into from
Feb 10, 2025
Merged

New syntax support, backwards compat cpp for ghcjs #757

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
c95686a
threejs example: Use new JS backend syntax
sevanspowell May 3, 2024
a55e940
canvas2d example: Use new JS backend syntax
sevanspowell May 3, 2024
06d7c3c
canvas2d example: Fix broken image links
sevanspowell May 3, 2024
bb79537
file-reader example: Use new JS backend syntax
sevanspowell May 3, 2024
f715944
Add CPP for backwards compatabililty.
dmjio Feb 9, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
33 changes: 30 additions & 3 deletions examples/canvas2d/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
Expand All @@ -19,9 +20,9 @@ data Action
main :: IO ()
main = do
[sun, moon, earth] <- replicateM 3 newImage
setSrc sun "https://mdn.mozillademos.org/files/1456/Canvas_sun.png"
setSrc moon "https://mdn.mozillademos.org/files/1443/Canvas_moon.png"
setSrc earth "https://mdn.mozillademos.org/files/1429/Canvas_earth.png"
setSrc sun "https://7b40c187-5088-4a99-9118-37d20a2f875e.mdnplay.dev/en-US/docs/Web/API/Canvas_API/Tutorial/Basic_animations/canvas_sun.png"
setSrc moon "https://7b40c187-5088-4a99-9118-37d20a2f875e.mdnplay.dev/en-US/docs/Web/API/Canvas_API/Tutorial/Basic_animations/canvas_moon.png"
setSrc earth "https://7b40c187-5088-4a99-9118-37d20a2f875e.mdnplay.dev/en-US/docs/Web/API/Canvas_API/Tutorial/Basic_animations/canvas_earth.png"
startApp App { initialAction = GetTime
, update = updateModel (sun,moon,earth)
, ..
Expand Down Expand Up @@ -70,6 +71,31 @@ updateModel (sun,moon,earth) (SetTime m@(secs,millis)) _ = m <# do
drawImage sun 0 0 300 300 ctx
pure GetTime

#ifndef ghcjs_HOST_OS
foreign import javascript unsafe "((x) => { x.globalCompositeOperation = 'destination-over'; })"
setGlobalCompositeOperation :: Context -> IO ()

foreign import javascript unsafe "((x, y, z, w) => { w.drawImage(x,y,z); })"
drawImage' :: Image -> Double -> Double -> Context -> IO ()

foreign import javascript unsafe "(() => { return document.getElementById('canvas').getContext('2d'); })"
getCtx :: IO Context

foreign import javascript unsafe "(() => { return new Image(); })"
newImage :: IO Image

foreign import javascript unsafe "((x, y) => { x.src = y; })"
setSrc :: Image -> MisoString -> IO ()

foreign import javascript unsafe "(() => { return new Date(); })"
newDate :: IO JSVal

foreign import javascript unsafe "((x) => { return x.getSeconds(); })"
getSecs :: JSVal -> IO Double

foreign import javascript unsafe "((x) => { return x.getMilliseconds(); })"
getMillis :: JSVal -> IO Double
#else
foreign import javascript unsafe "$1.globalCompositeOperation = 'destination-over';"
setGlobalCompositeOperation :: Context -> IO ()

Expand All @@ -93,4 +119,5 @@ foreign import javascript unsafe "$r = $1.getSeconds();"

foreign import javascript unsafe "$r = $1.getMilliseconds();"
getMillis :: JSVal -> IO Double
#endif

22 changes: 22 additions & 0 deletions examples/file-reader/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
Expand All @@ -12,7 +13,11 @@ import Miso.String
import Control.Concurrent.MVar

import GHCJS.Types
#ifndef ghcjs_HOST_OS
import GHC.JS.Foreign.Callback
#else
import GHCJS.Foreign.Callback
#endif

-- | Model
data Model
Expand Down Expand Up @@ -71,6 +76,22 @@ viewModel Model {..} = view
, div_ [] [ text info ]
]

#ifndef ghcjs_HOST_OS
Copy link
Contributor

@alexfmpe alexfmpe Feb 10, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@dmjio
This is defined both for ghcjs and ghc's js backend.
You want something like this
https://github.com/ghcjs/jsaddle/blob/b72b4d01fdc186d2c7447beb7273ad13358ff593/jsaddle/src/Language/Javascript/JSaddle/Exception.hs#L21-L29

Copy link
Owner Author

@dmjio dmjio Feb 10, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@alexfmpe where do you see ghcjs_HOST_OS defined for the new JS backend?

Also, have people on both GHCJS and on >= GHC 9.0.0, so this might explain some issues I was seeing.

Copy link
Owner Author

@dmjio dmjio Feb 10, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

https://github.com/ghc/ghc/blob/master/testsuite/tests/javascript/T23346.hs

Copy link
Contributor

@alexfmpe alexfmpe Feb 10, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@alexfmpe where do you see ghcjs_HOST_OS defined for the new JS backend?

Hmm? AFAICT cabal considers it os(ghcjs) for both old ghcjs and new js backend https://hackage.haskell.org/package/Cabal-syntax-3.14.1.0/docs/Distribution-System.html#v:Ghcjs
unlike impl(ghcjs)
https://hackage.haskell.org/package/Cabal-syntax-3.14.1.0/docs/Distribution-Compiler.html#v:GHCJS

Copy link
Owner Author

@dmjio dmjio Feb 10, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

#759

foreign import javascript unsafe "(() => { return new FileReader(); })"
newReader :: IO JSVal

foreign import javascript unsafe "((x) => { return x.files[0]; })"
getFile :: JSVal -> IO JSVal

foreign import javascript unsafe "((x, y) => { x.onload = y; })"
setOnLoad :: JSVal -> Callback (IO ()) -> IO ()

foreign import javascript unsafe "((x) => { return x.result; })"
getResult :: JSVal -> IO MisoString

foreign import javascript unsafe "((x, y) => { x.readAsText(y); })"
readText :: JSVal -> JSVal -> IO ()
#else
foreign import javascript unsafe "$r = new FileReader();"
newReader :: IO JSVal

Expand All @@ -85,3 +106,4 @@ foreign import javascript unsafe "$r = $1.result;"

foreign import javascript unsafe "$1.readAsText($2);"
readText :: JSVal -> JSVal -> IO ()
#endif
57 changes: 57 additions & 0 deletions examples/three/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Main where
Expand Down Expand Up @@ -97,6 +98,61 @@ updateModel ref GetTime m = m <# do
updateModel _ (SetTime m) _ =
m <# pure GetTime

#ifndef ghcjs_HOST_OS
foreign import javascript unsafe "(() => { return new Stats(); })"
newStats :: IO JSVal

foreign import javascript unsafe "((x) => { x.begin(); })"
statsBegin :: JSVal -> IO ()

foreign import javascript unsafe "((x) => { x.end(); })"
statsEnd :: JSVal -> IO ()

foreign import javascript unsafe "((x) => { x.showPanel(0); })"
showPanel :: JSVal -> IO ()

foreign import javascript unsafe "(() => { return new THREE.Scene();})"
newScene :: IO JSVal

foreign import javascript unsafe "((x,y,z) => { return new THREE.BoxGeometry(x,y,z); })"
newBoxGeometry :: Int -> Int -> Int -> IO JSVal

foreign import javascript unsafe "(() => { return new THREE.PerspectiveCamera( 75, window.innerWidth/window.innerHeight, 0.1, 1000 ); })"
newCamera :: IO JSVal

foreign import javascript unsafe "((x,y) => { return new THREE.Mesh( x, y ); })"
newMesh :: JSVal -> JSVal -> IO JSVal

foreign import javascript unsafe "(() => { return new THREE.MeshBasicMaterial( { color: 0x00ff00 } ); })"
newMeshBasicMaterial :: IO JSVal

foreign import javascript unsafe "((x) => { return new THREE.WebGLRenderer({canvas:x, antialias : true}); })"
newRenderer :: JSVal -> IO JSVal

foreign import javascript unsafe "((x) => { x.setSize( window.innerWidth, window.innerHeight ); })"
setSize :: JSVal -> IO ()

foreign import javascript unsafe "((x, y) => { x.add(y); })"
addToScene :: JSVal -> JSVal -> IO ()

foreign import javascript unsafe "((x, y) => { x.position.z = y; })"
cameraZ :: JSVal -> Int -> IO ()

foreign import javascript unsafe "((a, y) => { a.rotation.x += y; })"
rotateX :: JSVal -> Double -> IO ()

foreign import javascript unsafe "((x, a) => { x.rotation.y += a; })"
rotateY :: JSVal -> Double -> IO ()

foreign import javascript unsafe "((x, y, z) => { x.render(y, z); })"
render :: JSVal -> JSVal -> JSVal -> IO ()

foreign import javascript unsafe "((x, y) => { x.position.z = y; })"
positionCamera :: JSVal -> Double -> IO ()

foreign import javascript unsafe "((x, y) => { x.appendChild( y.domElement ); })"
addStatsToDOM :: JSVal -> JSVal -> IO ()
#else
foreign import javascript unsafe "$r = new Stats();"
newStats :: IO JSVal

Expand Down Expand Up @@ -150,3 +206,4 @@ foreign import javascript unsafe "$1.position.z = $2;"

foreign import javascript unsafe "$1.appendChild( $2.domElement );"
addStatsToDOM :: JSVal -> JSVal -> IO ()
#endif