Initial commit of Components

- Adds Component existential wrapper used for nesting App
- Adds `notify` for bidirectional communication between components (parent, child or siblings)
- Modifies diff.js to mount / unmount components
- Creates top-level ComponentMap used to store sinks and threads for each Component
- Adds components example (modified from simple.jsexe)
- Renames Notify to Waiter (reuse 'notify' elsewhere)
- Creates Miso.Internal

examples/canvas2d/Main.hs

@@ -35,7 +35,7 @@ main = do
     model  = (0.0, 0.0)
     subs   = []
     events = defaultEvents
-    mountPoint = Nothing -- default to body
+    mountPoint = "body" -- default to body
     logLevel = Off
 
 updateModel

examples/components/Main.hs

@@ -0,0 +1,154 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE CPP #-}
+
+module Main where
+
+import Control.Monad.IO.Class
+
+import Miso
+import Miso.String
+
+type Model = Int
+
+data Action
+  = AddOne
+  | SubtractOne
+  | NoOp
+  | SayHelloWorld
+  | Toggle4
+  deriving (Show, Eq)
+
+main :: IO ()
+main = startApp app
+
+app :: App Model Action
+app = App {..}
+  where
+    initialAction = SayHelloWorld -- initial action to be executed on application load
+    model         = 0             -- initial model
+    update        = updateModel1  -- update function
+    view          = viewModel1    -- view function
+    events        = defaultEvents -- default delegated events
+    subs          = []            -- empty subscription list
+    mountPoint    = "body"        -- mount point for application (Nothing defaults to 'body')
+    logLevel      = Off           -- Used to copy DOM into VDOM, applies only to `miso` function
+
+-- | Constructs a virtual DOM from a model
+viewModel1 :: Model -> View Action
+viewModel1 x = div_ [ id_ "main div" ]
+  [ "Main app - two sub components below me"
+  , Component counterApp2
+  , Component counterApp3
+  ]
+
+-- | Updates model, optionally introduces side effects
+updateModel1 :: Action -> Model -> Effect Action Model
+updateModel1 NoOp m          = noEff m
+updateModel1 SayHelloWorld m = m <# do
+  liftIO (putStrLn "Hello World1") >> pure NoOp
+
+-- are you sure counter-app is on the DOM before you start the delegator?
+counterApp2 :: App Model Action
+counterApp2 = App {..}
+  where
+    initialAction = SayHelloWorld -- initial action to be executed on application load
+    model  = 0                    -- initial model
+    update = updateModel2         -- update function
+    view   = viewModel2           -- view function
+    events = defaultEvents        -- default delegated events
+    subs   = []                   -- empty subscription list
+    mountPoint = "counter-app-2"    -- mount point for application (Nothing defaults to 'body')
+    logLevel = Off                -- Used to copy DOM into VDOM, applies only to `miso` function
+
+-- | Updates model, optionally introduces side effects
+updateModel2 :: Action -> Model -> Effect Action Model
+updateModel2 AddOne m = do
+  noEff (m + 1)
+updateModel2 SubtractOne m   = do
+  noEff (m - 1)
+updateModel2 NoOp m          = noEff m
+updateModel2 SayHelloWorld m = m <# do
+  liftIO (putStrLn "Hello World2") >> pure NoOp
+
+-- | Constructs a virtual DOM from a model
+viewModel2 :: Model -> View Action
+viewModel2 x = div_ []
+  [ "counter app 2"
+  , button_ [ onClick AddOne ] [ text "+" ]
+  , text (ms x)
+  , button_ [ onClick SubtractOne ] [ text "-" ]
+  , rawHtml "<div><p>hey expandable 2!</div></p>"
+  ]
+
+counterApp3 :: App (Bool, Model) Action
+counterApp3 = App {..}
+  where
+    initialAction = SayHelloWorld -- initial action to be executed on application load
+    model  = (True,0)                    -- initial model
+    update = updateModel3         -- update function
+    view   = viewModel3           -- view function
+    events = defaultEvents        -- default delegated events
+    subs   = []                   -- empty subscription list
+    mountPoint = "counter-app-3"    -- mount point for application (Nothing defaults to 'body')
+    logLevel = Off                -- Used to copy DOM into VDOM, applies only to `miso` function
+
+-- | Updates model, optionally introduces side effects
+updateModel3 :: Action -> (Bool, Model) -> Effect Action (Bool, Model)
+updateModel3 AddOne m@(t,n) = do
+  notify m counterApp2 AddOne
+  noEff (t, n + 1)
+updateModel3 SubtractOne m@(t,n)   = do
+  notify m counterApp2 SubtractOne
+  noEff (t, n - 1)
+updateModel3 NoOp m          = noEff m
+updateModel3 SayHelloWorld m = m <# do
+  liftIO (putStrLn "Hello World3") >> pure NoOp
+updateModel3 Toggle4 (t,n) = pure (not t, n)
+  -- ^ this tests mounting and unmounting a componente
+
+-- | Constructs a virtual DOM from a model
+viewModel3 :: (Bool, Model) -> View Action
+viewModel3 (toggle, x) = div_ [] $
+  [ "counter app 3"
+  , button_ [ onClick AddOne ] [ text "+" ]
+  , text (ms x)
+  , button_ [ onClick SubtractOne ] [ text "-" ]
+  , button_ [ onClick Toggle4 ] [ text "toggle component 4" ]
+  , rawHtml "<div><p>hey expandable 3!</div></p>"
+  ] ++ [ Component counterApp4 | toggle ]
+
+counterApp4 :: App Model Action
+counterApp4 = App {..}
+  where
+    initialAction = SayHelloWorld -- initial action to be executed on application load
+    model  = 0                    -- initial model
+    update = updateModel4         -- update function
+    view   = viewModel4           -- view function
+    events = defaultEvents        -- default delegated events
+    subs   = []                   -- empty subscription list
+    mountPoint = "counter-app-4"    -- mount point for application (Nothing defaults to 'body')
+    logLevel = Off                -- Used to copy DOM into VDOM, applies only to `miso` function
+
+-- | Updates model, optionally introduces side effects
+updateModel4 :: Action -> Model -> Effect Action Model
+updateModel4 AddOne m = do
+  notify m counterApp2 AddOne
+  noEff (m + 1)
+updateModel4 SubtractOne m   = do
+  notify m counterApp2 SubtractOne
+  noEff (m - 1)
+updateModel4 NoOp m          = noEff m
+updateModel4 SayHelloWorld m = m <# do
+  liftIO (putStrLn "Hello World4") >> pure NoOp
+
+-- | Constructs a virtual DOM from a model
+viewModel4 :: Model -> View Action
+viewModel4 x = div_ []
+  [ "counter app 4"
+  , button_ [ onClick AddOne ] [ text "+" ]
+  , text (ms x)
+  , button_ [ onClick SubtractOne ] [ text "-" ]
+  , rawHtml "<div><p>hey expandable 4!</div></p>"
+  ]
+

