From 14a29ade5424aa6059dfdfebfb7d93669f928b58 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Thu, 17 Oct 2024 14:19:21 +0100 Subject: [PATCH 1/4] Make examples runnable with `jsaddle-warp` --- app/App.hs | 9 ++++++++- app/Main.hs | 24 ++++++++++++++++++++++++ app/XHR.hs | 16 ++++++++++++++-- ghc-wasm-miso-examples.cabal | 8 +++++--- 4 files changed, 51 insertions(+), 6 deletions(-) diff --git a/app/App.hs b/app/App.hs index 0bac028..3236b6e 100644 --- a/app/App.hs +++ b/app/App.hs @@ -1,7 +1,14 @@ +{-# LANGUAGE CPP #-} + module App (start) where +#ifdef wasi_HOST_OS import GHC.Wasm.Prim import Language.Javascript.JSaddle (JSM) +#else +import Language.Javascript.JSaddle +#endif + import SimpleCounter qualified import Snake qualified import TodoMVC qualified @@ -10,7 +17,7 @@ import XHR qualified start :: JSString -> JSM () start e = - case fromJSString e of + case fromJSString e :: String of "simplecounter" -> SimpleCounter.start "snake" -> Snake.start "todomvc" -> TodoMVC.start diff --git a/app/Main.hs b/app/Main.hs index 3f1a49c..e77363e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE CPP #-} + +#ifdef wasi_HOST_OS + module MyMain (main) where import App (start) @@ -8,3 +12,23 @@ foreign export javascript "hs_start" main :: JSString -> IO () main :: JSString -> IO () main e = JSaddle.Wasm.run $ start e + +#else + +module Main (main) where + +import App (start) +import Language.Javascript.JSaddle +import Language.Javascript.JSaddle.Warp +import Network.Wai.Handler.Warp +import Network.WebSockets +import System.Environment + +main :: IO () +main = getArgs >>= \case + [arg] -> runSettings (setPort 8000 defaultSettings) + =<< jsaddleOr defaultConnectionOptions (start $ toJSString arg) + jsaddleApp + _ -> fail "bad args: specify an example, e.g. 2048" + +#endif diff --git a/app/XHR.hs b/app/XHR.hs index c26e4ac..8ea38a6 100644 --- a/app/XHR.hs +++ b/app/XHR.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-} @@ -9,13 +10,19 @@ module XHR (start) where -- slightly adapted from https://github.com/dmjio/miso/blob/master/examples/xhr/Main.hs +#ifdef wasi_HOST_OS +import GHC.Wasm.Prim +#else +import Data.JSString (JSString) +import Language.Javascript.JSaddle (fromJSString, toJSString) +#endif + import Control.Monad.IO.Class import Data.Aeson import qualified Data.Map as M import Data.Maybe import qualified Data.Text as T import GHC.Generics -import GHC.Wasm.Prim import Miso hiding (defaultOptions) import Miso.String @@ -135,14 +142,19 @@ instance FromJSON APIInfo where getGitHubAPIInfo :: JSM APIInfo getGitHubAPIInfo = do resp <- liftIO $ - T.pack . fromJSString <$> js_fetch (toJSString "https://api.github.com") + T.pack . fromJSString <$> js_fetch (toJSString ("https://api.github.com" :: String)) case eitherDecodeStrictText resp :: Either String APIInfo of Left s -> error s Right j -> pure j +#ifdef wasi_HOST_OS -- We use the WASM JS FFI here to access the more modern fetch API. If you want -- your code to eg also work when compiling with non-cross GHC and using -- jsaddle-warp, you can use fetch or XMLHttpRequest via JSaddle, for example -- via ghcjs-dom, servant-jsaddle or servant-client-js. foreign import javascript safe "const r = await fetch($1); return r.text();" js_fetch :: JSString -> IO JSString +#else +js_fetch :: JSString -> IO JSString +js_fetch = error "not implemented" +#endif diff --git a/ghc-wasm-miso-examples.cabal b/ghc-wasm-miso-examples.cabal index d8e3fe1..4b98b3d 100644 --- a/ghc-wasm-miso-examples.cabal +++ b/ghc-wasm-miso-examples.cabal @@ -8,10 +8,8 @@ executable ghc-wasm-miso-examples , aeson , base , containers - , ghc-experimental , hs2048 , jsaddle - , jsaddle-wasm , miso , mtl , random @@ -26,4 +24,8 @@ executable ghc-wasm-miso-examples Snake TodoMVC XHR - ghc-options: -no-hs-main -optl-mexec-model=reactor "-optl-Wl,--export=hs_start" + if arch(wasm32) + build-depends: ghc-experimental, jsaddle-wasm + ghc-options: -no-hs-main -optl-mexec-model=reactor "-optl-Wl,--export=hs_start" + else + build-depends: jsaddle-warp, warp, websockets From 691f1260c58ba857c639e8200df2f5283494b2d8 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Tue, 26 Nov 2024 01:33:39 +0000 Subject: [PATCH 2/4] Use latest Miso All previous versions are broken, especially without Hackage revisions to add bounds: https://github.com/dmjio/miso/pull/752. --- cabal.project | 2 +- ghc-wasm-miso-examples.cabal | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index 17bd992..b81c139 100644 --- a/cabal.project +++ b/cabal.project @@ -1,6 +1,6 @@ packages: . hs2048 -index-state: 2024-10-26T13:27:42Z +index-state: 2024-11-25T21:40:33Z if arch(wasm32) -- Required for TemplateHaskell. When using wasm32-wasi-cabal from diff --git a/ghc-wasm-miso-examples.cabal b/ghc-wasm-miso-examples.cabal index 4b98b3d..570a503 100644 --- a/ghc-wasm-miso-examples.cabal +++ b/ghc-wasm-miso-examples.cabal @@ -11,6 +11,7 @@ executable ghc-wasm-miso-examples , hs2048 , jsaddle , miso + , miso >= 1.8.5.0 , mtl , random , text From d482b0632417ee230e0e978d189fe8aa4276338e Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 27 Nov 2024 12:00:49 +0000 Subject: [PATCH 3/4] WIP - support assets including stylesheets --- app/App.hs | 48 +++++++++++++++++++++++----- app/Main.hs | 61 ++++++++++++++++++++++++++++++------ cabal.project | 8 +++++ ghc-wasm-miso-examples.cabal | 2 +- 4 files changed, 100 insertions(+), 19 deletions(-) diff --git a/app/App.hs b/app/App.hs index 3236b6e..c6b9f0d 100644 --- a/app/App.hs +++ b/app/App.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} -module App (start) where +module App (start, App(..)) where #ifdef wasi_HOST_OS import GHC.Wasm.Prim @@ -9,18 +9,50 @@ import Language.Javascript.JSaddle (JSM) import Language.Javascript.JSaddle #endif +import Data.Text.Lazy (Text) import SimpleCounter qualified import Snake qualified import TodoMVC qualified import TwoZeroFourEight qualified import XHR qualified -start :: JSString -> JSM () +data App = App + { name :: Text + , stylesheets :: [Text] + , app :: JSM () + } + +start :: JSString -> App start e = case fromJSString e :: String of - "simplecounter" -> SimpleCounter.start - "snake" -> Snake.start - "todomvc" -> TodoMVC.start - "xhr" -> XHR.start - "2048" -> TwoZeroFourEight.start - _ -> fail "unknown example" + "simplecounter" -> + App + { name = "SimpleCounter" + , stylesheets = [] + , app = SimpleCounter.start + } + "snake" -> + App + { name = "Snake" + , stylesheets = [] + , app = Snake.start + } + "todomvc" -> + App + { name = "TodoMVC" + , stylesheets = ["todomvc/base.css", "todomvc/index.css"] + , app = TodoMVC.start + } + "xhr" -> + App + { name = "XHR" + , stylesheets = [] + , app = XHR.start + } + "2048" -> + App + { name = "TwoZeroFourEight" + , stylesheets = ["2048/main.css"] + , app = TwoZeroFourEight.start + } + _ -> error "unknown example" diff --git a/app/Main.hs b/app/Main.hs index e77363e..77975f6 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,34 +1,75 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedRecordDot #-} #ifdef wasi_HOST_OS module MyMain (main) where -import App (start) +import App import GHC.Wasm.Prim import Language.Javascript.JSaddle.Wasm qualified as JSaddle.Wasm foreign export javascript "hs_start" main :: JSString -> IO () main :: JSString -> IO () -main e = JSaddle.Wasm.run $ start e +main e = JSaddle.Wasm.run (start e).app #else module Main (main) where -import App (start) +import App +import Data.Text.Lazy qualified as T +import Data.Text.Lazy.Encoding (encodeUtf8) import Language.Javascript.JSaddle import Language.Javascript.JSaddle.Warp -import Network.Wai.Handler.Warp -import Network.WebSockets +import Network.Wai.Application.Static import System.Environment +{- TODO +work out how to live-reload on changes to stylesheet +maybe don't use `dist` version... +maybe just a matter of passing right flag to GHCID? +in theory I shouldn't even need to do that - just force a page refresh +is that something we can hook in to? + +open jsaddle PR and use it here as a SRP + +punt: +somehow DRY to match static HTML files +-} main :: IO () -main = getArgs >>= \case - [arg] -> runSettings (setPort 8000 defaultSettings) - =<< jsaddleOr defaultConnectionOptions (start $ toJSString arg) - jsaddleApp - _ -> fail "bad args: specify an example, e.g. 2048" +main = + getArgs >>= \case + -- Note that `debug` works with `cabal repl` but not `cabal run`. + -- The best workflow is to run `ghcid -c "cabal repl ghc-wasm-miso-examples" -W -T ':main primer'`. + [arg] -> + let app = + start + -- "2048" + (toJSString arg) + -- we can't use multiline syntax alongside CPP... + -- "\n\ + -- \\n\ + -- \2048 | Miso example via GHC WASM\n\ + -- \\n\ + -- \" + header = + encodeUtf8 $ + T.unlines $ + [ "" <> app.name <> "" + ] + <> map + (\s -> "") + app.stylesheets + in + -- can't work out how to get non-`debug` version working + -- but I think I prefer this anyway + debugOr + (Just header) + 8000 + app.app + (staticApp (defaultWebAppSettings "frontend/dist")) + _ -> fail "bad args: specify an example, e.g. 2048" #endif diff --git a/cabal.project b/cabal.project index b81c139..d1485ff 100644 --- a/cabal.project +++ b/cabal.project @@ -18,5 +18,13 @@ if arch(wasm32) location: https://github.com/amesgen/splitmix tag: 5f5b766d97dc735ac228215d240a3bb90bc2ff75 +else + -- https://github.com/ghcjs/jsaddle/pull/149 + source-repository-package + type: git + location: https://github.com/georgefst/jsaddle + tag: 8ebf96891fe9580fc16e1fe99b0ca503b9cf2ed8 + subdir: jsaddle jsaddle-warp + package aeson flags: -ordered-keymap diff --git a/ghc-wasm-miso-examples.cabal b/ghc-wasm-miso-examples.cabal index 570a503..e898d0e 100644 --- a/ghc-wasm-miso-examples.cabal +++ b/ghc-wasm-miso-examples.cabal @@ -29,4 +29,4 @@ executable ghc-wasm-miso-examples build-depends: ghc-experimental, jsaddle-wasm ghc-options: -no-hs-main -optl-mexec-model=reactor "-optl-Wl,--export=hs_start" else - build-depends: jsaddle-warp, warp, websockets + build-depends: jsaddle-warp, wai-app-static, warp, websockets From d83c036e9e7023dadc39fee53fc87e10abf4a677 Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 12 Feb 2025 14:17:37 +0000 Subject: [PATCH 4/4] Fix typo --- app/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/app/Main.hs b/app/Main.hs index 77975f6..7fbed10 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -42,7 +42,7 @@ main :: IO () main = getArgs >>= \case -- Note that `debug` works with `cabal repl` but not `cabal run`. - -- The best workflow is to run `ghcid -c "cabal repl ghc-wasm-miso-examples" -W -T ':main primer'`. + -- The best workflow is to run `ghcid -c "cabal repl ghc-wasm-miso-examples" -W -T ':main simplecounter'`. [arg] -> let app = start