Merge pull request #194 from dmjio/initial-action

Added initial action

README.md

@@ -82,22 +82,28 @@ type Model = Int
 data Action
   = AddOne
   | SubtractOne
+  | NoOp
+  | SayHelloWorld
   deriving (Show, Eq)
 
 -- | Entry point for a miso application
 main :: IO ()
 main = startApp App {..}
   where
-    model  = 0   		-- initial model
-    update = updateModel	-- update function
-    view   = viewModel		-- view function
-    events = defaultEvents	-- default delegated events
-    subs   = []			-- empty subscription list
+    initialAction = SayHelloWorld -- initial action to be executed on application load
+    model  = 0   		  -- initial model
+    update = updateModel	  -- update function
+    view   = viewModel		  -- view function
+    events = defaultEvents	  -- default delegated events
+    subs   = []			  -- empty subscription list
 
 -- | Updates model, optionally introduces side effects
 updateModel :: Action -> Model -> Effect Model Action
 updateModel AddOne m = noEff (m + 1)
 updateModel SubtractOne m = noEff (m - 1)
+updateModel NoOp m = noEff m
+updateModel SayHelloWorld m = m <# do
+  putStrLn "Hello World" >> pure NoOp
 
 -- | Constructs a virtual DOM from a model
 viewModel :: Model -> View Action

examples/mario/Main.hs

@@ -15,6 +15,7 @@ data Action
   = GetArrows !Arrows
   | Time !Double
   | WindowCoords !(Int,Int)
+  | NoOp
 
 foreign import javascript unsafe "$r = performance.now();"
   now :: IO Double
@@ -23,7 +24,7 @@ main :: IO ()
 main = do
     time <- now
     let m = mario { time = time }
-    startApp App { model = m, ..}
+    startApp App { model = m, initialAction = NoOp, ..}
   where
     update = updateMario
     view   = display
@@ -63,6 +64,7 @@ mario = Model
     }
 
 updateMario :: Action -> Model -> Effect Model Action
+updateMario NoOp m = noEff m
 updateMario (GetArrows arrs) m = step newModel
   where
     newModel = m { arrows = arrs }

examples/router/Main.hs

@@ -35,7 +35,7 @@ data Action
 main :: IO ()
 main = do
   currentURI <- getCurrentURI
-  startApp App { model = Model currentURI, ..}
+  startApp App { model = Model currentURI, initialAction = NoOp, ..}
   where
     update = updateModel
     events = defaultEvents

examples/todo-mvc/Main.hs

@@ -78,7 +78,7 @@ data Msg
    deriving Show
 
 main :: IO ()
-main = startApp App{..}
+main = startApp App { initialAction = NoOp, ..}
   where
     model  = emptyModel
     update = updateModel

examples/websocket/Main.hs

@@ -21,7 +21,7 @@ import           Miso.String  (MisoString)
 import qualified Miso.String  as S
 
 main :: IO ()
-main = startApp App {..}
+main = startApp App { initialAction = Id, ..}
   where
     model = Model mempty mempty
     events = defaultEvents

exe/Main.hs

@@ -6,7 +6,7 @@ import Miso
 type Model = Int
 
 main :: IO ()
-main = startApp App {..}
+main = startApp App { initialAction = SayHelloWorld, ..}
   where
     model  = 0
     update = updateModel
@@ -17,10 +17,15 @@ main = startApp App {..}
 updateModel :: Action -> Model -> Effect Model Action
 updateModel AddOne m = noEff (m + 1)
 updateModel SubtractOne m = noEff (m - 1)
+updateModel NoOp m = noEff m
+updateModel SayHelloWorld m = m <# do
+  putStrLn "Hello World!" >> pure NoOp
 
 data Action
   = AddOne
   | SubtractOne
+  | NoOp
+  | SayHelloWorld
   deriving (Show, Eq)
 
 viewModel :: Int -> View Action

ghcjs-src/Miso.hs

@@ -57,9 +57,9 @@ startApp App {..} = do
     sub (readIORef modelRef) writeEvent
   -- init event application thread
   void . forkIO . forever $ do
-    action <- getEvent
+    newAction <- getEvent
     modifyMVar_ actionsMVar $! \actions ->
-      pure (actions |> action)
+      pure (actions |> newAction)
   -- Hack to get around `BlockedIndefinitelyOnMVar` exception
   -- that occurs when no event handlers are present on a template
   -- and `notify` is no longer in scope
@@ -70,6 +70,8 @@ startApp App {..} = do
   viewRef <- newIORef initialVTree
   -- Begin listening for events in the virtual dom
   delegator viewRef events
+  -- Process initial action of application
+  writeEvent initialAction
   -- Program loop, blocking on SkipChan
   forever $ wait >> do
     -- Apply actions to model

ghcjs-src/Miso/Types.hs

@@ -28,5 +28,7 @@ data App model action = App
   -- ^ List of subscriptions to run during application lifetime
   , events :: M.Map MisoString Bool
   -- ^ List of delegated events that the body element will listen for
+  , initialAction :: action
+  -- ^ Initial action that is run after the application has loaded
   }