WIP dev-css support

Author: georgefst

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"

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...
+                -- "<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

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

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