(3/3) Initial commit of domRef removal on vcomp

src/Miso.hs

@@ -28,6 +28,8 @@ module Miso
   , startComponent
   , component
   , (+>)
+  , mount
+  , mount_
     -- ** Sink
   , withSink
   , Sink
@@ -132,7 +134,7 @@ miso :: Eq model => (URI -> App model action) -> JSM ()
 miso f = withJS $ do
   vcomp <- f <$> getURI
   body <- FFI.getBody
-  initialize Hydrate isRoot vcomp (pure body)
+  initialize rootComponentId Hydrate isRoot vcomp (pure body)
 -----------------------------------------------------------------------------
 -- | Synonym for 'startComponent'.
 --
@@ -181,8 +183,8 @@ initComponent
   => Component parent model action
   -> JSM (ComponentState model action)
 initComponent vcomp@Component {..} = do
-  mount <- mountElement (getMountPoint mountPoint)
-  initialize Draw isRoot vcomp (pure mount)
+  root <- mountElement (getMountPoint mountPoint)
+  initialize rootComponentId Draw isRoot vcomp (pure root)
 ----------------------------------------------------------------------------
 isRoot :: Bool
 isRoot = True

src/Miso/Effect.hs

@@ -171,9 +171,9 @@ type Effect parent model action = RWS (ComponentInfo parent) [Schedule action] m
 --
 -- All t'IO' is by default asynchronous, use the 'sync' function for synchronous
 -- execution. Beware 'sync' can block the render thread for a specific
--- 'Component'.
+-- t'Miso.Types.Component'.
 --
--- N.B. During 'Miso.Types.Component' unmounting, all effects are evaluated
+-- N.B. During t'Miso.Types.Component' unmounting, all effects are evaluated
 -- synchronously.
 --
 -- @since 1.9.0.0

src/Miso/FFI.hs

@@ -58,9 +58,6 @@ module Miso.FFI
   , toLocaleString
   , getSeconds
   , getMilliseconds
-    -- ** 'Miso.Types.Component'
-  , getParentComponentId
-  , getComponentId
     -- ** DOM Traversal
   , nextSibling
   , previousSibling

src/Miso/FFI/Internal.hs

@@ -112,9 +112,6 @@ module Miso.FFI.Internal
    -- * Utils
    , getMilliseconds
    , getSeconds
-   -- * 'Miso.Types.Component'
-   , getParentComponentId
-   , getComponentId
    -- * Element
    , files
    , click
@@ -393,7 +390,7 @@ eventJSON x y = do
   moduleMiso <- jsg "miso"
   moduleMiso # "eventJSON" $ [x,y]
 -----------------------------------------------------------------------------
--- | Populate the `classList` Set on the virtual DOM.
+-- | Populate the 'Miso.Html.Property.classList' Set on the virtual DOM.
 populateClass
     :: JSVal
     -- ^ Node
@@ -516,13 +513,13 @@ undelegate mountPoint events debug callback ctx = do
 --
 -- See [hydration](https://en.wikipedia.org/wiki/Hydration_(web_development))
 --
-hydrate :: Bool -> JSVal -> JSVal -> JSM ()
-hydrate logLevel mountPoint vtree = void $ do
+hydrate :: Bool -> JSVal -> JSVal -> JSM JSVal
+hydrate logLevel mountPoint vtree = do
   ll <- toJSVal logLevel
   drawingContext <- getDrawingContext
   hydrationContext <- getHydrationContext
   moduleMiso <- jsg "miso"
-  void $ moduleMiso # "hydrate" $ [ll, mountPoint, vtree, hydrationContext, drawingContext]
+  moduleMiso # "hydrate" $ (ll, mountPoint, vtree, hydrationContext, drawingContext)
 -----------------------------------------------------------------------------
 -- | Fails silently if the element is not found.
 --
@@ -747,18 +744,6 @@ getSeconds date =
   fromJSValUnchecked =<< do
     date # "getSeconds" $ ([] :: [MisoString])
 -----------------------------------------------------------------------------
--- | Climb the tree, get the parent.
-getParentComponentId :: JSVal -> JSM (Maybe Int)
-getParentComponentId domRef =
-  fromJSVal =<< do
-    jsg "miso" # "getParentComponentId" $ [domRef]
------------------------------------------------------------------------------
--- | Get access to the 'Miso.Effect.ComponentId'
--- N.B. you * must * call this on the DOMRef, otherwise, problems.
--- For use in 'Miso.Event.onMounted', etc.
-getComponentId :: JSVal -> JSM Int
-getComponentId vtree = fromJSValUnchecked =<< vtree ! "componentId"
------------------------------------------------------------------------------
 -- | Fetch next sibling DOM node
 --
 -- @since 1.9.0.0

src/Miso/Html/Render.hs

@@ -96,8 +96,8 @@ renderBuilder (VNode ns tag attrs children) = mconcat
               , ns == MATHML
               ]
 
