{-# 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 #-}

-- | Render the first widget on the server, and the second on the client.
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
  )

-- | Render the first widget on the server, and the second on the client. The
-- hydration builder will run *both* widgets.
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
  -- | Monad in which the client widget is built
  type Client m :: Type -> Type
  -- | Render the first widget on the server, and the second on the client. The
  -- hydration builder will run *both* widgets, updating the result dynamic at
  -- switchover time.
  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
  -- | PostBuildT is needed here because we delay running the client builder
  -- until after switchover, at which point the postBuild of @m@ has already fired
  type Client (HydrationDomBuilderT HydrationDomSpace t m) = PostBuildT t (HydrationDomBuilderT GhcjsDomSpace t m)
  -- | Runs the server widget up until switchover, then replaces it with the
  -- client widget.
  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 -- server dom should not be mounted in the window's doc in hydration
    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 -- Can we avoid the incrementalToDynamic?
    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