Make examples runnable with jsaddle-warp

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"

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 primer'`.
+        [arg] ->
+            let app =
+                    start
+                        -- "2048"
+                        (toJSString arg)
+                -- we can't use multiline syntax alongside CPP...
+                -- "<meta charset='utf-8'>\n\
+                -- \<meta name='viewport' content='width=device-width, initial-scale=1'>\n\
+                -- \<title>2048 | Miso example via GHC WASM</title>\n\
+                -- \<link rel='stylesheet' href='2048/main.css'/>\n\
+                -- \"
+                header =
+                    encodeUtf8 $
+                        T.unlines $
+                            [ "<title>" <> app.name <> "</title>"
+                            ]
+                                <> map
+                                    (\s -> "<link rel='stylesheet' href='" <> 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

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

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

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