diff --git a/app/App.hs b/app/App.hs
index 0bac028..c6b9f0d 100644
--- a/app/App.hs
+++ b/app/App.hs
@@ -1,19 +1,58 @@
-module App (start) where
+{-# LANGUAGE CPP #-}
+module App (start, App(..)) where
+
+#ifdef wasi_HOST_OS
import GHC.Wasm.Prim
import Language.Javascript.JSaddle (JSM)
+#else
+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 of
- "simplecounter" -> SimpleCounter.start
- "snake" -> Snake.start
- "todomvc" -> TodoMVC.start
- "xhr" -> XHR.start
- "2048" -> TwoZeroFourEight.start
- _ -> fail "unknown example"
+ case fromJSString e :: String of
+ "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 3f1a49c..7fbed10 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,10 +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
+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.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
+ -- 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 simplecounter'`.
+ [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/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/cabal.project b/cabal.project
index 17bd992..d1485ff 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
@@ -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 d8e3fe1..e898d0e 100644
--- a/ghc-wasm-miso-examples.cabal
+++ b/ghc-wasm-miso-examples.cabal
@@ -8,11 +8,10 @@ executable ghc-wasm-miso-examples
, aeson
, base
, containers
- , ghc-experimental
, hs2048
, jsaddle
- , jsaddle-wasm
, miso
+ , miso >= 1.8.5.0
, mtl
, random
, text
@@ -26,4 +25,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, wai-app-static, warp, websockets