examples/compose-update/Main.hs

@@ -96,7 +96,7 @@ main = startApp App { initialAction = NoOp, ..}
     view   = viewModel
     events = defaultEvents
     subs   = []
-    mountPoint = Nothing
+    mountPoint = "body"
     logLevel = Off
 
 viewModel :: Model -> View Action

examples/file-reader/Main.hs

@@ -40,7 +40,7 @@ main = do
                , ..
                }
     where
-      mountPoint = Nothing
+      mountPoint = "body"
       update = updateModel
       events = defaultEvents
       subs   = []

examples/mario/Main.hs

@@ -65,7 +65,7 @@ main = runApp $ do
     subs   = [ arrowsSub GetArrows
              , windowCoordsSub WindowCoords
              ]
-    mountPoint = Nothing
+    mountPoint = "body"
     logLevel = Off
 
 data Model = Model

examples/mathml/Main.hs

@@ -27,7 +27,7 @@ main = startApp App {..}
     view   = viewModel            -- view function
     events = defaultEvents        -- default delegated events
     subs   = []                   -- empty subscription list
-    mountPoint = Nothing          -- mount point for application (Nothing defaults to 'body')
+    mountPoint = "body"          -- mount point for application (Nothing defaults to 'body')
     logLevel = Off
 
 -- | Updates model, optionally introduces side effects

examples/miso-examples.cabal

@@ -30,6 +30,37 @@ flag ios
   description:
     Cross compile to iOS
 
