{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fspecialise-aggressively #-}
module Reflex.Dom.Main where

import Prelude hiding (concat, mapM, mapM_, sequence, sequence_)

import Reflex.Adjustable.Class
import Reflex.Class
import Reflex.Dom.Builder.Immediate
import Reflex.Dom.Class
import Reflex.Host.Class
import Reflex.PerformEvent.Base
import Reflex.PostBuild.Base
import Reflex.Spider (Global, Spider, SpiderHost, runSpiderHost)
import Reflex.TriggerEvent.Base
import Reflex.TriggerEvent.Class
#ifdef PROFILE_REFLEX
import Reflex.Profiled
#endif

import Control.Concurrent
import Control.Lens
import Control.Monad
import Control.Monad.Reader
import Control.Monad.Ref
import Data.ByteString (ByteString)
import Data.Dependent.Sum (DSum (..))
import Data.Foldable (for_)
import Data.IORef
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding
import GHCJS.DOM
import GHCJS.DOM.Document
import GHCJS.DOM.Element
import GHCJS.DOM.Node
import GHCJS.DOM.NonElementParentNode
import GHCJS.DOM.Types (JSM)
import qualified GHCJS.DOM.Types as DOM

#ifdef PROFILE_REFLEX
import Reflex.Profiled
#endif

{-# INLINE mainHydrationWidgetWithHead #-}
mainHydrationWidgetWithHead :: (forall x. HydrationWidget x ()) -> (forall x. HydrationWidget x ()) -> JSM ()
mainHydrationWidgetWithHead :: (forall x. HydrationWidget x ())
-> (forall x. HydrationWidget x ()) -> JSM ()
mainHydrationWidgetWithHead forall x. HydrationWidget x ()
head' forall x. HydrationWidget x ()
body = HydrationWidget () () -> HydrationWidget () () -> JSM ()
mainHydrationWidgetWithHead' HydrationWidget () ()
forall x. HydrationWidget x ()
head' HydrationWidget () ()
forall x. HydrationWidget x ()
body

{-# INLINABLE mainHydrationWidgetWithHead' #-}
-- | Warning: `mainHydrationWidgetWithHead'` is provided only as performance tweak. It is expected to disappear in future releases.
mainHydrationWidgetWithHead' :: HydrationWidget () () -> HydrationWidget () () -> JSM ()
mainHydrationWidgetWithHead' :: HydrationWidget () () -> HydrationWidget () () -> JSM ()
mainHydrationWidgetWithHead' = JSM () -> HydrationWidget () () -> HydrationWidget () () -> JSM ()
mainHydrationWidgetWithSwitchoverAction' (() -> JSM ()
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

{-# INLINE mainHydrationWidgetWithSwitchoverAction #-}
mainHydrationWidgetWithSwitchoverAction :: JSM () -> (forall x. HydrationWidget x ()) -> (forall x. HydrationWidget x ()) -> JSM ()
mainHydrationWidgetWithSwitchoverAction :: JSM ()
-> (forall x. HydrationWidget x ())
-> (forall x. HydrationWidget x ())
-> JSM ()
mainHydrationWidgetWithSwitchoverAction JSM ()
switchoverAction forall x. HydrationWidget x ()
head' forall x. HydrationWidget x ()
body = JSM () -> HydrationWidget () () -> HydrationWidget () () -> JSM ()
mainHydrationWidgetWithSwitchoverAction' JSM ()
switchoverAction HydrationWidget () ()
forall x. HydrationWidget x ()
head' HydrationWidget () ()
forall x. HydrationWidget x ()
body

{-# INLINABLE mainHydrationWidgetWithSwitchoverAction' #-}
-- | Warning: `mainHydrationWidgetWithSwitchoverAction'` is provided only as performance tweak. It is expected to disappear in future releases.
mainHydrationWidgetWithSwitchoverAction' :: JSM () -> HydrationWidget () () -> HydrationWidget () () -> JSM ()
mainHydrationWidgetWithSwitchoverAction' :: JSM () -> HydrationWidget () () -> HydrationWidget () () -> JSM ()
mainHydrationWidgetWithSwitchoverAction' = IO ()
-> JSM ()
-> HydrationWidget () ()
-> HydrationWidget () ()
-> JSM ()
mainHydrationWidgetWithSwitchoverActionWithFailure' (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())


{-# INLINABLE mainHydrationWidgetWithSwitchoverActionWithFailure' #-}
-- | Warning: `mainHydrationWidgetWithSwitchoverActionWithFaiilure'` is provided only as performance tweak. It is expected to disappear in future releases.
mainHydrationWidgetWithSwitchoverActionWithFailure' :: IO () -> JSM () -> HydrationWidget () () -> HydrationWidget () () -> JSM ()
mainHydrationWidgetWithSwitchoverActionWithFailure' :: IO ()
-> JSM ()
-> HydrationWidget () ()
-> HydrationWidget () ()
-> JSM ()
mainHydrationWidgetWithSwitchoverActionWithFailure' IO ()
onFailure JSM ()
switchoverAction HydrationWidget () ()
head' HydrationWidget () ()
body = do
  IO ()
-> JSM ()
-> ((forall c. HydrationWidget () c -> FloatingWidget () c)
    -> (forall c. HydrationWidget () c -> FloatingWidget () c)
    -> FloatingWidget () ())
-> JSM ()
runHydrationWidgetWithHeadAndBodyWithFailure IO ()
onFailure JSM ()
switchoverAction (((forall c. HydrationWidget () c -> FloatingWidget () c)
  -> (forall c. HydrationWidget () c -> FloatingWidget () c)
  -> FloatingWidget () ())
 -> JSM ())
-> ((forall c. HydrationWidget () c -> FloatingWidget () c)
    -> (forall c. HydrationWidget () c -> FloatingWidget () c)
    -> FloatingWidget () ())
-> JSM ()
forall a b. (a -> b) -> a -> b
$ \forall c. HydrationWidget () c -> FloatingWidget () c
appendHead forall c. HydrationWidget () c -> FloatingWidget () c
appendBody -> do
    HydrationWidget () () -> FloatingWidget () ()
forall c. HydrationWidget () c -> FloatingWidget () c
appendHead HydrationWidget () ()
head'
    HydrationWidget () () -> FloatingWidget () ()
forall c. HydrationWidget () c -> FloatingWidget () c
appendBody HydrationWidget () ()
body

{-# INLINABLE attachHydrationWidget #-}
attachHydrationWidget
  :: JSM ()
  -> JSContextSingleton ()
  -> ( Event DomTimeline ()
    -> IORef HydrationMode
    -> Maybe (IORef [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
    -> EventChannel
    -> PerformEventT DomTimeline DomHost (a, IORef (Maybe (EventTrigger DomTimeline ())))
     )
  -> IO (a, FireCommand DomTimeline DomHost)
attachHydrationWidget :: forall a.
JSM ()
-> JSContextSingleton ()
-> (Event DomTimeline ()
    -> IORef HydrationMode
    -> Maybe
         (IORef
            [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
    -> EventChannel
    -> PerformEventT
         DomTimeline
         (SpiderHost Global)
         (a, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (a, FireCommand DomTimeline (SpiderHost Global))
attachHydrationWidget = IO ()
-> JSM ()
-> JSContextSingleton ()
-> (Event DomTimeline ()
    -> IORef HydrationMode
    -> Maybe
         (IORef
            [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
    -> EventChannel
    -> PerformEventT
         DomTimeline
         (SpiderHost Global)
         (a, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (a, FireCommand DomTimeline (SpiderHost Global))
forall a.
IO ()
-> JSM ()
-> JSContextSingleton ()
-> (Event DomTimeline ()
    -> IORef HydrationMode
    -> Maybe
         (IORef
            [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
    -> EventChannel
    -> PerformEventT
         DomTimeline
         (SpiderHost Global)
         (a, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (a, FireCommand DomTimeline (SpiderHost Global))
attachHydrationWidgetWithFailure (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

{-# INLINABLE attachHydrationWidgetWithFailure #-}
attachHydrationWidgetWithFailure
  :: IO ()
  -> JSM ()
  -> JSContextSingleton ()
  -> ( Event DomTimeline ()
    -> IORef HydrationMode
    -> Maybe (IORef [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
    -> EventChannel
    -> PerformEventT DomTimeline DomHost (a, IORef (Maybe (EventTrigger DomTimeline ())))
     )
  -> IO (a, FireCommand DomTimeline DomHost)
attachHydrationWidgetWithFailure :: forall a.
IO ()
-> JSM ()
-> JSContextSingleton ()
-> (Event DomTimeline ()
    -> IORef HydrationMode
    -> Maybe
         (IORef
            [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
    -> EventChannel
    -> PerformEventT
         DomTimeline
         (SpiderHost Global)
         (a, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (a, FireCommand DomTimeline (SpiderHost Global))
attachHydrationWidgetWithFailure IO ()
onFailure JSM ()
switchoverAction JSContextSingleton ()
jsSing Event DomTimeline ()
-> IORef HydrationMode
-> Maybe
     (IORef
        [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
-> EventChannel
-> PerformEventT
     DomTimeline
     (SpiderHost Global)
     (a, IORef (Maybe (EventTrigger DomTimeline ())))
w = do
  hydrationMode <- IO (IORef HydrationMode) -> IO (IORef HydrationMode)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef HydrationMode) -> IO (IORef HydrationMode))
-> IO (IORef HydrationMode) -> IO (IORef HydrationMode)
forall a b. (a -> b) -> a -> b
$ HydrationMode -> IO (IORef HydrationMode)
forall a. a -> IO (IORef a)
newIORef HydrationMode
HydrationMode_Hydrating
  rootNodesRef <- liftIO $ newIORef []
  events <- newChan
  runDomHost $ flip runTriggerEventT events $ mdo
    (syncEvent, fireSync) <- newTriggerEvent
    ((result, postBuildTriggerRef), fc@(FireCommand fire)) <- lift $ hostPerformEventT $ do
      a <- w syncEvent hydrationMode (Just rootNodesRef) events
      _ <- runWithReplace (return ()) $ delayedAction <$ syncEvent
      pure a
    mPostBuildTrigger <- readRef postBuildTriggerRef
    lift $ forM_ mPostBuildTrigger $ \RootTrigger Global ()
postBuildTrigger -> [DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase (SpiderHost Global) () -> SpiderHost Global [()]
forall a.
[DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase (SpiderHost Global) a -> SpiderHost Global [a]
fire [RootTrigger Global ()
postBuildTrigger RootTrigger Global ()
-> Identity () -> DSum (RootTrigger Global) Identity
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> () -> Identity ()
forall a. a -> Identity a
Identity ()] (ReadPhase (SpiderHost Global) () -> SpiderHost Global [()])
-> ReadPhase (SpiderHost Global) () -> SpiderHost Global [()]
forall a b. (a -> b) -> a -> b
$ () -> ReadPhase (SpiderHost Global) ()
forall a. a -> ReadPhase (SpiderHost Global) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    liftIO $ fireSync ()
    rootNodes <- liftIO $ readIORef rootNodesRef
    let delayedAction = do
          [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
-> ((Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
    -> PerformEventT DomTimeline (SpiderHost Global) ())
-> PerformEventT DomTimeline (SpiderHost Global) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
-> [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
forall a. [a] -> [a]
reverse [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
rootNodes) (((Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
  -> PerformEventT DomTimeline (SpiderHost Global) ())
 -> PerformEventT DomTimeline (SpiderHost Global) ())
-> ((Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
    -> PerformEventT DomTimeline (SpiderHost Global) ())
-> PerformEventT DomTimeline (SpiderHost Global) ()
forall a b. (a -> b) -> a -> b
$ \(Node
rootNode, HydrationRunnerT DomTimeline (DomCoreWidget ()) ()
runner) -> do
            let hydrate :: DomCoreWidget () ()
hydrate = HydrationRunnerT DomTimeline (DomCoreWidget ()) ()
-> IO ()
-> Maybe Node
-> Node
-> EventChannel
-> DomCoreWidget () ()
forall (m :: * -> *) t a.
(MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m,
 MonadReflexCreateTrigger t m, MonadJSM m,
 MonadJSM (Performable m)) =>
HydrationRunnerT t m a
-> IO ()
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationRunnerTWithFailure HydrationRunnerT DomTimeline (DomCoreWidget ()) ()
runner IO ()
onFailure Maybe Node
forall a. Maybe a
Nothing Node
rootNode EventChannel
events
            PerformEventT DomTimeline (SpiderHost Global) ()
-> PerformEventT DomTimeline (SpiderHost Global) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PerformEventT DomTimeline (SpiderHost Global) ()
 -> PerformEventT DomTimeline (SpiderHost Global) ())
-> PerformEventT DomTimeline (SpiderHost Global) ()
-> PerformEventT DomTimeline (SpiderHost Global) ()
forall a b. (a -> b) -> a -> b
$ WithJSContextSingleton
  () (PerformEventT DomTimeline (SpiderHost Global)) ()
-> JSContextSingleton ()
-> PerformEventT DomTimeline (SpiderHost Global) ()
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> JSContextSingleton x -> m a
runWithJSContextSingleton (DomCoreWidget () ()
-> Event DomTimeline ()
-> WithJSContextSingleton
     () (PerformEventT DomTimeline (SpiderHost Global)) ()
forall t (m :: * -> *) a. PostBuildT t m a -> Event t () -> m a
runPostBuildT DomCoreWidget () ()
hydrate Event DomTimeline ()
forall a. Event DomTimeline a
forall {k} (t :: k) a. Reflex t => Event t a
never) JSContextSingleton ()
jsSing
          IO () -> PerformEventT DomTimeline (SpiderHost Global) ()
forall a. IO a -> PerformEventT DomTimeline (SpiderHost Global) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PerformEventT DomTimeline (SpiderHost Global) ())
-> IO () -> PerformEventT DomTimeline (SpiderHost Global) ()
forall a b. (a -> b) -> a -> b
$ IORef HydrationMode -> HydrationMode -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef HydrationMode
hydrationMode HydrationMode
HydrationMode_Immediate
          WithJSContextSingleton
  () (PerformEventT DomTimeline (SpiderHost Global)) ()
-> JSContextSingleton ()
-> PerformEventT DomTimeline (SpiderHost Global) ()
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> JSContextSingleton x -> m a
runWithJSContextSingleton (JSM ()
-> WithJSContextSingleton
     () (PerformEventT DomTimeline (SpiderHost Global)) ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
DOM.liftJSM JSM ()
switchoverAction) JSContextSingleton ()
jsSing
    pure (result, fc)

type HydrationWidget x a = HydrationDomBuilderT HydrationDomSpace DomTimeline (DomCoreWidget x) a

-- | A widget that isn't attached to any particular part of the DOM hierarchy
type FloatingWidget x = TriggerEventT DomTimeline (DomCoreWidget x)

type DomCoreWidget x = PostBuildT DomTimeline (WithJSContextSingleton x (PerformEventT DomTimeline DomHost))

{-# INLINABLE runHydrationWidgetWithHeadAndBody #-}
runHydrationWidgetWithHeadAndBody
  :: JSM ()
  -> (   (forall c. HydrationWidget () c -> FloatingWidget () c) -- "Append to head" --TODO: test invoking this more than once
      -> (forall c. HydrationWidget () c -> FloatingWidget () c) -- "Append to body" --TODO: test invoking this more than once
      -> FloatingWidget () ()
     )
  -> JSM ()
runHydrationWidgetWithHeadAndBody :: JSM ()
-> ((forall c. HydrationWidget () c -> FloatingWidget () c)
    -> (forall c. HydrationWidget () c -> FloatingWidget () c)
    -> FloatingWidget () ())
-> JSM ()
runHydrationWidgetWithHeadAndBody = IO ()
-> JSM ()
-> ((forall c. HydrationWidget () c -> FloatingWidget () c)
    -> (forall c. HydrationWidget () c -> FloatingWidget () c)
    -> FloatingWidget () ())
-> JSM ()
runHydrationWidgetWithHeadAndBodyWithFailure (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

{-# INLINABLE runHydrationWidgetWithHeadAndBodyWithFailure #-}
runHydrationWidgetWithHeadAndBodyWithFailure
  :: IO ()
  -> JSM ()
  -> (   (forall c. HydrationWidget () c -> FloatingWidget () c) -- "Append to head" --TODO: test invoking this more than once
      -> (forall c. HydrationWidget () c -> FloatingWidget () c) -- "Append to body" --TODO: test invoking this more than once
      -> FloatingWidget () ()
     )
  -> JSM ()
runHydrationWidgetWithHeadAndBodyWithFailure :: IO ()
-> JSM ()
-> ((forall c. HydrationWidget () c -> FloatingWidget () c)
    -> (forall c. HydrationWidget () c -> FloatingWidget () c)
    -> FloatingWidget () ())
-> JSM ()
runHydrationWidgetWithHeadAndBodyWithFailure IO ()
onFailure JSM ()
switchoverAction (forall c. HydrationWidget () c -> FloatingWidget () c)
-> (forall c. HydrationWidget () c -> FloatingWidget () c)
-> FloatingWidget () ()
app = (JSContextSingleton () -> JSM ()) -> JSM ()
forall (m :: * -> *) r.
MonadJSM m =>
(JSContextSingleton () -> m r) -> m r
withJSContextSingletonMono ((JSContextSingleton () -> JSM ()) -> JSM ())
-> (JSContextSingleton () -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSContextSingleton ()
jsSing -> do
  globalDoc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  headElement <- getHeadUnchecked globalDoc
  bodyElement <- getBodyUnchecked globalDoc
  (events, fc) <- liftIO . attachHydrationWidgetWithFailure onFailure switchoverAction jsSing $ \Event DomTimeline ()
switchover IORef HydrationMode
hydrationMode Maybe
  (IORef
     [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
hydrationResult EventChannel
events -> do
    (postBuild, postBuildTriggerRef) <- PerformEventT
  DomTimeline
  (SpiderHost Global)
  (Event DomTimeline (), IORef (Maybe (RootTrigger Global ())))
PerformEventT
  DomTimeline
  (SpiderHost Global)
  (Event DomTimeline (),
   Ref
     (PerformEventT DomTimeline (SpiderHost Global))
     (Maybe (EventTrigger DomTimeline ())))
forall t (m :: * -> *) a.
(MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref IO) =>
m (Event t a, Ref m (Maybe (EventTrigger t a)))
newEventWithTriggerRef
    let hydrateDom :: DOM.Node -> HydrationWidget () c -> FloatingWidget () c
        hydrateDom Node
n HydrationWidget () c
w = do
          delayed <- IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()))
-> TriggerEventT
     DomTimeline
     (DomCoreWidget ())
     (IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()))
forall a. IO a -> TriggerEventT DomTimeline (DomCoreWidget ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()))
 -> TriggerEventT
      DomTimeline
      (DomCoreWidget ())
      (IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())))
-> IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()))
-> TriggerEventT
     DomTimeline
     (DomCoreWidget ())
     (IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()))
forall a b. (a -> b) -> a -> b
$ HydrationRunnerT DomTimeline (DomCoreWidget ()) ()
-> IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()))
forall a. a -> IO (IORef a)
newIORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()
 -> IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())))
-> HydrationRunnerT DomTimeline (DomCoreWidget ()) ()
-> IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()))
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT DomTimeline (DomCoreWidget ()) ()
forall a. a -> HydrationRunnerT DomTimeline (DomCoreWidget ()) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          unreadyChildren <- liftIO $ newIORef 0
          lift $ do
            let builderEnv = HydrationDomBuilderEnv
                  { _hydrationDomBuilderEnv_document :: Document
_hydrationDomBuilderEnv_document = Document
globalDoc
                  , _hydrationDomBuilderEnv_parent :: Either Node (IORef Node)
_hydrationDomBuilderEnv_parent = Node -> Either Node (IORef Node)
forall a b. a -> Either a b
Left (Node -> Either Node (IORef Node))
-> Node -> Either Node (IORef Node)
forall a b. (a -> b) -> a -> b
$ Node -> Node
forall o. IsNode o => o -> Node
toNode Node
n
                  , _hydrationDomBuilderEnv_unreadyChildren :: IORef Word
_hydrationDomBuilderEnv_unreadyChildren = IORef Word
unreadyChildren
                  , _hydrationDomBuilderEnv_commitAction :: JSM ()
_hydrationDomBuilderEnv_commitAction = () -> JSM ()
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                  , _hydrationDomBuilderEnv_hydrationMode :: IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode = IORef HydrationMode
hydrationMode
                  , _hydrationDomBuilderEnv_switchover :: Event DomTimeline ()
_hydrationDomBuilderEnv_switchover = Event DomTimeline ()
switchover
                  , _hydrationDomBuilderEnv_delayed :: IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
_hydrationDomBuilderEnv_delayed = IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
delayed
                  }
            a <- runHydrationDomBuilderT w builderEnv events
            forM_ hydrationResult $ \IORef [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
hr -> do
              res <- IO (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
-> PostBuildT
     DomTimeline
     (WithJSContextSingleton
        () (PerformEventT DomTimeline (SpiderHost Global)))
     (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
forall a.
IO a
-> PostBuildT
     DomTimeline
     (WithJSContextSingleton
        () (PerformEventT DomTimeline (SpiderHost Global)))
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
 -> PostBuildT
      DomTimeline
      (WithJSContextSingleton
         () (PerformEventT DomTimeline (SpiderHost Global)))
      (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()))
-> IO (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
-> PostBuildT
     DomTimeline
     (WithJSContextSingleton
        () (PerformEventT DomTimeline (SpiderHost Global)))
     (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
forall a b. (a -> b) -> a -> b
$ IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
-> IO (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
forall a. IORef a -> IO a
readIORef IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
delayed
              liftIO $ modifyIORef' hr ((n, res) :)
            pure a
    runWithJSContextSingleton (runPostBuildT (runTriggerEventT (app (hydrateDom $ toNode headElement) (hydrateDom $ toNode bodyElement)) events) postBuild) jsSing
    return (events, postBuildTriggerRef)
  liftIO $ processAsyncEvents events fc

{-# INLINE mainWidget #-}
mainWidget :: (forall x. Widget x ()) -> JSM ()
mainWidget :: (forall x. Widget x ()) -> JSM ()
mainWidget forall x. Widget x ()
w = Widget () () -> JSM ()
mainWidget' Widget () ()
forall x. Widget x ()
w

{-# INLINABLE mainWidget' #-}
-- | Warning: `mainWidget'` is provided only as performance tweak. It is expected to disappear in future releases.
mainWidget' :: Widget () () -> JSM ()
mainWidget' :: Widget () () -> JSM ()
mainWidget' Widget () ()
w = (JSContextSingleton () -> JSM ()) -> JSM ()
forall (m :: * -> *) r.
MonadJSM m =>
(JSContextSingleton () -> m r) -> m r
withJSContextSingletonMono ((JSContextSingleton () -> JSM ()) -> JSM ())
-> (JSContextSingleton () -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSContextSingleton ()
jsSing -> do
  doc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  body <- getBodyUnchecked doc
  attachWidget body jsSing w

--TODO: The x's should be unified here
{-# INLINABLE mainWidgetWithHead #-}
mainWidgetWithHead :: (forall x. Widget x ()) -> (forall x. Widget x ()) -> JSM ()
mainWidgetWithHead :: (forall x. Widget x ()) -> (forall x. Widget x ()) -> JSM ()
mainWidgetWithHead forall x. Widget x ()
h forall x. Widget x ()
b = (JSContextSingleton () -> JSM ()) -> JSM ()
forall (m :: * -> *) r.
MonadJSM m =>
(JSContextSingleton () -> m r) -> m r
withJSContextSingletonMono ((JSContextSingleton () -> JSM ()) -> JSM ())
-> (JSContextSingleton () -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSContextSingleton ()
jsSing -> do
  doc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  headElement <- getHeadUnchecked doc
  attachWidget headElement jsSing h
  body <- getBodyUnchecked doc
  attachWidget body jsSing b

{-# INLINABLE mainWidgetWithCss #-}
mainWidgetWithCss :: ByteString -> (forall x. Widget x ()) -> JSM ()
mainWidgetWithCss :: ByteString -> (forall x. Widget x ()) -> JSM ()
mainWidgetWithCss ByteString
css forall x. Widget x ()
w = (forall x. JSContextSingleton x -> JSM ()) -> JSM ()
forall (m :: * -> *) r.
MonadJSM m =>
(forall x. JSContextSingleton x -> m r) -> m r
withJSContextSingleton ((forall x. JSContextSingleton x -> JSM ()) -> JSM ())
-> (forall x. JSContextSingleton x -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSContextSingleton x
jsSing -> do
  doc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  headElement <- getHeadUnchecked doc
  setInnerHTML headElement $ "<style>" <> T.unpack (decodeUtf8 css) <> "</style>" --TODO: Fix this
  body <- getBodyUnchecked doc
  attachWidget body jsSing w

-- | The Reflex timeline for interacting with the DOM
type DomTimeline =
#ifdef PROFILE_REFLEX
  ProfiledTimeline
#endif
  Spider

-- | The ReflexHost the DOM lives in
type DomHost =
#ifdef PROFILE_REFLEX
  ProfiledM
#endif
  (SpiderHost Global)

runDomHost :: DomHost a -> IO a
runDomHost :: forall a. DomHost a -> IO a
runDomHost = SpiderHost Global a -> IO a
forall a. DomHost a -> IO a
runSpiderHost
#ifdef PROFILE_REFLEX
  . runProfiledM
#endif

type Widget x = ImmediateDomBuilderT DomTimeline (DomCoreWidget x)

{-# INLINABLE attachWidget #-}
attachWidget :: DOM.IsElement e => e -> JSContextSingleton x -> Widget x a -> JSM a
attachWidget :: forall e x a.
IsElement e =>
e -> JSContextSingleton x -> Widget x a -> JSM a
attachWidget e
rootElement JSContextSingleton x
wv Widget x a
w = (a, FireCommand DomTimeline (SpiderHost Global)) -> a
forall a b. (a, b) -> a
fst ((a, FireCommand DomTimeline (SpiderHost Global)) -> a)
-> JSM (a, FireCommand DomTimeline (SpiderHost Global)) -> JSM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e
-> JSContextSingleton x
-> Widget x a
-> JSM (a, FireCommand DomTimeline (SpiderHost Global))
forall e x a.
IsElement e =>
e
-> JSContextSingleton x
-> Widget x a
-> JSM (a, FireCommand DomTimeline (SpiderHost Global))
attachWidget' e
rootElement JSContextSingleton x
wv Widget x a
w

{-# INLINABLE runImmediateWidgetWithHeadAndBody #-}
runImmediateWidgetWithHeadAndBody
  :: (   (forall c. Widget () c -> FloatingWidget () c) -- "Append to head"
      -> (forall c. Widget () c -> FloatingWidget () c) -- "Append to body"
      -> FloatingWidget () ()
     )
  -> JSM ()
runImmediateWidgetWithHeadAndBody :: ((forall c. Widget () c -> FloatingWidget () c)
 -> (forall c. Widget () c -> FloatingWidget () c)
 -> FloatingWidget () ())
-> JSM ()
runImmediateWidgetWithHeadAndBody (forall c. Widget () c -> FloatingWidget () c)
-> (forall c. Widget () c -> FloatingWidget () c)
-> FloatingWidget () ()
app = (JSContextSingleton () -> JSM ()) -> JSM ()
forall (m :: * -> *) r.
MonadJSM m =>
(JSContextSingleton () -> m r) -> m r
withJSContextSingletonMono ((JSContextSingleton () -> JSM ()) -> JSM ())
-> (JSContextSingleton () -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSContextSingleton ()
jsSing -> do
  globalDoc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  headElement <- getHeadUnchecked globalDoc
  bodyElement <- getBodyUnchecked globalDoc
  headFragment <- createDocumentFragment globalDoc
  bodyFragment <- createDocumentFragment globalDoc
  (events, fc) <- liftIO . attachImmediateWidget $ \IORef HydrationMode
hydrationMode EventChannel
events -> do
    (postBuild, postBuildTriggerRef) <- PerformEventT
  DomTimeline
  (SpiderHost Global)
  (Event DomTimeline (), IORef (Maybe (RootTrigger Global ())))
PerformEventT
  DomTimeline
  (SpiderHost Global)
  (Event DomTimeline (),
   Ref
     (PerformEventT DomTimeline (SpiderHost Global))
     (Maybe (EventTrigger DomTimeline ())))
forall t (m :: * -> *) a.
(MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref IO) =>
m (Event t a, Ref m (Maybe (EventTrigger t a)))
newEventWithTriggerRef
    let go :: forall c. DOM.DocumentFragment -> Widget () c -> FloatingWidget () c
        go DocumentFragment
df Widget () c
w = do
          unreadyChildren <- IO (IORef Word)
-> TriggerEventT DomTimeline (DomCoreWidget ()) (IORef Word)
forall a. IO a -> TriggerEventT DomTimeline (DomCoreWidget ()) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Word)
 -> TriggerEventT DomTimeline (DomCoreWidget ()) (IORef Word))
-> IO (IORef Word)
-> TriggerEventT DomTimeline (DomCoreWidget ()) (IORef Word)
forall a b. (a -> b) -> a -> b
$ Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef Word
0
          delayed <- liftIO $ newIORef $ pure ()
          let builderEnv = HydrationDomBuilderEnv
                { _hydrationDomBuilderEnv_document :: Document
_hydrationDomBuilderEnv_document = Document
globalDoc
                , _hydrationDomBuilderEnv_parent :: Either Node (IORef Node)
_hydrationDomBuilderEnv_parent = Node -> Either Node (IORef Node)
forall a b. a -> Either a b
Left (Node -> Either Node (IORef Node))
-> Node -> Either Node (IORef Node)
forall a b. (a -> b) -> a -> b
$ DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode DocumentFragment
df
                , _hydrationDomBuilderEnv_unreadyChildren :: IORef Word
_hydrationDomBuilderEnv_unreadyChildren = IORef Word
unreadyChildren
                , _hydrationDomBuilderEnv_commitAction :: JSM ()
_hydrationDomBuilderEnv_commitAction = () -> JSM ()
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () --TODO: possibly `replaceElementContents n f`
                , _hydrationDomBuilderEnv_hydrationMode :: IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode = IORef HydrationMode
hydrationMode
                , _hydrationDomBuilderEnv_switchover :: Event DomTimeline ()
_hydrationDomBuilderEnv_switchover = Event DomTimeline ()
forall a. Event DomTimeline a
forall {k} (t :: k) a. Reflex t => Event t a
never
                , _hydrationDomBuilderEnv_delayed :: IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
_hydrationDomBuilderEnv_delayed = IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
delayed
                }
          lift $ runHydrationDomBuilderT w builderEnv events
    runWithJSContextSingleton (runPostBuildT (runTriggerEventT (app (go headFragment) (go bodyFragment)) events) postBuild) jsSing
    return (events, postBuildTriggerRef)
  replaceElementContents headElement headFragment
  replaceElementContents bodyElement bodyFragment
  liftIO $ processAsyncEvents events fc

-- | Warning: `mainWidgetWithHead'` is provided only as performance tweak. It is expected to disappear in future releases.
mainWidgetWithHead' :: (a -> Widget () b, b -> Widget () a) -> JSM ()
mainWidgetWithHead' :: forall a b. (a -> Widget () b, b -> Widget () a) -> JSM ()
mainWidgetWithHead' (a -> Widget () b
h, b -> Widget () a
b) = ((forall c. Widget () c -> FloatingWidget () c)
 -> (forall c. Widget () c -> FloatingWidget () c)
 -> FloatingWidget () ())
-> JSM ()
runImmediateWidgetWithHeadAndBody (((forall c. Widget () c -> FloatingWidget () c)
  -> (forall c. Widget () c -> FloatingWidget () c)
  -> FloatingWidget () ())
 -> JSM ())
-> ((forall c. Widget () c -> FloatingWidget () c)
    -> (forall c. Widget () c -> FloatingWidget () c)
    -> FloatingWidget () ())
-> JSM ()
forall a b. (a -> b) -> a -> b
$ \forall c. Widget () c -> FloatingWidget () c
appendHead forall c. Widget () c -> FloatingWidget () c
appendBody -> do
  rec hOut <- appendHead $ h bOut
      bOut <- appendBody $ b hOut
  pure ()

replaceElementContents :: DOM.IsElement e => e -> DOM.DocumentFragment -> JSM ()
replaceElementContents :: forall e. IsElement e => e -> DocumentFragment -> JSM ()
replaceElementContents e
e DocumentFragment
df = do
  e -> String -> JSM ()
forall (m :: * -> *) self val.
(MonadDOM m, IsElement self, ToJSString val) =>
self -> val -> m ()
setInnerHTML e
e (String
"" :: String)
  _ <- e -> DocumentFragment -> JSM Node
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m Node
appendChild e
e DocumentFragment
df
  return ()

{-# INLINABLE attachWidget' #-}
attachWidget' :: DOM.IsElement e => e -> JSContextSingleton x -> Widget x a -> JSM (a, FireCommand DomTimeline DomHost)
attachWidget' :: forall e x a.
IsElement e =>
e
-> JSContextSingleton x
-> Widget x a
-> JSM (a, FireCommand DomTimeline (SpiderHost Global))
attachWidget' e
rootElement JSContextSingleton x
jsSing Widget x a
w = do
  doc <- e -> JSM Document
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Document
getOwnerDocumentUnchecked e
rootElement
  df <- createDocumentFragment doc
  ((a, events), fc) <- liftIO . attachImmediateWidget $ \IORef HydrationMode
hydrationMode EventChannel
events -> do
    (postBuild, postBuildTriggerRef) <- PerformEventT
  DomTimeline
  (SpiderHost Global)
  (Event DomTimeline (), IORef (Maybe (RootTrigger Global ())))
PerformEventT
  DomTimeline
  (SpiderHost Global)
  (Event DomTimeline (),
   Ref
     (PerformEventT DomTimeline (SpiderHost Global))
     (Maybe (EventTrigger DomTimeline ())))
forall t (m :: * -> *) a.
(MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref IO) =>
m (Event t a, Ref m (Maybe (EventTrigger t a)))
newEventWithTriggerRef
    unreadyChildren <- liftIO $ newIORef 0
    delayed <- liftIO $ newIORef $ pure ()
    let builderEnv = HydrationDomBuilderEnv
          { _hydrationDomBuilderEnv_document :: Document
_hydrationDomBuilderEnv_document = Document -> Document
forall o. IsDocument o => o -> Document
toDocument Document
doc
          , _hydrationDomBuilderEnv_parent :: Either Node (IORef Node)
_hydrationDomBuilderEnv_parent = Node -> Either Node (IORef Node)
forall a b. a -> Either a b
Left (Node -> Either Node (IORef Node))
-> Node -> Either Node (IORef Node)
forall a b. (a -> b) -> a -> b
$ DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode DocumentFragment
df
          , _hydrationDomBuilderEnv_unreadyChildren :: IORef Word
_hydrationDomBuilderEnv_unreadyChildren = IORef Word
unreadyChildren
          , _hydrationDomBuilderEnv_commitAction :: JSM ()
_hydrationDomBuilderEnv_commitAction = () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO
          , _hydrationDomBuilderEnv_switchover :: Event DomTimeline ()
_hydrationDomBuilderEnv_switchover = Event DomTimeline ()
forall a. Event DomTimeline a
forall {k} (t :: k) a. Reflex t => Event t a
never
          , _hydrationDomBuilderEnv_delayed :: IORef
  (HydrationRunnerT
     DomTimeline
     (PostBuildT
        DomTimeline
        (WithJSContextSingleton
           x (PerformEventT DomTimeline (SpiderHost Global))))
     ())
_hydrationDomBuilderEnv_delayed = IORef
  (HydrationRunnerT
     DomTimeline
     (PostBuildT
        DomTimeline
        (WithJSContextSingleton
           x (PerformEventT DomTimeline (SpiderHost Global))))
     ())
delayed
          , _hydrationDomBuilderEnv_hydrationMode :: IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode = IORef HydrationMode
hydrationMode
          }
    a <- runWithJSContextSingleton (runPostBuildT (runHydrationDomBuilderT w builderEnv events) postBuild) jsSing
    return ((a, events), postBuildTriggerRef)
  replaceElementContents rootElement df
  liftIO $ processAsyncEvents events fc
  return (a, fc)

type EventChannel = Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]

{-# INLINABLE attachImmediateWidget #-}
attachImmediateWidget
  :: (   IORef HydrationMode
      -> EventChannel
      -> PerformEventT DomTimeline DomHost (a, IORef (Maybe (EventTrigger DomTimeline ())))
     )
  -> IO (a, FireCommand DomTimeline DomHost)
attachImmediateWidget :: forall a.
(IORef HydrationMode
 -> EventChannel
 -> PerformEventT
      DomTimeline
      (SpiderHost Global)
      (a, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (a, FireCommand DomTimeline (SpiderHost Global))
attachImmediateWidget IORef HydrationMode
-> EventChannel
-> PerformEventT
     DomTimeline
     (SpiderHost Global)
     (a, IORef (Maybe (EventTrigger DomTimeline ())))
w = do
  hydrationMode <- IO (IORef HydrationMode) -> IO (IORef HydrationMode)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef HydrationMode) -> IO (IORef HydrationMode))
-> IO (IORef HydrationMode) -> IO (IORef HydrationMode)
forall a b. (a -> b) -> a -> b
$ HydrationMode -> IO (IORef HydrationMode)
forall a. a -> IO (IORef a)
newIORef HydrationMode
HydrationMode_Immediate
  events <- newChan
  runDomHost $ do
    ((result, postBuildTriggerRef), fc@(FireCommand fire)) <- hostPerformEventT $ w hydrationMode events
    mPostBuildTrigger <- readRef postBuildTriggerRef
    forM_ mPostBuildTrigger $ \RootTrigger Global ()
postBuildTrigger -> [DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase (SpiderHost Global) () -> SpiderHost Global [()]
forall a.
[DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase (SpiderHost Global) a -> SpiderHost Global [a]
fire [RootTrigger Global ()
postBuildTrigger RootTrigger Global ()
-> Identity () -> DSum (RootTrigger Global) Identity
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> () -> Identity ()
forall a. a -> Identity a
Identity ()] (ReadPhase (SpiderHost Global) () -> SpiderHost Global [()])
-> ReadPhase (SpiderHost Global) () -> SpiderHost Global [()]
forall a b. (a -> b) -> a -> b
$ () -> ReadPhase (SpiderHost Global) ()
forall a. a -> ReadPhase (SpiderHost Global) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    return (result, fc)

processAsyncEvents :: EventChannel -> FireCommand DomTimeline DomHost -> IO ()
processAsyncEvents :: EventChannel
-> FireCommand DomTimeline (SpiderHost Global) -> IO ()
processAsyncEvents EventChannel
events (FireCommand forall a.
[DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase (SpiderHost Global) a -> SpiderHost Global [a]
fire) = IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  ers <- EventChannel
-> IO [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
forall a. Chan a -> IO a
readChan EventChannel
events
  _ <- runDomHost $ do
    mes <- liftIO $ forM ers $ \(EventTriggerRef IORef (Maybe (EventTrigger DomTimeline a))
er :=> TriggerInvocation a
a IO ()
_) -> do
      me <- IORef (Maybe (RootTrigger Global a))
-> IO (Maybe (RootTrigger Global a))
forall a. IORef a -> IO a
readIORef IORef (Maybe (EventTrigger DomTimeline a))
IORef (Maybe (RootTrigger Global a))
er
      return $ fmap (\RootTrigger Global a
e -> RootTrigger Global a
e RootTrigger Global a
-> Identity a -> DSum (RootTrigger Global) Identity
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> a -> Identity a
forall a. a -> Identity a
Identity a
a) me
    _ <- fire (catMaybes mes) $ return ()
    liftIO $ forM_ ers $ \(EventTriggerRef DomTimeline a
_ :=> TriggerInvocation a
_ IO ()
cb) -> IO ()
cb
  return ()

-- | Run a reflex-dom application inside of an existing DOM element with the given ID
mainWidgetInElementById :: Text -> (forall x. Widget x ()) -> JSM ()
mainWidgetInElementById :: Text -> (forall x. Widget x ()) -> JSM ()
mainWidgetInElementById Text
eid forall x. Widget x ()
w = (forall x. JSContextSingleton x -> JSM ()) -> JSM ()
forall (m :: * -> *) r.
MonadJSM m =>
(forall x. JSContextSingleton x -> m r) -> m r
withJSContextSingleton ((forall x. JSContextSingleton x -> JSM ()) -> JSM ())
-> (forall x. JSContextSingleton x -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSContextSingleton x
jsSing -> do
  doc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  root <- getElementByIdUnchecked doc eid
  attachWidget root jsSing w

newtype AppInput t = AppInput
  { forall t. AppInput t -> Window t
_appInput_window :: Window t
  }

newtype AppOutput t = AppOutput --TODO: Add quit event
  { forall t. AppOutput t -> WindowConfig t
_appOutput_windowConfig :: WindowConfig t
  }

runApp' :: (t ~ DomTimeline) => (forall x. AppInput t -> Widget x (AppOutput t)) -> JSM ()
runApp' :: forall t.
(t ~ DomTimeline) =>
(forall x. AppInput t -> Widget x (AppOutput t)) -> JSM ()
runApp' forall x. AppInput t -> Widget x (AppOutput t)
app = (forall x. JSContextSingleton x -> JSM ()) -> JSM ()
forall (m :: * -> *) r.
MonadJSM m =>
(forall x. JSContextSingleton x -> m r) -> m r
withJSContextSingleton ((forall x. JSContextSingleton x -> JSM ()) -> JSM ())
-> (forall x. JSContextSingleton x -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \JSContextSingleton x
jsSing -> do
  doc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  body <- getBodyUnchecked doc
  win <- getDefaultViewUnchecked doc
  rec o <- attachWidget body jsSing $ do
        w <- wrapWindow win $ _appOutput_windowConfig o
        app $ AppInput
          { _appInput_window = w
          }
  return ()

{-# DEPRECATED attachWidget'' "Use 'attachImmediateWidget . const' instead" #-}
{-# INLINABLE attachWidget'' #-}
attachWidget'' :: (EventChannel -> PerformEventT DomTimeline DomHost (a, IORef (Maybe (EventTrigger DomTimeline ())))) -> IO (a, FireCommand DomTimeline DomHost)
attachWidget'' :: forall a.
(EventChannel
 -> PerformEventT
      DomTimeline
      (SpiderHost Global)
      (a, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (a, FireCommand DomTimeline (SpiderHost Global))
attachWidget'' = (IORef HydrationMode
 -> EventChannel
 -> PerformEventT
      DomTimeline
      (SpiderHost Global)
      (a, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (a, FireCommand DomTimeline (SpiderHost Global))
(IORef HydrationMode
 -> EventChannel
 -> PerformEventT
      DomTimeline
      (SpiderHost Global)
      (a, IORef (Maybe (RootTrigger Global ()))))
-> IO (a, FireCommand DomTimeline (SpiderHost Global))
forall a.
(IORef HydrationMode
 -> EventChannel
 -> PerformEventT
      DomTimeline
      (SpiderHost Global)
      (a, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (a, FireCommand DomTimeline (SpiderHost Global))
attachImmediateWidget ((IORef HydrationMode
  -> EventChannel
  -> PerformEventT
       DomTimeline
       (SpiderHost Global)
       (a, IORef (Maybe (RootTrigger Global ()))))
 -> IO (a, FireCommand DomTimeline (SpiderHost Global)))
-> ((EventChannel
     -> PerformEventT
          DomTimeline
          (SpiderHost Global)
          (a, IORef (Maybe (RootTrigger Global ()))))
    -> IORef HydrationMode
    -> EventChannel
    -> PerformEventT
         DomTimeline
         (SpiderHost Global)
         (a, IORef (Maybe (RootTrigger Global ()))))
-> (EventChannel
    -> PerformEventT
         DomTimeline
         (SpiderHost Global)
         (a, IORef (Maybe (RootTrigger Global ()))))
-> IO (a, FireCommand DomTimeline (SpiderHost Global))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventChannel
 -> PerformEventT
      DomTimeline
      (SpiderHost Global)
      (a, IORef (Maybe (RootTrigger Global ()))))
-> IORef HydrationMode
-> EventChannel
-> PerformEventT
     DomTimeline
     (SpiderHost Global)
     (a, IORef (Maybe (RootTrigger Global ())))
forall a b. a -> b -> a
const