{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE PatternSynonyms #-}
{-# 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 hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
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.Monoid ((<>))
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 = HydrationWidget () () -> HydrationWidget () () -> JSM ()
(forall x. HydrationWidget x ())
-> (forall x. HydrationWidget x ()) -> JSM ()
mainHydrationWidgetWithHead'

{-# 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 (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 () -> HydrationWidget () () -> HydrationWidget () () -> JSM ()
JSM ()
-> (forall x. HydrationWidget x ())
-> (forall x. HydrationWidget x ())
-> JSM ()
mainHydrationWidgetWithSwitchoverAction'

{-# 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' switchoverAction :: JSM ()
switchoverAction head' :: HydrationWidget () ()
head' body :: HydrationWidget () ()
body = do
  JSM ()
-> ((forall c. HydrationWidget () c -> FloatingWidget () c)
    -> (forall c. HydrationWidget () c -> FloatingWidget () c)
    -> FloatingWidget () ())
-> JSM ()
runHydrationWidgetWithHeadAndBody 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
$ \appendHead :: forall c. HydrationWidget () c -> FloatingWidget () c
appendHead appendBody :: 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 :: 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 switchoverAction :: JSM ()
switchoverAction jsSing :: JSContextSingleton ()
jsSing w :: Event DomTimeline ()
-> IORef HydrationMode
-> Maybe
     (IORef
        [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
-> EventChannel
-> PerformEventT
     DomTimeline
     DomHost
     (a, IORef (Maybe (EventTrigger DomTimeline ())))
w = do
  IORef HydrationMode
hydrationMode <- IO (IORef HydrationMode) -> IO (IORef HydrationMode)
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
  IORef [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
rootNodesRef <- IO
  (IORef
     [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
-> IO
     (IORef
        [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (IORef
      [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
 -> IO
      (IORef
         [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]))
-> IO
     (IORef
        [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
-> IO
     (IORef
        [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
forall a b. (a -> b) -> a -> b
$ [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
-> IO
     (IORef
        [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
forall a. a -> IO (IORef a)
newIORef []
  EventChannel
events <- IO EventChannel
forall a. IO (Chan a)
newChan
  DomHost (a, FireCommand DomTimeline DomHost)
-> IO (a, FireCommand DomTimeline DomHost)
forall a. DomHost a -> IO a
runDomHost (DomHost (a, FireCommand DomTimeline DomHost)
 -> IO (a, FireCommand DomTimeline DomHost))
-> DomHost (a, FireCommand DomTimeline DomHost)
-> IO (a, FireCommand DomTimeline DomHost)
forall a b. (a -> b) -> a -> b
$ (TriggerEventT
   DomTimeline DomHost (a, FireCommand DomTimeline DomHost)
 -> EventChannel -> DomHost (a, FireCommand DomTimeline DomHost))
-> EventChannel
-> TriggerEventT
     DomTimeline DomHost (a, FireCommand DomTimeline DomHost)
-> DomHost (a, FireCommand DomTimeline DomHost)
forall a b c. (a -> b -> c) -> b -> a -> c
flip TriggerEventT
  DomTimeline DomHost (a, FireCommand DomTimeline DomHost)
-> EventChannel -> DomHost (a, FireCommand DomTimeline DomHost)
forall t (m :: * -> *) a.
TriggerEventT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runTriggerEventT EventChannel
events (TriggerEventT
   DomTimeline DomHost (a, FireCommand DomTimeline DomHost)
 -> DomHost (a, FireCommand DomTimeline DomHost))
-> TriggerEventT
     DomTimeline DomHost (a, FireCommand DomTimeline DomHost)
-> DomHost (a, FireCommand DomTimeline DomHost)
forall a b. (a -> b) -> a -> b
$ mdo
    (syncEvent :: Event DomTimeline ()
syncEvent, fireSync :: () -> IO ()
fireSync) <- TriggerEventT
  DomTimeline DomHost (Event DomTimeline (), () -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
    ((result :: a
result, postBuildTriggerRef :: IORef (Maybe (RootTrigger Global ()))
postBuildTriggerRef), fc :: FireCommand DomTimeline DomHost
fc@(FireCommand fire :: forall a.
[DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase DomHost a -> DomHost [a]
fire)) <- DomHost
  ((a, IORef (Maybe (RootTrigger Global ()))),
   FireCommand DomTimeline DomHost)
-> TriggerEventT
     DomTimeline
     DomHost
     ((a, IORef (Maybe (RootTrigger Global ()))),
      FireCommand DomTimeline DomHost)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomHost
   ((a, IORef (Maybe (RootTrigger Global ()))),
    FireCommand DomTimeline DomHost)
 -> TriggerEventT
      DomTimeline
      DomHost
      ((a, IORef (Maybe (RootTrigger Global ()))),
       FireCommand DomTimeline DomHost))
-> DomHost
     ((a, IORef (Maybe (RootTrigger Global ()))),
      FireCommand DomTimeline DomHost)
-> TriggerEventT
     DomTimeline
     DomHost
     ((a, IORef (Maybe (RootTrigger Global ()))),
      FireCommand DomTimeline DomHost)
forall a b. (a -> b) -> a -> b
$ PerformEventT
  DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ())))
-> DomHost
     ((a, IORef (Maybe (RootTrigger Global ()))),
      FireCommand DomTimeline DomHost)
forall t (m :: * -> *) a.
(Monad m, MonadSubscribeEvent t m, MonadReflexHost t m, MonadRef m,
 Ref m ~ Ref IO) =>
PerformEventT t m a -> m (a, FireCommand t m)
hostPerformEventT (PerformEventT
   DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ())))
 -> DomHost
      ((a, IORef (Maybe (RootTrigger Global ()))),
       FireCommand DomTimeline DomHost))
-> PerformEventT
     DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ())))
-> DomHost
     ((a, IORef (Maybe (RootTrigger Global ()))),
      FireCommand DomTimeline DomHost)
forall a b. (a -> b) -> a -> b
$ do
      (a, IORef (Maybe (RootTrigger Global ())))
a <- Event DomTimeline ()
-> IORef HydrationMode
-> Maybe
     (IORef
        [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
-> EventChannel
-> PerformEventT
     DomTimeline
     DomHost
     (a, IORef (Maybe (EventTrigger DomTimeline ())))
w Event DomTimeline ()
syncEvent IORef HydrationMode
hydrationMode (IORef [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
-> Maybe
     (IORef
        [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
forall a. a -> Maybe a
Just IORef [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
rootNodesRef) EventChannel
events
      ((), Event DomTimeline ())
_ <- PerformEventT DomTimeline DomHost ()
-> Event DomTimeline (PerformEventT DomTimeline DomHost ())
-> PerformEventT DomTimeline DomHost ((), Event DomTimeline ())
forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace (() -> PerformEventT DomTimeline DomHost ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Event DomTimeline (PerformEventT DomTimeline DomHost ())
 -> PerformEventT DomTimeline DomHost ((), Event DomTimeline ()))
-> Event DomTimeline (PerformEventT DomTimeline DomHost ())
-> PerformEventT DomTimeline DomHost ((), Event DomTimeline ())
forall a b. (a -> b) -> a -> b
$ PerformEventT DomTimeline DomHost ()
delayedAction PerformEventT DomTimeline DomHost ()
-> Event DomTimeline ()
-> Event DomTimeline (PerformEventT DomTimeline DomHost ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event DomTimeline ()
syncEvent
      (a, IORef (Maybe (RootTrigger Global ())))
-> PerformEventT
     DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ())))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a, IORef (Maybe (RootTrigger Global ())))
a
    Maybe (RootTrigger Global ())
mPostBuildTrigger <- Ref
  (TriggerEventT DomTimeline DomHost) (Maybe (RootTrigger Global ()))
-> TriggerEventT
     DomTimeline DomHost (Maybe (RootTrigger Global ()))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef IORef (Maybe (RootTrigger Global ()))
Ref
  (TriggerEventT DomTimeline DomHost) (Maybe (RootTrigger Global ()))
postBuildTriggerRef
    SpiderHost Global () -> TriggerEventT DomTimeline DomHost ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SpiderHost Global () -> TriggerEventT DomTimeline DomHost ())
-> SpiderHost Global () -> TriggerEventT DomTimeline DomHost ()
forall a b. (a -> b) -> a -> b
$ Maybe (RootTrigger Global ())
-> (RootTrigger Global () -> SpiderHost Global [()])
-> SpiderHost Global ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (RootTrigger Global ())
mPostBuildTrigger ((RootTrigger Global () -> SpiderHost Global [()])
 -> SpiderHost Global ())
-> (RootTrigger Global () -> SpiderHost Global [()])
-> SpiderHost Global ()
forall a b. (a -> b) -> a -> b
$ \postBuildTrigger :: RootTrigger Global ()
postBuildTrigger -> [DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase DomHost () -> SpiderHost Global [()]
forall a.
[DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase DomHost a -> DomHost [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 DomHost () -> SpiderHost Global [()])
-> ReadPhase DomHost () -> SpiderHost Global [()]
forall a b. (a -> b) -> a -> b
$ () -> ReadPhase Global ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    IO () -> TriggerEventT DomTimeline DomHost ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> TriggerEventT DomTimeline DomHost ())
-> IO () -> TriggerEventT DomTimeline DomHost ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
fireSync ()
    [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
rootNodes <- IO [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
-> TriggerEventT
     DomTimeline
     DomHost
     [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
 -> TriggerEventT
      DomTimeline
      DomHost
      [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
-> IO [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
-> TriggerEventT
     DomTimeline
     DomHost
     [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
forall a b. (a -> b) -> a -> b
$ IORef [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
-> IO [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
forall a. IORef a -> IO a
readIORef IORef [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
rootNodesRef
    let delayedAction :: PerformEventT DomTimeline DomHost ()
delayedAction = do
          [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
-> ((Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
    -> PerformEventT DomTimeline DomHost ())
-> PerformEventT DomTimeline DomHost ()
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 DomHost ())
 -> PerformEventT DomTimeline DomHost ())
-> ((Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
    -> PerformEventT DomTimeline DomHost ())
-> PerformEventT DomTimeline DomHost ()
forall a b. (a -> b) -> a -> b
$ \(rootNode :: Node
rootNode, runner :: HydrationRunnerT DomTimeline (DomCoreWidget ()) ()
runner) -> do
            let hydrate :: DomCoreWidget () ()
hydrate = HydrationRunnerT DomTimeline (DomCoreWidget ()) ()
-> 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
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationRunnerT HydrationRunnerT DomTimeline (DomCoreWidget ()) ()
runner Maybe Node
forall a. Maybe a
Nothing Node
rootNode EventChannel
events
            PerformEventT DomTimeline DomHost ()
-> PerformEventT DomTimeline DomHost ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PerformEventT DomTimeline DomHost ()
 -> PerformEventT DomTimeline DomHost ())
-> PerformEventT DomTimeline DomHost ()
-> PerformEventT DomTimeline DomHost ()
forall a b. (a -> b) -> a -> b
$ WithJSContextSingleton () (PerformEventT DomTimeline DomHost) ()
-> JSContextSingleton () -> PerformEventT DomTimeline DomHost ()
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> JSContextSingleton x -> m a
runWithJSContextSingleton (DomCoreWidget () ()
-> Event DomTimeline ()
-> WithJSContextSingleton () (PerformEventT DomTimeline DomHost) ()
forall t (m :: * -> *) a. PostBuildT t m a -> Event t () -> m a
runPostBuildT DomCoreWidget () ()
hydrate Event DomTimeline ()
forall k (t :: k) a. Reflex t => Event t a
never) JSContextSingleton ()
jsSing
          IO () -> PerformEventT DomTimeline DomHost ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PerformEventT DomTimeline DomHost ())
-> IO () -> PerformEventT DomTimeline DomHost ()
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 DomHost) ()
-> JSContextSingleton () -> PerformEventT DomTimeline DomHost ()
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> JSContextSingleton x -> m a
runWithJSContextSingleton (JSM ()
-> WithJSContextSingleton () (PerformEventT DomTimeline DomHost) ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
DOM.liftJSM JSM ()
switchoverAction) JSContextSingleton ()
jsSing
    (a, FireCommand DomTimeline DomHost)
-> TriggerEventT
     DomTimeline DomHost (a, FireCommand DomTimeline DomHost)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
result, FireCommand DomTimeline DomHost
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 switchoverAction :: JSM ()
switchoverAction app :: (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
$ \jsSing :: JSContextSingleton ()
jsSing -> do
  Document
globalDoc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  HTMLHeadElement
headElement <- Document -> JSM HTMLHeadElement
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLHeadElement
getHeadUnchecked Document
globalDoc
  HTMLElement
bodyElement <- Document -> JSM HTMLElement
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLElement
getBodyUnchecked Document
globalDoc
  (events :: EventChannel
events, fc :: FireCommand DomTimeline DomHost
fc) <- IO (EventChannel, FireCommand DomTimeline DomHost)
-> JSM (EventChannel, FireCommand DomTimeline DomHost)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (EventChannel, FireCommand DomTimeline DomHost)
 -> JSM (EventChannel, FireCommand DomTimeline DomHost))
-> ((Event DomTimeline ()
     -> IORef HydrationMode
     -> Maybe
          (IORef
             [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
     -> EventChannel
     -> PerformEventT
          DomTimeline
          DomHost
          (EventChannel, IORef (Maybe (RootTrigger Global ()))))
    -> IO (EventChannel, FireCommand DomTimeline DomHost))
-> (Event DomTimeline ()
    -> IORef HydrationMode
    -> Maybe
         (IORef
            [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
    -> EventChannel
    -> PerformEventT
         DomTimeline
         DomHost
         (EventChannel, IORef (Maybe (RootTrigger Global ()))))
-> JSM (EventChannel, FireCommand DomTimeline DomHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM ()
-> JSContextSingleton ()
-> (Event DomTimeline ()
    -> IORef HydrationMode
    -> Maybe
         (IORef
            [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
    -> EventChannel
    -> PerformEventT
         DomTimeline
         DomHost
         (EventChannel, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (EventChannel, FireCommand DomTimeline DomHost)
forall a.
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 JSM ()
switchoverAction JSContextSingleton ()
jsSing ((Event DomTimeline ()
  -> IORef HydrationMode
  -> Maybe
       (IORef
          [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
  -> EventChannel
  -> PerformEventT
       DomTimeline
       DomHost
       (EventChannel, IORef (Maybe (RootTrigger Global ()))))
 -> JSM (EventChannel, FireCommand DomTimeline DomHost))
-> (Event DomTimeline ()
    -> IORef HydrationMode
    -> Maybe
         (IORef
            [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
    -> EventChannel
    -> PerformEventT
         DomTimeline
         DomHost
         (EventChannel, IORef (Maybe (RootTrigger Global ()))))
-> JSM (EventChannel, FireCommand DomTimeline DomHost)
forall a b. (a -> b) -> a -> b
$ \switchover :: Event DomTimeline ()
switchover hydrationMode :: IORef HydrationMode
hydrationMode hydrationResult :: Maybe
  (IORef
     [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
hydrationResult events :: EventChannel
events -> do
    (postBuild :: Event DomTimeline ()
postBuild, postBuildTriggerRef :: IORef (Maybe (RootTrigger Global ()))
postBuildTriggerRef) <- PerformEventT
  DomTimeline
  DomHost
  (Event DomTimeline (), IORef (Maybe (RootTrigger Global ())))
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 -> HydrationWidget () c -> FloatingWidget () c
hydrateDom n :: Node
n w :: HydrationWidget () c
w = do
          IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
delayed <- IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()))
-> TriggerEventT
     DomTimeline
     (DomCoreWidget ())
     (IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()))
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
          IORef Word
unreadyChildren <- IO (IORef Word)
-> TriggerEventT DomTimeline (DomCoreWidget ()) (IORef Word)
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 0
          DomCoreWidget () c -> FloatingWidget () c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomCoreWidget () c -> FloatingWidget () c)
-> DomCoreWidget () c -> FloatingWidget () c
forall a b. (a -> b) -> a -> b
$ do
            let builderEnv :: HydrationDomBuilderEnv DomTimeline (DomCoreWidget ())
builderEnv = $WHydrationDomBuilderEnv :: forall t (m :: * -> *).
Document
-> Either Node (IORef Node)
-> IORef Word
-> JSM ()
-> IORef HydrationMode
-> Event t ()
-> IORef (HydrationRunnerT t m ())
-> HydrationDomBuilderEnv t m
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 (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
                  }
            c
a <- HydrationWidget () c
-> HydrationDomBuilderEnv DomTimeline (DomCoreWidget ())
-> EventChannel
-> DomCoreWidget () c
forall k (m :: * -> *) t (s :: k) a.
(MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m,
 MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef) =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderEnv t m
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationDomBuilderT HydrationWidget () c
w HydrationDomBuilderEnv DomTimeline (DomCoreWidget ())
builderEnv EventChannel
events
            Maybe
  (IORef
     [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
-> (IORef
      [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
    -> DomCoreWidget () ())
-> DomCoreWidget () ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe
  (IORef
     [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
hydrationResult ((IORef
    [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
  -> DomCoreWidget () ())
 -> DomCoreWidget () ())
-> (IORef
      [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
    -> DomCoreWidget () ())
-> DomCoreWidget () ()
forall a b. (a -> b) -> a -> b
$ \hr :: IORef [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
hr -> do
              HydrationRunnerT DomTimeline (DomCoreWidget ()) ()
res <- IO (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
-> DomCoreWidget
     () (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
 -> DomCoreWidget
      () (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()))
-> IO (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
-> DomCoreWidget
     () (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
              IO () -> DomCoreWidget () ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DomCoreWidget () ()) -> IO () -> DomCoreWidget () ()
forall a b. (a -> b) -> a -> b
$ IORef [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
-> ([(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
    -> [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
hr ((Node
n, HydrationRunnerT DomTimeline (DomCoreWidget ()) ()
res) (Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
-> [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
-> [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())]
forall a. a -> [a] -> [a]
:)
            c -> DomCoreWidget () c
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
a
    WithJSContextSingleton () (PerformEventT DomTimeline DomHost) ()
-> JSContextSingleton () -> PerformEventT DomTimeline DomHost ()
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> JSContextSingleton x -> m a
runWithJSContextSingleton (DomCoreWidget () ()
-> Event DomTimeline ()
-> WithJSContextSingleton () (PerformEventT DomTimeline DomHost) ()
forall t (m :: * -> *) a. PostBuildT t m a -> Event t () -> m a
runPostBuildT (FloatingWidget () () -> EventChannel -> DomCoreWidget () ()
forall t (m :: * -> *) a.
TriggerEventT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runTriggerEventT ((forall c. HydrationWidget () c -> FloatingWidget () c)
-> (forall c. HydrationWidget () c -> FloatingWidget () c)
-> FloatingWidget () ()
app (Node -> HydrationWidget () c -> FloatingWidget () c
forall c. Node -> HydrationWidget () c -> FloatingWidget () c
hydrateDom (Node -> HydrationWidget () c -> FloatingWidget () c)
-> Node -> HydrationWidget () c -> FloatingWidget () c
forall a b. (a -> b) -> a -> b
$ HTMLHeadElement -> Node
forall o. IsNode o => o -> Node
toNode HTMLHeadElement
headElement) (Node -> HydrationWidget () c -> FloatingWidget () c
forall c. Node -> HydrationWidget () c -> FloatingWidget () c
hydrateDom (Node -> HydrationWidget () c -> FloatingWidget () c)
-> Node -> HydrationWidget () c -> FloatingWidget () c
forall a b. (a -> b) -> a -> b
$ HTMLElement -> Node
forall o. IsNode o => o -> Node
toNode HTMLElement
bodyElement)) EventChannel
events) Event DomTimeline ()
postBuild) JSContextSingleton ()
jsSing
    (EventChannel, IORef (Maybe (RootTrigger Global ())))
-> PerformEventT
     DomTimeline
     DomHost
     (EventChannel, IORef (Maybe (RootTrigger Global ())))
forall (m :: * -> *) a. Monad m => a -> m a
return (EventChannel
events, IORef (Maybe (RootTrigger Global ()))
postBuildTriggerRef)
  IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ EventChannel -> FireCommand DomTimeline DomHost -> IO ()
processAsyncEvents EventChannel
events FireCommand DomTimeline DomHost
fc

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

{-# 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' w :: 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
$ \jsSing :: JSContextSingleton ()
jsSing -> do
  Document
doc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  HTMLElement
body <- Document -> JSM HTMLElement
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLElement
getBodyUnchecked Document
doc
  HTMLElement -> JSContextSingleton () -> Widget () () -> JSM ()
forall e x a.
IsElement e =>
e -> JSContextSingleton x -> Widget x a -> JSM a
attachWidget HTMLElement
body JSContextSingleton ()
jsSing Widget () ()
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 h :: forall x. Widget x ()
h b :: 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
$ \jsSing :: JSContextSingleton ()
jsSing -> do
  Document
doc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  HTMLHeadElement
headElement <- Document -> JSM HTMLHeadElement
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLHeadElement
getHeadUnchecked Document
doc
  HTMLHeadElement -> JSContextSingleton () -> Widget () () -> JSM ()
forall e x a.
IsElement e =>
e -> JSContextSingleton x -> Widget x a -> JSM a
attachWidget HTMLHeadElement
headElement JSContextSingleton ()
jsSing Widget () ()
forall x. Widget x ()
h
  HTMLElement
body <- Document -> JSM HTMLElement
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLElement
getBodyUnchecked Document
doc
  HTMLElement -> JSContextSingleton () -> Widget () () -> JSM ()
forall e x a.
IsElement e =>
e -> JSContextSingleton x -> Widget x a -> JSM a
attachWidget HTMLElement
body JSContextSingleton ()
jsSing Widget () ()
forall x. Widget x ()
b

{-# INLINABLE mainWidgetWithCss #-}
mainWidgetWithCss :: ByteString -> (forall x. Widget x ()) -> JSM ()
mainWidgetWithCss :: ByteString -> (forall x. Widget x ()) -> JSM ()
mainWidgetWithCss css :: ByteString
css w :: 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
$ \jsSing :: JSContextSingleton x
jsSing -> do
  Document
doc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  HTMLHeadElement
headElement <- Document -> JSM HTMLHeadElement
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLHeadElement
getHeadUnchecked Document
doc
  HTMLHeadElement -> [Char] -> JSM ()
forall (m :: * -> *) self val.
(MonadDOM m, IsElement self, ToJSString val) =>
self -> val -> m ()
setInnerHTML HTMLHeadElement
headElement ([Char] -> JSM ()) -> [Char] -> JSM ()
forall a b. (a -> b) -> a -> b
$ "<style>" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (ByteString -> Text
decodeUtf8 ByteString
css) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> "</style>" --TODO: Fix this
  HTMLElement
body <- Document -> JSM HTMLElement
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLElement
getBodyUnchecked Document
doc
  HTMLElement -> JSContextSingleton x -> Widget x () -> JSM ()
forall e x a.
IsElement e =>
e -> JSContextSingleton x -> Widget x a -> JSM a
attachWidget HTMLElement
body JSContextSingleton x
jsSing Widget x ()
forall x. Widget x ()
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 :: DomHost a -> IO a
runDomHost = DomHost 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 :: e -> JSContextSingleton x -> Widget x a -> JSM a
attachWidget rootElement :: e
rootElement wv :: JSContextSingleton x
wv w :: Widget x a
w = (a, FireCommand DomTimeline DomHost) -> a
forall a b. (a, b) -> a
fst ((a, FireCommand DomTimeline DomHost) -> a)
-> JSM (a, FireCommand DomTimeline DomHost) -> JSM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e
-> JSContextSingleton x
-> Widget x a
-> JSM (a, FireCommand DomTimeline DomHost)
forall e x a.
IsElement e =>
e
-> JSContextSingleton x
-> Widget x a
-> JSM (a, FireCommand DomTimeline DomHost)
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 app :: (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
$ \jsSing :: JSContextSingleton ()
jsSing -> do
  Document
globalDoc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  HTMLHeadElement
headElement <- Document -> JSM HTMLHeadElement
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLHeadElement
getHeadUnchecked Document
globalDoc
  HTMLElement
bodyElement <- Document -> JSM HTMLElement
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLElement
getBodyUnchecked Document
globalDoc
  DocumentFragment
headFragment <- Document -> JSM DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment Document
globalDoc
  DocumentFragment
bodyFragment <- Document -> JSM DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment Document
globalDoc
  (events :: EventChannel
events, fc :: FireCommand DomTimeline DomHost
fc) <- IO (EventChannel, FireCommand DomTimeline DomHost)
-> JSM (EventChannel, FireCommand DomTimeline DomHost)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (EventChannel, FireCommand DomTimeline DomHost)
 -> JSM (EventChannel, FireCommand DomTimeline DomHost))
-> ((IORef HydrationMode
     -> EventChannel
     -> PerformEventT
          DomTimeline
          DomHost
          (EventChannel, IORef (Maybe (RootTrigger Global ()))))
    -> IO (EventChannel, FireCommand DomTimeline DomHost))
-> (IORef HydrationMode
    -> EventChannel
    -> PerformEventT
         DomTimeline
         DomHost
         (EventChannel, IORef (Maybe (RootTrigger Global ()))))
-> JSM (EventChannel, FireCommand DomTimeline DomHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IORef HydrationMode
 -> EventChannel
 -> PerformEventT
      DomTimeline
      DomHost
      (EventChannel, IORef (Maybe (RootTrigger Global ()))))
-> IO (EventChannel, FireCommand DomTimeline DomHost)
forall a.
(IORef HydrationMode
 -> EventChannel
 -> PerformEventT
      DomTimeline
      DomHost
      (a, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (a, FireCommand DomTimeline DomHost)
attachImmediateWidget ((IORef HydrationMode
  -> EventChannel
  -> PerformEventT
       DomTimeline
       DomHost
       (EventChannel, IORef (Maybe (RootTrigger Global ()))))
 -> JSM (EventChannel, FireCommand DomTimeline DomHost))
-> (IORef HydrationMode
    -> EventChannel
    -> PerformEventT
         DomTimeline
         DomHost
         (EventChannel, IORef (Maybe (RootTrigger Global ()))))
-> JSM (EventChannel, FireCommand DomTimeline DomHost)
forall a b. (a -> b) -> a -> b
$ \hydrationMode :: IORef HydrationMode
hydrationMode events :: EventChannel
events -> do
    (postBuild :: Event DomTimeline ()
postBuild, postBuildTriggerRef :: IORef (Maybe (RootTrigger Global ()))
postBuildTriggerRef) <- PerformEventT
  DomTimeline
  DomHost
  (Event DomTimeline (), IORef (Maybe (RootTrigger Global ())))
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 -> Widget () c -> FloatingWidget () c
go df :: DocumentFragment
df w :: Widget () c
w = do
          IORef Word
unreadyChildren <- IO (IORef Word)
-> TriggerEventT DomTimeline (DomCoreWidget ()) (IORef Word)
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 0
          IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
delayed <- IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()))
-> TriggerEventT
     DomTimeline
     (DomCoreWidget ())
     (IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ()))
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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
          let builderEnv :: HydrationDomBuilderEnv DomTimeline (DomCoreWidget ())
builderEnv = $WHydrationDomBuilderEnv :: forall t (m :: * -> *).
Document
-> Either Node (IORef Node)
-> IORef Word
-> JSM ()
-> IORef HydrationMode
-> Event t ()
-> IORef (HydrationRunnerT t m ())
-> HydrationDomBuilderEnv t m
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 (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 k (t :: k) a. Reflex t => Event t a
never
                , _hydrationDomBuilderEnv_delayed :: IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
_hydrationDomBuilderEnv_delayed = IORef (HydrationRunnerT DomTimeline (DomCoreWidget ()) ())
delayed
                }
          DomCoreWidget () c -> FloatingWidget () c
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomCoreWidget () c -> FloatingWidget () c)
-> DomCoreWidget () c -> FloatingWidget () c
forall a b. (a -> b) -> a -> b
$ Widget () c
-> HydrationDomBuilderEnv DomTimeline (DomCoreWidget ())
-> EventChannel
-> DomCoreWidget () c
forall k (m :: * -> *) t (s :: k) a.
(MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m,
 MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef) =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderEnv t m
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationDomBuilderT Widget () c
w HydrationDomBuilderEnv DomTimeline (DomCoreWidget ())
builderEnv EventChannel
events
    WithJSContextSingleton () (PerformEventT DomTimeline DomHost) ()
-> JSContextSingleton () -> PerformEventT DomTimeline DomHost ()
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> JSContextSingleton x -> m a
runWithJSContextSingleton (DomCoreWidget () ()
-> Event DomTimeline ()
-> WithJSContextSingleton () (PerformEventT DomTimeline DomHost) ()
forall t (m :: * -> *) a. PostBuildT t m a -> Event t () -> m a
runPostBuildT (FloatingWidget () () -> EventChannel -> DomCoreWidget () ()
forall t (m :: * -> *) a.
TriggerEventT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runTriggerEventT ((forall c. Widget () c -> FloatingWidget () c)
-> (forall c. Widget () c -> FloatingWidget () c)
-> FloatingWidget () ()
app (DocumentFragment -> Widget () c -> FloatingWidget () c
forall c. DocumentFragment -> Widget () c -> FloatingWidget () c
go DocumentFragment
headFragment) (DocumentFragment -> Widget () c -> FloatingWidget () c
forall c. DocumentFragment -> Widget () c -> FloatingWidget () c
go DocumentFragment
bodyFragment)) EventChannel
events) Event DomTimeline ()
postBuild) JSContextSingleton ()
jsSing
    (EventChannel, IORef (Maybe (RootTrigger Global ())))
-> PerformEventT
     DomTimeline
     DomHost
     (EventChannel, IORef (Maybe (RootTrigger Global ())))
forall (m :: * -> *) a. Monad m => a -> m a
return (EventChannel
events, IORef (Maybe (RootTrigger Global ()))
postBuildTriggerRef)
  HTMLHeadElement -> DocumentFragment -> JSM ()
forall e. IsElement e => e -> DocumentFragment -> JSM ()
replaceElementContents HTMLHeadElement
headElement DocumentFragment
headFragment
  HTMLElement -> DocumentFragment -> JSM ()
forall e. IsElement e => e -> DocumentFragment -> JSM ()
replaceElementContents HTMLElement
bodyElement DocumentFragment
bodyFragment
  IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ EventChannel -> FireCommand DomTimeline DomHost -> IO ()
processAsyncEvents EventChannel
events FireCommand DomTimeline DomHost
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' :: (a -> Widget () b, b -> Widget () a) -> JSM ()
mainWidgetWithHead' (h :: a -> Widget () b
h, b :: 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
$ \appendHead :: forall c. Widget () c -> FloatingWidget () c
appendHead appendBody :: forall c. Widget () c -> FloatingWidget () c
appendBody -> do
  rec b
hOut <- Widget () b -> FloatingWidget () b
forall c. Widget () c -> FloatingWidget () c
appendHead (Widget () b -> FloatingWidget () b)
-> Widget () b -> FloatingWidget () b
forall a b. (a -> b) -> a -> b
$ a -> Widget () b
h a
bOut
      a
bOut <- Widget () a -> FloatingWidget () a
forall c. Widget () c -> FloatingWidget () c
appendBody (Widget () a -> FloatingWidget () a)
-> Widget () a -> FloatingWidget () a
forall a b. (a -> b) -> a -> b
$ b -> Widget () a
b b
hOut
  () -> FloatingWidget () ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

{-# INLINABLE attachWidget' #-}
attachWidget' :: DOM.IsElement e => e -> JSContextSingleton x -> Widget x a -> JSM (a, FireCommand DomTimeline DomHost)
attachWidget' :: e
-> JSContextSingleton x
-> Widget x a
-> JSM (a, FireCommand DomTimeline DomHost)
attachWidget' rootElement :: e
rootElement jsSing :: JSContextSingleton x
jsSing w :: Widget x a
w = do
  Document
doc <- e -> JSM Document
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Document
getOwnerDocumentUnchecked e
rootElement
  DocumentFragment
df <- Document -> JSM DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment Document
doc
  ((a :: a
a, events :: EventChannel
events), fc :: FireCommand DomTimeline DomHost
fc) <- IO ((a, EventChannel), FireCommand DomTimeline DomHost)
-> JSM ((a, EventChannel), FireCommand DomTimeline DomHost)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ((a, EventChannel), FireCommand DomTimeline DomHost)
 -> JSM ((a, EventChannel), FireCommand DomTimeline DomHost))
-> ((IORef HydrationMode
     -> EventChannel
     -> PerformEventT
          DomTimeline
          DomHost
          ((a, EventChannel), IORef (Maybe (RootTrigger Global ()))))
    -> IO ((a, EventChannel), FireCommand DomTimeline DomHost))
-> (IORef HydrationMode
    -> EventChannel
    -> PerformEventT
         DomTimeline
         DomHost
         ((a, EventChannel), IORef (Maybe (RootTrigger Global ()))))
-> JSM ((a, EventChannel), FireCommand DomTimeline DomHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IORef HydrationMode
 -> EventChannel
 -> PerformEventT
      DomTimeline
      DomHost
      ((a, EventChannel), IORef (Maybe (RootTrigger Global ()))))
-> IO ((a, EventChannel), FireCommand DomTimeline DomHost)
forall a.
(IORef HydrationMode
 -> EventChannel
 -> PerformEventT
      DomTimeline
      DomHost
      (a, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (a, FireCommand DomTimeline DomHost)
attachImmediateWidget ((IORef HydrationMode
  -> EventChannel
  -> PerformEventT
       DomTimeline
       DomHost
       ((a, EventChannel), IORef (Maybe (RootTrigger Global ()))))
 -> JSM ((a, EventChannel), FireCommand DomTimeline DomHost))
-> (IORef HydrationMode
    -> EventChannel
    -> PerformEventT
         DomTimeline
         DomHost
         ((a, EventChannel), IORef (Maybe (RootTrigger Global ()))))
-> JSM ((a, EventChannel), FireCommand DomTimeline DomHost)
forall a b. (a -> b) -> a -> b
$ \hydrationMode :: IORef HydrationMode
hydrationMode events :: EventChannel
events -> do
    (postBuild :: Event DomTimeline ()
postBuild, postBuildTriggerRef :: IORef (Maybe (RootTrigger Global ()))
postBuildTriggerRef) <- PerformEventT
  DomTimeline
  DomHost
  (Event DomTimeline (), IORef (Maybe (RootTrigger Global ())))
forall t (m :: * -> *) a.
(MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref IO) =>
m (Event t a, Ref m (Maybe (EventTrigger t a)))
newEventWithTriggerRef
    IORef Word
unreadyChildren <- IO (IORef Word) -> PerformEventT DomTimeline DomHost (IORef Word)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Word) -> PerformEventT DomTimeline DomHost (IORef Word))
-> IO (IORef Word)
-> PerformEventT DomTimeline DomHost (IORef Word)
forall a b. (a -> b) -> a -> b
$ Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef 0
    IORef (HydrationRunnerT DomTimeline (DomCoreWidget x) ())
delayed <- IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget x) ()))
-> PerformEventT
     DomTimeline
     DomHost
     (IORef (HydrationRunnerT DomTimeline (DomCoreWidget x) ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget x) ()))
 -> PerformEventT
      DomTimeline
      DomHost
      (IORef (HydrationRunnerT DomTimeline (DomCoreWidget x) ())))
-> IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget x) ()))
-> PerformEventT
     DomTimeline
     DomHost
     (IORef (HydrationRunnerT DomTimeline (DomCoreWidget x) ()))
forall a b. (a -> b) -> a -> b
$ HydrationRunnerT DomTimeline (DomCoreWidget x) ()
-> IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget x) ()))
forall a. a -> IO (IORef a)
newIORef (HydrationRunnerT DomTimeline (DomCoreWidget x) ()
 -> IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget x) ())))
-> HydrationRunnerT DomTimeline (DomCoreWidget x) ()
-> IO (IORef (HydrationRunnerT DomTimeline (DomCoreWidget x) ()))
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT DomTimeline (DomCoreWidget x) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    let builderEnv :: HydrationDomBuilderEnv DomTimeline (DomCoreWidget x)
builderEnv = $WHydrationDomBuilderEnv :: forall t (m :: * -> *).
Document
-> Either Node (IORef Node)
-> IORef Word
-> JSM ()
-> IORef HydrationMode
-> Event t ()
-> IORef (HydrationRunnerT t m ())
-> HydrationDomBuilderEnv t m
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 (m :: * -> *) a. Monad m => a -> m a
return () --TODO
          , _hydrationDomBuilderEnv_switchover :: Event DomTimeline ()
_hydrationDomBuilderEnv_switchover = Event DomTimeline ()
forall k (t :: k) a. Reflex t => Event t a
never
          , _hydrationDomBuilderEnv_delayed :: IORef (HydrationRunnerT DomTimeline (DomCoreWidget x) ())
_hydrationDomBuilderEnv_delayed = IORef (HydrationRunnerT DomTimeline (DomCoreWidget x) ())
delayed
          , _hydrationDomBuilderEnv_hydrationMode :: IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode = IORef HydrationMode
hydrationMode
          }
    a
a <- WithJSContextSingleton x (PerformEventT DomTimeline DomHost) a
-> JSContextSingleton x -> PerformEventT DomTimeline DomHost a
forall x (m :: * -> *) a.
WithJSContextSingleton x m a -> JSContextSingleton x -> m a
runWithJSContextSingleton (PostBuildT
  DomTimeline
  (WithJSContextSingleton x (PerformEventT DomTimeline DomHost))
  a
-> Event DomTimeline ()
-> WithJSContextSingleton x (PerformEventT DomTimeline DomHost) a
forall t (m :: * -> *) a. PostBuildT t m a -> Event t () -> m a
runPostBuildT (Widget x a
-> HydrationDomBuilderEnv DomTimeline (DomCoreWidget x)
-> EventChannel
-> PostBuildT
     DomTimeline
     (WithJSContextSingleton x (PerformEventT DomTimeline DomHost))
     a
forall k (m :: * -> *) t (s :: k) a.
(MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m,
 MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef) =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderEnv t m
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationDomBuilderT Widget x a
w HydrationDomBuilderEnv DomTimeline (DomCoreWidget x)
builderEnv EventChannel
events) Event DomTimeline ()
postBuild) JSContextSingleton x
jsSing
    ((a, EventChannel), IORef (Maybe (RootTrigger Global ())))
-> PerformEventT
     DomTimeline
     DomHost
     ((a, EventChannel), IORef (Maybe (RootTrigger Global ())))
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a, EventChannel
events), IORef (Maybe (RootTrigger Global ()))
postBuildTriggerRef)
  e -> DocumentFragment -> JSM ()
forall e. IsElement e => e -> DocumentFragment -> JSM ()
replaceElementContents e
rootElement DocumentFragment
df
  IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ EventChannel -> FireCommand DomTimeline DomHost -> IO ()
processAsyncEvents EventChannel
events FireCommand DomTimeline DomHost
fc
  (a, FireCommand DomTimeline DomHost)
-> JSM (a, FireCommand DomTimeline DomHost)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, FireCommand DomTimeline DomHost
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 :: (IORef HydrationMode
 -> EventChannel
 -> PerformEventT
      DomTimeline
      DomHost
      (a, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (a, FireCommand DomTimeline DomHost)
attachImmediateWidget w :: IORef HydrationMode
-> EventChannel
-> PerformEventT
     DomTimeline
     DomHost
     (a, IORef (Maybe (EventTrigger DomTimeline ())))
w = do
  IORef HydrationMode
hydrationMode <- IO (IORef HydrationMode) -> IO (IORef HydrationMode)
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
  EventChannel
events <- IO EventChannel
forall a. IO (Chan a)
newChan
  DomHost (a, FireCommand DomTimeline DomHost)
-> IO (a, FireCommand DomTimeline DomHost)
forall a. DomHost a -> IO a
runDomHost (DomHost (a, FireCommand DomTimeline DomHost)
 -> IO (a, FireCommand DomTimeline DomHost))
-> DomHost (a, FireCommand DomTimeline DomHost)
-> IO (a, FireCommand DomTimeline DomHost)
forall a b. (a -> b) -> a -> b
$ do
    ((result :: a
result, postBuildTriggerRef :: IORef (Maybe (RootTrigger Global ()))
postBuildTriggerRef), fc :: FireCommand DomTimeline DomHost
fc@(FireCommand fire :: forall a.
[DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase DomHost a -> DomHost [a]
fire)) <- PerformEventT
  DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ())))
-> DomHost
     ((a, IORef (Maybe (RootTrigger Global ()))),
      FireCommand DomTimeline DomHost)
forall t (m :: * -> *) a.
(Monad m, MonadSubscribeEvent t m, MonadReflexHost t m, MonadRef m,
 Ref m ~ Ref IO) =>
PerformEventT t m a -> m (a, FireCommand t m)
hostPerformEventT (PerformEventT
   DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ())))
 -> DomHost
      ((a, IORef (Maybe (RootTrigger Global ()))),
       FireCommand DomTimeline DomHost))
-> PerformEventT
     DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ())))
-> DomHost
     ((a, IORef (Maybe (RootTrigger Global ()))),
      FireCommand DomTimeline DomHost)
forall a b. (a -> b) -> a -> b
$ IORef HydrationMode
-> EventChannel
-> PerformEventT
     DomTimeline
     DomHost
     (a, IORef (Maybe (EventTrigger DomTimeline ())))
w IORef HydrationMode
hydrationMode EventChannel
events
    Maybe (RootTrigger Global ())
mPostBuildTrigger <- Ref DomHost (Maybe (RootTrigger Global ()))
-> SpiderHost Global (Maybe (RootTrigger Global ()))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef IORef (Maybe (RootTrigger Global ()))
Ref DomHost (Maybe (RootTrigger Global ()))
postBuildTriggerRef
    Maybe (RootTrigger Global ())
-> (RootTrigger Global () -> SpiderHost Global [()])
-> SpiderHost Global ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (RootTrigger Global ())
mPostBuildTrigger ((RootTrigger Global () -> SpiderHost Global [()])
 -> SpiderHost Global ())
-> (RootTrigger Global () -> SpiderHost Global [()])
-> SpiderHost Global ()
forall a b. (a -> b) -> a -> b
$ \postBuildTrigger :: RootTrigger Global ()
postBuildTrigger -> [DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase DomHost () -> SpiderHost Global [()]
forall a.
[DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase DomHost a -> DomHost [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 DomHost () -> SpiderHost Global [()])
-> ReadPhase DomHost () -> SpiderHost Global [()]
forall a b. (a -> b) -> a -> b
$ () -> ReadPhase Global ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (a, FireCommand DomTimeline DomHost)
-> DomHost (a, FireCommand DomTimeline DomHost)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
result, FireCommand DomTimeline DomHost
fc)

processAsyncEvents :: EventChannel -> FireCommand DomTimeline DomHost -> IO ()
processAsyncEvents :: EventChannel -> FireCommand DomTimeline DomHost -> IO ()
processAsyncEvents events :: EventChannel
events (FireCommand fire :: forall a.
[DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase DomHost a -> DomHost [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
  [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
ers <- EventChannel
-> IO [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
forall a. Chan a -> IO a
readChan EventChannel
events
  ()
_ <- SpiderHost Global () -> IO ()
forall a. DomHost a -> IO a
runDomHost (SpiderHost Global () -> IO ()) -> SpiderHost Global () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    [Maybe (DSum (RootTrigger Global) Identity)]
mes <- IO [Maybe (DSum (RootTrigger Global) Identity)]
-> SpiderHost Global [Maybe (DSum (RootTrigger Global) Identity)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Maybe (DSum (RootTrigger Global) Identity)]
 -> SpiderHost Global [Maybe (DSum (RootTrigger Global) Identity)])
-> IO [Maybe (DSum (RootTrigger Global) Identity)]
-> SpiderHost Global [Maybe (DSum (RootTrigger Global) Identity)]
forall a b. (a -> b) -> a -> b
$ [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
-> (DSum (EventTriggerRef DomTimeline) TriggerInvocation
    -> IO (Maybe (DSum (RootTrigger Global) Identity)))
-> IO [Maybe (DSum (RootTrigger Global) Identity)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
ers ((DSum (EventTriggerRef DomTimeline) TriggerInvocation
  -> IO (Maybe (DSum (RootTrigger Global) Identity)))
 -> IO [Maybe (DSum (RootTrigger Global) Identity)])
-> (DSum (EventTriggerRef DomTimeline) TriggerInvocation
    -> IO (Maybe (DSum (RootTrigger Global) Identity)))
-> IO [Maybe (DSum (RootTrigger Global) Identity)]
forall a b. (a -> b) -> a -> b
$ \(EventTriggerRef er :: IORef (Maybe (EventTrigger DomTimeline a))
er :=> TriggerInvocation a :: a
a _) -> do
      Maybe (RootTrigger Global a)
me <- IORef (Maybe (RootTrigger Global a))
-> IO (Maybe (RootTrigger Global a))
forall a. IORef a -> IO a
readIORef IORef (Maybe (RootTrigger Global a))
IORef (Maybe (EventTrigger DomTimeline a))
er
      Maybe (DSum (RootTrigger Global) Identity)
-> IO (Maybe (DSum (RootTrigger Global) Identity))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (DSum (RootTrigger Global) Identity)
 -> IO (Maybe (DSum (RootTrigger Global) Identity)))
-> Maybe (DSum (RootTrigger Global) Identity)
-> IO (Maybe (DSum (RootTrigger Global) Identity))
forall a b. (a -> b) -> a -> b
$ (RootTrigger Global a -> DSum (RootTrigger Global) Identity)
-> Maybe (RootTrigger Global a)
-> Maybe (DSum (RootTrigger Global) Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\e :: 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) Maybe (RootTrigger Global a)
me
    [()]
_ <- [DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase DomHost () -> SpiderHost Global [()]
forall a.
[DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase DomHost a -> DomHost [a]
fire ([Maybe (DSum (RootTrigger Global) Identity)]
-> [DSum (RootTrigger Global) Identity]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (DSum (RootTrigger Global) Identity)]
mes) (ReadPhase DomHost () -> SpiderHost Global [()])
-> ReadPhase DomHost () -> SpiderHost Global [()]
forall a b. (a -> b) -> a -> b
$ () -> ReadPhase Global ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    IO () -> SpiderHost Global ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SpiderHost Global ()) -> IO () -> SpiderHost Global ()
forall a b. (a -> b) -> a -> b
$ [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
-> (DSum (EventTriggerRef DomTimeline) TriggerInvocation -> IO ())
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
ers ((DSum (EventTriggerRef DomTimeline) TriggerInvocation -> IO ())
 -> IO ())
-> (DSum (EventTriggerRef DomTimeline) TriggerInvocation -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(_ :=> TriggerInvocation _ cb :: IO ()
cb) -> IO ()
cb
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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 eid :: Text
eid w :: 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
$ \jsSing :: JSContextSingleton x
jsSing -> do
  Document
doc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  Element
root <- Document -> Text -> JSM Element
forall (m :: * -> *) self elementId.
(MonadDOM m, IsNonElementParentNode self, ToJSString elementId) =>
self -> elementId -> m Element
getElementByIdUnchecked Document
doc Text
eid
  Element -> JSContextSingleton x -> Widget x () -> JSM ()
forall e x a.
IsElement e =>
e -> JSContextSingleton x -> Widget x a -> JSM a
attachWidget Element
root JSContextSingleton x
jsSing Widget x ()
forall x. Widget x ()
w

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

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

runApp' :: (t ~ DomTimeline) => (forall x. AppInput t -> Widget x (AppOutput t)) -> JSM ()
runApp' :: (forall x. AppInput t -> Widget x (AppOutput t)) -> JSM ()
runApp' app :: 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
$ \jsSing :: JSContextSingleton x
jsSing -> do
  Document
doc <- JSM Document
forall (m :: * -> *). MonadDOM m => m Document
currentDocumentUnchecked
  HTMLElement
body <- Document -> JSM HTMLElement
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m HTMLElement
getBodyUnchecked Document
doc
  Window
win <- Document -> JSM Window
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m Window
getDefaultViewUnchecked Document
doc
  rec AppOutput t
o <- HTMLElement
-> JSContextSingleton x
-> Widget x (AppOutput t)
-> JSM (AppOutput t)
forall e x a.
IsElement e =>
e -> JSContextSingleton x -> Widget x a -> JSM a
attachWidget HTMLElement
body JSContextSingleton x
jsSing (Widget x (AppOutput t) -> JSM (AppOutput t))
-> Widget x (AppOutput t) -> JSM (AppOutput t)
forall a b. (a -> b) -> a -> b
$ do
        Window DomTimeline
w <- Window
-> WindowConfig DomTimeline
-> HydrationDomBuilderT
     GhcjsDomSpace DomTimeline (DomCoreWidget x) (Window DomTimeline)
forall (m :: * -> *) t.
(MonadJSM m, MonadReflexCreateTrigger t m) =>
Window
-> WindowConfig t
-> HydrationDomBuilderT GhcjsDomSpace t m (Window t)
wrapWindow Window
win (WindowConfig DomTimeline
 -> HydrationDomBuilderT
      GhcjsDomSpace DomTimeline (DomCoreWidget x) (Window DomTimeline))
-> WindowConfig DomTimeline
-> HydrationDomBuilderT
     GhcjsDomSpace DomTimeline (DomCoreWidget x) (Window DomTimeline)
forall a b. (a -> b) -> a -> b
$ AppOutput DomTimeline -> WindowConfig DomTimeline
forall t. AppOutput t -> WindowConfig t
_appOutput_windowConfig AppOutput DomTimeline
o
        AppInput t -> Widget x (AppOutput t)
forall x. AppInput t -> Widget x (AppOutput t)
app (AppInput t -> Widget x (AppOutput t))
-> AppInput t -> Widget x (AppOutput t)
forall a b. (a -> b) -> a -> b
$ AppInput :: forall t. Window t -> AppInput t
AppInput
          { _appInput_window :: Window t
_appInput_window = Window t
Window DomTimeline
w
          }
  () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
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'' :: (EventChannel
 -> PerformEventT
      DomTimeline
      DomHost
      (a, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (a, FireCommand DomTimeline DomHost)
attachWidget'' = (IORef HydrationMode
 -> EventChannel
 -> PerformEventT
      DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ()))))
-> IO (a, FireCommand DomTimeline DomHost)
forall a.
(IORef HydrationMode
 -> EventChannel
 -> PerformEventT
      DomTimeline
      DomHost
      (a, IORef (Maybe (EventTrigger DomTimeline ()))))
-> IO (a, FireCommand DomTimeline DomHost)
attachImmediateWidget ((IORef HydrationMode
  -> EventChannel
  -> PerformEventT
       DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ()))))
 -> IO (a, FireCommand DomTimeline DomHost))
-> ((EventChannel
     -> PerformEventT
          DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ()))))
    -> IORef HydrationMode
    -> EventChannel
    -> PerformEventT
         DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ()))))
-> (EventChannel
    -> PerformEventT
         DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ()))))
-> IO (a, FireCommand DomTimeline DomHost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventChannel
 -> PerformEventT
      DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ()))))
-> IORef HydrationMode
-> EventChannel
-> PerformEventT
     DomTimeline DomHost (a, IORef (Maybe (RootTrigger Global ())))
forall a b. a -> b -> a
const