+executable components
+  default-language:
+    Haskell2010
+  main-is:
+    Main.hs
+  if !impl(ghcjs) && !flag(jsaddle)
+    buildable: False
+  else
+    ghcjs-options:
+      -dedupe
+    cpp-options:
+      -DGHCJS_BROWSER
+    hs-source-dirs:
+      components
+    build-depends:
+      aeson,
+      base < 5,
+      containers,
+      miso,
+      transformers
+    if flag(ios)
+      cpp-options:
+        -DIOS
+      ghc-options:
+        -threaded
+      build-depends:
+        jsaddle-wkwebview
+    else
+      build-depends:
+        jsaddle-warp
+
 executable simple
   default-language:
     Haskell2010

examples/router/Main.hs

@@ -54,7 +54,7 @@ main =
     events = defaultEvents
     subs   = [ uriSub HandleURI ]
     view   = viewModel
-    mountPoint = Nothing
+    mountPoint = "body"
     logLevel = Off
 
 -- | Update your model

examples/simple/Main.hs

@@ -45,7 +45,7 @@ main = runApp $ miso $ \_ -> App {..}
     view   = viewModel            -- view function
     events = defaultEvents        -- default delegated events
     subs   = []                   -- empty subscription list
-    mountPoint = Nothing          -- mount point for application (Nothing defaults to 'body')
+    mountPoint = "body"          -- mount point for application (Nothing defaults to 'body')
     logLevel = Off                -- Used to copy DOM into VDOM, applies only to `miso` function
 
 -- | Updates model, optionally introduces side effects

examples/svg/Main.hs

@@ -26,7 +26,7 @@ main = startApp App {..}
                     M.insert (pack "touchmove") False defaultEvents
     subs          = [ mouseSub HandleMouse ]
     logLevel      = Off
-    mountPoint    = Nothing
+    mountPoint    = "body"
 
 emptyModel :: Model
 emptyModel = Model (0,0)

examples/three/Main.hs

@@ -59,7 +59,7 @@ main = do
   startApp App { model = m
                , initialAction = Init
                , update = updateModel ref
-               , mountPoint = Nothing
+               , mountPoint = "body"
                , logLevel = Off
                , ..
                }

examples/todo-mvc/Main.hs

@@ -99,7 +99,7 @@ main = runApp $ startApp App { initialAction = NoOp, ..}
     update     = updateModel
     view       = viewModel
     events     = defaultEvents
-    mountPoint = Nothing
+    mountPoint = "body"
     subs       = []
     logLevel   = Off
 

examples/websocket/Main.hs

@@ -43,7 +43,7 @@ main = runApp $ startApp App { initialAction = Id, ..}
     view = appView
     uri = URL "wss://echo.websocket.org"
     protocols = Protocols [ ]
-    mountPoint = Nothing
+    mountPoint = "body"
     logLevel = Off
 
 updateModel :: Action -> Model -> Effect Action Model

examples/xhr/Main.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators #-}
@@ -34,7 +35,7 @@ main :: IO ()
 main = do
   startApp App { model = Model Nothing
                , initialAction = NoOp
-               , mountPoint = Nothing
+               , mountPoint = "body"
                , ..
                }
     where

jsbits/delegate.js

@@ -62,10 +62,10 @@ window['delegateEvent'] = function delegateEvent (event, obj, stack, parentStack
         event.preventDefault();
       eventObj['runEvent'](event);
       if (!options['stopPropagation'])
-        window['propogateWhileAble'] (parentStack, event);
+        window['propagateWhileAble'] (parentStack, event);
     } else {
       /* still propagate to parent handlers even if event not defined */
-      window['propogateWhileAble'] (parentStack, event);
+      window['propagateWhileAble'] (parentStack, event);
     }
   }
 };
@@ -79,14 +79,16 @@ window['buildTargetToElement'] = function buildTargetToElement (element, target)
   return stack;
 };
 
-window['propogateWhileAble'] = function propogateWhileAble (parentStack, event) {
+window['propagateWhileAble'] = function propagateWhileAble (parentStack, event) {
   for (var i = 0; i < parentStack.length; i++) {
     if (parentStack[i]['events'][event.type]) {
-      var eventObj = parentStack[i]['events'][event.type],
-        options = eventObj['options'];
+      var eventObj = parentStack[i]['events'][event.type], options = eventObj['options'];
       if (options['preventDefault']) event.preventDefault();
       eventObj['runEvent'](event);
-      if (options['stopPropagation']) break;
+      if (options['stopPropagation']) {
+        event.stopPropagation();
+        break;
+      }
     }
   }
 };