{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Reflex.Dom.Prerender
( Prerender (..)
, prerender_
, PrerenderClientConstraint
, PrerenderBaseConstraints
) where
import Control.Monad
import Control.Monad.Fix
import Control.Monad.Primitive (PrimMonad(..))
import Control.Monad.Reader
import Control.Monad.Ref (MonadRef(..), MonadAtomicRef(..))
import Data.IORef (IORef, newIORef)
import Data.Kind (Type)
import Data.Semigroup.Commutative
import Data.Text (Text)
import Data.Void
import GHCJS.DOM.Types (MonadJSM)
import Reflex hiding (askEvents)
import Reflex.Dom.Builder.Class
import Reflex.Dom.Builder.Hydratable
import Reflex.Dom.Builder.Immediate
import Reflex.Dom.Builder.InputDisabled
import Reflex.Dom.Builder.Static
import Reflex.Host.Class
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import qualified GHCJS.DOM.Document as Document
import qualified GHCJS.DOM.Node as Node
import qualified GHCJS.DOM.Types as DOM
type PrerenderClientConstraint t m =
( DomBuilder t m
, DomBuilderSpace m ~ GhcjsDomSpace
, DomRenderHook t m
, HasDocument m
, TriggerEvent t m
, PrerenderBaseConstraints t m
)
type PrerenderBaseConstraints t m =
( MonadFix m
, MonadHold t m
, MonadJSM (Performable m)
, MonadJSM m
, MonadRef (Performable m)
, MonadRef m
, MonadReflexCreateTrigger t m
, MonadSample t (Performable m)
, PerformEvent t m
, PostBuild t m
, PrimMonad m
, Ref (Performable m) ~ IORef
, Ref m ~ IORef
)
prerender_
:: (Functor m, Reflex t, Prerender t m)
=> m () -> Client m () -> m ()
prerender_ :: forall (m :: * -> *) t.
(Functor m, Reflex t, Prerender t m) =>
m () -> Client m () -> m ()
prerender_ m ()
server Client m ()
client = m (Dynamic t ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Dynamic t ()) -> m ()) -> m (Dynamic t ()) -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> Client m () -> m (Dynamic t ())
forall a. m a -> Client m a -> m (Dynamic t a)
forall t (m :: * -> *) a.
Prerender t m =>
m a -> Client m a -> m (Dynamic t a)
prerender m ()
server Client m ()
client
class (PrerenderClientConstraint t (Client m), Client (Client m) ~ Client m, Prerender t (Client m)) => Prerender t m | m -> t where
type Client m :: Type -> Type
prerender :: m a -> Client m a -> m (Dynamic t a)
instance (ReflexHost t, Adjustable t m, PrerenderBaseConstraints t m) => Prerender t (HydrationDomBuilderT GhcjsDomSpace t m) where
type Client (HydrationDomBuilderT GhcjsDomSpace t m) = HydrationDomBuilderT GhcjsDomSpace t m
prerender :: forall a.
HydrationDomBuilderT GhcjsDomSpace t m a
-> Client (HydrationDomBuilderT GhcjsDomSpace t m) a
-> HydrationDomBuilderT GhcjsDomSpace t m (Dynamic t a)
prerender HydrationDomBuilderT GhcjsDomSpace t m a
_ Client (HydrationDomBuilderT GhcjsDomSpace t m) a
client = a -> Dynamic t a
forall a. a -> Dynamic t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Dynamic t a)
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT GhcjsDomSpace t m (Dynamic t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HydrationDomBuilderT GhcjsDomSpace t m a
Client (HydrationDomBuilderT GhcjsDomSpace t m) a
client
instance (Adjustable t m, PrerenderBaseConstraints t m, ReflexHost t) => Prerender t (HydrationDomBuilderT HydrationDomSpace t m) where
type Client (HydrationDomBuilderT HydrationDomSpace t m) = PostBuildT t (HydrationDomBuilderT GhcjsDomSpace t m)
prerender :: forall a.
HydrationDomBuilderT HydrationDomSpace t m a
-> Client (HydrationDomBuilderT HydrationDomSpace t m) a
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t a)
prerender HydrationDomBuilderT HydrationDomSpace t m a
server Client (HydrationDomBuilderT HydrationDomSpace t m) a
client = do
env <- ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT
HydrationDomSpace t m (HydrationDomBuilderEnv t m)
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(HydrationDomBuilderEnv t m)
forall r (m :: * -> *). MonadReader r m => m r
ask
events <- askEvents
doc <- askDocument
serverDf <- Document.createDocumentFragment doc
df <- Document.createDocumentFragment doc
unreadyChildren <- HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_unreadyChildren
immediateMode <- liftIO $ newIORef HydrationMode_Immediate
delayed <- liftIO $ newIORef $ pure ()
let clientEnv = HydrationDomBuilderEnv t m
env
{ _hydrationDomBuilderEnv_parent = Left $ DOM.toNode df
, _hydrationDomBuilderEnv_hydrationMode = immediateMode
}
serverEnv = HydrationDomBuilderEnv
{ _hydrationDomBuilderEnv_document :: Document
_hydrationDomBuilderEnv_document = 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
DOM.toNode DocumentFragment
serverDf
, _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_delayed :: IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed = IORef (HydrationRunnerT t m ())
delayed
, _hydrationDomBuilderEnv_hydrationMode :: IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode = IORef HydrationMode
immediateMode
, _hydrationDomBuilderEnv_switchover :: Event t ()
_hydrationDomBuilderEnv_switchover = Event t ()
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never
}
a0 <- lift $ runHydrationDomBuilderT server serverEnv events
(a', trigger) <- newTriggerEvent
getHydrationMode >>= \case
HydrationMode
HydrationMode_Immediate -> do
IO () -> HydrationDomBuilderT HydrationDomSpace t m ()
forall a. IO a -> HydrationDomBuilderT HydrationDomSpace t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT HydrationDomSpace t m ())
-> (a -> IO ())
-> a
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO ()
trigger (a -> HydrationDomBuilderT HydrationDomSpace t m ())
-> (m a -> HydrationDomBuilderT HydrationDomSpace t m a)
-> m a
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< m a -> HydrationDomBuilderT HydrationDomSpace t m a
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT HydrationDomSpace t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT HydrationDomSpace t m ())
-> m a -> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderEnv t m
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m 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 (PostBuildT t (HydrationDomBuilderT GhcjsDomSpace t m) a
-> Event t () -> HydrationDomBuilderT GhcjsDomSpace t m a
forall t (m :: * -> *) a. PostBuildT t m a -> Event t () -> m a
runPostBuildT PostBuildT t (HydrationDomBuilderT GhcjsDomSpace t m) a
Client (HydrationDomBuilderT HydrationDomSpace t m) a
client (Event t () -> HydrationDomBuilderT GhcjsDomSpace t m a)
-> Event t () -> HydrationDomBuilderT GhcjsDomSpace t m a
forall a b. (a -> b) -> a -> b
$ Event t a -> Event t ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Event t a
a') HydrationDomBuilderEnv t m
clientEnv Chan [DSum (EventTriggerRef t) TriggerInvocation]
events
Node -> HydrationDomBuilderT HydrationDomSpace t m ()
forall {k} (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT HydrationDomSpace t m ())
-> Node -> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ DocumentFragment -> Node
forall o. IsNode o => o -> Node
DOM.toNode DocumentFragment
df
HydrationMode
HydrationMode_Hydrating -> HydrationRunnerT t m ()
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall {k} (m :: * -> *) t (s :: k).
MonadIO m =>
HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
addHydrationStep (HydrationRunnerT t m ()
-> HydrationDomBuilderT HydrationDomSpace t m ())
-> HydrationRunnerT t m ()
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> HydrationRunnerT t m ()
forall a. IO a -> HydrationRunnerT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> (a -> IO ()) -> a -> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO ()
trigger (a -> HydrationRunnerT t m ())
-> (m a -> HydrationRunnerT t m a)
-> m a
-> HydrationRunnerT t m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< m a -> HydrationRunnerT t m a
forall (m :: * -> *) a. Monad m => m a -> HydrationRunnerT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationRunnerT t m ()) -> m a -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderEnv t m
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m 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 (PostBuildT t (HydrationDomBuilderT GhcjsDomSpace t m) a
-> Event t () -> HydrationDomBuilderT GhcjsDomSpace t m a
forall t (m :: * -> *) a. PostBuildT t m a -> Event t () -> m a
runPostBuildT PostBuildT t (HydrationDomBuilderT GhcjsDomSpace t m) a
Client (HydrationDomBuilderT HydrationDomSpace t m) a
client (Event t () -> HydrationDomBuilderT GhcjsDomSpace t m a)
-> Event t () -> HydrationDomBuilderT GhcjsDomSpace t m a
forall a b. (a -> b) -> a -> b
$ Event t a -> Event t ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Event t a
a') HydrationDomBuilderEnv t m
clientEnv Chan [DSum (EventTriggerRef t) TriggerInvocation]
events
DocumentFragment -> Comment -> HydrationRunnerT t m ()
forall (m :: * -> *) new existing.
(MonadJSM m, IsNode new, IsNode existing) =>
new -> existing -> m ()
insertBefore DocumentFragment
df (Comment -> HydrationRunnerT t m ())
-> HydrationRunnerT t m Comment -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Document -> HydrationRunnerT t m Comment
forall (m :: * -> *) t.
(MonadIO m, MonadJSM m, Reflex t, MonadFix m) =>
Document -> HydrationRunnerT t m Comment
deleteToPrerenderEnd Document
doc
holdDyn a0 a'
newtype UnrunnableT t m a = UnrunnableT (ReaderT Void m a)
deriving ((forall a b. (a -> b) -> UnrunnableT t m a -> UnrunnableT t m b)
-> (forall a b. a -> UnrunnableT t m b -> UnrunnableT t m a)
-> Functor (UnrunnableT t m)
forall a b. a -> UnrunnableT t m b -> UnrunnableT t m a
forall a b. (a -> b) -> UnrunnableT t m a -> UnrunnableT t m b
forall t (m :: * -> *) a b.
Functor m =>
a -> UnrunnableT t m b -> UnrunnableT t m a
forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> UnrunnableT t m a -> UnrunnableT t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> UnrunnableT t m a -> UnrunnableT t m b
fmap :: forall a b. (a -> b) -> UnrunnableT t m a -> UnrunnableT t m b
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> UnrunnableT t m b -> UnrunnableT t m a
<$ :: forall a b. a -> UnrunnableT t m b -> UnrunnableT t m a
Functor, Functor (UnrunnableT t m)
Functor (UnrunnableT t m) =>
(forall a. a -> UnrunnableT t m a)
-> (forall a b.
UnrunnableT t m (a -> b) -> UnrunnableT t m a -> UnrunnableT t m b)
-> (forall a b c.
(a -> b -> c)
-> UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m c)
-> (forall a b.
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m b)
-> (forall a b.
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m a)
-> Applicative (UnrunnableT t m)
forall a. a -> UnrunnableT t m a
forall a b.
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m a
forall a b.
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m b
forall a b.
UnrunnableT t m (a -> b) -> UnrunnableT t m a -> UnrunnableT t m b
forall a b c.
(a -> b -> c)
-> UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m c
forall t (m :: * -> *). Applicative m => Functor (UnrunnableT t m)
forall t (m :: * -> *) a. Applicative m => a -> UnrunnableT t m a
forall t (m :: * -> *) a b.
Applicative m =>
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m a
forall t (m :: * -> *) a b.
Applicative m =>
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m b
forall t (m :: * -> *) a b.
Applicative m =>
UnrunnableT t m (a -> b) -> UnrunnableT t m a -> UnrunnableT t m b
forall t (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall t (m :: * -> *) a. Applicative m => a -> UnrunnableT t m a
pure :: forall a. a -> UnrunnableT t m a
$c<*> :: forall t (m :: * -> *) a b.
Applicative m =>
UnrunnableT t m (a -> b) -> UnrunnableT t m a -> UnrunnableT t m b
<*> :: forall a b.
UnrunnableT t m (a -> b) -> UnrunnableT t m a -> UnrunnableT t m b
$cliftA2 :: forall t (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m c
liftA2 :: forall a b c.
(a -> b -> c)
-> UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m c
$c*> :: forall t (m :: * -> *) a b.
Applicative m =>
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m b
*> :: forall a b.
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m b
$c<* :: forall t (m :: * -> *) a b.
Applicative m =>
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m a
<* :: forall a b.
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m a
Applicative, Applicative (UnrunnableT t m)
Applicative (UnrunnableT t m) =>
(forall a b.
UnrunnableT t m a -> (a -> UnrunnableT t m b) -> UnrunnableT t m b)
-> (forall a b.
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m b)
-> (forall a. a -> UnrunnableT t m a)
-> Monad (UnrunnableT t m)
forall a. a -> UnrunnableT t m a
forall a b.
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m b
forall a b.
UnrunnableT t m a -> (a -> UnrunnableT t m b) -> UnrunnableT t m b
forall t (m :: * -> *). Monad m => Applicative (UnrunnableT t m)
forall t (m :: * -> *) a. Monad m => a -> UnrunnableT t m a
forall t (m :: * -> *) a b.
Monad m =>
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m b
forall t (m :: * -> *) a b.
Monad m =>
UnrunnableT t m a -> (a -> UnrunnableT t m b) -> UnrunnableT t m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
UnrunnableT t m a -> (a -> UnrunnableT t m b) -> UnrunnableT t m b
>>= :: forall a b.
UnrunnableT t m a -> (a -> UnrunnableT t m b) -> UnrunnableT t m b
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m b
>> :: forall a b.
UnrunnableT t m a -> UnrunnableT t m b -> UnrunnableT t m b
$creturn :: forall t (m :: * -> *) a. Monad m => a -> UnrunnableT t m a
return :: forall a. a -> UnrunnableT t m a
Monad, (forall (m :: * -> *). Monad m => Monad (UnrunnableT t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> UnrunnableT t m a)
-> MonadTrans (UnrunnableT t)
forall t (m :: * -> *). Monad m => Monad (UnrunnableT t m)
forall t (m :: * -> *) a. Monad m => m a -> UnrunnableT t m a
forall (m :: * -> *). Monad m => Monad (UnrunnableT t m)
forall (m :: * -> *) a. Monad m => m a -> UnrunnableT t m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall t (m :: * -> *) a. Monad m => m a -> UnrunnableT t m a
lift :: forall (m :: * -> *) a. Monad m => m a -> UnrunnableT t m a
MonadTrans)
unrunnable :: UnrunnableT t m a
unrunnable :: forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable = ReaderT Void m a -> UnrunnableT t m a
forall t (m :: * -> *) a. ReaderT Void m a -> UnrunnableT t m a
UnrunnableT (ReaderT Void m a -> UnrunnableT t m a)
-> ReaderT Void m a -> UnrunnableT t m a
forall a b. (a -> b) -> a -> b
$ (Void -> m a) -> ReaderT Void m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Void -> m a) -> ReaderT Void m a)
-> (Void -> m a) -> ReaderT Void m a
forall a b. (a -> b) -> a -> b
$ \case {}
instance (Reflex t, Monad m) => DomBuilder t (UnrunnableT t m) where
type DomBuilderSpace (UnrunnableT t m) = GhcjsDomSpace
textNode :: TextNodeConfig t
-> UnrunnableT t m (TextNode (DomBuilderSpace (UnrunnableT t m)) t)
textNode TextNodeConfig t
_ = UnrunnableT t m (TextNode (DomBuilderSpace (UnrunnableT t m)) t)
UnrunnableT t m (TextNode GhcjsDomSpace t)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
commentNode :: CommentNodeConfig t
-> UnrunnableT
t m (CommentNode (DomBuilderSpace (UnrunnableT t m)) t)
commentNode CommentNodeConfig t
_ = UnrunnableT t m (CommentNode (DomBuilderSpace (UnrunnableT t m)) t)
UnrunnableT t m (CommentNode GhcjsDomSpace t)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
element :: forall (er :: EventTag -> *) a.
Text
-> ElementConfig er t (DomBuilderSpace (UnrunnableT t m))
-> UnrunnableT t m a
-> UnrunnableT
t m (Element er (DomBuilderSpace (UnrunnableT t m)) t, a)
element Text
_ ElementConfig er t (DomBuilderSpace (UnrunnableT t m))
_ UnrunnableT t m a
_ = UnrunnableT
t m (Element er (DomBuilderSpace (UnrunnableT t m)) t, a)
UnrunnableT t m (Element er GhcjsDomSpace t, a)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
inputElement :: forall (er :: EventTag -> *).
InputElementConfig er t (DomBuilderSpace (UnrunnableT t m))
-> UnrunnableT
t m (InputElement er (DomBuilderSpace (UnrunnableT t m)) t)
inputElement InputElementConfig er t (DomBuilderSpace (UnrunnableT t m))
_ = UnrunnableT
t m (InputElement er (DomBuilderSpace (UnrunnableT t m)) t)
UnrunnableT t m (InputElement er GhcjsDomSpace t)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
textAreaElement :: forall (er :: EventTag -> *).
TextAreaElementConfig er t (DomBuilderSpace (UnrunnableT t m))
-> UnrunnableT
t m (TextAreaElement er (DomBuilderSpace (UnrunnableT t m)) t)
textAreaElement TextAreaElementConfig er t (DomBuilderSpace (UnrunnableT t m))
_ = UnrunnableT
t m (TextAreaElement er (DomBuilderSpace (UnrunnableT t m)) t)
UnrunnableT t m (TextAreaElement er GhcjsDomSpace t)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
selectElement :: forall (er :: EventTag -> *) a.
SelectElementConfig er t (DomBuilderSpace (UnrunnableT t m))
-> UnrunnableT t m a
-> UnrunnableT
t m (SelectElement er (DomBuilderSpace (UnrunnableT t m)) t, a)
selectElement SelectElementConfig er t (DomBuilderSpace (UnrunnableT t m))
_ UnrunnableT t m a
_ = UnrunnableT
t m (SelectElement er (DomBuilderSpace (UnrunnableT t m)) t, a)
UnrunnableT t m (SelectElement er GhcjsDomSpace t, a)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
placeRawElement :: RawElement (DomBuilderSpace (UnrunnableT t m))
-> UnrunnableT t m ()
placeRawElement RawElement (DomBuilderSpace (UnrunnableT t m))
_ = UnrunnableT t m ()
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
wrapRawElement :: forall (er :: EventTag -> *).
RawElement (DomBuilderSpace (UnrunnableT t m))
-> RawElementConfig er t (DomBuilderSpace (UnrunnableT t m))
-> UnrunnableT
t m (Element er (DomBuilderSpace (UnrunnableT t m)) t)
wrapRawElement RawElement (DomBuilderSpace (UnrunnableT t m))
_ RawElementConfig er t (DomBuilderSpace (UnrunnableT t m))
_ = UnrunnableT t m (Element er (DomBuilderSpace (UnrunnableT t m)) t)
UnrunnableT t m (Element er GhcjsDomSpace t)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance (Reflex t, Monad m) => NotReady t (UnrunnableT t m) where
notReadyUntil :: forall a. Event t a -> UnrunnableT t m ()
notReadyUntil Event t a
_ = UnrunnableT t m ()
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
notReady :: UnrunnableT t m ()
notReady = UnrunnableT t m ()
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance (Reflex t, Monad m) => Adjustable t (UnrunnableT t m) where
runWithReplace :: forall a b.
UnrunnableT t m a
-> Event t (UnrunnableT t m b) -> UnrunnableT t m (a, Event t b)
runWithReplace UnrunnableT t m a
_ Event t (UnrunnableT t m b)
_ = UnrunnableT t m (a, Event t b)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
traverseIntMapWithKeyWithAdjust :: forall v v'.
(Key -> v -> UnrunnableT t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> UnrunnableT t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust Key -> v -> UnrunnableT t m v'
_ IntMap v
_ Event t (PatchIntMap v)
_ = UnrunnableT t m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
traverseDMapWithKeyWithAdjust :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> UnrunnableT t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> UnrunnableT t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust forall a. k a -> v a -> UnrunnableT t m (v' a)
_ DMap k v
_ Event t (PatchDMap k v)
_ = UnrunnableT t m (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
traverseDMapWithKeyWithAdjustWithMove :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> UnrunnableT t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> UnrunnableT t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove forall a. k a -> v a -> UnrunnableT t m (v' a)
_ DMap k v
_ Event t (PatchDMapWithMove k v)
_ = UnrunnableT t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance (Reflex t, Monad m) => PerformEvent t (UnrunnableT t m) where
type Performable (UnrunnableT t m) = UnrunnableT t m
performEvent :: forall a.
Event t (Performable (UnrunnableT t m) a)
-> UnrunnableT t m (Event t a)
performEvent Event t (Performable (UnrunnableT t m) a)
_ = UnrunnableT t m (Event t a)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
performEvent_ :: Event t (Performable (UnrunnableT t m) ()) -> UnrunnableT t m ()
performEvent_ Event t (Performable (UnrunnableT t m) ())
_ = UnrunnableT t m ()
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance Monad m => MonadRef (UnrunnableT t m) where
type Ref (UnrunnableT t m) = Ref IO
newRef :: forall a. a -> UnrunnableT t m (Ref (UnrunnableT t m) a)
newRef a
_ = UnrunnableT t m (IORef a)
UnrunnableT t m (Ref (UnrunnableT t m) a)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
readRef :: forall a. Ref (UnrunnableT t m) a -> UnrunnableT t m a
readRef Ref (UnrunnableT t m) a
_ = UnrunnableT t m a
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
writeRef :: forall a. Ref (UnrunnableT t m) a -> a -> UnrunnableT t m ()
writeRef Ref (UnrunnableT t m) a
_ a
_ = UnrunnableT t m ()
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance Monad m => MonadAtomicRef (UnrunnableT t m) where
atomicModifyRef :: forall a b.
Ref (UnrunnableT t m) a -> (a -> (a, b)) -> UnrunnableT t m b
atomicModifyRef Ref (UnrunnableT t m) a
_ a -> (a, b)
_ = UnrunnableT t m b
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance Monad m => HasDocument (UnrunnableT t m) where
askDocument :: UnrunnableT t m (RawDocument (DomBuilderSpace (UnrunnableT t m)))
askDocument = UnrunnableT t m Document
UnrunnableT t m (RawDocument (DomBuilderSpace (UnrunnableT t m)))
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance Monad m => TriggerEvent t (UnrunnableT t m) where
newTriggerEvent :: forall a. UnrunnableT t m (Event t a, a -> IO ())
newTriggerEvent = UnrunnableT t m (Event t a, a -> IO ())
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
newTriggerEventWithOnComplete :: forall a. UnrunnableT t m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete = UnrunnableT t m (Event t a, a -> IO () -> IO ())
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
newEventWithLazyTriggerWithOnComplete :: forall a.
((a -> IO () -> IO ()) -> IO (IO ()))
-> UnrunnableT t m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
_ = UnrunnableT t m (Event t a)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance Monad m => MonadReflexCreateTrigger t (UnrunnableT t m) where
newEventWithTrigger :: forall a.
(EventTrigger t a -> IO (IO ())) -> UnrunnableT t m (Event t a)
newEventWithTrigger EventTrigger t a -> IO (IO ())
_ = UnrunnableT t m (Event t a)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
newFanEventWithTrigger :: forall (k :: * -> *).
GCompare k =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> UnrunnableT t m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
_ = UnrunnableT t m (EventSelector t k)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance Monad m => MonadFix (UnrunnableT t m) where
mfix :: forall a. (a -> UnrunnableT t m a) -> UnrunnableT t m a
mfix a -> UnrunnableT t m a
_ = UnrunnableT t m a
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance (Monad m, MonadHold t m) => MonadHold t (UnrunnableT t m) where
hold :: forall a. a -> Event t a -> UnrunnableT t m (Behavior t a)
hold a
_ Event t a
_ = UnrunnableT t m (Behavior t a)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
holdDyn :: forall a. a -> Event t a -> UnrunnableT t m (Dynamic t a)
holdDyn a
_ Event t a
_ = UnrunnableT t m (Dynamic t a)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
holdIncremental :: forall p.
Patch p =>
PatchTarget p -> Event t p -> UnrunnableT t m (Incremental t p)
holdIncremental PatchTarget p
_ Event t p
_ = UnrunnableT t m (Incremental t p)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
buildDynamic :: forall a. PushM t a -> Event t a -> UnrunnableT t m (Dynamic t a)
buildDynamic PushM t a
_ Event t a
_ = UnrunnableT t m (Dynamic t a)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
headE :: forall a. Event t a -> UnrunnableT t m (Event t a)
headE Event t a
_ = UnrunnableT t m (Event t a)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
now :: UnrunnableT t m (Event t ())
now = UnrunnableT t m (Event t ())
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance Monad m => MonadSample t (UnrunnableT t m) where
sample :: forall a. Behavior t a -> UnrunnableT t m a
sample Behavior t a
_ = UnrunnableT t m a
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance Monad m => MonadIO (UnrunnableT t m) where
liftIO :: forall a. IO a -> UnrunnableT t m a
liftIO IO a
_ = UnrunnableT t m a
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
#ifndef ghcjs_HOST_OS
instance Monad m => MonadJSM (UnrunnableT t m) where
liftJSM' :: forall a. JSM a -> UnrunnableT t m a
liftJSM' JSM a
_ = UnrunnableT t m a
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
#endif
instance (Reflex t, Monad m) => PostBuild t (UnrunnableT t m) where
getPostBuild :: UnrunnableT t m (Event t ())
getPostBuild = UnrunnableT t m (Event t ())
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance Monad m => PrimMonad (UnrunnableT t m) where
type PrimState (UnrunnableT t m) = PrimState IO
primitive :: forall a.
(State# (PrimState (UnrunnableT t m))
-> (# State# (PrimState (UnrunnableT t m)), a #))
-> UnrunnableT t m a
primitive State# (PrimState (UnrunnableT t m))
-> (# State# (PrimState (UnrunnableT t m)), a #)
_ = UnrunnableT t m a
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance (Reflex t, Monad m) => DomRenderHook t (UnrunnableT t m) where
withRenderHook :: forall a.
(forall x. JSM x -> JSM x)
-> UnrunnableT t m a -> UnrunnableT t m a
withRenderHook forall x. JSM x -> JSM x
_ UnrunnableT t m a
_ = UnrunnableT t m a
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
requestDomAction :: forall a. Event t (JSM a) -> UnrunnableT t m (Event t a)
requestDomAction Event t (JSM a)
_ = UnrunnableT t m (Event t a)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
requestDomAction_ :: forall a. Event t (JSM a) -> UnrunnableT t m ()
requestDomAction_ Event t (JSM a)
_ = UnrunnableT t m ()
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance (Reflex t, Monad m, MonadHold t m) => Prerender t (UnrunnableT t m) where
type Client (UnrunnableT t m) = UnrunnableT t m
prerender :: forall a.
UnrunnableT t m a
-> Client (UnrunnableT t m) a -> UnrunnableT t m (Dynamic t a)
prerender UnrunnableT t m a
_ Client (UnrunnableT t m) a
_ = UnrunnableT t m (Dynamic t a)
forall t (m :: * -> *) a. UnrunnableT t m a
unrunnable
instance (SupportsStaticDomBuilder t m) => Prerender t (StaticDomBuilderT t m) where
type Client (StaticDomBuilderT t m) = UnrunnableT t m
prerender :: forall a.
StaticDomBuilderT t m a
-> Client (StaticDomBuilderT t m) a
-> StaticDomBuilderT t m (Dynamic t a)
prerender StaticDomBuilderT t m a
server Client (StaticDomBuilderT t m) a
_ = do
_ <- CommentNodeConfig t
-> StaticDomBuilderT
t m (CommentNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
forall t (m :: * -> *).
DomBuilder t m =>
CommentNodeConfig t -> m (CommentNode (DomBuilderSpace m) t)
commentNode (CommentNodeConfig t
-> StaticDomBuilderT
t m (CommentNode (DomBuilderSpace (StaticDomBuilderT t m)) t))
-> CommentNodeConfig t
-> StaticDomBuilderT
t m (CommentNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Event t Text) -> CommentNodeConfig t
forall {k} (t :: k).
Text -> Maybe (Event t Text) -> CommentNodeConfig t
CommentNodeConfig Text
startMarker Maybe (Event t Text)
forall a. Maybe a
Nothing
a <- server
_ <- commentNode $ CommentNodeConfig endMarker Nothing
pure $ pure a
instance (Prerender t m, Monad m) => Prerender t (ReaderT r m) where
type Client (ReaderT r m) = ReaderT r (Client m)
prerender :: forall a.
ReaderT r m a
-> Client (ReaderT r m) a -> ReaderT r m (Dynamic t a)
prerender ReaderT r m a
server Client (ReaderT r m) a
client = do
r <- ReaderT r m r
forall r (m :: * -> *). MonadReader r m => m r
ask
lift $ prerender (runReaderT server r) (runReaderT client r)
instance (Prerender t m, Monad m, Reflex t, MonadFix m, Monoid w) => Prerender t (DynamicWriterT t w m) where
type Client (DynamicWriterT t w m) = DynamicWriterT t w (Client m)
prerender :: forall a.
DynamicWriterT t w m a
-> Client (DynamicWriterT t w m) a
-> DynamicWriterT t w m (Dynamic t a)
prerender DynamicWriterT t w m a
server Client (DynamicWriterT t w m) a
client = do
x <- m (Dynamic t (a, Dynamic t w))
-> DynamicWriterT t w m (Dynamic t (a, Dynamic t w))
forall (m :: * -> *) a. Monad m => m a -> DynamicWriterT t w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t (a, Dynamic t w))
-> DynamicWriterT t w m (Dynamic t (a, Dynamic t w)))
-> m (Dynamic t (a, Dynamic t w))
-> DynamicWriterT t w m (Dynamic t (a, Dynamic t w))
forall a b. (a -> b) -> a -> b
$ m (a, Dynamic t w)
-> Client m (a, Dynamic t w) -> m (Dynamic t (a, Dynamic t w))
forall a. m a -> Client m a -> m (Dynamic t a)
forall t (m :: * -> *) a.
Prerender t m =>
m a -> Client m a -> m (Dynamic t a)
prerender (DynamicWriterT t w m a -> m (a, Dynamic t w)
forall (m :: * -> *) t w a.
(Monad m, Reflex t, Monoid w) =>
DynamicWriterT t w m a -> m (a, Dynamic t w)
runDynamicWriterT DynamicWriterT t w m a
server) (DynamicWriterT t w (Client m) a -> Client m (a, Dynamic t w)
forall (m :: * -> *) t w a.
(Monad m, Reflex t, Monoid w) =>
DynamicWriterT t w m a -> m (a, Dynamic t w)
runDynamicWriterT DynamicWriterT t w (Client m) a
Client (DynamicWriterT t w m) a
client)
let (a, w') = splitDynPure x
w = Dynamic t (Dynamic t w) -> Dynamic t w
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Dynamic t (Dynamic t w)
w'
tellDyn w
pure a
instance (Prerender t m, Monad m, Reflex t, Semigroup w) => Prerender t (EventWriterT t w m) where
type Client (EventWriterT t w m) = EventWriterT t w (Client m)
prerender :: forall a.
EventWriterT t w m a
-> Client (EventWriterT t w m) a
-> EventWriterT t w m (Dynamic t a)
prerender EventWriterT t w m a
server Client (EventWriterT t w m) a
client = do
x <- m (Dynamic t (a, Event t w))
-> EventWriterT t w m (Dynamic t (a, Event t w))
forall (m :: * -> *) a. Monad m => m a -> EventWriterT t w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t (a, Event t w))
-> EventWriterT t w m (Dynamic t (a, Event t w)))
-> m (Dynamic t (a, Event t w))
-> EventWriterT t w m (Dynamic t (a, Event t w))
forall a b. (a -> b) -> a -> b
$ m (a, Event t w)
-> Client m (a, Event t w) -> m (Dynamic t (a, Event t w))
forall a. m a -> Client m a -> m (Dynamic t a)
forall t (m :: * -> *) a.
Prerender t m =>
m a -> Client m a -> m (Dynamic t a)
prerender (EventWriterT t w m a -> m (a, Event t w)
forall t (m :: * -> *) w a.
(Reflex t, Monad m, Semigroup w) =>
EventWriterT t w m a -> m (a, Event t w)
runEventWriterT EventWriterT t w m a
server) (EventWriterT t w (Client m) a -> Client m (a, Event t w)
forall t (m :: * -> *) w a.
(Reflex t, Monad m, Semigroup w) =>
EventWriterT t w m a -> m (a, Event t w)
runEventWriterT EventWriterT t w (Client m) a
Client (EventWriterT t w m) a
client)
let (a, w') = splitDynPure x
w = Behavior t (Event t w) -> Event t w
forall a. Behavior t (Event t a) -> Event t a
forall {k} (t :: k) a.
Reflex t =>
Behavior t (Event t a) -> Event t a
switch (Behavior t (Event t w) -> Event t w)
-> Behavior t (Event t w) -> Event t w
forall a b. (a -> b) -> a -> b
$ Dynamic t (Event t w) -> Behavior t (Event t w)
forall a. Dynamic t a -> Behavior t a
forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Event t w)
w'
tellEvent w
pure a
instance (Prerender t m, MonadFix m, Reflex t) => Prerender t (RequesterT t request response m) where
type Client (RequesterT t request response m) = RequesterT t request response (Client m)
prerender :: forall a.
RequesterT t request response m a
-> Client (RequesterT t request response m) a
-> RequesterT t request response m (Dynamic t a)
prerender RequesterT t request response m a
server Client (RequesterT t request response m) a
client = mdo
let fannedResponses = Event t (IntMap (RequesterData response))
-> EventSelectorInt t (RequesterData response)
forall a. Event t (IntMap a) -> EventSelectorInt t a
forall {k} (t :: k) a.
Reflex t =>
Event t (IntMap a) -> EventSelectorInt t a
fanInt Event t (IntMap (RequesterData response))
responses
withFannedResponses :: forall m' a. Monad m' => RequesterT t request response m' a -> Int -> m' (a, Event t (IntMap (RequesterData request)))
withFannedResponses RequesterT t request response m' a
w Key
selector = do
(x, e) <- RequesterT t request response m' a
-> Event t (RequesterData response)
-> m' (a, Event t (RequesterData request))
forall t (m :: * -> *) (request :: * -> *) (response :: * -> *) a.
(Reflex t, Monad m) =>
RequesterT t request response m a
-> Event t (RequesterData response)
-> m (a, Event t (RequesterData request))
runRequesterT RequesterT t request response m' a
w (EventSelectorInt t (RequesterData response)
-> Key -> Event t (RequesterData response)
forall {k} (t :: k) a. EventSelectorInt t a -> Key -> Event t a
selectInt EventSelectorInt t (RequesterData response)
fannedResponses Key
selector)
pure (x, fmapCheap (IntMap.singleton selector) e)
(result, requestsDyn) <- fmap splitDynPure $ lift $ prerender (withFannedResponses server 0) (withFannedResponses client 1)
responses <- fmap (fmapCheap unMultiEntry) $ requesting' $ fmapCheap multiEntry $ switchPromptlyDyn requestsDyn
return result
instance (Prerender t m, Monad m, Reflex t, MonadFix m, Group q, Commutative q, Query q, Eq q) => Prerender t (QueryT t q m) where
type Client (QueryT t q m) = QueryT t q (Client m)
prerender :: forall a.
QueryT t q m a
-> Client (QueryT t q m) a -> QueryT t q m (Dynamic t a)
prerender QueryT t q m a
server Client (QueryT t q m) a
client = mdo
result <- queryDyn query
x <- lift $ prerender (runQueryT server result) (runQueryT client result)
let (a, inc) = splitDynPure x
query = Incremental t (AdditivePatch q) -> Dynamic t q
Incremental t (AdditivePatch q)
-> Dynamic t (PatchTarget (AdditivePatch q))
forall p. Patch p => Incremental t p -> Dynamic t (PatchTarget p)
forall {k} (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Dynamic t (PatchTarget p)
incrementalToDynamic (Incremental t (AdditivePatch q) -> Dynamic t q)
-> Dynamic t (Incremental t (AdditivePatch q)) -> Dynamic t q
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Dynamic t (Incremental t (AdditivePatch q))
inc
pure a
instance (Prerender t m, Monad m) => Prerender t (InputDisabledT m) where
type Client (InputDisabledT m) = InputDisabledT (Client m)
prerender :: forall a.
InputDisabledT m a
-> Client (InputDisabledT m) a -> InputDisabledT m (Dynamic t a)
prerender (InputDisabledT m a
server) (InputDisabledT Client m a
client) = m (Dynamic t a) -> InputDisabledT m (Dynamic t a)
forall (m :: * -> *) a. m a -> InputDisabledT m a
InputDisabledT (m (Dynamic t a) -> InputDisabledT m (Dynamic t a))
-> m (Dynamic t a) -> InputDisabledT m (Dynamic t a)
forall a b. (a -> b) -> a -> b
$ m a -> Client m a -> m (Dynamic t a)
forall a. m a -> Client m a -> m (Dynamic t a)
forall t (m :: * -> *) a.
Prerender t m =>
m a -> Client m a -> m (Dynamic t a)
prerender m a
server Client m a
client
instance (Prerender t m, Monad m) => Prerender t (HydratableT m) where
type Client (HydratableT m) = HydratableT (Client m)
prerender :: forall a.
HydratableT m a
-> Client (HydratableT m) a -> HydratableT m (Dynamic t a)
prerender (HydratableT m a
server) (HydratableT Client m a
client) = m (Dynamic t a) -> HydratableT m (Dynamic t a)
forall (m :: * -> *) a. m a -> HydratableT m a
HydratableT (m (Dynamic t a) -> HydratableT m (Dynamic t a))
-> m (Dynamic t a) -> HydratableT m (Dynamic t a)
forall a b. (a -> b) -> a -> b
$ m a -> Client m a -> m (Dynamic t a)
forall a. m a -> Client m a -> m (Dynamic t a)
forall t (m :: * -> *) a.
Prerender t m =>
m a -> Client m a -> m (Dynamic t a)
prerender m a
server Client m a
client
instance (Prerender t m, Monad m, ReflexHost t) => Prerender t (PostBuildT t m) where
type Client (PostBuildT t m) = PostBuildT t (Client m)
prerender :: forall a.
PostBuildT t m a
-> Client (PostBuildT t m) a -> PostBuildT t m (Dynamic t a)
prerender PostBuildT t m a
server Client (PostBuildT t m) a
client = ReaderT (Event t ()) m (Dynamic t a)
-> PostBuildT t m (Dynamic t a)
forall t (m :: * -> *) a.
ReaderT (Event t ()) m a -> PostBuildT t m a
PostBuildT (ReaderT (Event t ()) m (Dynamic t a)
-> PostBuildT t m (Dynamic t a))
-> ReaderT (Event t ()) m (Dynamic t a)
-> PostBuildT t m (Dynamic t a)
forall a b. (a -> b) -> a -> b
$ do
pb <- ReaderT (Event t ()) m (Event t ())
forall r (m :: * -> *). MonadReader r m => m r
ask
lift $ prerender (runPostBuildT server pb) (runPostBuildT client pb)
startMarker, endMarker :: Text
startMarker :: Text
startMarker = Text
"prerender/start"
endMarker :: Text
endMarker = Text
"prerender/end"
deleteToPrerenderEnd :: (MonadIO m, MonadJSM m, Reflex t, MonadFix m) => DOM.Document -> HydrationRunnerT t m DOM.Comment
deleteToPrerenderEnd :: forall (m :: * -> *) t.
(MonadIO m, MonadJSM m, Reflex t, MonadFix m) =>
Document -> HydrationRunnerT t m Comment
deleteToPrerenderEnd Document
doc = do
startNode <- Document
-> Text -> Maybe (Event t Text) -> HydrationRunnerT t m Comment
forall (m :: * -> *) t.
(MonadJSM m, Reflex t, MonadFix m) =>
Document
-> Text -> Maybe (Event t Text) -> HydrationRunnerT t m Comment
hydrateComment Document
doc Text
startMarker Maybe (Event t Text)
forall a. Maybe a
Nothing
let go (Key
n :: Int) Node
lastNode = Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling Node
lastNode HydrationRunnerT t m (Maybe Node)
-> (Maybe Node -> HydrationRunnerT t m Comment)
-> HydrationRunnerT t m Comment
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Node
Nothing -> do
c <- Document -> Text -> HydrationRunnerT t m Comment
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Comment
Document.createComment Document
doc Text
endMarker
insertAfterPreviousNode c
pure c
Just Node
node -> (JSVal -> Comment) -> Node -> HydrationRunnerT t m (Maybe Comment)
forall obj obj' (m :: * -> *).
(Coercible obj JSVal, IsGObject obj', MonadJSM m) =>
(JSVal -> obj') -> obj -> m (Maybe obj')
DOM.castTo JSVal -> Comment
DOM.Comment Node
node HydrationRunnerT t m (Maybe Comment)
-> (Maybe Comment -> HydrationRunnerT t m Comment)
-> HydrationRunnerT t m Comment
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Comment
Nothing -> Key -> Node -> HydrationRunnerT t m Comment
go Key
n Node
node
Just Comment
c -> Comment -> HydrationRunnerT t m Text
forall (m :: * -> *) self result.
(MonadDOM m, IsNode self, FromJSString result) =>
self -> m result
Node.getTextContentUnchecked Comment
c HydrationRunnerT t m Text
-> (Text -> HydrationRunnerT t m Comment)
-> HydrationRunnerT t m Comment
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Text
t | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
startMarker -> Key -> Node -> HydrationRunnerT t m Comment
go (Key -> Key
forall a. Enum a => a -> a
succ Key
n) Node
node
| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
endMarker -> case Key
n of
Key
0 -> Comment -> HydrationRunnerT t m Comment
forall a. a -> HydrationRunnerT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
c
Key
_ -> Key -> Node -> HydrationRunnerT t m Comment
go (Key -> Key
forall a. Enum a => a -> a
pred Key
n) Node
node
| Bool
otherwise -> Key -> Node -> HydrationRunnerT t m Comment
go Key
n Node
node
endNode <- go 0 $ DOM.toNode startNode
deleteBetweenExclusive startNode endNode
setPreviousNode $ Just $ DOM.toNode endNode
pure endNode