Make initialAction optional

.github/workflows/main.yml

@@ -53,6 +53,9 @@ jobs:
      - name: (JS) Miso examples
        run: nix-build -A miso-examples
 
+     - name: (JS) Miso third-party examples (2048, flatris, etc.)
+       run: nix-build -A more-examples -j1
+
      - name: (x86) Miso examples
        run: nix-build -A miso-examples-ghc
 

README.md

@@ -270,7 +270,7 @@ main :: IO ()
 main = run (startApp app)
 ----------------------------------------------------------------------------
 app :: App Model Action
-app = defaultApp emptyModel updateModel viewModel SayHelloWorld
+app = defaultApp emptyModel updateModel viewModel
 ----------------------------------------------------------------------------
 -- | Empty model
 emptyModel :: Model
@@ -281,14 +281,15 @@ updateModel :: Action -> Model -> Effect Action Model
 updateModel NoOp m          = noEff m
 updateModel AddOne m        = noEff (m + 1)
 updateModel SubtractOne m   = noEff (m - 1)
-updateModel SayHelloWorld m = m <# NoOp <$ consoleLog "Hello World"
+updateModel SayHelloWorld m = m <# NoOp <$ alert "Hello World"
 ----------------------------------------------------------------------------
 -- | Constructs a virtual DOM from a model
 viewModel :: Model -> View Action
 viewModel x = div_ []
   [ button_ [ onClick AddOne ] [ text "+" ]
   , text (ms x)
   , button_ [ onClick SubtractOne ] [ text "-" ]
+  , button_ [ onClick SayHelloWorld ] [ text "Alert Hello World!" ]
   ]
 ----------------------------------------------------------------------------
 ```
@@ -334,9 +335,9 @@ data Action
 main :: IO ()
 main = run (startApp app)
 ----------------------------------------------------------------------------
--- | `defaultApp` takes as arguments the initial model, update function, view function and initial action.
+-- | `defaultApp` takes as arguments the initial model, update function, view function
 app :: App Model Action
-app = defaultApp emptyModel (fromTransition . updateModel) viewModel SayHelloWorld
+app = defaultApp emptyModel (fromTransition . updateModel) viewModel
 ----------------------------------------------------------------------------
 -- | Empty application state
 emptyModel :: Model
@@ -356,6 +357,7 @@ viewModel x = div_ []
   [ button_ [ onClick AddOne ] [ text "+" ]
   , text . ms $ x^.counter
   , button_ [ onClick SubtractOne ] [ text "-" ]
+  , button_ [ onClick SayHelloWorld ] [ text "Alert Hello World!" ]
   ]
 ----------------------------------------------------------------------------
 ```

default.nix

@@ -26,8 +26,11 @@ in with pkgs.haskell.lib;
   miso-examples-ghc = pkgs.haskell.packages.ghc865.miso-examples;
   inherit (pkgs.haskell.packages.ghc865) sample-app;
 
-  # miso wasm examples
-  # nix-build -A wasmExamples && ./result/bin/build.sh && nix-build -A svgWasm && http-server ./result/svg.wasmexe
+  # Miso wasm examples
+  # nix-build -A wasmExamples
+  #   && ./result/bin/build.sh
+  #   && nix-build -A svgWasm
+  #   && http-server ./result/svg.wasmexe
   inherit (pkgs)
     wasmExamples
     svgWasm
@@ -64,4 +67,7 @@ in with pkgs.haskell.lib;
 
   # utils
   inherit (pkgs.haskell.packages.ghc865) miso-from-html;
+
+  # misc. examples
+  inherit (pkgs) more-examples;
 }

examples/canvas2d/Main.hs

@@ -26,7 +26,7 @@ main = run $ do
     setSrc earth "https://7b40c187-5088-4a99-9118-37d20a2f875e.mdnplay.dev/en-US/docs/Web/API/Canvas_API/Tutorial/Basic_animations/canvas_earth.png"
     startApp
         App
