Expose global sink

src/Miso.hs

@@ -41,17 +41,18 @@ import           Control.Monad
 import           Control.Monad.IO.Class
 import           Data.IORef
 import           Data.List
-import           Data.Sequence ((|>))
+import           Data.Sequence                 ((|>))
+import qualified Data.Sequence                 as S
+import qualified JavaScript.Object.Internal    as OI
+import           System.IO.Unsafe
 import           System.Mem.StableName
-import qualified Data.Sequence as S
-import qualified JavaScript.Object.Internal as OI
 
 #ifndef ghcjs_HOST_OS
-import           Language.Javascript.JSaddle (eval, waitForAnimationFrame)
+import           Language.Javascript.JSaddle   (eval, waitForAnimationFrame)
 #ifdef IOS
 import           Miso.JSBits
 #else
-import           GHCJS.Types (JSString)
+import           GHCJS.Types                   (JSString)
 import           Data.FileEmbed
 #endif
 #else
@@ -99,6 +100,8 @@ common App {..} m getView = do
   let writeEvent a = void . liftIO . forkIO $ do
         atomicModifyIORef' actionsRef $ \as -> (as |> a, ())
         notify
+  -- init global sink
+  liftIO (writeIORef globalSinkRef writeEvent)
   -- init Subs
   forM_ subs $ \sub ->
     sub writeEvent
@@ -152,6 +155,13 @@ miso f = do
     -- Create virtual dom, perform initial diff
     liftIO (newIORef initialVTree)
 
+globalSinkRef :: IORef (Sink action)
+{-# NOINLINE globalSinkRef #-}
+globalSinkRef = unsafePerformIO $ newIORef (\_ -> pure ())
+
+globalSink :: IO (Sink action)
+globalSink = readIORef globalSinkRef
+
 -- | Runs a miso application
 startApp :: Eq model => App model action -> JSM ()
 startApp app@App {..} =