-renderBuilder (VComp ns tag attrs (SomeComponent vcomp)) =
-  renderBuilder (VNode ns tag attrs vkids)
+renderBuilder (VComp _ (SomeComponent vcomp)) =
+  foldMap renderBuilder vkids
     where
 #ifdef SSR
       vkids = [ unsafeCoerce $ (view vcomp) $ getInitialComponentModel vcomp ]
@@ -113,6 +113,7 @@ renderAttrs (ClassList classes) =
   , fromMisoString (MS.unwords classes)
   , stringUtf8 "\""
   ]
+renderAttrs (Property "key" _) = mempty
 renderAttrs (Property key value) =
   mconcat
   [ fromMisoString key

src/Miso/Hydrate.hs

@@ -20,8 +20,9 @@ import qualified Miso.FFI.Internal as FFI
 import           Miso.Types
 -----------------------------------------------------------------------------
 -- | Hydration of a t'VTree'
-hydrate :: LogLevel -> DOMRef -> VTree -> JSM ()
+hydrate :: LogLevel -> DOMRef -> VTree -> JSM Bool
 hydrate loggingLevel domRef vtree = do
   jval <- toJSVal vtree
-  FFI.hydrate (loggingLevel `elem` [DebugHydrate, DebugAll]) domRef jval
+  fromJSValUnchecked =<<
+    FFI.hydrate (loggingLevel `elem` [DebugHydrate, DebugAll]) domRef jval
 -----------------------------------------------------------------------------

src/Miso/Runtime.hs

@@ -120,14 +120,15 @@ import           Miso.Effect ( ComponentInfo(..), Sub, Sink, Effect, Schedule(..
 -- | Helper function to abstract out initialization of t'Miso.Types.Component' between top-level API functions.
 initialize
   :: (Eq parent, Eq model)
-  => Hydrate
+  => ComponentId
+  -> Hydrate
   -> Bool
   -- ^ Is the root node being rendered?
   -> Component parent model action
   -> JSM DOMRef
   -- ^ Callback function is used for obtaining the t'Miso.Types.Component' 'DOMRef'.
   -> JSM (ComponentState model action)
-initialize hydrate isRoot Component {..} getComponentMountPoint = do
+initialize componentParentId hydrate isRoot Component {..} getComponentMountPoint = do
   Waiter {..} <- liftIO waiter
   componentActions <- liftIO (newIORef S.empty)
   let
@@ -152,22 +153,25 @@ initialize hydrate isRoot Component {..} getComponentMountPoint = do
 #ifdef BENCH
     start <- if isRoot then FFI.now else pure 0
 #endif
-    vtree <- buildVTree hydrate componentSink logLevel events (view initializedModel)
+    vtree <- buildVTree componentId hydrate componentSink logLevel events (view initializedModel)
 #ifdef BENCH
     end <- if isRoot then FFI.now else pure 0
     when isRoot $ FFI.consoleLog $ ms (printf "buildVTree: %.3f ms" (end - start) :: String)
 #endif
+    ref <- liftIO (newIORef vtree)
     case hydrate of
       Draw -> do
         Diff.diff Nothing (Just vtree) componentDOMRef
+        pure ref
       Hydrate -> do
-        Hydrate.hydrate logLevel componentDOMRef vtree
-    liftIO (newIORef vtree)
+        when isRoot $ do
+          hydrated <- Hydrate.hydrate logLevel componentDOMRef vtree
+          when (not hydrated) $ do
+            newTree <- buildVTree componentId Draw componentSink logLevel events (view initializedModel)
+            liftIO (atomicWriteIORef ref newTree)
+            Diff.diff Nothing (Just newTree) componentDOMRef
+        pure ref
   componentDOMRef <# ("componentId" :: MisoString) $ componentId
-  componentParentId <- do
-    FFI.getParentComponentId componentDOMRef >>= \case
-      Nothing -> pure rootComponentId
-      Just parentId -> pure parentId
   componentSubThreads <- liftIO (newIORef M.empty)
   forM_ subs $ \sub -> do
     threadId <- FFI.forkJSM (sub componentSink)
@@ -185,7 +189,7 @@ initialize hydrate isRoot Component {..} getComponentMountPoint = do
       updatedName <- liftIO $ updatedModel `seq` makeStableName updatedModel
       isDirty <- liftIO (readTVarIO componentIsDirty)
       when ((currentName /= updatedName && currentModel /= updatedModel) || isDirty) $ do
-        newVTree <- buildVTree Draw componentSink logLevel events (view updatedModel)
+        newVTree <- buildVTree componentId Draw componentSink logLevel events (view updatedModel)
         oldVTree <- liftIO (readIORef componentVTree)
         void waitForAnimationFrame
         Diff.diff (Just oldVTree) (Just newVTree) componentDOMRef
@@ -233,14 +237,14 @@ initialize hydrate isRoot Component {..} getComponentMountPoint = do
   let vcomp = ComponentState
         { componentNotify = notify
         , componentEvents = events
+        , componentParentId = componentParentId
         , ..
         }
 
   registerComponent vcomp
   if isRoot
     then
-      delegator componentDOMRef componentVTree
-        events (logLevel `elem` [DebugEvents, DebugAll])
+      delegator componentDOMRef componentVTree events (logLevel `elem` [DebugEvents, DebugAll])
     else
       addToDelegatedEvents logLevel events
   forM_ initialAction componentSink
@@ -820,33 +824,47 @@ killSubscribers componentId =
 -- process we go between the Haskell heap and the JS heap.
 buildVTree
   :: Eq model
-  => Hydrate
+  => ComponentId
+  -> Hydrate
   -> Sink action
   -> LogLevel
   -> Events
   -> View model action
   -> JSM VTree
-buildVTree hydrate snk logLevel_ events_ = \case
-  VComp ns tag attrs (SomeComponent app) -> do
+buildVTree parentId hydrate snk logLevel_ events_ = \case
+  VComp attrs (SomeComponent app) -> do
+    vcomp <- create
+
     mountCallback <- do
-      FFI.syncCallback2 $ \vcomp continuation -> do
-        domRef <- vcomp ! ("domRef" :: MisoString)
-        ComponentState {..} <- initialize hydrate False app (pure domRef)
+      FFI.syncCallback2 $ \parent_ continuation -> do
+        ComponentState {..} <- initialize parentId Draw False app (pure parent_)
         vtree <- toJSVal =<< liftIO (readIORef componentVTree)
         FFI.set "parent" vcomp (Object vtree)
         vcompId <- toJSVal componentId
-        FFI.set "componentId" vcompId (Object domRef)
         void $ call continuation global [vcompId, vtree]
+
     unmountCallback <- toJSVal =<< do
-      FFI.syncCallback1 $ \domRef -> do
-        componentId <- liftJSM (FFI.getComponentId domRef)
+      FFI.syncCallback1 $ \vcompId -> do
+        componentId <- fromJSValUnchecked vcompId
         IM.lookup componentId <$> liftIO (readIORef components) >>= \case
           Nothing -> pure ()
           Just componentState ->
             unmount app componentState
-    vcomp <- createNode "vcomp" ns tag
+
+    case hydrate of
+      Hydrate -> do
+        -- Mock .domRef for use during hydration
+        domRef <- toJSVal =<< create
+        ComponentState {..} <- initialize parentId hydrate False app (pure domRef)
+        vtree <- toJSVal =<< liftIO (readIORef componentVTree)
+        FFI.set "parent" vcomp (Object vtree)
+        vcompId <- toJSVal componentId
+        FFI.set "componentId" vcompId vcomp
+        FFI.set "child" vtree vcomp
+      Draw -> do
+        FFI.set "child" jsNull vcomp        
+
     setAttrs vcomp attrs snk (logLevel app) (events app)
-    flip (FFI.set "children") vcomp =<< toJSVal ([] :: [MisoString])
     flip (FFI.set "mount") vcomp =<< toJSVal mountCallback
     FFI.set "unmount" unmountCallback vcomp
     FFI.set "eventPropagation" (eventPropagation app) vcomp
@@ -858,11 +876,11 @@ buildVTree hydrate snk logLevel_ events_ = \case
     vchildren <- toJSVal =<< procreate vnode
     flip (FFI.set "children") vnode vchildren
     flip (FFI.set "type") vnode =<< toJSVal VNodeType
-    pure $ VTree vnode
+    pure (VTree vnode)
       where
         procreate parentVTree = do
           kidsViews <- forM kids $ \kid -> do
-            VTree child <- buildVTree hydrate snk logLevel_ events_ kid
+            VTree child <- buildVTree parentId hydrate snk logLevel_ events_ kid
             FFI.set "parent" parentVTree child
             pure child
           setNextSibling kidsViews
@@ -876,7 +894,7 @@ buildVTree hydrate snk logLevel_ events_ = \case
     forM_ key $ \k -> FFI.set "key" (ms k) vtree
     FFI.set "ns" ("text" :: JSString) vtree
     FFI.set "text" t vtree
-    pure $ VTree vtree
+    pure (VTree vtree)
 -----------------------------------------------------------------------------
 -- | @createNode@
 -- A helper function for constructing a vtree (used for @vcomp@ and @vnode@)