-            { initialAction = GetTime
+            { initialAction = Just GetTime
             , update = updateModel (sun, moon, earth)
             , ..
             }

examples/components/Main.hs

@@ -14,7 +14,7 @@ import Miso.String
 
 type Model = Int
 
-#if defined(wasm32_HOST_ARCH)
+#ifdef WASM
 foreign export javascript "hs_start" main :: IO ()
 #endif
 
@@ -39,7 +39,10 @@ data MainAction
 type MainModel = Bool
 
 main :: IO ()
-main = run $ startApp app { logLevel = DebugPrerender }
+main = run $ startApp app
+  { logLevel = DebugPrerender
+  , subs = [loggerSub "main-app"]
+  }
 
 secs :: Int -> Int
 secs = (* 1000000)
@@ -51,10 +54,7 @@ loggerSub msg = \_ ->
         consoleLog msg
 
 app :: App MainModel MainAction
-app =
-    (defaultApp False updateModel1 viewModel1 MainNoOp)
-        { subs = [loggerSub "main-app"]
-        }
+app = defaultApp False updateModel1 viewModel1
 
 component2 :: Component Model Action
 component2 =
@@ -120,7 +120,7 @@ updateModel1 SampleChild m =
       pure MainNoOp
 
 counterApp2 :: App Model Action
-counterApp2 = defaultApp 0 updateModel2 viewModel2 SayHelloWorld
+counterApp2 = defaultApp 0 updateModel2 viewModel2
 
 -- | Updates model, optionally introduces side effects
 updateModel2 :: Action -> Model -> Effect Action Model
@@ -156,7 +156,7 @@ viewModel2 x =
         ]
 
 counterApp3 :: App (Bool, Model) Action
-counterApp3 = defaultApp (True, 0) updateModel3 viewModel3 SayHelloWorld
+counterApp3 = defaultApp (True, 0) updateModel3 viewModel3
 
 -- | Updates model, optionally introduces side effects
 updateModel3 :: Action -> (Bool, Model) -> Effect Action (Bool, Model)
@@ -199,7 +199,7 @@ viewModel3 (toggle, x) =
                ]
 
 counterApp4 :: App Model Action
-counterApp4 = defaultApp 0 updateModel4 viewModel4 SayHelloWorld
+counterApp4 = defaultApp 0 updateModel4 viewModel4
 
 -- | Updates model, optionally introduces side effects
 updateModel4 :: Action -> Model -> Effect Action Model

examples/compose-update/Main.hs

@@ -100,15 +100,11 @@ foreign export javascript "hs_start" main :: IO ()
 #endif
 
 main :: IO ()
-main = run $ startApp App{initialAction = NoOp, ..}
+main = run $ startApp (defaultApp model update view)
   where
     model = (0, 0)
     update = updateModel
     view = viewModel
-    events = defaultEvents
-    subs = []
-    mountPoint = Nothing
-    logLevel = Off
 
 viewModel :: Model -> View Action
 viewModel (x, y) =

examples/file-reader/Main.hs

@@ -40,7 +40,7 @@ main = run $ do
     startApp
         App
             { model = Model ""
-            , initialAction = NoOp
+            , initialAction = Nothing
             , ..
             }
   where

examples/mario/Main.hs

@@ -30,22 +30,12 @@ main :: IO ()
 main = run $ do
     time <- now
     let m = mario{time = time}
