diff --git a/src/Miso.hs b/src/Miso.hs index 9eb7836..dab1d1a 100644 --- a/src/Miso.hs +++ b/src/Miso.hs @@ -22,6 +22,7 @@ module Miso ( miso , startApp + , sink , module Miso.Effect , module Miso.Event , module Miso.Html @@ -41,17 +42,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 +101,8 @@ common App {..} m getView = do let writeEvent a = void . liftIO . forkIO $ do atomicModifyIORef' actionsRef $ \as -> (as |> a, ()) notify + -- init global sink + liftIO (writeIORef sinkRef writeEvent) -- init Subs forM_ subs $ \sub -> sub writeEvent @@ -152,6 +156,16 @@ miso f = do -- Create virtual dom, perform initial diff liftIO (newIORef initialVTree) +sinkRef :: IORef (Sink action) +{-# NOINLINE sinkRef #-} +sinkRef = unsafePerformIO $ newIORef (\_ -> pure ()) + +-- | Global sink exposed as a backdoor +-- Meant for usage in long running IO actions, or custom callbacks +-- Good for integrating with third-party components. +sink :: Sink action +sink = unsafePerformIO (readIORef sinkRef) + -- | Runs a miso application startApp :: Eq model => App model action -> JSM () startApp app@App {..} =