Add ShadowRoot support.

src/Miso.hs

@@ -1,5 +1,6 @@
 -----------------------------------------------------------------------------
 {-# LANGUAGE CPP                       #-}
+{-# LANGUAGE LambdaCase                #-}
 {-# LANGUAGE NamedFieldPuns            #-}
 {-# LANGUAGE RecordWildCards           #-}
 {-# LANGUAGE TemplateHaskell           #-}
@@ -111,12 +112,13 @@ miso :: Eq model => (URI -> App model action) -> JSM ()
 miso f = withJS $ do
   vcomp@Component {..} <- f <$> getURI
   initialize vcomp $ \snk -> do
-    refs <- (++) <$> renderScripts scripts <*> renderStyles styles
-    VTree (Object vtree) <- runView Hydrate (view model) snk logLevel events
     mount_ <- FFI.getBody
+    refs <- (++) <$> renderScripts mount_ scripts <*> renderStyles mount_ styles
+    VTree (Object vtree) <- runView Hydrate (view model) snk logLevel events
     FFI.hydrate (logLevel `elem` [DebugHydrate, DebugAll]) mount_ vtree
     viewRef <- liftIO $ newIORef $ VTree (Object vtree)
-    pure (refs, mount_, viewRef)
+    shadow <- getShadowRoot mount_ shadowRoot
+    pure (refs, shadow, viewRef)
 -----------------------------------------------------------------------------
 -- | Synonym 'startApp' to 'startComponent'.
 startApp :: Eq model => App model action -> JSM ()
@@ -129,9 +131,9 @@ startApp = startComponent
 -- | Runs a miso application
 startComponent :: Eq model => Component ROOT model action -> JSM ()
 startComponent vcomp@Component { styles, scripts } =
-  withJS $ initComponent vcomp $ do
-     (++) <$> renderScripts scripts
-          <*> renderStyles styles
+  withJS $ initComponent vcomp $ \domRef ->
+     (++) <$> renderScripts domRef scripts
+          <*> renderStyles domRef styles
 ----------------------------------------------------------------------------
 -- | Runs a miso application, but with a custom rendering engine.
 -- The @MisoString@ specified here is the variable name of a globally-scoped
@@ -143,7 +145,7 @@ renderApp
   -- ^ Name of the JS object that contains the drawing context
   -> App model action
   -- ^ Component application
-  -> JSM [DOMRef]
+  -> (DOMRef -> JSM [DOMRef])
   -- ^ Custom hook to perform any JSM action (e.g. render styles) before initialization.
   -> JSM ()
 renderApp renderer vcomp hooks = withJS $ do
@@ -155,17 +157,18 @@ initComponent
   :: Eq model
   => Component ROOT model action
   -- ^ Component application
-  -> JSM [DOMRef]
+  -> (DOMRef -> JSM [DOMRef])
   -- ^ Custom hook to perform any JSM action (e.g. render styles) before initialization.
   -> JSM (ComponentState model action)
 initComponent vcomp@Component{..} hooks = do
   initialize vcomp $ \snk -> do
-    refs <- hooks
     vtree <- runView Draw (view model) snk logLevel events
     mount_ <- mountElement (getMountPoint mountPoint)
+    shadow <- getShadowRoot mount_ shadowRoot
+    refs <- hooks shadow
     diff Nothing (Just vtree) mount_
     viewRef <- liftIO (newIORef vtree)
-    pure (refs, mount_, viewRef)
+    pure (refs, shadow, viewRef)
 -----------------------------------------------------------------------------
 #ifdef PRODUCTION
 #define MISO_JS_PATH "js/miso.prod.js"

src/Miso/FFI/Internal.hs

@@ -135,8 +135,10 @@ module Miso.FFI.Internal
    -- * FileReader
    , FileReader (..)
    , newFileReader
-   -- * fetch API
+   -- * Fetch API
    , Response (..)
+   -- * Shadow
+   , attachShadow
    ) where
 -----------------------------------------------------------------------------
 import           Control.Monad (foldM)
@@ -726,6 +728,17 @@ nextSibling domRef = domRef ! "nextSibling"
 previousSibling :: JSVal -> JSM JSVal
 previousSibling domRef = domRef ! "previousSibling"
 -----------------------------------------------------------------------------
+-- | Calls 'node.attachShadow({ mode : \"open\" })'
+--
+-- <https://developer.mozilla.org/en-US/docs/Web/API/Element/attachShadow>
+--
+-- @since 1.9.0.0
+attachShadow :: JSVal -> JSM JSVal
+attachShadow domRef = do
+  args <- create
+  set (ms "mode") "open" args
+  (domRef # "attachShadow") [args]
+-----------------------------------------------------------------------------
 -- | When working with /<input>/ of type="file", this is useful for
 -- extracting out the selected files.
 --

src/Miso/Runtime.hs

@@ -70,6 +70,8 @@ module Miso.Runtime
   , json
   , blob
   , arrayBuffer
+  -- ** ShadowRoot
+  , getShadowRoot
   ) where
 -----------------------------------------------------------------------------
 import           Control.Concurrent.STM
@@ -654,7 +656,7 @@ drawComponent
   -> Sink action
   -> JSM ([DOMRef], DOMRef, IORef VTree)
 drawComponent hydrate mountElement Component {..} snk = do
-  refs <- (++) <$> renderScripts scripts <*> renderStyles styles
+  refs <- (++) <$> renderScripts mountElement scripts <*> renderStyles mountElement styles
   vtree <- runView hydrate (view model) snk logLevel events
   case hydrate of
     Draw ->
@@ -716,6 +718,12 @@ killSubscribers componentId =
   mapM_ (flip unsubscribe_ componentId) =<<
     M.keys <$> liftIO (readIORef mailboxes)
 -----------------------------------------------------------------------------
+-- | If shadowRoot is enabled
+getShadowRoot :: DOMRef -> Bool -> JSM DOMRef
+getShadowRoot domRef = \case
+  True -> pure domRef
+  False -> FFI.attachShadow domRef
+-----------------------------------------------------------------------------
 -- | Internal function for construction of a Virtual DOM.
 --
 -- Component mounting should be synchronous.
@@ -730,23 +738,24 @@ runView
   -> LogLevel
   -> Events
   -> JSM VTree
-runView hydrate (VComp ns tag attrs (SomeComponent app)) snk _ _ = do
+runView hydrate (VComp ns tag attrs (SomeComponent comp)) snk _ _ = do
   mountCallback <- do
     FFI.syncCallback2 $ \domRef continuation -> do
-      ComponentState {..} <- initialize app (drawComponent hydrate domRef app)
+      shadow <- getShadowRoot domRef (shadowRoot comp)
+      ComponentState {..} <- initialize comp (drawComponent hydrate shadow comp)
       vtree <- toJSVal =<< liftIO (readIORef componentVTree)
       vcompId <- toJSVal componentId
-      FFI.set "componentId" vcompId (Object domRef)
+      FFI.set "componentId" vcompId (Object shadow)
       void $ call continuation global [vcompId, vtree]
   unmountCallback <- toJSVal =<< do
     FFI.syncCallback1 $ \domRef -> do
       componentId <- liftJSM (FFI.getComponentId domRef)
       IM.lookup componentId <$> liftIO (readIORef components) >>= \case
         Nothing -> pure ()
         Just componentState ->
-          unmount mountCallback app componentState
+          unmount mountCallback comp componentState
   vcomp <- createNode "vcomp" ns tag
-  setAttrs vcomp attrs snk (logLevel app) (events app)
+  setAttrs vcomp attrs snk (logLevel comp) (events comp)
   flip (FFI.set "children") vcomp =<< toJSVal ([] :: [MisoString])
   flip (FFI.set "mount") vcomp =<< toJSVal mountCallback
   FFI.set "unmount" unmountCallback vcomp
@@ -825,8 +834,8 @@ registerComponent componentState = liftIO
 -- Meant for development purposes
 -- Appends CSS to <head>
 --
-renderStyles :: [CSS] -> JSM [DOMRef]
-renderStyles styles =
+renderStyles :: DOMRef -> [CSS] -> JSM [DOMRef]
+renderStyles _ styles =
   forM styles $ \case
     Href url -> FFI.addStyleSheet url
     Style css -> FFI.addStyle css
@@ -837,8 +846,8 @@ renderStyles styles =
 -- Meant for development purposes
 -- Appends JS to <head>
 --
-renderScripts :: [JS] -> JSM [DOMRef]
-renderScripts scripts =
+renderScripts :: DOMRef -> [JS] -> JSM [DOMRef]
+renderScripts _ scripts =
   forM scripts $ \case
     Src src ->
       FFI.addSrc src

src/Miso/Types.hs

@@ -130,6 +130,13 @@ data Component parent model action
   --
   -- @since 1.9.0.0
   , bindings :: [ Binding parent model ]
+  -- ^ Use data binding between the parent model and Component model
+  --
+  -- @since 1.9.0.0
+  , shadowRoot :: Bool
+  -- ^ Use ShadowRoot for DOM encapsulation of events and styling
+  --
+  -- @since 1.9.0.0
   }
 -----------------------------------------------------------------------------
 -- | @mountPoint@ for @Component@, e.g "body"
@@ -192,6 +199,7 @@ component m u v = Component
   , initialAction = Nothing
   , mailbox = const Nothing
   , bindings = []
+  , shadowRoot = False
   }
 -----------------------------------------------------------------------------
 -- | A top-level 'Component' can have no 'parent'