Initial commit of WASM support (#768)

- Supports building 8/12 examples w/ the GHC WASM backend
- Exports main functions for WASM in examples
- Adds wasm dep. entries to cabal.project
- Refactors nix infra
- Removes superfulous CPP (old servant CPP and
- Adds Miso.Runner to abstract over various jsaddle backends
- Adds common stanzas to cabal files for readability
- Removes wai dep. in mario example.
- Migrates haskell-miso.org to Cabal 2.2 (adds shell.nix)
- haskell-miso.org client can be built w/ WASM
- Cleans up some -Wall warnings
- Exposes Miso.Concurrent
- shell.nix is now dynamic (can take "ghc" or "ghcjs" as an arg)
  - "nix-shell --arg pkg ghcjs"

cabal.project

@@ -2,3 +2,33 @@ packages:
   .
   examples/
   haskell-miso.org/
+
+index-state: 2025-02-11T14:26:56Z
+
+allow-newer:
+  all:base
+
+if arch(wasm32)
+  -- Required for TemplateHaskell. When using wasm32-wasi-cabal from
+  -- ghc-wasm-meta, this is superseded by the global cabal.config.
+  shared: True
+
+  -- https://github.com/haskellari/time-compat/issues/37
+  -- Older versions of time don't build on WASM.
+  constraints: time installed
+  allow-newer: time
+
+  -- https://github.com/haskellari/splitmix/pull/73
+  source-repository-package
+    type: git
+    location: https://github.com/amesgen/splitmix
+    tag: 5f5b766d97dc735ac228215d240a3bb90bc2ff75
+
+  package aeson
+    flags: -ordered-keymap
+
+  source-repository-package
+    type: git
+    location: https://github.com/haskell-wasm/foundation.git
+    tag: 8e6dd48527fb429c1922083a5030ef88e3d58dd3
+    subdir: basement

default.nix

@@ -23,11 +23,22 @@ let
 in
 {
   inherit pkgs;
-  deploy = pkgs.deploy rev;
+
+  #js
   miso-ghcjs = pkgs.haskell.packages.ghcjs86.miso;
-  miso-ghc = pkgs.haskell.packages.ghc865.miso;
   inherit (pkgs.haskell.packages.ghcjs86) miso-examples sample-app;
+
+  #native
+  miso-ghc = pkgs.haskell.packages.ghc865.miso;
+  miso-examples-ghc = pkgs.haskell.packages.ghc865.miso-examples;
   inherit (pkgs.haskell.packages.ghc865) sample-app-jsaddle;
+
+  #hackage releases
   inherit release release-examples;
+
+  #website
   inherit (pkgs) haskell-miso;
+
+  #ci
+  deploy = pkgs.deploy rev;
 }

examples/canvas2d/Main.hs

@@ -18,7 +18,7 @@ data Action
   | SetTime Model
 
 main :: IO ()
-main = do
+main = run $ do
   [sun, moon, earth] <- replicateM 3 newImage
   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"

examples/compose-update/Main.hs

@@ -1,6 +1,7 @@
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TupleSections     #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Main where
 
@@ -10,7 +11,6 @@ module Main where
 -- model which combines their effects.
 
 import Control.Monad
-import Data.Monoid
 
 import Miso
 import Miso.String
@@ -88,8 +88,12 @@ updateModel act =
      -- @(<=<) :: (b -> Effect Action c) -> (a -> Effect Action b) -> a -> Effect Action c
      liftedUpdateFirst <=< liftedUpdateSecond
 
+#if defined(wasm32_HOST_ARCH)
+foreign export javascript "hs_start" main :: IO ()
+#endif
+
 main :: IO ()
-main = startApp App { initialAction = NoOp, ..}
+main = run $ startApp App { initialAction = NoOp, ..}
   where
     model  = (0, 0)
     update = updateModel

examples/file-reader/Main.hs

@@ -34,7 +34,7 @@ data Action
 
 -- | Main entry point
 main :: IO ()
-main = do
+main = run $ do
   startApp App { model = Model ""
                , initialAction = NoOp
                , ..

examples/mario/Main.hs

@@ -8,33 +8,10 @@ module Main where
 import           Data.Bool
 import           Data.Function
 import qualified Data.Map as M
-import           Data.Monoid
 
 import           Miso
 import           Miso.String
 
-import qualified Language.Javascript.JSaddle.Warp as JSaddle
-
-#ifdef ghcjs_HOST_OS
-runApp :: JSM () -> IO ()
-runApp = JSaddle.run 8080
-
-#else
-import           Network.Wai.Application.Static
-import qualified Network.Wai as Wai
-import qualified Network.Wai.Handler.Warp as Warp
-import           Network.WebSockets
-
-runApp :: JSM () -> IO ()
-runApp f =
-    Warp.runSettings (Warp.setPort 8080 (Warp.setTimeout 3600 Warp.defaultSettings)) =<<
-        JSaddle.jsaddleOr defaultConnectionOptions (f >> syncPoint) app
-    where app req sendResp =
-            case Wai.pathInfo req of
-              ("imgs" : _) -> staticApp (defaultWebAppSettings "examples/mario") req sendResp
-              _ -> JSaddle.jsaddleApp req sendResp
-#endif
-
 data Action
   = GetArrows !Arrows
   | Time !Double
@@ -44,8 +21,12 @@ data Action
 spriteFrames :: [MisoString]
 spriteFrames = ["0 0", "-74px 0","-111px 0","-148px 0","-185px 0","-222px 0","-259px 0","-296px 0"]
 
+#if defined(wasm32_HOST_ARCH)
+foreign export javascript "hs_start" main :: IO ()
+#endif
+
 main :: IO ()
-main = runApp $ do
+main = run $ do
     time <- now
     let m = mario { time = time }
     startApp App { model = m

examples/mathml/Main.hs

@@ -1,5 +1,5 @@
-
 -- | Haskell language pragma
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
@@ -8,35 +8,38 @@ module Main where
 
 -- | Miso framework import
 import Miso
-import Miso.String
 import Miso.Mathml
 
-data Model = Empty deriving Eq
-
-data Action
-  =  NoOp
-  deriving (Show, Eq)
+#if defined(wasm32_HOST_ARCH)
+foreign export javascript "hs_start" main :: IO ()
+#endif
 
 -- | Entry point for a miso application
 main :: IO ()
-main = startApp App {..}
+main = run $ startApp App {..}
   where
     initialAction = NoOp -- initial action to be executed on application load
-    model  = Empty                -- initial model
+    model  = Main.Empty           -- initial model
     update = updateModel          -- update function
     view   = viewModel            -- view function
     events = defaultEvents        -- default delegated events
     subs   = []                   -- empty subscription list
     mountPoint = Nothing          -- mount point for application (Nothing defaults to 'body')
     logLevel = Off
 
+data Model = Empty deriving Eq
+
+data Action
+  =  NoOp
+  deriving (Show, Eq)
+
 -- | Updates model, optionally introduces side effects
 updateModel :: Action -> Model -> Effect Action Model
 updateModel NoOp = noEff
 
 -- | Constructs a virtual DOM from a model
 viewModel :: Model -> View Action
-viewModel x = nodeMathml "math" [] [
+viewModel _ = nodeMathml "math" [] [
     nodeMathml "msup" [] [
         nodeMathml "mi" [] [text "x"]
         , nodeMathml "mn" [] [text "2"]