-    startApp
-        App
-            { model = m
-            , initialAction = NoOp
-            , ..
-            }
-  where
-    update = updateMario
-    view = display
-    events = defaultEvents
-    subs =
-        [ arrowsSub GetArrows
-        , windowCoordsSub WindowCoords
-        ]
-    mountPoint = Nothing
-    logLevel = Off
+    startApp (defaultApp m updateMario display)
+      { subs =
+          [ arrowsSub GetArrows
+          , windowCoordsSub WindowCoords
+          ]
+      }
 
 data Model = Model
     { x :: !Double

examples/mathml/Main.hs

@@ -1,13 +1,8 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
-
--- \| Haskell module declaration
-
--- | Haskell language pragma
 module Main where
 
--- \| Miso framework import
 import Miso
 
 #if defined(wasm32_HOST_ARCH)
@@ -16,22 +11,15 @@ foreign export javascript "hs_start" main :: IO ()
 
 -- | Entry point for a miso application
 main :: IO ()
-main = run $ startApp App{..}
-  where
-    initialAction = NoOp -- initial action to be executed on application load
-    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
+main = run $ startApp (defaultApp Main.Empty updateModel viewModel)
 
-data Model = Empty deriving (Eq)
+data Model
+  = Empty
+  deriving (Eq)
 
 data Action
-    = NoOp
-    deriving (Show, Eq)
+  = NoOp
+  deriving (Show, Eq)
 
 -- | Updates model, optionally introduces side effects
 updateModel :: Action -> Model -> Effect Action Model

examples/router/Main.hs

@@ -33,17 +33,11 @@ data Action
 
 -- | Main entry point
 main :: IO ()
-main =
-    run $ do
-        currentURI <- getCurrentURI
-        startApp App{model = Model currentURI, initialAction = NoOp, ..}
-  where
-    update = updateModel
-    events = defaultEvents
-    subs = [uriSub HandleURI]
-    view = viewModel
-    mountPoint = Nothing
-    logLevel = Off
+main = run $
+  miso $ \uri ->
+    (defaultApp (Model uri) updateModel viewModel)
+       { subs = [uriSub HandleURI]
+       }
 
 -- | Update your model
 updateModel :: Action -> Model -> Effect Action Model

examples/simple/Main.hs

@@ -34,7 +34,7 @@ main = run $ startApp app
 
 -- | Application definition (uses 'defaultApp' smart constructor)
 app :: App Model Action
-app = defaultApp 0 updateModel viewModel SayHelloWorld
+app = defaultApp 0 updateModel viewModel
 
 -- | UpdateModels model, optionally introduces side effects
 updateModel :: Action -> Model -> Effect Action Model

examples/sse/shared/Common.hs

@@ -5,11 +5,9 @@
 module Common (
     -- * App
     sse,
-
     -- * Types
     Model,
     Action,
-
     -- * Exported links
     goHome,
     the404,
@@ -64,25 +62,18 @@ goHome :: URI
 goHome = allLinks' linkURI (Proxy :: Proxy ClientRoutes)
 
 sse :: URI -> App Model Action
-sse currentURI =
-        App
-            { initialAction = NoOp
-            , model = Model currentURI "No event received"
-            , ..
-            }
+sse currentURI
+  = app { subs =
+          [ sseSub "/sse" handleSseMsg
+          , uriSub HandleURI
+          ]
+        }
   where
-    update = updateModel
+    app = defaultApp (Model currentURI "No event received") updateModel view
     view m
         | Right r <- route (Proxy :: Proxy ClientRoutes) home modelUri m =
             r
         | otherwise = the404
-    events = defaultEvents
-    subs =
-        [ sseSub "/sse" handleSseMsg
-        , uriSub HandleURI
-        ]
-    mountPoint = Nothing
-    logLevel = Off
 
 handleSseMsg :: SSE String -> Action
 handleSseMsg (SSEMessage msg) = ServerMsg msg

examples/svg/Main.hs

@@ -24,7 +24,7 @@ main = run $ startApp app
 
 -- | Application definition (uses 'defaultApp' smart constructor)
 app :: App Model Action
-app = defaultApp emptyModel updateModel viewModel Id
+app = defaultApp emptyModel updateModel viewModel
 
 emptyModel :: Model
 emptyModel = Model (0, 0)

examples/three/Main.hs

@@ -62,19 +62,9 @@ main = run $ do
     stats <- newStats
     ref <- newIORef $ Context (pure ()) (pure ()) stats
     m <- now
-    startApp
-        App
-            { model = m
-            , initialAction = Init
-            , update = updateModel ref
-            , mountPoint = Nothing
-            , logLevel = Off
-            , ..
-            }
-  where
-    events = defaultEvents
-    view = viewModel
-    subs = []
+    startApp (defaultApp m (updateModel ref) viewModel)
+      { initialAction = Just Init
+      }
 
 viewModel :: Double -> View action
 viewModel _ =

examples/todo-mvc/Main.hs

@@ -94,7 +94,7 @@ main = run $ startApp app
   }
 
 app :: App Model Msg
-app = defaultApp emptyModel updateModel viewModel NoOp
+app = defaultApp emptyModel updateModel viewModel
 
 updateModel :: Msg -> Model -> Effect Msg Model
 updateModel NoOp m = noEff m

examples/websocket/Main.hs

@@ -37,7 +37,7 @@ main = run $ startApp app
       protocols = Protocols []
 
 app :: App Model Action
-app = defaultApp emptyModel updateModel appView Id
+app = defaultApp emptyModel updateModel appView
 
 emptyModel :: Model
 emptyModel = Model (Message "") mempty

examples/xhr/Main.hs

@@ -34,7 +34,7 @@ main :: IO ()
 main = run (startApp app)
 
 app :: App Model Action
-app = defaultApp emptyModel updateModel viewModel NoOp
+app = defaultApp emptyModel updateModel viewModel
 
 emptyModel :: Model
 emptyModel = Model Nothing

haskell-miso.org/shared/Common.hs

@@ -97,7 +97,7 @@ haskellMisoComponent uri
   }
 
 app :: URI -> App Model Action
-app currentUri = defaultApp emptyModel updateModel viewModel NoOp
+app currentUri = defaultApp emptyModel updateModel viewModel
   where
     emptyModel = Model currentUri False
     viewModel m =

nix/haskell/packages/ghcjs/default.nix

@@ -10,7 +10,7 @@ self: super:
   sample-app-js = self.callCabal2nix "app" source.sample-app {};
   jsaddle = self.callCabal2nix "jsaddle" "${source.jsaddle}/jsaddle" {};
   jsaddle-warp = dontCheck (self.callCabal2nix "jsaddle-warp" "${source.jsaddle}/jsaddle-warp" {});
-  flatris = self.callCabal2nix "hs-flatris" source.flatris {};
+  flatris = self.callCabal2nix "flatris" source.flatris {};
   miso-plane =
     let
       miso-plane = self.callCabal2nix "miso-plane" source.miso-plane {};