{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
#ifdef USE_TEMPLATE_HASKELL
{-# LANGUAGE TemplateHaskell #-}
#endif
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#ifdef ghcjs_HOST_OS
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE JavaScriptFFI #-}
#endif
-- | This is a builder to be used on the client side. It can be run in two modes:
--
--  1. in "hydration mode", reusing DOM nodes already in the page (as produced
--  by 'Reflex.Dom.Builder.Static.renderStatic')
--  2. in "immediate mode", creating and appending DOM nodes as required
--
-- In "hydration mode", the preexisting DOM __must contain__ what the builder
-- will expect at switchover time (the time at which parity with the static
-- renderer is reached, and the time after which the page is "live").
--
-- For example, displaying the current time as text should be done inside
-- 'Reflex.Dom.Prerender.prerender' to ensure that we don't attempt to hydrate the incorrect text.
-- The server will prerender a text node with time A, and the client will expect
-- a text node with time B. Barring a miracle, time A and time B will not match,
-- and hydration will fail.
module Reflex.Dom.Builder.Immediate
  ( HydrationDomBuilderT (..)
  , HydrationDomBuilderEnv (..)
  , HydrationMode (..)
  , HydrationRunnerT (..)
  , runHydrationRunnerT
  , runHydrationRunnerTWithFailure
  , ImmediateDomBuilderT
  , runHydrationDomBuilderT
  , getHydrationMode
  , addHydrationStep
  , addHydrationStepWithSetup
  , setPreviousNode
  , insertAfterPreviousNode
  , hydrateComment
  , askParent
  , askEvents
  , append
  , textNodeInternal
  , removeSubsequentNodes
  , deleteBetweenExclusive
  , extractBetweenExclusive
  , deleteUpTo
  , extractUpTo
  , SupportsHydrationDomBuilder
  , collectUpTo
  , collectUpToGivenParent
  , EventTriggerRef (..)
  , EventFilterTriggerRef (..)
  , wrap
  , elementInternal
  , HydrationDomSpace
  , GhcjsDomSpace
  , GhcjsDomHandler (..)
  , GhcjsDomHandler1 (..)
  , GhcjsDomEvent (..)
  , GhcjsEventFilter (..)
  , Pair1 (..)
  , Maybe1 (..)
  , GhcjsEventSpec (..)
  , HasDocument (..)
  , ghcjsEventSpec_filters
  , ghcjsEventSpec_handler
  , GhcjsEventHandler (..)
  , drawChildUpdate
  , ChildReadyState (..)
  , mkHasFocus
  , insertBefore
  , EventType
  , defaultDomEventHandler
  , defaultDomWindowEventHandler
  , withIsEvent
  , showEventName
  , elementOnEventName
  , windowOnEventName
  , wrapDomEvent
  , subscribeDomEvent
  , wrapDomEventMaybe
  , wrapDomEventsMaybe
  , getKeyEvent
  , getMouseEventCoords
  , getTouchEvent
  , WindowConfig (..)
  , Window (..)
  , wrapWindow
  -- * Attributes for controlling hydration
  , hydratableAttribute
  , skipHydrationAttribute
  -- * Internal
  , traverseDMapWithKeyWithAdjust'
  , hoistTraverseWithKeyWithAdjust
  , traverseIntMapWithKeyWithAdjust'
  , hoistTraverseIntMapWithKeyWithAdjust
  ) where

import Control.Concurrent
import Control.Exception (bracketOnError)
import Control.Lens (Identity(..), imapM_, iforM_, (^.), makeLenses)
import Control.Monad.Exception
import Control.Monad.Primitive
import Control.Monad.Reader
import Control.Monad.Ref
import Control.Monad.State.Strict (StateT, mapStateT, get, modify', gets, runStateT)
import Data.Bitraversable
import Data.Default
import Data.Dependent.Map (DMap)
import Data.Dependent.Sum
import Data.FastMutableIntMap (PatchIntMap (..))
import Data.Foldable (for_, traverse_)
import Data.Functor.Compose
import Data.Functor.Constant
import Data.Functor.Misc
import Data.Functor.Product
import Data.GADT.Compare (GCompare)
import Data.IORef
import Data.IntMap.Strict (IntMap)
import Data.Maybe
import Data.Monoid ((<>))
import Data.Some (Some(..))
import Data.GADT.Compare (GCompare)
import Data.String (IsString)
import Data.Text (Text)
import Foreign.JavaScript.Internal.Utils
import Foreign.JavaScript.TH
import GHCJS.DOM.ClipboardEvent as ClipboardEvent
import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)
import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS, hasAttribute)
import GHCJS.DOM.EventM (EventM, event, on)
import GHCJS.DOM.KeyboardEvent as KeyboardEvent
import GHCJS.DOM.MouseEvent
import GHCJS.DOM.Node (appendChild_, getOwnerDocumentUnchecked, getParentNodeUnchecked, setNodeValue, toNode)
import GHCJS.DOM.Types (liftJSM, askJSM, runJSM, JSM, MonadJSM, FocusEvent, IsElement, IsEvent, IsNode, KeyboardEvent, Node, TouchEvent, WheelEvent, uncheckedCastTo, ClipboardEvent)
import GHCJS.DOM.UIEvent
import Language.Javascript.JSaddle (call, eval)
import Reflex.Adjustable.Class
import Reflex.Class as Reflex
import Reflex.Dom.Builder.Class
import Reflex.Dynamic
import Reflex.Host.Class
import Reflex.Patch.DMapWithMove (PatchDMapWithMove(..))
import Reflex.Patch.MapWithMove (PatchMapWithMove(..))
import Reflex.PerformEvent.Base (PerformEventT)
import Reflex.PerformEvent.Class
import Reflex.PostBuild.Base (PostBuildT)
import Reflex.PostBuild.Class
#ifdef PROFILE_REFLEX
import Reflex.Profiled
#endif
import Reflex.Requester.Base
import Reflex.Requester.Class
import Reflex.Spider (Spider, SpiderHost, Global)
import Reflex.TriggerEvent.Base hiding (askEvents)
import Reflex.TriggerEvent.Class

import qualified Data.Dependent.Map as DMap
import qualified Data.FastMutableIntMap as FastMutableIntMap
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified GHCJS.DOM as DOM
import qualified GHCJS.DOM.DataTransfer as DataTransfer
import qualified GHCJS.DOM.DocumentAndElementEventHandlers as Events
import qualified GHCJS.DOM.DocumentOrShadowRoot as Document
import qualified GHCJS.DOM.Element as Element
import qualified GHCJS.DOM.Event as Event
import qualified GHCJS.DOM.EventM as DOM
import qualified GHCJS.DOM.FileList as FileList
import qualified GHCJS.DOM.GlobalEventHandlers as Events
import qualified GHCJS.DOM.HTMLInputElement as Input
import qualified GHCJS.DOM.HTMLSelectElement as Select
import qualified GHCJS.DOM.HTMLTextAreaElement as TextArea
import qualified GHCJS.DOM.Node as Node
import qualified GHCJS.DOM.Text as DOM
import qualified GHCJS.DOM.Touch as Touch
import qualified GHCJS.DOM.TouchEvent as TouchEvent
import qualified GHCJS.DOM.TouchList as TouchList
import qualified GHCJS.DOM.Types as DOM
import qualified GHCJS.DOM.Window as Window
import qualified GHCJS.DOM.WheelEvent as WheelEvent
import qualified Reflex.Patch.DMap as PatchDMap
import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)

#ifndef USE_TEMPLATE_HASKELL
import Data.Functor.Contravariant (phantom)
import Control.Lens (Lens', Getter)
#endif

#ifndef ghcjs_HOST_OS
import GHCJS.DOM.Types (MonadJSM (..))

instance MonadJSM m => MonadJSM (HydrationRunnerT t m) where
  {-# INLINABLE liftJSM' #-}
  liftJSM' :: JSM a -> HydrationRunnerT t m a
liftJSM' = 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 a)
-> (JSM a -> m a) -> JSM a -> HydrationRunnerT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'

instance MonadJSM m => MonadJSM (HydrationDomBuilderT s t m) where
  {-# INLINABLE liftJSM' #-}
  liftJSM' :: JSM a -> HydrationDomBuilderT s t m a
liftJSM' = m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> (JSM a -> m a) -> JSM a -> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'

instance MonadJSM m => MonadJSM (DomRenderHookT t m) where
  {-# INLINABLE liftJSM' #-}
  liftJSM' :: JSM a -> DomRenderHookT t m a
liftJSM' = m a -> DomRenderHookT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> DomRenderHookT t m a)
-> (JSM a -> m a) -> JSM a -> DomRenderHookT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
#endif

data HydrationDomBuilderEnv t m = HydrationDomBuilderEnv
  { HydrationDomBuilderEnv t m -> Document
_hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document
  -- ^ Reference to the document
  , HydrationDomBuilderEnv t m -> Either Node (IORef Node)
_hydrationDomBuilderEnv_parent :: !(Either Node (IORef Node))
  -- ^ This is in an IORef because in the time up to hydration we can't actually know what the
  -- parent is - we populate this reference during the DOM traversal at hydration time
  , HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren :: {-# UNPACK #-} !(IORef Word)
  -- ^ Number of children who still aren't fully rendered
  , HydrationDomBuilderEnv t m -> JSM ()
_hydrationDomBuilderEnv_commitAction :: !(JSM ())
  -- ^ Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it
  , HydrationDomBuilderEnv t m -> IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode :: {-# UNPACK #-} !(IORef HydrationMode)
  -- ^ In hydration mode? Should be switched to `HydrationMode_Immediate` after hydration is finished
  , HydrationDomBuilderEnv t m -> Event t ()
_hydrationDomBuilderEnv_switchover :: !(Event t ())
  , HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed :: {-# UNPACK #-} !(IORef (HydrationRunnerT t m ()))
  }

-- | A monad for DomBuilder which just gets the results of children and pushes
-- work into an action that is delayed until after postBuild (to match the
-- static builder). The action runs in 'HydrationRunnerT', which performs the
-- DOM takeover and sets up the events, after which point this monad will
-- continue in the vein of 'ImmediateDomBuilderT'.
newtype HydrationDomBuilderT s t m a = HydrationDomBuilderT { HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT :: ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a }
  deriving (a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
(forall a b.
 (a -> b)
 -> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b)
-> (forall a b.
    a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a)
-> Functor (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
forall a b.
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall a b.
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
$c<$ :: forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
fmap :: (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
$cfmap :: forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
Functor, Functor (HydrationDomBuilderT s t m)
a -> HydrationDomBuilderT s t m a
Functor (HydrationDomBuilderT s t m)
-> (forall a. a -> HydrationDomBuilderT s t m a)
-> (forall a b.
    HydrationDomBuilderT s t m (a -> b)
    -> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b)
-> (forall a b c.
    (a -> b -> c)
    -> HydrationDomBuilderT s t m a
    -> HydrationDomBuilderT s t m b
    -> HydrationDomBuilderT s t m c)
-> (forall a b.
    HydrationDomBuilderT s t m a
    -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b)
-> (forall a b.
    HydrationDomBuilderT s t m a
    -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a)
-> Applicative (HydrationDomBuilderT s t m)
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
forall a. a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
Monad m =>
Functor (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
forall k (s :: k) t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall a b.
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
forall a b c.
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s 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
<* :: HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
$c<* :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
*> :: HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
$c*> :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
liftA2 :: (a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
$cliftA2 :: forall k (s :: k) t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
<*> :: HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
$c<*> :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
pure :: a -> HydrationDomBuilderT s t m a
$cpure :: forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
$cp1Applicative :: forall k (s :: k) t (m :: * -> *).
Monad m =>
Functor (HydrationDomBuilderT s t m)
Applicative, Applicative (HydrationDomBuilderT s t m)
a -> HydrationDomBuilderT s t m a
Applicative (HydrationDomBuilderT s t m)
-> (forall a b.
    HydrationDomBuilderT s t m a
    -> (a -> HydrationDomBuilderT s t m b)
    -> HydrationDomBuilderT s t m b)
-> (forall a b.
    HydrationDomBuilderT s t m a
    -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b)
-> (forall a. a -> HydrationDomBuilderT s t m a)
-> Monad (HydrationDomBuilderT s t m)
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall a. a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
Monad m =>
Applicative (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall a b.
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s 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
return :: a -> HydrationDomBuilderT s t m a
$creturn :: forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
>> :: HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
$c>> :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
>>= :: HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
$c>>= :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
$cp1Monad :: forall k (s :: k) t (m :: * -> *).
Monad m =>
Applicative (HydrationDomBuilderT s t m)
Monad, Monad (HydrationDomBuilderT s t m)
Monad (HydrationDomBuilderT s t m)
-> (forall a.
    (a -> HydrationDomBuilderT s t m a)
    -> HydrationDomBuilderT s t m a)
-> MonadFix (HydrationDomBuilderT s t m)
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
forall a.
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
MonadFix m =>
Monad (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
$cmfix :: forall k (s :: k) t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
$cp1MonadFix :: forall k (s :: k) t (m :: * -> *).
MonadFix m =>
Monad (HydrationDomBuilderT s t m)
MonadFix, Monad (HydrationDomBuilderT s t m)
Monad (HydrationDomBuilderT s t m)
-> (forall a. IO a -> HydrationDomBuilderT s t m a)
-> MonadIO (HydrationDomBuilderT s t m)
IO a -> HydrationDomBuilderT s t m a
forall a. IO a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
MonadIO m =>
Monad (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationDomBuilderT s t m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> HydrationDomBuilderT s t m a
$cliftIO :: forall k (s :: k) t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationDomBuilderT s t m a
$cp1MonadIO :: forall k (s :: k) t (m :: * -> *).
MonadIO m =>
Monad (HydrationDomBuilderT s t m)
MonadIO, Monad (HydrationDomBuilderT s t m)
e -> HydrationDomBuilderT s t m a
Monad (HydrationDomBuilderT s t m)
-> (forall e a. Exception e => e -> HydrationDomBuilderT s t m a)
-> (forall e a.
    Exception e =>
    HydrationDomBuilderT s t m a
    -> (e -> HydrationDomBuilderT s t m a)
    -> HydrationDomBuilderT s t m a)
-> (forall a b.
    HydrationDomBuilderT s t m a
    -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a)
-> MonadException (HydrationDomBuilderT s t m)
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
MonadException m =>
Monad (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) e a.
(MonadException m, Exception e) =>
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
MonadException m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall e a. Exception e => e -> HydrationDomBuilderT s t m a
forall e a.
Exception e =>
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall (m :: * -> *).
Monad m
-> (forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
finally :: HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
$cfinally :: forall k (s :: k) t (m :: * -> *) a b.
MonadException m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
catch :: HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
$ccatch :: forall k (s :: k) t (m :: * -> *) e a.
(MonadException m, Exception e) =>
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
throw :: e -> HydrationDomBuilderT s t m a
$cthrow :: forall k (s :: k) t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationDomBuilderT s t m a
$cp1MonadException :: forall k (s :: k) t (m :: * -> *).
MonadException m =>
Monad (HydrationDomBuilderT s t m)
MonadException
#if MIN_VERSION_base(4,9,1)
           , MonadIO (HydrationDomBuilderT s t m)
MonadException (HydrationDomBuilderT s t m)
MonadIO (HydrationDomBuilderT s t m)
-> MonadException (HydrationDomBuilderT s t m)
-> (forall b.
    ((forall a.
      HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
     -> HydrationDomBuilderT s t m b)
    -> HydrationDomBuilderT s t m b)
-> MonadAsyncException (HydrationDomBuilderT s t m)
((forall a.
  HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
 -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall b.
((forall a.
  HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
 -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall k (s :: k) t (m :: * -> *).
MonadAsyncException m =>
MonadIO (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *).
MonadAsyncException m =>
MonadException (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) b.
MonadAsyncException m =>
((forall a.
  HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
 -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall (m :: * -> *).
MonadIO m
-> MonadException m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
mask :: ((forall a.
  HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
 -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
$cmask :: forall k (s :: k) t (m :: * -> *) b.
MonadAsyncException m =>
((forall a.
  HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
 -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
$cp2MonadAsyncException :: forall k (s :: k) t (m :: * -> *).
MonadAsyncException m =>
MonadException (HydrationDomBuilderT s t m)
$cp1MonadAsyncException :: forall k (s :: k) t (m :: * -> *).
MonadAsyncException m =>
MonadIO (HydrationDomBuilderT s t m)
MonadAsyncException
#endif
           )

instance PrimMonad m => PrimMonad (HydrationDomBuilderT s t m) where
  type PrimState (HydrationDomBuilderT s t m) = PrimState m
  primitive :: (State# (PrimState (HydrationDomBuilderT s t m))
 -> (# State# (PrimState (HydrationDomBuilderT s t m)), a #))
-> HydrationDomBuilderT s t m a
primitive = m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive

instance MonadTrans (HydrationDomBuilderT s t) where
  lift :: m a -> HydrationDomBuilderT s t m a
lift = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
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) a
 -> HydrationDomBuilderT s t m a)
-> (m a
    -> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> m a
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m a
 -> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> (m a -> DomRenderHookT t m a)
-> m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> DomRenderHookT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationDomBuilderT s t m) where
  withRenderHook :: (forall x. JSM x -> JSM x)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
withRenderHook forall x. JSM x -> JSM x
hook = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
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) a
 -> HydrationDomBuilderT s t m a)
-> (HydrationDomBuilderT s t m a
    -> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DomRenderHookT t m a -> DomRenderHookT t m a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((forall x. JSM x -> JSM x)
-> DomRenderHookT t m a -> DomRenderHookT t m a
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
(forall x. JSM x -> JSM x) -> m a -> m a
withRenderHook forall x. JSM x -> JSM x
hook) (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
 -> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> (HydrationDomBuilderT s t m a
    -> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT
  requestDomAction :: Event t (JSM a) -> HydrationDomBuilderT s t m (Event t a)
requestDomAction = ReaderT
  (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
-> HydrationDomBuilderT s t m (Event t a)
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) (Event t a)
 -> HydrationDomBuilderT s t m (Event t a))
-> (Event t (JSM a)
    -> ReaderT
         (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a))
-> Event t (JSM a)
-> HydrationDomBuilderT s t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a)
-> ReaderT
     (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a)
 -> ReaderT
      (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a))
-> (Event t (JSM a) -> DomRenderHookT t m (Event t a))
-> Event t (JSM a)
-> ReaderT
     (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> DomRenderHookT t m (Event t a)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction
  requestDomAction_ :: Event t (JSM a) -> HydrationDomBuilderT s t m ()
requestDomAction_ = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ()
-> HydrationDomBuilderT s 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) ()
 -> HydrationDomBuilderT s t m ())
-> (Event t (JSM a)
    -> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ())
-> Event t (JSM a)
-> HydrationDomBuilderT s t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m ()
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m ()
 -> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ())
-> (Event t (JSM a) -> DomRenderHookT t m ())
-> Event t (JSM a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> DomRenderHookT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_

-- | The monad which performs the delayed actions to reuse prerendered nodes and set up events.
-- State contains reference to the previous node sibling, if any, and the reader contains reference to the parent node.
newtype HydrationRunnerT t m a = HydrationRunnerT { HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
unHydrationRunnerT :: StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a }
  deriving (a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
(forall a b.
 (a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b)
-> (forall a b.
    a -> HydrationRunnerT t m b -> HydrationRunnerT t m a)
-> Functor (HydrationRunnerT t m)
forall a b. a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall a b.
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
forall t (m :: * -> *) a b.
Functor m =>
a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
fmap :: (a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
Functor, Functor (HydrationRunnerT t m)
a -> HydrationRunnerT t m a
Functor (HydrationRunnerT t m)
-> (forall a. a -> HydrationRunnerT t m a)
-> (forall a b.
    HydrationRunnerT t m (a -> b)
    -> HydrationRunnerT t m a -> HydrationRunnerT t m b)
-> (forall a b c.
    (a -> b -> c)
    -> HydrationRunnerT t m a
    -> HydrationRunnerT t m b
    -> HydrationRunnerT t m c)
-> (forall a b.
    HydrationRunnerT t m a
    -> HydrationRunnerT t m b -> HydrationRunnerT t m b)
-> (forall a b.
    HydrationRunnerT t m a
    -> HydrationRunnerT t m b -> HydrationRunnerT t m a)
-> Applicative (HydrationRunnerT t m)
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
forall a. a -> HydrationRunnerT t m a
forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall a b.
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
forall a b c.
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
forall t (m :: * -> *). Monad m => Functor (HydrationRunnerT t m)
forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT 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
<* :: HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
*> :: HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
liftA2 :: (a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
<*> :: HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
pure :: a -> HydrationRunnerT t m a
$cpure :: forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
$cp1Applicative :: forall t (m :: * -> *). Monad m => Functor (HydrationRunnerT t m)
Applicative, Applicative (HydrationRunnerT t m)
a -> HydrationRunnerT t m a
Applicative (HydrationRunnerT t m)
-> (forall a b.
    HydrationRunnerT t m a
    -> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b)
-> (forall a b.
    HydrationRunnerT t m a
    -> HydrationRunnerT t m b -> HydrationRunnerT t m b)
-> (forall a. a -> HydrationRunnerT t m a)
-> Monad (HydrationRunnerT t m)
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall a. a -> HydrationRunnerT t m a
forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall t (m :: * -> *).
Monad m =>
Applicative (HydrationRunnerT t m)
forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT 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
return :: a -> HydrationRunnerT t m a
$creturn :: forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
>> :: HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
>>= :: HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
$cp1Monad :: forall t (m :: * -> *).
Monad m =>
Applicative (HydrationRunnerT t m)
Monad, Monad (HydrationRunnerT t m)
Monad (HydrationRunnerT t m)
-> (forall a.
    (a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a)
-> MonadFix (HydrationRunnerT t m)
(a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall a. (a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall t (m :: * -> *). MonadFix m => Monad (HydrationRunnerT t m)
forall t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
$cp1MonadFix :: forall t (m :: * -> *). MonadFix m => Monad (HydrationRunnerT t m)
MonadFix, Monad (HydrationRunnerT t m)
Monad (HydrationRunnerT t m)
-> (forall a. IO a -> HydrationRunnerT t m a)
-> MonadIO (HydrationRunnerT t m)
IO a -> HydrationRunnerT t m a
forall a. IO a -> HydrationRunnerT t m a
forall t (m :: * -> *). MonadIO m => Monad (HydrationRunnerT t m)
forall t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationRunnerT t m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> HydrationRunnerT t m a
$cliftIO :: forall t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationRunnerT t m a
$cp1MonadIO :: forall t (m :: * -> *). MonadIO m => Monad (HydrationRunnerT t m)
MonadIO, Monad (HydrationRunnerT t m)
e -> HydrationRunnerT t m a
Monad (HydrationRunnerT t m)
-> (forall e a. Exception e => e -> HydrationRunnerT t m a)
-> (forall e a.
    Exception e =>
    HydrationRunnerT t m a
    -> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a)
-> (forall a b.
    HydrationRunnerT t m a
    -> HydrationRunnerT t m b -> HydrationRunnerT t m a)
-> MonadException (HydrationRunnerT t m)
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall e a. Exception e => e -> HydrationRunnerT t m a
forall e a.
Exception e =>
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall t (m :: * -> *).
MonadException m =>
Monad (HydrationRunnerT t m)
forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationRunnerT t m a
forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
MonadException m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall (m :: * -> *).
Monad m
-> (forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
finally :: HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
$cfinally :: forall t (m :: * -> *) a b.
MonadException m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
catch :: HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
$ccatch :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
throw :: e -> HydrationRunnerT t m a
$cthrow :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationRunnerT t m a
$cp1MonadException :: forall t (m :: * -> *).
MonadException m =>
Monad (HydrationRunnerT t m)
MonadException
#if MIN_VERSION_base(4,9,1)
           , MonadIO (HydrationRunnerT t m)
MonadException (HydrationRunnerT t m)
MonadIO (HydrationRunnerT t m)
-> MonadException (HydrationRunnerT t m)
-> (forall b.
    ((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
     -> HydrationRunnerT t m b)
    -> HydrationRunnerT t m b)
-> MonadAsyncException (HydrationRunnerT t m)
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
 -> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
forall b.
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
 -> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
forall t (m :: * -> *).
MonadAsyncException m =>
MonadIO (HydrationRunnerT t m)
forall t (m :: * -> *).
MonadAsyncException m =>
MonadException (HydrationRunnerT t m)
forall t (m :: * -> *) b.
MonadAsyncException m =>
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
 -> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
forall (m :: * -> *).
MonadIO m
-> MonadException m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
mask :: ((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
 -> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
$cmask :: forall t (m :: * -> *) b.
MonadAsyncException m =>
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
 -> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
$cp2MonadAsyncException :: forall t (m :: * -> *).
MonadAsyncException m =>
MonadException (HydrationRunnerT t m)
$cp1MonadAsyncException :: forall t (m :: * -> *).
MonadAsyncException m =>
MonadIO (HydrationRunnerT t m)
MonadAsyncException
#endif
           )

data HydrationState = HydrationState
  { HydrationState -> Maybe Node
_hydrationState_previousNode :: !(Maybe Node)
  , HydrationState -> Bool
_hydrationState_failed :: !Bool
  }

{-# INLINABLE localRunner #-}
localRunner :: (MonadJSM m, Monad m) => HydrationRunnerT t m a -> Maybe Node -> Node -> HydrationRunnerT t m a
localRunner :: HydrationRunnerT t m a
-> Maybe Node -> Node -> HydrationRunnerT t m a
localRunner (HydrationRunnerT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
m) Maybe Node
s Node
parent = do
  HydrationState
s0 <- StateT
  HydrationState (ReaderT Node (DomRenderHookT t m)) HydrationState
-> HydrationRunnerT t m HydrationState
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT StateT
  HydrationState (ReaderT Node (DomRenderHookT t m)) HydrationState
forall s (m :: * -> *). MonadState s m => m s
get
  (a
a, HydrationState
s') <- StateT
  HydrationState
  (ReaderT Node (DomRenderHookT t m))
  (a, HydrationState)
-> HydrationRunnerT t m (a, HydrationState)
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT
   HydrationState
   (ReaderT Node (DomRenderHookT t m))
   (a, HydrationState)
 -> HydrationRunnerT t m (a, HydrationState))
-> StateT
     HydrationState
     (ReaderT Node (DomRenderHookT t m))
     (a, HydrationState)
-> HydrationRunnerT t m (a, HydrationState)
forall a b. (a -> b) -> a -> b
$ ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> StateT
     HydrationState
     (ReaderT Node (DomRenderHookT t m))
     (a, HydrationState)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Node (DomRenderHookT t m) (a, HydrationState)
 -> StateT
      HydrationState
      (ReaderT Node (DomRenderHookT t m))
      (a, HydrationState))
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> StateT
     HydrationState
     (ReaderT Node (DomRenderHookT t m))
     (a, HydrationState)
forall a b. (a -> b) -> a -> b
$ (Node -> Node)
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\Node
_ -> Node
parent) (ReaderT Node (DomRenderHookT t m) (a, HydrationState)
 -> ReaderT Node (DomRenderHookT t m) (a, HydrationState))
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
forall a b. (a -> b) -> a -> b
$ StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationState
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
m (HydrationState
s0 { _hydrationState_previousNode :: Maybe Node
_hydrationState_previousNode = Maybe Node
s })
  (Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Node -> HydrationRunnerT t m ()
forall (m :: * -> *) n. (MonadJSM m, IsNode n) => n -> m ()
removeSubsequentNodes (Maybe Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ HydrationState -> Maybe Node
_hydrationState_previousNode HydrationState
s'
  StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
 -> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
 -> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
hs -> HydrationState
hs { _hydrationState_failed :: Bool
_hydrationState_failed = HydrationState -> Bool
_hydrationState_failed HydrationState
s' }
  a -> HydrationRunnerT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

{-# INLINABLE runHydrationRunnerT #-}
runHydrationRunnerT
  :: (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 t m a
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationRunnerT HydrationRunnerT t m a
m = HydrationRunnerT t m a
-> IO ()
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
forall (m :: * -> *) t a.
(MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m,
 MonadReflexCreateTrigger t m, MonadJSM m,
 MonadJSM (Performable m)) =>
HydrationRunnerT t m a
-> IO ()
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationRunnerTWithFailure HydrationRunnerT t m a
m (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

{-# INLINABLE runHydrationRunnerTWithFailure #-}
runHydrationRunnerTWithFailure
  :: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))
  => HydrationRunnerT t m a -> IO () -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runHydrationRunnerTWithFailure :: HydrationRunnerT t m a
-> IO ()
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationRunnerTWithFailure (HydrationRunnerT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
m) IO ()
onFailure Maybe Node
s Node
parent Chan [DSum (EventTriggerRef t) TriggerInvocation]
events = (DomRenderHookT t m a
 -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DomRenderHookT t m a
-> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
forall (m :: * -> *) t a.
(MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m,
 MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef) =>
DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runDomRenderHookT Chan [DSum (EventTriggerRef t) TriggerInvocation]
events (DomRenderHookT t m a -> m a) -> DomRenderHookT t m a -> m a
forall a b. (a -> b) -> a -> b
$ (ReaderT Node (DomRenderHookT t m) a
 -> Node -> DomRenderHookT t m a)
-> Node
-> ReaderT Node (DomRenderHookT t m) a
-> DomRenderHookT t m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Node (DomRenderHookT t m) a -> Node -> DomRenderHookT t m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Node
parent (ReaderT Node (DomRenderHookT t m) a -> DomRenderHookT t m a)
-> ReaderT Node (DomRenderHookT t m) a -> DomRenderHookT t m a
forall a b. (a -> b) -> a -> b
$ do
  (a
a, HydrationState
s') <- StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationState
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
m (Maybe Node -> Bool -> HydrationState
HydrationState Maybe Node
s Bool
False)
  (Node -> ReaderT Node (DomRenderHookT t m) ())
-> Maybe Node -> ReaderT Node (DomRenderHookT t m) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Node -> ReaderT Node (DomRenderHookT t m) ()
forall (m :: * -> *) n. (MonadJSM m, IsNode n) => n -> m ()
removeSubsequentNodes (Maybe Node -> ReaderT Node (DomRenderHookT t m) ())
-> Maybe Node -> ReaderT Node (DomRenderHookT t m) ()
forall a b. (a -> b) -> a -> b
$ HydrationState -> Maybe Node
_hydrationState_previousNode HydrationState
s'
  Bool
-> ReaderT Node (DomRenderHookT t m) ()
-> ReaderT Node (DomRenderHookT t m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HydrationState -> Bool
_hydrationState_failed HydrationState
s') (ReaderT Node (DomRenderHookT t m) ()
 -> ReaderT Node (DomRenderHookT t m) ())
-> ReaderT Node (DomRenderHookT t m) ()
-> ReaderT Node (DomRenderHookT t m) ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT Node (DomRenderHookT t m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Node (DomRenderHookT t m) ())
-> IO () -> ReaderT Node (DomRenderHookT t m) ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"reflex-dom warning: hydration failed: the DOM was not as expected at switchover time. This may be due to invalid HTML which the browser has altered upon parsing, some external JS altering the DOM, or the page being served from an outdated cache."
  Bool
-> ReaderT Node (DomRenderHookT t m) ()
-> ReaderT Node (DomRenderHookT t m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HydrationState -> Bool
_hydrationState_failed HydrationState
s') (ReaderT Node (DomRenderHookT t m) ()
 -> ReaderT Node (DomRenderHookT t m) ())
-> ReaderT Node (DomRenderHookT t m) ()
-> ReaderT Node (DomRenderHookT t m) ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT Node (DomRenderHookT t m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
onFailure
  a -> ReaderT Node (DomRenderHookT t m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a



instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRunnerT t m) where
  {-# INLINABLE newEventWithTrigger #-}
  newEventWithTrigger :: (EventTrigger t a -> IO (IO ()))
-> HydrationRunnerT t m (Event t a)
newEventWithTrigger = m (Event t a) -> HydrationRunnerT t m (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> HydrationRunnerT t m (Event t a))
-> ((EventTrigger t a -> IO (IO ())) -> m (Event t a))
-> (EventTrigger t a -> IO (IO ()))
-> HydrationRunnerT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventTrigger t a -> IO (IO ())) -> m (Event t a)
forall t (m :: * -> *) a.
MonadReflexCreateTrigger t m =>
(EventTrigger t a -> IO (IO ())) -> m (Event t a)
newEventWithTrigger
  {-# INLINABLE newFanEventWithTrigger #-}
  newFanEventWithTrigger :: (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> HydrationRunnerT t m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f = m (EventSelector t k) -> HydrationRunnerT t m (EventSelector t k)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (EventSelector t k) -> HydrationRunnerT t m (EventSelector t k))
-> m (EventSelector t k)
-> HydrationRunnerT t m (EventSelector t k)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f

instance MonadTrans (HydrationRunnerT t) where
  {-# INLINABLE lift #-}
  lift :: m a -> HydrationRunnerT t m a
lift = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
 -> HydrationRunnerT t m a)
-> (m a
    -> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> m a
-> HydrationRunnerT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Node (DomRenderHookT t m) a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Node (DomRenderHookT t m) a
 -> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> (m a -> ReaderT Node (DomRenderHookT t m) a)
-> m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m a -> ReaderT Node (DomRenderHookT t m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m a -> ReaderT Node (DomRenderHookT t m) a)
-> (m a -> DomRenderHookT t m a)
-> m a
-> ReaderT Node (DomRenderHookT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> DomRenderHookT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MonadSample t m => MonadSample t (HydrationRunnerT t m) where
  {-# INLINABLE sample #-}
  sample :: Behavior t a -> HydrationRunnerT t m a
sample = 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 a)
-> (Behavior t a -> m a) -> Behavior t a -> HydrationRunnerT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior t a -> m a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample

instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationRunnerT t m) where
  withRenderHook :: (forall x. JSM x -> JSM x)
-> HydrationRunnerT t m a -> HydrationRunnerT t m a
withRenderHook forall x. JSM x -> JSM x
hook = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
 -> HydrationRunnerT t m a)
-> (HydrationRunnerT t m a
    -> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT Node (DomRenderHookT t m) (a, HydrationState)
 -> ReaderT Node (DomRenderHookT t m) (a, HydrationState))
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((DomRenderHookT t m (a, HydrationState)
 -> DomRenderHookT t m (a, HydrationState))
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((forall x. JSM x -> JSM x)
-> DomRenderHookT t m (a, HydrationState)
-> DomRenderHookT t m (a, HydrationState)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
(forall x. JSM x -> JSM x) -> m a -> m a
withRenderHook forall x. JSM x -> JSM x
hook)) (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
 -> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> (HydrationRunnerT t m a
    -> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall t (m :: * -> *) a.
HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
unHydrationRunnerT
  requestDomAction :: Event t (JSM a) -> HydrationRunnerT t m (Event t a)
requestDomAction = StateT
  HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a)
-> HydrationRunnerT t m (Event t a)
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT
   HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a)
 -> HydrationRunnerT t m (Event t a))
-> (Event t (JSM a)
    -> StateT
         HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a))
-> Event t (JSM a)
-> HydrationRunnerT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Node (DomRenderHookT t m) (Event t a)
-> StateT
     HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Node (DomRenderHookT t m) (Event t a)
 -> StateT
      HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a))
-> (Event t (JSM a)
    -> ReaderT Node (DomRenderHookT t m) (Event t a))
-> Event t (JSM a)
-> StateT
     HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a)
-> ReaderT Node (DomRenderHookT t m) (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a)
 -> ReaderT Node (DomRenderHookT t m) (Event t a))
-> (Event t (JSM a) -> DomRenderHookT t m (Event t a))
-> Event t (JSM a)
-> ReaderT Node (DomRenderHookT t m) (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> DomRenderHookT t m (Event t a)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction
  requestDomAction_ :: Event t (JSM a) -> HydrationRunnerT t m ()
requestDomAction_ = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
 -> HydrationRunnerT t m ())
-> (Event t (JSM a)
    -> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> Event t (JSM a)
-> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Node (DomRenderHookT t m) ()
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Node (DomRenderHookT t m) ()
 -> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (Event t (JSM a) -> ReaderT Node (DomRenderHookT t m) ())
-> Event t (JSM a)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m () -> ReaderT Node (DomRenderHookT t m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m () -> ReaderT Node (DomRenderHookT t m) ())
-> (Event t (JSM a) -> DomRenderHookT t m ())
-> Event t (JSM a)
-> ReaderT Node (DomRenderHookT t m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> DomRenderHookT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_

-- | Add a hydration step which depends on some computation that should only be
-- done *before* the switchover to immediate mode - this is most likely some
-- form of 'hold' which we want to remove after hydration is done
{-# INLINABLE addHydrationStepWithSetup #-}
addHydrationStepWithSetup :: MonadIO m => m a -> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup :: m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup m a
setup a -> HydrationRunnerT t m ()
f = HydrationDomBuilderT s t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT s t m HydrationMode
-> (HydrationMode -> HydrationDomBuilderT s t m ())
-> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  HydrationMode
HydrationMode_Immediate -> () -> HydrationDomBuilderT s t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  HydrationMode
HydrationMode_Hydrating -> do
    a
s <- m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
setup
    HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) t (s :: k).
MonadIO m =>
HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
addHydrationStep (a -> HydrationRunnerT t m ()
f a
s)

-- | Add a hydration step
{-# INLINABLE addHydrationStep #-}
addHydrationStep :: MonadIO m => HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
addHydrationStep :: HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
addHydrationStep HydrationRunnerT t m ()
m = do
  IORef (HydrationRunnerT t m ())
delayedRef <- ReaderT
  (HydrationDomBuilderEnv t m)
  (DomRenderHookT t m)
  (IORef (HydrationRunnerT t m ()))
-> HydrationDomBuilderT s t m (IORef (HydrationRunnerT 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)
   (IORef (HydrationRunnerT t m ()))
 -> HydrationDomBuilderT s t m (IORef (HydrationRunnerT t m ())))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (IORef (HydrationRunnerT t m ()))
-> HydrationDomBuilderT s t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ (HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ()))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (IORef (HydrationRunnerT t m ()))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed
  IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ IORef (HydrationRunnerT t m ())
-> (HydrationRunnerT t m () -> HydrationRunnerT t m ()) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (HydrationRunnerT t m ())
delayedRef (HydrationRunnerT t m ()
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HydrationRunnerT t m ()
m)

-- | Shared behavior for HydrationDomBuilderT and HydrationRunnerT
newtype DomRenderHookT t m a = DomRenderHookT { DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT :: RequesterT t JSM Identity (TriggerEventT t m) a }
  deriving (a -> DomRenderHookT t m b -> DomRenderHookT t m a
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
(forall a b.
 (a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b)
-> (forall a b. a -> DomRenderHookT t m b -> DomRenderHookT t m a)
-> Functor (DomRenderHookT t m)
forall a b. a -> DomRenderHookT t m b -> DomRenderHookT t m a
forall a b.
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
forall t (m :: * -> *) a b.
Functor m =>
a -> DomRenderHookT t m b -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DomRenderHookT t m b -> DomRenderHookT t m a
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> DomRenderHookT t m b -> DomRenderHookT t m a
fmap :: (a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
Functor, Functor (DomRenderHookT t m)
a -> DomRenderHookT t m a
Functor (DomRenderHookT t m)
-> (forall a. a -> DomRenderHookT t m a)
-> (forall a b.
    DomRenderHookT t m (a -> b)
    -> DomRenderHookT t m a -> DomRenderHookT t m b)
-> (forall a b c.
    (a -> b -> c)
    -> DomRenderHookT t m a
    -> DomRenderHookT t m b
    -> DomRenderHookT t m c)
-> (forall a b.
    DomRenderHookT t m a
    -> DomRenderHookT t m b -> DomRenderHookT t m b)
-> (forall a b.
    DomRenderHookT t m a
    -> DomRenderHookT t m b -> DomRenderHookT t m a)
-> Applicative (DomRenderHookT t m)
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
forall a. a -> DomRenderHookT t m a
forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall a b.
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
forall a b c.
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
forall t (m :: * -> *). Monad m => Functor (DomRenderHookT t m)
forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT 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
<* :: DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
*> :: DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
liftA2 :: (a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
<*> :: DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
pure :: a -> DomRenderHookT t m a
$cpure :: forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
$cp1Applicative :: forall t (m :: * -> *). Monad m => Functor (DomRenderHookT t m)
Applicative, Applicative (DomRenderHookT t m)
a -> DomRenderHookT t m a
Applicative (DomRenderHookT t m)
-> (forall a b.
    DomRenderHookT t m a
    -> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b)
-> (forall a b.
    DomRenderHookT t m a
    -> DomRenderHookT t m b -> DomRenderHookT t m b)
-> (forall a. a -> DomRenderHookT t m a)
-> Monad (DomRenderHookT t m)
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall a. a -> DomRenderHookT t m a
forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall a b.
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b
forall t (m :: * -> *). Monad m => Applicative (DomRenderHookT t m)
forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT 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
return :: a -> DomRenderHookT t m a
$creturn :: forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
>> :: DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
>>= :: DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b
$cp1Monad :: forall t (m :: * -> *). Monad m => Applicative (DomRenderHookT t m)
Monad, Monad (DomRenderHookT t m)
Monad (DomRenderHookT t m)
-> (forall a. (a -> DomRenderHookT t m a) -> DomRenderHookT t m a)
-> MonadFix (DomRenderHookT t m)
(a -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall a. (a -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall t (m :: * -> *). MonadFix m => Monad (DomRenderHookT t m)
forall t (m :: * -> *) a.
MonadFix m =>
(a -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> DomRenderHookT t m a) -> DomRenderHookT t m a
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> DomRenderHookT t m a) -> DomRenderHookT t m a
$cp1MonadFix :: forall t (m :: * -> *). MonadFix m => Monad (DomRenderHookT t m)
MonadFix, Monad (DomRenderHookT t m)
Monad (DomRenderHookT t m)
-> (forall a. IO a -> DomRenderHookT t m a)
-> MonadIO (DomRenderHookT t m)
IO a -> DomRenderHookT t m a
forall a. IO a -> DomRenderHookT t m a
forall t (m :: * -> *). MonadIO m => Monad (DomRenderHookT t m)
forall t (m :: * -> *) a. MonadIO m => IO a -> DomRenderHookT t m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> DomRenderHookT t m a
$cliftIO :: forall t (m :: * -> *) a. MonadIO m => IO a -> DomRenderHookT t m a
$cp1MonadIO :: forall t (m :: * -> *). MonadIO m => Monad (DomRenderHookT t m)
MonadIO, Monad (DomRenderHookT t m)
e -> DomRenderHookT t m a
Monad (DomRenderHookT t m)
-> (forall e a. Exception e => e -> DomRenderHookT t m a)
-> (forall e a.
    Exception e =>
    DomRenderHookT t m a
    -> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a)
-> (forall a b.
    DomRenderHookT t m a
    -> DomRenderHookT t m b -> DomRenderHookT t m a)
-> MonadException (DomRenderHookT t m)
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall e a. Exception e => e -> DomRenderHookT t m a
forall e a.
Exception e =>
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall t (m :: * -> *).
MonadException m =>
Monad (DomRenderHookT t m)
forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> DomRenderHookT t m a
forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
MonadException m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall (m :: * -> *).
Monad m
-> (forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
finally :: DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
$cfinally :: forall t (m :: * -> *) a b.
MonadException m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
catch :: DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
$ccatch :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
throw :: e -> DomRenderHookT t m a
$cthrow :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> DomRenderHookT t m a
$cp1MonadException :: forall t (m :: * -> *).
MonadException m =>
Monad (DomRenderHookT t m)
MonadException
#if MIN_VERSION_base(4,9,1)
           , MonadIO (DomRenderHookT t m)
MonadException (DomRenderHookT t m)
MonadIO (DomRenderHookT t m)
-> MonadException (DomRenderHookT t m)
-> (forall b.
    ((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
     -> DomRenderHookT t m b)
    -> DomRenderHookT t m b)
-> MonadAsyncException (DomRenderHookT t m)
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
 -> DomRenderHookT t m b)
-> DomRenderHookT t m b
forall b.
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
 -> DomRenderHookT t m b)
-> DomRenderHookT t m b
forall t (m :: * -> *).
MonadAsyncException m =>
MonadIO (DomRenderHookT t m)
forall t (m :: * -> *).
MonadAsyncException m =>
MonadException (DomRenderHookT t m)
forall t (m :: * -> *) b.
MonadAsyncException m =>
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
 -> DomRenderHookT t m b)
-> DomRenderHookT t m b
forall (m :: * -> *).
MonadIO m
-> MonadException m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
mask :: ((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
 -> DomRenderHookT t m b)
-> DomRenderHookT t m b
$cmask :: forall t (m :: * -> *) b.
MonadAsyncException m =>
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
 -> DomRenderHookT t m b)
-> DomRenderHookT t m b
$cp2MonadAsyncException :: forall t (m :: * -> *).
MonadAsyncException m =>
MonadException (DomRenderHookT t m)
$cp1MonadAsyncException :: forall t (m :: * -> *).
MonadAsyncException m =>
MonadIO (DomRenderHookT t m)
MonadAsyncException
#endif
           )

{-# INLINABLE runDomRenderHookT #-}
runDomRenderHookT
  :: (MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef)
  => DomRenderHookT t m a
  -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
  -> m a
runDomRenderHookT :: DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runDomRenderHookT (DomRenderHookT RequesterT t JSM Identity (TriggerEventT t m) a
a) Chan [DSum (EventTriggerRef t) TriggerInvocation]
events = do
  (TriggerEventT t m a
 -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> TriggerEventT t m a
-> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip TriggerEventT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
forall t (m :: * -> *) a.
TriggerEventT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runTriggerEventT Chan [DSum (EventTriggerRef t) TriggerInvocation]
events (TriggerEventT t m a -> m a) -> TriggerEventT t m a -> m a
forall a b. (a -> b) -> a -> b
$ do
    rec (a
result, Event t (RequesterData JSM)
req) <- RequesterT t JSM Identity (TriggerEventT t m) a
-> Event t (RequesterData Identity)
-> TriggerEventT t m (a, Event t (RequesterData JSM))
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 JSM Identity (TriggerEventT t m) a
a Event t (RequesterData Identity)
rsp
        Event t (RequesterData Identity)
rsp <- Event
  t
  ((RequesterData Identity -> IO ())
   -> Performable (TriggerEventT t m) ())
-> TriggerEventT t m (Event t (RequesterData Identity))
forall t (m :: * -> *) a.
(TriggerEvent t m, PerformEvent t m) =>
Event t ((a -> IO ()) -> Performable m ()) -> m (Event t a)
performEventAsync (Event
   t
   ((RequesterData Identity -> IO ())
    -> Performable (TriggerEventT t m) ())
 -> TriggerEventT t m (Event t (RequesterData Identity)))
-> Event
     t
     ((RequesterData Identity -> IO ())
      -> Performable (TriggerEventT t m) ())
-> TriggerEventT t m (Event t (RequesterData Identity))
forall a b. (a -> b) -> a -> b
$ Event t (RequesterData JSM)
-> (RequesterData JSM
    -> (RequesterData Identity -> IO ()) -> Performable m ())
-> Event t ((RequesterData Identity -> IO ()) -> Performable m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (RequesterData JSM)
req ((RequesterData JSM
  -> (RequesterData Identity -> IO ()) -> Performable m ())
 -> Event t ((RequesterData Identity -> IO ()) -> Performable m ()))
-> (RequesterData JSM
    -> (RequesterData Identity -> IO ()) -> Performable m ())
-> Event t ((RequesterData Identity -> IO ()) -> Performable m ())
forall a b. (a -> b) -> a -> b
$ \RequesterData JSM
rm RequesterData Identity -> IO ()
f -> JSM () -> Performable m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> Performable m ()) -> JSM () -> Performable m ()
forall a b. (a -> b) -> a -> b
$ (RequesterData Identity -> IO ())
-> JSM (RequesterData Identity) -> JSM ()
forall t a. (t -> IO a) -> JSM t -> JSM ()
runInAnimationFrame RequesterData Identity -> IO ()
f (JSM (RequesterData Identity) -> JSM ())
-> JSM (RequesterData Identity) -> JSM ()
forall a b. (a -> b) -> a -> b
$
          (forall a. JSM a -> JSM (Identity a))
-> RequesterData JSM -> JSM (RequesterData Identity)
forall (m :: * -> *) (request :: * -> *) (response :: * -> *).
Applicative m =>
(forall a. request a -> m (response a))
-> RequesterData request -> m (RequesterData response)
traverseRequesterData ((a -> Identity a) -> JSM a -> JSM (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity) RequesterData JSM
rm
    a -> TriggerEventT t m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
  where
    runInAnimationFrame :: (t -> IO a) -> JSM t -> JSM ()
runInAnimationFrame t -> IO a
f JSM t
x = JSM AnimationFrameHandle -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM AnimationFrameHandle -> JSM ())
-> ((Double -> JSM ()) -> JSM AnimationFrameHandle)
-> (Double -> JSM ())
-> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> JSM ()) -> JSM AnimationFrameHandle
DOM.inAnimationFrame' ((Double -> JSM ()) -> JSM ()) -> (Double -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \Double
_ -> do
        t
v <- JSM t -> JSM t
forall x. JSM x -> JSM x
synchronously JSM t
x
        JSM a -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM a -> JSM ()) -> (IO a -> JSM a) -> IO a -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> JSM ()) -> IO a -> JSM ()
forall a b. (a -> b) -> a -> b
$ t -> IO a
f t
v

instance MonadTrans (DomRenderHookT t) where
  {-# INLINABLE lift #-}
  lift :: m a -> DomRenderHookT t m a
lift = RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) a
 -> DomRenderHookT t m a)
-> (m a -> RequesterT t JSM Identity (TriggerEventT t m) a)
-> m a
-> DomRenderHookT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m a
 -> RequesterT t JSM Identity (TriggerEventT t m) a)
-> (m a -> TriggerEventT t m a)
-> m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> TriggerEventT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (Reflex t, MonadFix m) => DomRenderHook t (DomRenderHookT t m) where
  withRenderHook :: (forall x. JSM x -> JSM x)
-> DomRenderHookT t m a -> DomRenderHookT t m a
withRenderHook forall x. JSM x -> JSM x
hook (DomRenderHookT RequesterT t JSM Identity (TriggerEventT t m) a
a) = do
    RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) a
 -> DomRenderHookT t m a)
-> RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
forall a b. (a -> b) -> a -> b
$ (Event
   t
   (Response
      (RequesterT t JSM Identity (TriggerEventT t m))
      (RequesterData Identity))
 -> RequesterT
      t
      JSM
      Identity
      (TriggerEventT t m)
      (Event
         t
         (Request
            (RequesterT t JSM Identity (TriggerEventT t m))
            (RequesterData Identity)),
       a))
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall t (m :: * -> *) a r.
(Requester t m, MonadFix m) =>
(Event t (Response m a) -> m (Event t (Request m a), r)) -> m r
withRequesting ((Event
    t
    (Response
       (RequesterT t JSM Identity (TriggerEventT t m))
       (RequesterData Identity))
  -> RequesterT
       t
       JSM
       Identity
       (TriggerEventT t m)
       (Event
          t
          (Request
             (RequesterT t JSM Identity (TriggerEventT t m))
             (RequesterData Identity)),
        a))
 -> RequesterT t JSM Identity (TriggerEventT t m) a)
-> (Event
      t
      (Response
         (RequesterT t JSM Identity (TriggerEventT t m))
         (RequesterData Identity))
    -> RequesterT
         t
         JSM
         Identity
         (TriggerEventT t m)
         (Event
            t
            (Request
               (RequesterT t JSM Identity (TriggerEventT t m))
               (RequesterData Identity)),
          a))
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall a b. (a -> b) -> a -> b
$ \Event
  t
  (Response
     (RequesterT t JSM Identity (TriggerEventT t m))
     (RequesterData Identity))
rsp -> do
      (a
x, Event t (RequesterData JSM)
req) <- TriggerEventT t m (a, Event t (RequesterData JSM))
-> RequesterT
     t JSM Identity (TriggerEventT t m) (a, Event t (RequesterData JSM))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m (a, Event t (RequesterData JSM))
 -> RequesterT
      t
      JSM
      Identity
      (TriggerEventT t m)
      (a, Event t (RequesterData JSM)))
-> TriggerEventT t m (a, Event t (RequesterData JSM))
-> RequesterT
     t JSM Identity (TriggerEventT t m) (a, Event t (RequesterData JSM))
forall a b. (a -> b) -> a -> b
$ RequesterT t JSM Identity (TriggerEventT t m) a
-> Event t (RequesterData Identity)
-> TriggerEventT t m (a, Event t (RequesterData JSM))
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 JSM Identity (TriggerEventT t m) a
a (Event t (RequesterData Identity)
 -> TriggerEventT t m (a, Event t (RequesterData JSM)))
-> Event t (RequesterData Identity)
-> TriggerEventT t m (a, Event t (RequesterData JSM))
forall a b. (a -> b) -> a -> b
$ Identity (RequesterData Identity) -> RequesterData Identity
forall a. Identity a -> a
runIdentity (Identity (RequesterData Identity) -> RequesterData Identity)
-> Event t (Identity (RequesterData Identity))
-> Event t (RequesterData Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (Identity (RequesterData Identity))
Event
  t
  (Response
     (RequesterT t JSM Identity (TriggerEventT t m))
     (RequesterData Identity))
rsp
      (Event t (JSM (RequesterData Identity)), a)
-> RequesterT
     t
     JSM
     Identity
     (TriggerEventT t m)
     (Event t (JSM (RequesterData Identity)), a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t (RequesterData JSM)
-> (RequesterData JSM -> JSM (RequesterData Identity))
-> Event t (JSM (RequesterData Identity))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (RequesterData JSM)
req ((RequesterData JSM -> JSM (RequesterData Identity))
 -> Event t (JSM (RequesterData Identity)))
-> (RequesterData JSM -> JSM (RequesterData Identity))
-> Event t (JSM (RequesterData Identity))
forall a b. (a -> b) -> a -> b
$ \RequesterData JSM
rm -> JSM (RequesterData Identity) -> JSM (RequesterData Identity)
forall x. JSM x -> JSM x
hook (JSM (RequesterData Identity) -> JSM (RequesterData Identity))
-> JSM (RequesterData Identity) -> JSM (RequesterData Identity)
forall a b. (a -> b) -> a -> b
$ (forall a. JSM a -> JSM (Identity a))
-> RequesterData JSM -> JSM (RequesterData Identity)
forall (m :: * -> *) (request :: * -> *) (response :: * -> *).
Applicative m =>
(forall a. request a -> m (response a))
-> RequesterData request -> m (RequesterData response)
traverseRequesterData ((a -> Identity a) -> JSM a -> JSM (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity) RequesterData JSM
rm, a
x)
  requestDomAction :: Event t (JSM a) -> DomRenderHookT t m (Event t a)
requestDomAction = RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
-> DomRenderHookT t m (Event t a)
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
 -> DomRenderHookT t m (Event t a))
-> (Event t (JSM a)
    -> RequesterT t JSM Identity (TriggerEventT t m) (Event t a))
-> Event t (JSM a)
-> DomRenderHookT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a)
-> RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
forall t (m :: * -> *) a.
(Requester t m, Response m ~ Identity) =>
Event t (Request m a) -> m (Event t a)
requestingIdentity
  requestDomAction_ :: Event t (JSM a) -> DomRenderHookT t m ()
requestDomAction_ = RequesterT t JSM Identity (TriggerEventT t m) ()
-> DomRenderHookT t m ()
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) ()
 -> DomRenderHookT t m ())
-> (Event t (JSM a)
    -> RequesterT t JSM Identity (TriggerEventT t m) ())
-> Event t (JSM a)
-> DomRenderHookT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> RequesterT t JSM Identity (TriggerEventT t m) ()
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m ()
requesting_

{-# INLINABLE runHydrationDomBuilderT #-}
runHydrationDomBuilderT
  :: ( 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 :: HydrationDomBuilderT s t m a
-> HydrationDomBuilderEnv t m
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationDomBuilderT (HydrationDomBuilderT ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
a) HydrationDomBuilderEnv t m
env = DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
forall (m :: * -> *) t a.
(MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m,
 MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef) =>
DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runDomRenderHookT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
a HydrationDomBuilderEnv t m
env)

instance (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, Monad m) => HasDocument (HydrationDomBuilderT s t m) where
  {-# INLINABLE askDocument #-}
  askDocument :: HydrationDomBuilderT
  s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
askDocument = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) Document
-> HydrationDomBuilderT s t m Document
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) Document
 -> HydrationDomBuilderT s t m Document)
-> ReaderT
     (HydrationDomBuilderEnv t m) (DomRenderHookT t m) Document
-> HydrationDomBuilderT s t m Document
forall a b. (a -> b) -> a -> b
$ (HydrationDomBuilderEnv t m -> Document)
-> ReaderT
     (HydrationDomBuilderEnv t m) (DomRenderHookT t m) Document
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> Document
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> Document
_hydrationDomBuilderEnv_document

{-# INLINABLE askParent #-}
askParent :: Monad m => HydrationRunnerT t m DOM.Node
askParent :: HydrationRunnerT t m Node
askParent = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) Node
-> HydrationRunnerT t m Node
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) Node
forall r (m :: * -> *). MonadReader r m => m r
ask

{-# INLINABLE getParent #-}
getParent :: MonadIO m => HydrationDomBuilderT s t m DOM.Node
getParent :: HydrationDomBuilderT s t m Node
getParent = (Node -> HydrationDomBuilderT s t m Node)
-> (IORef Node -> HydrationDomBuilderT s t m Node)
-> Either Node (IORef Node)
-> HydrationDomBuilderT s t m Node
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Node -> HydrationDomBuilderT s t m Node
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO Node -> HydrationDomBuilderT s t m Node
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Node -> HydrationDomBuilderT s t m Node)
-> (IORef Node -> IO Node)
-> IORef Node
-> HydrationDomBuilderT s t m Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Node -> IO Node
forall a. IORef a -> IO a
readIORef) (Either Node (IORef Node) -> HydrationDomBuilderT s t m Node)
-> HydrationDomBuilderT s t m (Either Node (IORef Node))
-> HydrationDomBuilderT s t m Node
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT
  (HydrationDomBuilderEnv t m)
  (DomRenderHookT t m)
  (Either Node (IORef Node))
-> HydrationDomBuilderT s t m (Either Node (IORef Node))
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT ((HydrationDomBuilderEnv t m -> Either Node (IORef Node))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (Either Node (IORef Node))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> Either Node (IORef Node)
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> Either Node (IORef Node)
_hydrationDomBuilderEnv_parent)

{-# INLINABLE askEvents #-}
askEvents :: Monad m => HydrationDomBuilderT s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents :: HydrationDomBuilderT
  s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents = ReaderT
  (HydrationDomBuilderEnv t m)
  (DomRenderHookT t m)
  (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> HydrationDomBuilderT
     s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
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)
   (Chan [DSum (EventTriggerRef t) TriggerInvocation])
 -> HydrationDomBuilderT
      s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> (TriggerEventT
      t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
    -> ReaderT
         (HydrationDomBuilderEnv t m)
         (DomRenderHookT t m)
         (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> TriggerEventT
     t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> HydrationDomBuilderT
     s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT
  t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT
   t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
 -> ReaderT
      (HydrationDomBuilderEnv t m)
      (DomRenderHookT t m)
      (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> (TriggerEventT
      t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
    -> DomRenderHookT
         t m (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> TriggerEventT
     t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequesterT
  t
  JSM
  Identity
  (TriggerEventT t m)
  (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> DomRenderHookT
     t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
   t
   JSM
   Identity
   (TriggerEventT t m)
   (Chan [DSum (EventTriggerRef t) TriggerInvocation])
 -> DomRenderHookT
      t m (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> (TriggerEventT
      t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
    -> RequesterT
         t
         JSM
         Identity
         (TriggerEventT t m)
         (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> TriggerEventT
     t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> DomRenderHookT
     t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT
  t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> RequesterT
     t
     JSM
     Identity
     (TriggerEventT t m)
     (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT
   t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
 -> HydrationDomBuilderT
      s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> TriggerEventT
     t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> HydrationDomBuilderT
     s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall a b. (a -> b) -> a -> b
$ TriggerEventT
  t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall (m :: * -> *) t.
Monad m =>
TriggerEventT
  t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
TriggerEventT.askEvents

{-# INLINABLE localEnv #-}
localEnv :: Monad m => (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m) -> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
localEnv :: (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
localEnv HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m
f = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
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) a
 -> HydrationDomBuilderT s t m a)
-> (HydrationDomBuilderT s t m a
    -> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m
f (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m
forall a b. (a -> b) -> a -> b
$!) (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
 -> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> (HydrationDomBuilderT s t m a
    -> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT

{-# INLINABLE append #-}
append :: MonadJSM m => DOM.Node -> HydrationDomBuilderT s t m ()
append :: Node -> HydrationDomBuilderT s t m ()
append Node
n = do
  Node
p <- HydrationDomBuilderT s t m Node
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
  JSM () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> HydrationDomBuilderT s t m ())
-> JSM () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Node -> Node -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
appendChild_ Node
p Node
n
  () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# SPECIALIZE append
  :: DOM.Node
  -> HydrationDomBuilderT s Spider HydrationM ()
  #-}

data HydrationMode
  = HydrationMode_Hydrating
  -- ^ The time from initial load to parity with static builder
  | HydrationMode_Immediate
  -- ^ After hydration
  deriving (HydrationMode -> HydrationMode -> Bool
(HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> Bool) -> Eq HydrationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HydrationMode -> HydrationMode -> Bool
$c/= :: HydrationMode -> HydrationMode -> Bool
== :: HydrationMode -> HydrationMode -> Bool
$c== :: HydrationMode -> HydrationMode -> Bool
Eq, Eq HydrationMode
Eq HydrationMode
-> (HydrationMode -> HydrationMode -> Ordering)
-> (HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> HydrationMode)
-> (HydrationMode -> HydrationMode -> HydrationMode)
-> Ord HydrationMode
HydrationMode -> HydrationMode -> Bool
HydrationMode -> HydrationMode -> Ordering
HydrationMode -> HydrationMode -> HydrationMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HydrationMode -> HydrationMode -> HydrationMode
$cmin :: HydrationMode -> HydrationMode -> HydrationMode
max :: HydrationMode -> HydrationMode -> HydrationMode
$cmax :: HydrationMode -> HydrationMode -> HydrationMode
>= :: HydrationMode -> HydrationMode -> Bool
$c>= :: HydrationMode -> HydrationMode -> Bool
> :: HydrationMode -> HydrationMode -> Bool
$c> :: HydrationMode -> HydrationMode -> Bool
<= :: HydrationMode -> HydrationMode -> Bool
$c<= :: HydrationMode -> HydrationMode -> Bool
< :: HydrationMode -> HydrationMode -> Bool
$c< :: HydrationMode -> HydrationMode -> Bool
compare :: HydrationMode -> HydrationMode -> Ordering
$ccompare :: HydrationMode -> HydrationMode -> Ordering
$cp1Ord :: Eq HydrationMode
Ord, Int -> HydrationMode -> ShowS
[HydrationMode] -> ShowS
HydrationMode -> String
(Int -> HydrationMode -> ShowS)
-> (HydrationMode -> String)
-> ([HydrationMode] -> ShowS)
-> Show HydrationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HydrationMode] -> ShowS
$cshowList :: [HydrationMode] -> ShowS
show :: HydrationMode -> String
$cshow :: HydrationMode -> String
showsPrec :: Int -> HydrationMode -> ShowS
$cshowsPrec :: Int -> HydrationMode -> ShowS
Show)

{-# INLINABLE getPreviousNode #-}
getPreviousNode :: Monad m => HydrationRunnerT t m (Maybe DOM.Node)
getPreviousNode :: HydrationRunnerT t m (Maybe Node)
getPreviousNode = StateT
  HydrationState (ReaderT Node (DomRenderHookT t m)) (Maybe Node)
-> HydrationRunnerT t m (Maybe Node)
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT
   HydrationState (ReaderT Node (DomRenderHookT t m)) (Maybe Node)
 -> HydrationRunnerT t m (Maybe Node))
-> StateT
     HydrationState (ReaderT Node (DomRenderHookT t m)) (Maybe Node)
-> HydrationRunnerT t m (Maybe Node)
forall a b. (a -> b) -> a -> b
$ (HydrationState -> Maybe Node)
-> StateT
     HydrationState (ReaderT Node (DomRenderHookT t m)) (Maybe Node)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HydrationState -> Maybe Node
_hydrationState_previousNode

{-# INLINABLE setPreviousNode #-}
setPreviousNode :: Monad m => Maybe DOM.Node -> HydrationRunnerT t m ()
setPreviousNode :: Maybe Node -> HydrationRunnerT t m ()
setPreviousNode Maybe Node
n = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
 -> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\HydrationState
hs -> HydrationState
hs { _hydrationState_previousNode :: Maybe Node
_hydrationState_previousNode = Maybe Node
n })

{-# INLINABLE askUnreadyChildren #-}
askUnreadyChildren :: Monad m => HydrationDomBuilderT s t m (IORef Word)
askUnreadyChildren :: HydrationDomBuilderT s t m (IORef Word)
askUnreadyChildren = ReaderT
  (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (IORef Word)
-> HydrationDomBuilderT s t m (IORef Word)
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) (IORef Word)
 -> HydrationDomBuilderT s t m (IORef Word))
-> ReaderT
     (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (IORef Word)
-> HydrationDomBuilderT s t m (IORef Word)
forall a b. (a -> b) -> a -> b
$ (HydrationDomBuilderEnv t m -> IORef Word)
-> ReaderT
     (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (IORef Word)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren

{-# INLINABLE askCommitAction #-}
askCommitAction :: Monad m => HydrationDomBuilderT s t m (JSM ())
askCommitAction :: HydrationDomBuilderT s t m (JSM ())
askCommitAction = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (JSM ())
-> HydrationDomBuilderT s t m (JSM ())
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) (JSM ())
 -> HydrationDomBuilderT s t m (JSM ()))
-> ReaderT
     (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (JSM ())
-> HydrationDomBuilderT s t m (JSM ())
forall a b. (a -> b) -> a -> b
$ (HydrationDomBuilderEnv t m -> JSM ())
-> ReaderT
     (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (JSM ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> JSM ()
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> JSM ()
_hydrationDomBuilderEnv_commitAction

{-# INLINABLE getHydrationMode #-}
getHydrationMode :: MonadIO m => HydrationDomBuilderT s t m HydrationMode
getHydrationMode :: HydrationDomBuilderT s t m HydrationMode
getHydrationMode = IO HydrationMode -> HydrationDomBuilderT s t m HydrationMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HydrationMode -> HydrationDomBuilderT s t m HydrationMode)
-> (IORef HydrationMode -> IO HydrationMode)
-> IORef HydrationMode
-> HydrationDomBuilderT s t m HydrationMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef HydrationMode -> IO HydrationMode
forall a. IORef a -> IO a
readIORef (IORef HydrationMode -> HydrationDomBuilderT s t m HydrationMode)
-> HydrationDomBuilderT s t m (IORef HydrationMode)
-> HydrationDomBuilderT s t m HydrationMode
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT
  (HydrationDomBuilderEnv t m)
  (DomRenderHookT t m)
  (IORef HydrationMode)
-> HydrationDomBuilderT s t m (IORef HydrationMode)
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT ((HydrationDomBuilderEnv t m -> IORef HydrationMode)
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (IORef HydrationMode)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> IORef HydrationMode
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode)

-- | Remove all nodes after given node
removeSubsequentNodes :: (MonadJSM m, IsNode n) => n -> m ()
removeSubsequentNodes :: n -> m ()
removeSubsequentNodes n
n = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  JSVal
f <- Text -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval (Text
"(function(n) { while (n.nextSibling) { (n.parentNode).removeChild(n.nextSibling); }; })" :: Text)
  JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal -> JSVal -> [n] -> JSM JSVal
forall f this args.
(MakeObject f, MakeObject this, MakeArgs args) =>
f -> this -> args -> JSM JSVal
call JSVal
f JSVal
f [n
n]

-- | s and e must both be children of the same node and s must precede e;
--   all nodes between s and e will be removed, but s and e will not be removed
deleteBetweenExclusive :: (MonadJSM m, IsNode start, IsNode end) => start -> end -> m ()
deleteBetweenExclusive :: start -> end -> m ()
deleteBetweenExclusive start
s end
e = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  DocumentFragment
df <- Document -> JSM DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment (Document -> JSM DocumentFragment)
-> JSM Document -> JSM DocumentFragment
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< start -> JSM Document
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Document
getOwnerDocumentUnchecked start
s
  DocumentFragment -> start -> end -> JSM ()
forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
DocumentFragment -> start -> end -> m ()
extractBetweenExclusive DocumentFragment
df start
s end
e -- In many places in ImmediateDomBuilderT, we assume that things always have a parent; by adding them to this DocumentFragment, we maintain that invariant

-- | s and e must both be children of the same node and s must precede e; all
--   nodes between s and e will be moved into the given DocumentFragment, but s
--   and e will not be moved
extractBetweenExclusive :: (MonadJSM m, IsNode start, IsNode end) => DOM.DocumentFragment -> start -> end -> m ()
extractBetweenExclusive :: DocumentFragment -> start -> end -> m ()
extractBetweenExclusive DocumentFragment
df start
s end
e = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  JSVal
f <- Text -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval (Text
"(function(df,s,e) { var x; for(;;) { x = s['nextSibling']; if(e===x) { break; }; df['appendChild'](x); } })" :: Text)
  JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal -> JSVal -> (DocumentFragment, start, end) -> JSM JSVal
forall f this args.
(MakeObject f, MakeObject this, MakeArgs args) =>
f -> this -> args -> JSM JSVal
call JSVal
f JSVal
f (DocumentFragment
df, start
s, end
e)

-- | s and e must both be children of the same node and s must precede e;
--   s and all nodes between s and e will be removed, but e will not be removed
{-# INLINABLE deleteUpTo #-}
deleteUpTo :: (MonadJSM m, IsNode start, IsNode end) => start -> end -> m ()
deleteUpTo :: start -> end -> m ()
deleteUpTo start
s end
e = do
  DocumentFragment
df <- Document -> m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment (Document -> m DocumentFragment)
-> m Document -> m DocumentFragment
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< start -> m Document
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Document
getOwnerDocumentUnchecked start
s
  DocumentFragment -> start -> end -> m ()
forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
DocumentFragment -> start -> end -> m ()
extractUpTo DocumentFragment
df start
s end
e -- In many places in ImmediateDomBuilderT, we assume that things always have a parent; by adding them to this DocumentFragment, we maintain that invariant

extractUpTo :: (MonadJSM m, IsNode start, IsNode end) => DOM.DocumentFragment -> start -> end -> m ()
#ifdef ghcjs_HOST_OS
--NOTE: Although wrapping this javascript in a function seems unnecessary, GHCJS's optimizer will break it if it is entered without that wrapping (as of 2017-09-04)
foreign import javascript unsafe
  "(function() { var x = $2; while(x !== $3) { var y = x['nextSibling']; $1['appendChild'](x); x = y; } })()"
  extractUpTo_ :: DOM.DocumentFragment -> DOM.Node -> DOM.Node -> IO ()
extractUpTo df s e = liftJSM $ extractUpTo_ df (toNode s) (toNode e)
#else
extractUpTo :: DocumentFragment -> start -> end -> m ()
extractUpTo DocumentFragment
df start
s end
e = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  JSVal
f <- Text -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval (Text
"(function(df,s,e){ var x = s; var y; for(;;) { y = x['nextSibling']; df['appendChild'](x); if(e===y) { break; } x = y; } })" :: Text)
  JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal -> JSVal -> (DocumentFragment, start, end) -> JSM JSVal
forall f this args.
(MakeObject f, MakeObject this, MakeArgs args) =>
f -> this -> args -> JSM JSVal
call JSVal
f JSVal
f (DocumentFragment
df, start
s, end
e)
#endif

type SupportsHydrationDomBuilder t m = (Reflex t, MonadJSM m, MonadHold t m, MonadFix m, MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref JSM, Adjustable t m, PrimMonad m, PerformEvent t m, MonadJSM (Performable m))

{-# INLINABLE collectUpTo #-}
collectUpTo :: (MonadJSM m, IsNode start, IsNode end) => start -> end -> m DOM.DocumentFragment
collectUpTo :: start -> end -> m DocumentFragment
collectUpTo start
s end
e = do
  Node
currentParent <- end -> m Node
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Node
getParentNodeUnchecked end
e -- May be different than it was at initial construction, e.g., because the parent may have dumped us in from a DocumentFragment
  Node -> start -> end -> m DocumentFragment
forall (m :: * -> *) parent start end.
(MonadJSM m, IsNode parent, IsNode start, IsNode end) =>
parent -> start -> end -> m DocumentFragment
collectUpToGivenParent Node
currentParent start
s end
e

{-# INLINABLE collectUpToGivenParent #-}
collectUpToGivenParent :: (MonadJSM m, IsNode parent, IsNode start, IsNode end) => parent -> start -> end -> m DOM.DocumentFragment
collectUpToGivenParent :: parent -> start -> end -> m DocumentFragment
collectUpToGivenParent parent
currentParent start
s end
e = do
  Document
doc <- parent -> m Document
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Document
getOwnerDocumentUnchecked parent
currentParent
  DocumentFragment
df <- Document -> m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment Document
doc
  DocumentFragment -> start -> end -> m ()
forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
DocumentFragment -> start -> end -> m ()
extractUpTo DocumentFragment
df start
s end
e
  DocumentFragment -> m DocumentFragment
forall (m :: * -> *) a. Monad m => a -> m a
return DocumentFragment
df

newtype EventFilterTriggerRef t er (en :: EventTag) = EventFilterTriggerRef (IORef (Maybe (EventTrigger t (er en))))

-- | This 'wrap' is only partial: it doesn't create the 'EventSelector' itself
{-# INLINE wrap #-}
wrap
  :: forall s m er t. (Reflex t, MonadJSM m, MonadReflexCreateTrigger t m, DomRenderHook t m, EventSpec s ~ GhcjsEventSpec)
  => Chan [DSum (EventTriggerRef t) TriggerInvocation]
  -> DOM.Element
  -> RawElementConfig er t s
  -> m (DMap EventName (EventFilterTriggerRef t er))
wrap :: Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t s
-> m (DMap EventName (EventFilterTriggerRef t er))
wrap Chan [DSum (EventTriggerRef t) TriggerInvocation]
events Element
e RawElementConfig er t s
cfg = do
  Maybe (Event t (Map AttributeName (Maybe Text)))
-> (Event t (Map AttributeName (Maybe Text)) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (RawElementConfig er t s
-> Maybe (Event t (Map AttributeName (Maybe Text)))
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
RawElementConfig er t s
-> Maybe (Event t (Map AttributeName (Maybe Text)))
_rawElementConfig_modifyAttributes RawElementConfig er t s
cfg) ((Event t (Map AttributeName (Maybe Text)) -> m ()) -> m ())
-> (Event t (Map AttributeName (Maybe Text)) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Event t (Map AttributeName (Maybe Text))
modifyAttrs -> Event t (JSM ()) -> m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> m ()) -> Event t (JSM ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Event t (Map AttributeName (Maybe Text))
-> (Map AttributeName (Maybe Text) -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (Map AttributeName (Maybe Text))
modifyAttrs ((Map AttributeName (Maybe Text) -> JSM ()) -> Event t (JSM ()))
-> (Map AttributeName (Maybe Text) -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ (AttributeName -> Maybe Text -> JSM ())
-> Map AttributeName (Maybe Text) -> JSM ()
forall i (t :: * -> *) (m :: * -> *) a b.
(FoldableWithIndex i t, Monad m) =>
(i -> a -> m b) -> t a -> m ()
imapM_ ((AttributeName -> Maybe Text -> JSM ())
 -> Map AttributeName (Maybe Text) -> JSM ())
-> (AttributeName -> Maybe Text -> JSM ())
-> Map AttributeName (Maybe Text)
-> JSM ()
forall a b. (a -> b) -> a -> b
$ \(AttributeName Maybe Text
mAttrNamespace Text
n) Maybe Text
mv -> case Maybe Text
mAttrNamespace of
    Maybe Text
Nothing -> JSM () -> (Text -> JSM ()) -> Maybe Text -> JSM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Element -> Text -> JSM ()
forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsElement self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
removeAttribute Element
e Text
n) (Element -> Text -> Text -> JSM ()
forall (m :: * -> *) self qualifiedName value.
(MonadDOM m, IsElement self, ToJSString qualifiedName,
 ToJSString value) =>
self -> qualifiedName -> value -> m ()
setAttribute Element
e Text
n) Maybe Text
mv
    Just Text
ns -> JSM () -> (Text -> JSM ()) -> Maybe Text -> JSM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Element -> Maybe Text -> Text -> JSM ()
forall (m :: * -> *) self namespaceURI localName.
(MonadDOM m, IsElement self, ToJSString namespaceURI,
 ToJSString localName) =>
self -> Maybe namespaceURI -> localName -> m ()
removeAttributeNS Element
e (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ns) Text
n) (Element -> Maybe Text -> Text -> Text -> JSM ()
forall (m :: * -> *) self namespaceURI qualifiedName value.
(MonadDOM m, IsElement self, ToJSString namespaceURI,
 ToJSString qualifiedName, ToJSString value) =>
self -> Maybe namespaceURI -> qualifiedName -> value -> m ()
setAttributeNS Element
e (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ns) Text
n) Maybe Text
mv
  DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs :: DMap EventName (EventFilterTriggerRef t er) <- JSM (DMap EventName (EventFilterTriggerRef t er))
-> m (DMap EventName (EventFilterTriggerRef t er))
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM (DMap EventName (EventFilterTriggerRef t er))
 -> m (DMap EventName (EventFilterTriggerRef t er)))
-> JSM (DMap EventName (EventFilterTriggerRef t er))
-> m (DMap EventName (EventFilterTriggerRef t er))
forall a b. (a -> b) -> a -> b
$ ([DSum EventName (EventFilterTriggerRef t er)]
 -> DMap EventName (EventFilterTriggerRef t er))
-> JSM [DSum EventName (EventFilterTriggerRef t er)]
-> JSM (DMap EventName (EventFilterTriggerRef t er))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [DSum EventName (EventFilterTriggerRef t er)]
-> DMap EventName (EventFilterTriggerRef t er)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
[DSum k2 f] -> DMap k2 f
DMap.fromList (JSM [DSum EventName (EventFilterTriggerRef t er)]
 -> JSM (DMap EventName (EventFilterTriggerRef t er)))
-> JSM [DSum EventName (EventFilterTriggerRef t er)]
-> JSM (DMap EventName (EventFilterTriggerRef t er))
forall a b. (a -> b) -> a -> b
$ [DSum EventName (GhcjsEventFilter er)]
-> (DSum EventName (GhcjsEventFilter er)
    -> JSM (DSum EventName (EventFilterTriggerRef t er)))
-> JSM [DSum EventName (EventFilterTriggerRef t er)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (DMap EventName (GhcjsEventFilter er)
-> [DSum EventName (GhcjsEventFilter er)]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList (DMap EventName (GhcjsEventFilter er)
 -> [DSum EventName (GhcjsEventFilter er)])
-> DMap EventName (GhcjsEventFilter er)
-> [DSum EventName (GhcjsEventFilter er)]
forall a b. (a -> b) -> a -> b
$ GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
forall (er :: EventTag -> *).
GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters (GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er))
-> GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
forall a b. (a -> b) -> a -> b
$ RawElementConfig er t s -> EventSpec s er
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
RawElementConfig er t s -> EventSpec s er
_rawElementConfig_eventSpec RawElementConfig er t s
cfg) ((DSum EventName (GhcjsEventFilter er)
  -> JSM (DSum EventName (EventFilterTriggerRef t er)))
 -> JSM [DSum EventName (EventFilterTriggerRef t er)])
-> (DSum EventName (GhcjsEventFilter er)
    -> JSM (DSum EventName (EventFilterTriggerRef t er)))
-> JSM [DSum EventName (EventFilterTriggerRef t er)]
forall a b. (a -> b) -> a -> b
$ \(EventName a
en :=> GhcjsEventFilter GhcjsDomEvent a -> JSM (EventFlags, JSM (Maybe (er a)))
f) -> do
    IORef (Maybe (EventTrigger t (er a)))
triggerRef <- IO (IORef (Maybe (EventTrigger t (er a))))
-> JSM (IORef (Maybe (EventTrigger t (er a))))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe (EventTrigger t (er a))))
 -> JSM (IORef (Maybe (EventTrigger t (er a)))))
-> IO (IORef (Maybe (EventTrigger t (er a))))
-> JSM (IORef (Maybe (EventTrigger t (er a))))
forall a b. (a -> b) -> a -> b
$ Maybe (EventTrigger t (er a))
-> IO (IORef (Maybe (EventTrigger t (er a))))
forall a. a -> IO (IORef a)
newIORef Maybe (EventTrigger t (er a))
forall a. Maybe a
Nothing
    JSM ()
_ <- EventName a
-> Element -> EventM Element (EventType a) () -> JSM (JSM ())
forall e (en :: EventTag).
IsElement e =>
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
elementOnEventName EventName a
en Element
e (EventM Element (EventType a) () -> JSM (JSM ()))
-> EventM Element (EventType a) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do --TODO: Something safer than this cast
      EventType a
evt <- EventM Any (EventType a) (EventType a)
forall t e. EventM t e e
DOM.event
      (EventFlags
flags, JSM (Maybe (er a))
k) <- JSM (EventFlags, JSM (Maybe (er a)))
-> ReaderT (EventType a) JSM (EventFlags, JSM (Maybe (er a)))
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM (EventFlags, JSM (Maybe (er a)))
 -> ReaderT (EventType a) JSM (EventFlags, JSM (Maybe (er a))))
-> JSM (EventFlags, JSM (Maybe (er a)))
-> ReaderT (EventType a) JSM (EventFlags, JSM (Maybe (er a)))
forall a b. (a -> b) -> a -> b
$ GhcjsDomEvent a -> JSM (EventFlags, JSM (Maybe (er a)))
f (GhcjsDomEvent a -> JSM (EventFlags, JSM (Maybe (er a))))
-> GhcjsDomEvent a -> JSM (EventFlags, JSM (Maybe (er a)))
forall a b. (a -> b) -> a -> b
$ EventType a -> GhcjsDomEvent a
forall (en :: EventTag). EventType en -> GhcjsDomEvent en
GhcjsDomEvent EventType a
evt
      Bool
-> EventM Element (EventType a) ()
-> EventM Element (EventType a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventFlags -> Bool
_eventFlags_preventDefault EventFlags
flags) (EventM Element (EventType a) ()
 -> EventM Element (EventType a) ())
-> EventM Element (EventType a) ()
-> EventM Element (EventType a) ()
forall a b. (a -> b) -> a -> b
$ EventName a
-> (IsEvent (EventType a) => EventM Element (EventType a) ())
-> EventM Element (EventType a) ()
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName a
en IsEvent (EventType a) => EventM Element (EventType a) ()
forall e t. IsEvent e => EventM t e ()
DOM.preventDefault
      case EventFlags -> Propagation
_eventFlags_propagation EventFlags
flags of
        Propagation
Propagation_Continue -> () -> EventM Element (EventType a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Propagation
Propagation_Stop -> EventName a
-> (IsEvent (EventType a) => EventM Element (EventType a) ())
-> EventM Element (EventType a) ()
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName a
en IsEvent (EventType a) => EventM Element (EventType a) ()
forall e t. IsEvent e => EventM t e ()
DOM.stopPropagation
        Propagation
Propagation_StopImmediate -> EventName a
-> (IsEvent (EventType a) => EventM Element (EventType a) ())
-> EventM Element (EventType a) ()
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName a
en IsEvent (EventType a) => EventM Element (EventType a) ()
forall e t. IsEvent e => EventM t e ()
DOM.stopImmediatePropagation
      Maybe (er a)
mv <- JSM (Maybe (er a)) -> ReaderT (EventType a) JSM (Maybe (er a))
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM (Maybe (er a))
k --TODO: Only do this when the event is subscribed
      IO () -> EventM Element (EventType a) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Element (EventType a) ())
-> IO () -> EventM Element (EventType a) ()
forall a b. (a -> b) -> a -> b
$ Maybe (er a) -> (er a -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (er a)
mv ((er a -> IO ()) -> IO ()) -> (er a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \er a
v -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> [DSum (EventTriggerRef t) TriggerInvocation] -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan [DSum (EventTriggerRef t) TriggerInvocation]
events [IORef (Maybe (EventTrigger t (er a))) -> EventTriggerRef t (er a)
forall t a. IORef (Maybe (EventTrigger t a)) -> EventTriggerRef t a
EventTriggerRef IORef (Maybe (EventTrigger t (er a)))
triggerRef EventTriggerRef t (er a)
-> TriggerInvocation (er a)
-> DSum (EventTriggerRef t) TriggerInvocation
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> er a -> IO () -> TriggerInvocation (er a)
forall a. a -> IO () -> TriggerInvocation a
TriggerInvocation er a
v (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())]
    DSum EventName (EventFilterTriggerRef t er)
-> JSM (DSum EventName (EventFilterTriggerRef t er))
forall (m :: * -> *) a. Monad m => a -> m a
return (DSum EventName (EventFilterTriggerRef t er)
 -> JSM (DSum EventName (EventFilterTriggerRef t er)))
-> DSum EventName (EventFilterTriggerRef t er)
-> JSM (DSum EventName (EventFilterTriggerRef t er))
forall a b. (a -> b) -> a -> b
$ EventName a
en EventName a
-> EventFilterTriggerRef t er a
-> DSum EventName (EventFilterTriggerRef t er)
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> IORef (Maybe (EventTrigger t (er a)))
-> EventFilterTriggerRef t er a
forall t (er :: EventTag -> *) (en :: EventTag).
IORef (Maybe (EventTrigger t (er en)))
-> EventFilterTriggerRef t er en
EventFilterTriggerRef IORef (Maybe (EventTrigger t (er a)))
triggerRef
  DMap EventName (EventFilterTriggerRef t er)
-> m (DMap EventName (EventFilterTriggerRef t er))
forall (m :: * -> *) a. Monad m => a -> m a
return DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs

{-# SPECIALIZE wrap
  :: Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
  -> DOM.Element
  -> RawElementConfig er DomTimeline HydrationDomSpace
  -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (DMap EventName (EventFilterTriggerRef DomTimeline er))
  #-}

{-# SPECIALIZE wrap
  :: Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
  -> DOM.Element
  -> RawElementConfig er DomTimeline GhcjsDomSpace
  -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (DMap EventName (EventFilterTriggerRef DomTimeline er))
  #-}

{-# INLINE triggerBody #-}
triggerBody
  :: forall s er t x. EventSpec s ~ GhcjsEventSpec
  => DOM.JSContextRef
  -> RawElementConfig er t s
  -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
  -> DMap EventName (EventFilterTriggerRef t er)
  -> DOM.Element
  -> WrapArg er EventName x
  -> EventTrigger t x
  -> IO (IO ())
triggerBody :: JSContextRef
-> RawElementConfig er t s
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName x
-> EventTrigger t x
-> IO (IO ())
triggerBody JSContextRef
ctx RawElementConfig er t s
cfg Chan [DSum (EventTriggerRef t) TriggerInvocation]
events DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs Element
e (WrapArg EventName a1
en) EventTrigger t x
t = case EventName a1
-> DMap EventName (EventFilterTriggerRef t er)
-> Maybe (EventFilterTriggerRef t er a1)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup EventName a1
en DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs of
  Just (EventFilterTriggerRef IORef (Maybe (EventTrigger t (er a1)))
r) -> do
    IORef (Maybe (EventTrigger t (er a1)))
-> Maybe (EventTrigger t (er a1)) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (EventTrigger t (er a1)))
r (Maybe (EventTrigger t (er a1)) -> IO ())
-> Maybe (EventTrigger t (er a1)) -> IO ()
forall a b. (a -> b) -> a -> b
$ EventTrigger t (er a1) -> Maybe (EventTrigger t (er a1))
forall a. a -> Maybe a
Just EventTrigger t x
EventTrigger t (er a1)
t
    IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ do
      IORef (Maybe (EventTrigger t (er a1)))
-> Maybe (EventTrigger t (er a1)) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (EventTrigger t (er a1)))
r Maybe (EventTrigger t (er a1))
forall a. Maybe a
Nothing
  Maybe (EventFilterTriggerRef t er a1)
Nothing -> (JSM () -> JSContextRef -> IO ()
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM () -> IO ()) -> IO (JSM ()) -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSM (JSM ()) -> JSContextRef -> IO (JSM ())
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (EventName a1
-> Element -> EventM Element (EventType a1) () -> JSM (JSM ())
forall e (en :: EventTag).
IsElement e =>
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
elementOnEventName EventName a1
en Element
e (EventM Element (EventType a1) () -> JSM (JSM ()))
-> EventM Element (EventType a1) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
    EventType a1
evt <- EventM Any (EventType a1) (EventType a1)
forall t e. EventM t e e
DOM.event
    Maybe (er a1)
mv <- JSM (Maybe (er a1)) -> ReaderT (EventType a1) JSM (Maybe (er a1))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (JSM (Maybe (er a1)) -> ReaderT (EventType a1) JSM (Maybe (er a1)))
-> JSM (Maybe (er a1))
-> ReaderT (EventType a1) JSM (Maybe (er a1))
forall a b. (a -> b) -> a -> b
$ GhcjsEventHandler er
-> (EventName a1, GhcjsDomEvent a1) -> JSM (Maybe (er a1))
forall (er :: EventTag -> *).
GhcjsEventHandler er
-> forall (en :: EventTag).
   (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
unGhcjsEventHandler GhcjsEventHandler er
handler (EventName a1
en, EventType a1 -> GhcjsDomEvent a1
forall (en :: EventTag). EventType en -> GhcjsDomEvent en
GhcjsDomEvent EventType a1
evt)
    case Maybe (er a1)
mv of
      Maybe (er a1)
Nothing -> () -> EventM Element (EventType a1) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just er a1
v -> IO () -> EventM Element (EventType a1) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Element (EventType a1) ())
-> IO () -> EventM Element (EventType a1) ()
forall a b. (a -> b) -> a -> b
$ do
        --TODO: I don't think this is quite right: if a new trigger is created between when this is enqueued and when it fires, this may not work quite right
        IORef (Maybe (EventTrigger t (er a1)))
ref <- Maybe (EventTrigger t (er a1))
-> IO (IORef (Maybe (EventTrigger t (er a1))))
forall a. a -> IO (IORef a)
newIORef (Maybe (EventTrigger t (er a1))
 -> IO (IORef (Maybe (EventTrigger t (er a1)))))
-> Maybe (EventTrigger t (er a1))
-> IO (IORef (Maybe (EventTrigger t (er a1))))
forall a b. (a -> b) -> a -> b
$ EventTrigger t (er a1) -> Maybe (EventTrigger t (er a1))
forall a. a -> Maybe a
Just EventTrigger t x
EventTrigger t (er a1)
t
        Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> [DSum (EventTriggerRef t) TriggerInvocation] -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan [DSum (EventTriggerRef t) TriggerInvocation]
events [IORef (Maybe (EventTrigger t (er a1))) -> EventTriggerRef t (er a1)
forall t a. IORef (Maybe (EventTrigger t a)) -> EventTriggerRef t a
EventTriggerRef IORef (Maybe (EventTrigger t (er a1)))
ref EventTriggerRef t (er a1)
-> TriggerInvocation (er a1)
-> DSum (EventTriggerRef t) TriggerInvocation
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> er a1 -> IO () -> TriggerInvocation (er a1)
forall a. a -> IO () -> TriggerInvocation a
TriggerInvocation er a1
v (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())])
  where
    -- Note: this needs to be done strictly and outside of the newFanEventWithTrigger, so that the newFanEventWithTrigger doesn't
    -- retain the entire cfg, which can cause a cyclic dependency that the GC won't be able to clean up
    handler :: GhcjsEventHandler er
    !handler :: GhcjsEventHandler er
handler = GhcjsEventSpec er -> GhcjsEventHandler er
forall (er :: EventTag -> *).
GhcjsEventSpec er -> GhcjsEventHandler er
_ghcjsEventSpec_handler (GhcjsEventSpec er -> GhcjsEventHandler er)
-> GhcjsEventSpec er -> GhcjsEventHandler er
forall a b. (a -> b) -> a -> b
$ RawElementConfig er t s -> EventSpec s er
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
RawElementConfig er t s -> EventSpec s er
_rawElementConfig_eventSpec RawElementConfig er t s
cfg

{-# SPECIALIZE triggerBody
  :: DOM.JSContextRef
  -> RawElementConfig er DomTimeline HydrationDomSpace
  -> Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
  -> DMap EventName (EventFilterTriggerRef DomTimeline er)
  -> DOM.Element
  -> WrapArg er EventName x
  -> EventTrigger DomTimeline x
  -> IO (IO ())
  #-}

{-# SPECIALIZE triggerBody
  :: DOM.JSContextRef
  -> RawElementConfig er DomTimeline GhcjsDomSpace
  -> Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
  -> DMap EventName (EventFilterTriggerRef DomTimeline er)
  -> DOM.Element
  -> WrapArg er EventName x
  -> EventTrigger DomTimeline x
  -> IO (IO ())
  #-}

newtype GhcjsDomHandler a b = GhcjsDomHandler { GhcjsDomHandler a b -> a -> JSM b
unGhcjsDomHandler :: a -> JSM b }

newtype GhcjsDomHandler1 a b = GhcjsDomHandler1 { GhcjsDomHandler1 a b -> forall (x :: EventTag). a x -> JSM (b x)
unGhcjsDomHandler1 :: forall (x :: EventTag). a x -> JSM (b x) }

newtype GhcjsDomEvent en = GhcjsDomEvent { GhcjsDomEvent en -> EventType en
unGhcjsDomEvent :: EventType en }

data GhcjsDomSpace

instance DomSpace GhcjsDomSpace where
  type EventSpec GhcjsDomSpace = GhcjsEventSpec
  type RawDocument GhcjsDomSpace = DOM.Document
  type RawTextNode GhcjsDomSpace = DOM.Text
  type RawCommentNode GhcjsDomSpace = DOM.Comment
  type RawElement GhcjsDomSpace = DOM.Element
  type RawInputElement GhcjsDomSpace = DOM.HTMLInputElement
  type RawTextAreaElement GhcjsDomSpace = DOM.HTMLTextAreaElement
  type RawSelectElement GhcjsDomSpace = DOM.HTMLSelectElement
  addEventSpecFlags :: proxy GhcjsDomSpace
-> EventName en
-> (Maybe (er en) -> EventFlags)
-> EventSpec GhcjsDomSpace er
-> EventSpec GhcjsDomSpace er
addEventSpecFlags proxy GhcjsDomSpace
_ EventName en
en Maybe (er en) -> EventFlags
f EventSpec GhcjsDomSpace er
es = EventSpec GhcjsDomSpace er
GhcjsEventSpec er
es
    { _ghcjsEventSpec_filters :: DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters =
        let f' :: Maybe (GhcjsEventFilter er en) -> Maybe (GhcjsEventFilter er en)
f' = GhcjsEventFilter er en -> Maybe (GhcjsEventFilter er en)
forall a. a -> Maybe a
Just (GhcjsEventFilter er en -> Maybe (GhcjsEventFilter er en))
-> (Maybe (GhcjsEventFilter er en) -> GhcjsEventFilter er en)
-> Maybe (GhcjsEventFilter er en)
-> Maybe (GhcjsEventFilter er en)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
forall (er :: EventTag -> *) (en :: EventTag).
(GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
GhcjsEventFilter ((GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
 -> GhcjsEventFilter er en)
-> (Maybe (GhcjsEventFilter er en)
    -> GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> Maybe (GhcjsEventFilter er en)
-> GhcjsEventFilter er en
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
              Maybe (GhcjsEventFilter er en)
Nothing -> \GhcjsDomEvent en
evt -> do
                Maybe (er en)
mEventResult <- GhcjsEventHandler er
-> (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
forall (er :: EventTag -> *).
GhcjsEventHandler er
-> forall (en :: EventTag).
   (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
unGhcjsEventHandler (GhcjsEventSpec er -> GhcjsEventHandler er
forall (er :: EventTag -> *).
GhcjsEventSpec er -> GhcjsEventHandler er
_ghcjsEventSpec_handler EventSpec GhcjsDomSpace er
GhcjsEventSpec er
es) (EventName en
en, GhcjsDomEvent en
evt)
                (EventFlags, JSM (Maybe (er en)))
-> JSM (EventFlags, JSM (Maybe (er en)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (er en) -> EventFlags
f Maybe (er en)
mEventResult, Maybe (er en) -> JSM (Maybe (er en))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (er en)
mEventResult)
              Just (GhcjsEventFilter GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter) -> \GhcjsDomEvent en
evt -> do
                (EventFlags
oldFlags, JSM (Maybe (er en))
oldContinuation) <- GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter GhcjsDomEvent en
evt
                Maybe (er en)
mEventResult <- JSM (Maybe (er en))
oldContinuation
                let newFlags :: EventFlags
newFlags = EventFlags
oldFlags EventFlags -> EventFlags -> EventFlags
forall a. Semigroup a => a -> a -> a
<> Maybe (er en) -> EventFlags
f Maybe (er en)
mEventResult
                (EventFlags, JSM (Maybe (er en)))
-> JSM (EventFlags, JSM (Maybe (er en)))
forall (m :: * -> *) a. Monad m => a -> m a
return (EventFlags
newFlags, Maybe (er en) -> JSM (Maybe (er en))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (er en)
mEventResult)
        in (Maybe (GhcjsEventFilter er en) -> Maybe (GhcjsEventFilter er en))
-> EventName en
-> DMap EventName (GhcjsEventFilter er)
-> DMap EventName (GhcjsEventFilter er)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
(Maybe (f v) -> Maybe (f v)) -> k2 v -> DMap k2 f -> DMap k2 f
DMap.alter Maybe (GhcjsEventFilter er en) -> Maybe (GhcjsEventFilter er en)
f' EventName en
en (DMap EventName (GhcjsEventFilter er)
 -> DMap EventName (GhcjsEventFilter er))
-> DMap EventName (GhcjsEventFilter er)
-> DMap EventName (GhcjsEventFilter er)
forall a b. (a -> b) -> a -> b
$ GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
forall (er :: EventTag -> *).
GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters EventSpec GhcjsDomSpace er
GhcjsEventSpec er
es
    }

newtype GhcjsEventFilter er en = GhcjsEventFilter (GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))

data Pair1 (f :: k -> *) (g :: k -> *) (a :: k) = Pair1 (f a) (g a)

data Maybe1 f a = Nothing1 | Just1 (f a)

data GhcjsEventSpec er = GhcjsEventSpec
  { GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters :: DMap EventName (GhcjsEventFilter er)
  , GhcjsEventSpec er -> GhcjsEventHandler er
_ghcjsEventSpec_handler :: GhcjsEventHandler er
  }

newtype GhcjsEventHandler er = GhcjsEventHandler { GhcjsEventHandler er
-> forall (en :: EventTag).
   (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
unGhcjsEventHandler :: forall en. (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)) }

#ifndef USE_TEMPLATE_HASKELL
ghcjsEventSpec_filters :: forall er . Lens' (GhcjsEventSpec er) (DMap EventName (GhcjsEventFilter er))
ghcjsEventSpec_filters f (GhcjsEventSpec a b) = (\a' -> GhcjsEventSpec a' b) <$> f a
{-# INLINE ghcjsEventSpec_filters #-}
ghcjsEventSpec_handler :: forall er en . Getter (GhcjsEventSpec er) ((EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
ghcjsEventSpec_handler f (GhcjsEventSpec _ (GhcjsEventHandler b)) = phantom (f b)
{-# INLINE ghcjsEventSpec_handler #-}
#endif

instance er ~ EventResult => Default (GhcjsEventSpec er) where
  def :: GhcjsEventSpec er
def = GhcjsEventSpec :: forall (er :: EventTag -> *).
DMap EventName (GhcjsEventFilter er)
-> GhcjsEventHandler er -> GhcjsEventSpec er
GhcjsEventSpec
    { _ghcjsEventSpec_filters :: DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters = DMap EventName (GhcjsEventFilter er)
forall a. Monoid a => a
mempty
    , _ghcjsEventSpec_handler :: GhcjsEventHandler er
_ghcjsEventSpec_handler = (forall (en :: EventTag).
 (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
-> GhcjsEventHandler er
forall (er :: EventTag -> *).
(forall (en :: EventTag).
 (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
-> GhcjsEventHandler er
GhcjsEventHandler ((forall (en :: EventTag).
  (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
 -> GhcjsEventHandler er)
-> (forall (en :: EventTag).
    (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
-> GhcjsEventHandler er
forall a b. (a -> b) -> a -> b
$ \(EventName en
en, GhcjsDomEvent EventType en
evt) -> do
        EventTarget
t :: DOM.EventTarget <- EventName en
-> (IsEvent (EventType en) => JSM EventTarget) -> JSM EventTarget
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName en
en ((IsEvent (EventType en) => JSM EventTarget) -> JSM EventTarget)
-> (IsEvent (EventType en) => JSM EventTarget) -> JSM EventTarget
forall a b. (a -> b) -> a -> b
$ EventType en -> JSM EventTarget
forall (m :: * -> *) self.
(MonadDOM m, IsEvent self) =>
self -> m EventTarget
Event.getTargetUnchecked EventType en
evt --TODO: Rework this; defaultDomEventHandler shouldn't need to take this as an argument
        let e :: Element
e = (JSVal -> Element) -> EventTarget -> Element
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> Element
DOM.Element EventTarget
t
        ReaderT (EventType en) JSM (Maybe (EventResult en))
-> EventType en -> DOM (Maybe (EventResult en))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Element
-> EventName en
-> ReaderT (EventType en) JSM (Maybe (EventResult en))
forall e (en :: EventTag).
IsElement e =>
e
-> EventName en -> EventM e (EventType en) (Maybe (EventResult en))
defaultDomEventHandler Element
e EventName en
en) EventType en
evt
    }

{-# INLINE makeElement #-}
makeElement :: MonadJSM m => Document -> Text -> ElementConfig er t s -> m DOM.Element
makeElement :: Document -> Text -> ElementConfig er t s -> m Element
makeElement Document
doc Text
elementTag ElementConfig er t s
cfg = do
  Element
e <- (JSVal -> Element) -> Element -> Element
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> Element
DOM.Element (Element -> Element) -> m Element -> m Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ElementConfig er t s
cfg ElementConfig er t s
-> Getting (Maybe Text) (ElementConfig er t s) (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) (ElementConfig er t s) (Maybe Text)
forall a. HasNamespace a => Lens' a (Maybe Text)
namespace of
    Maybe Text
Nothing -> Document -> Text -> m Element
forall (m :: * -> *) self localName.
(MonadDOM m, IsDocument self, ToJSString localName) =>
self -> localName -> m Element
createElement Document
doc Text
elementTag
    Just Text
ens -> Document -> Maybe Text -> Text -> m Element
forall (m :: * -> *) self namespaceURI qualifiedName.
(MonadDOM m, IsDocument self, ToJSString namespaceURI,
 ToJSString qualifiedName) =>
self -> Maybe namespaceURI -> qualifiedName -> m Element
createElementNS Document
doc (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ens) Text
elementTag
  Map AttributeName Text -> (AttributeName -> Text -> m ()) -> m ()
forall i (t :: * -> *) (m :: * -> *) a b.
(FoldableWithIndex i t, Monad m) =>
t a -> (i -> a -> m b) -> m ()
iforM_ (ElementConfig er t s
cfg ElementConfig er t s
-> Getting
     (Map AttributeName Text)
     (ElementConfig er t s)
     (Map AttributeName Text)
-> Map AttributeName Text
forall s a. s -> Getting a s a -> a
^. Getting
  (Map AttributeName Text)
  (ElementConfig er t s)
  (Map AttributeName Text)
forall a. InitialAttributes a => Lens' a (Map AttributeName Text)
initialAttributes) ((AttributeName -> Text -> m ()) -> m ())
-> (AttributeName -> Text -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(AttributeName Maybe Text
mAttrNamespace Text
n) Text
v -> case Maybe Text
mAttrNamespace of
    Maybe Text
Nothing -> Element -> Text -> Text -> m ()
forall (m :: * -> *) self qualifiedName value.
(MonadDOM m, IsElement self, ToJSString qualifiedName,
 ToJSString value) =>
self -> qualifiedName -> value -> m ()
setAttribute Element
e Text
n Text
v
    Just Text
ans -> Element -> Maybe Text -> Text -> Text -> m ()
forall (m :: * -> *) self namespaceURI qualifiedName value.
(MonadDOM m, IsElement self, ToJSString namespaceURI,
 ToJSString qualifiedName, ToJSString value) =>
self -> Maybe namespaceURI -> qualifiedName -> value -> m ()
setAttributeNS Element
e (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ans) Text
n Text
v
  Element -> m Element
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
e

{-# INLINE elementImmediate #-}
elementImmediate
  :: ( RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, EventSpec s ~ GhcjsEventSpec
     , MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m )
  => Text
  -> ElementConfig er t s
  -> HydrationDomBuilderT s t m a
  -> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate :: Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
elementTag ElementConfig er t s
cfg HydrationDomBuilderT s t m a
child = do
  Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  JSContextRef
ctx <- HydrationDomBuilderT s t m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
  Chan [DSum (EventTriggerRef t) TriggerInvocation]
events <- HydrationDomBuilderT
  s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT
  s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents
  Node
parent <- HydrationDomBuilderT s t m Node
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
  Element
e <- Document
-> Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m Element
forall k k (m :: * -> *) (er :: EventTag -> *) (t :: k) (s :: k).
MonadJSM m =>
Document -> Text -> ElementConfig er t s -> m Element
makeElement Document
doc Text
elementTag ElementConfig er t s
cfg
  Node -> Element -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
appendChild_ Node
parent Element
e
  -- Run the child builder with updated parent and previous sibling references
  a
result <- (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
forall k (m :: * -> *) t (s :: k) a.
Monad m =>
(HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
localEnv (\HydrationDomBuilderEnv t m
env -> HydrationDomBuilderEnv t m
env { _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
$ Element -> Node
forall o. IsNode o => o -> Node
toNode Element
e }) HydrationDomBuilderT s t m a
child
  let rawCfg :: RawElementConfig er t s
rawCfg = ElementConfig er t s -> RawElementConfig er t s
forall k1 k2 (er :: EventTag -> *) (t :: k1) (m :: k2).
ElementConfig er t m -> RawElementConfig er t m
extractRawElementConfig ElementConfig er t s
cfg
  DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs <- Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t s
-> HydrationDomBuilderT
     s t m (DMap EventName (EventFilterTriggerRef t er))
forall k (s :: k) (m :: * -> *) (er :: EventTag -> *) t.
(Reflex t, MonadJSM m, MonadReflexCreateTrigger t m,
 DomRenderHook t m, EventSpec s ~ GhcjsEventSpec) =>
Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t s
-> m (DMap EventName (EventFilterTriggerRef t er))
wrap Chan [DSum (EventTriggerRef t) TriggerInvocation]
events Element
e RawElementConfig er t s
rawCfg
  EventSelector t (WrapArg er EventName)
es <- (forall a.
 WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
     s t m (EventSelector t (WrapArg er EventName))
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger ((forall a.
  WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
 -> HydrationDomBuilderT
      s t m (EventSelector t (WrapArg er EventName)))
-> (forall a.
    WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
     s t m (EventSelector t (WrapArg er EventName))
forall a b. (a -> b) -> a -> b
$ JSContextRef
-> RawElementConfig er t s
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName a
-> EventTrigger t a
-> IO (IO ())
forall k (s :: k) (er :: EventTag -> *) t x.
(EventSpec s ~ GhcjsEventSpec) =>
JSContextRef
-> RawElementConfig er t s
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName x
-> EventTrigger t x
-> IO (IO ())
triggerBody JSContextRef
ctx RawElementConfig er t s
rawCfg Chan [DSum (EventTriggerRef t) TriggerInvocation]
events DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs Element
e
  (Element er GhcjsDomSpace t, a)
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventSelector t (WrapArg er EventName)
-> RawElement GhcjsDomSpace -> Element er GhcjsDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element EventSelector t (WrapArg er EventName)
es Element
RawElement GhcjsDomSpace
e, a
result)

{-# SPECIALIZE elementImmediate
  :: Text
  -> ElementConfig er DomTimeline HydrationDomSpace
  -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM a
  -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (Element er GhcjsDomSpace DomTimeline, a)
  #-}

{-# SPECIALIZE elementImmediate
  :: Text
  -> ElementConfig er DomTimeline GhcjsDomSpace
  -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM a
  -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (Element er GhcjsDomSpace DomTimeline, a)
  #-}

-- For specialisation

-- | 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)

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

{-# INLINE elementInternal #-}
elementInternal
  :: (MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m)
  => Text
  -> ElementConfig er t HydrationDomSpace
  -> HydrationDomBuilderT HydrationDomSpace t m a
  -> HydrationDomBuilderT HydrationDomSpace t m (Element er HydrationDomSpace t, a)
elementInternal :: Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace t m (Element er HydrationDomSpace t, a)
elementInternal Text
elementTag ElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child = HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode
    -> HydrationDomBuilderT
         HydrationDomSpace t m (Element er HydrationDomSpace t, a))
-> HydrationDomBuilderT
     HydrationDomSpace t m (Element er HydrationDomSpace t, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  HydrationMode
HydrationMode_Immediate -> do
    (Element EventSelector t (WrapArg er EventName)
es RawElement GhcjsDomSpace
_, a
result) <- Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace t m (Element er GhcjsDomSpace t, a)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
 MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
elementTag ElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child
    (Element er HydrationDomSpace t, a)
-> HydrationDomBuilderT
     HydrationDomSpace t m (Element er HydrationDomSpace t, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventSelector t (WrapArg er EventName)
-> RawElement HydrationDomSpace -> Element er HydrationDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element EventSelector t (WrapArg er EventName)
es (), a
result)
  HydrationMode
HydrationMode_Hydrating -> ((Element er HydrationDomSpace t, a), IORef Element)
-> (Element er HydrationDomSpace t, a)
forall a b. (a, b) -> a
fst (((Element er HydrationDomSpace t, a), IORef Element)
 -> (Element er HydrationDomSpace t, a))
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     ((Element er HydrationDomSpace t, a), IORef Element)
-> HydrationDomBuilderT
     HydrationDomSpace t m (Element er HydrationDomSpace t, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     ((Element er HydrationDomSpace t, a), IORef Element)
forall (er :: EventTag -> *) t (m :: * -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     ((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
elementTag ElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child

{-# SPECIALIZE elementInternal
  :: Text
  -> ElementConfig er DomTimeline HydrationDomSpace
  -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM a
  -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (Element er HydrationDomSpace DomTimeline, a)
  #-}

-- | An attribute which causes hydration to skip over an element completely.
skipHydrationAttribute :: IsString s => s
skipHydrationAttribute :: s
skipHydrationAttribute = s
"data-hydration-skip"

-- | An attribute which signals that an element should be hydrated.
hydratableAttribute :: IsString s => s
hydratableAttribute :: s
hydratableAttribute = s
"data-ssr"

{-# INLINE hydrateElement #-}
hydrateElement
  :: forall er t m a. (MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m)
  => Text
  -> ElementConfig er t HydrationDomSpace
  -> HydrationDomBuilderT HydrationDomSpace t m a
  -> HydrationDomBuilderT HydrationDomSpace t m ((Element er HydrationDomSpace t, a), IORef DOM.Element)
hydrateElement :: Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     ((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
elementTag ElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child = do
  JSContextRef
ctx <- HydrationDomBuilderT HydrationDomSpace t m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
  Chan [DSum (EventTriggerRef t) TriggerInvocation]
events <- HydrationDomBuilderT
  HydrationDomSpace
  t
  m
  (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT
  s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents
  -- Schedule everything for after postBuild, except for getting the result itself
  IORef Node
parentRef <- IO (IORef Node)
-> HydrationDomBuilderT HydrationDomSpace t m (IORef Node)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Node)
 -> HydrationDomBuilderT HydrationDomSpace t m (IORef Node))
-> IO (IORef Node)
-> HydrationDomBuilderT HydrationDomSpace t m (IORef Node)
forall a b. (a -> b) -> a -> b
$ Node -> IO (IORef Node)
forall a. a -> IO (IORef a)
newIORef (Node -> IO (IORef Node)) -> Node -> IO (IORef Node)
forall a b. (a -> b) -> a -> b
$ String -> Node
forall a. HasCallStack => String -> a
error String
"Parent not yet initialized"
  IORef Element
e' <- IO (IORef Element)
-> HydrationDomBuilderT HydrationDomSpace t m (IORef Element)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Element)
 -> HydrationDomBuilderT HydrationDomSpace t m (IORef Element))
-> IO (IORef Element)
-> HydrationDomBuilderT HydrationDomSpace t m (IORef Element)
forall a b. (a -> b) -> a -> b
$ Element -> IO (IORef Element)
forall a. a -> IO (IORef a)
newIORef (Element -> IO (IORef Element)) -> Element -> IO (IORef Element)
forall a b. (a -> b) -> a -> b
$ String -> Element
forall a. HasCallStack => String -> a
error String
"hydrateElement: Element not yet initialized"
  HydrationDomBuilderEnv t m
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
  IORef (HydrationRunnerT t m ())
childDelayedRef <- IO (IORef (HydrationRunnerT t m ()))
-> HydrationDomBuilderT
     HydrationDomSpace t m (IORef (HydrationRunnerT t m ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HydrationRunnerT t m ()))
 -> HydrationDomBuilderT
      HydrationDomSpace t m (IORef (HydrationRunnerT t m ())))
-> IO (IORef (HydrationRunnerT t m ()))
-> HydrationDomBuilderT
     HydrationDomSpace t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a. a -> IO (IORef a)
newIORef (HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ())))
-> HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  let env' :: HydrationDomBuilderEnv t m
env' = HydrationDomBuilderEnv t m
env
        { _hydrationDomBuilderEnv_parent :: Either Node (IORef Node)
_hydrationDomBuilderEnv_parent = IORef Node -> Either Node (IORef Node)
forall a b. b -> Either a b
Right IORef Node
parentRef
        , _hydrationDomBuilderEnv_delayed :: IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed = IORef (HydrationRunnerT t m ())
childDelayedRef
        }
  a
result <- ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT HydrationDomSpace t m a
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) a
 -> HydrationDomBuilderT HydrationDomSpace t m a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT HydrationDomSpace t m a
forall a b. (a -> b) -> a -> b
$ DomRenderHookT t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m a
 -> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> DomRenderHookT t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall a b. (a -> b) -> a -> b
$ ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (HydrationDomBuilderT HydrationDomSpace t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT HydrationDomBuilderT HydrationDomSpace t m a
child) HydrationDomBuilderEnv t m
env'
  MVar (Element, DMap EventName (EventFilterTriggerRef t er))
wrapResult <- IO (MVar (Element, DMap EventName (EventFilterTriggerRef t er)))
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (MVar (Element, DMap EventName (EventFilterTriggerRef t er)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar (Element, DMap EventName (EventFilterTriggerRef t er)))
forall a. IO (MVar a)
newEmptyMVar
  let -- Determine if we should skip an element. We currently skip elements for
      -- two reasons:
      -- 1) it was not produced by a static builder which supports hydration
      -- 2) it is explicitly marked to be skipped
      shouldSkip :: DOM.Element -> HydrationRunnerT t m Bool
      shouldSkip :: Element -> HydrationRunnerT t m Bool
shouldSkip Element
e = do
        Bool
skip <- Element -> JSString -> HydrationRunnerT t m Bool
forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsElement self, ToJSString qualifiedName) =>
self -> qualifiedName -> m Bool
hasAttribute Element
e (JSString
forall s. IsString s => s
skipHydrationAttribute :: DOM.JSString)
        Bool
hydratable <- Element -> JSString -> HydrationRunnerT t m Bool
forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsElement self, ToJSString qualifiedName) =>
self -> qualifiedName -> m Bool
hasAttribute Element
e (JSString
forall s. IsString s => s
hydratableAttribute :: DOM.JSString)
        Bool -> HydrationRunnerT t m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> HydrationRunnerT t m Bool)
-> Bool -> HydrationRunnerT t m Bool
forall a b. (a -> b) -> a -> b
$ Bool
skip Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
hydratable
  HydrationRunnerT t m ()
childDom <- IO (HydrationRunnerT t m ())
-> HydrationDomBuilderT
     HydrationDomSpace t m (HydrationRunnerT t m ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HydrationRunnerT t m ())
 -> HydrationDomBuilderT
      HydrationDomSpace t m (HydrationRunnerT t m ()))
-> IO (HydrationRunnerT t m ())
-> HydrationDomBuilderT
     HydrationDomSpace t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ IORef (HydrationRunnerT t m ()) -> IO (HydrationRunnerT t m ())
forall a. IORef a -> IO a
readIORef IORef (HydrationRunnerT t m ())
childDelayedRef
  let rawCfg :: RawElementConfig er t HydrationDomSpace
rawCfg = ElementConfig er t HydrationDomSpace
-> RawElementConfig er t HydrationDomSpace
forall k1 k2 (er :: EventTag -> *) (t :: k1) (m :: k2).
ElementConfig er t m -> RawElementConfig er t m
extractRawElementConfig ElementConfig er t HydrationDomSpace
cfg
  Document
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  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
    Node
parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
    Maybe Node
lastHydrationNode <- HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) t.
Monad m =>
HydrationRunnerT t m (Maybe Node)
getPreviousNode
    let go :: Maybe Node -> HydrationRunnerT t m Element
go Maybe Node
mLastNode = HydrationRunnerT t m (Maybe Node)
-> (Node -> HydrationRunnerT t m (Maybe Node))
-> Maybe Node
-> HydrationRunnerT t m (Maybe Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getFirstChild Node
parent) Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling Maybe Node
mLastNode HydrationRunnerT t m (Maybe Node)
-> (Maybe Node -> HydrationRunnerT t m Element)
-> HydrationRunnerT t m Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe Node
Nothing -> do -- ran out of nodes, create the element
            StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
 -> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
 -> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
s -> HydrationState
s { _hydrationState_failed :: Bool
_hydrationState_failed = Bool
True }
            Element
e <- Document
-> Text
-> ElementConfig er t HydrationDomSpace
-> HydrationRunnerT t m Element
forall k k (m :: * -> *) (er :: EventTag -> *) (t :: k) (s :: k).
MonadJSM m =>
Document -> Text -> ElementConfig er t s -> m Element
makeElement Document
doc Text
elementTag ElementConfig er t HydrationDomSpace
cfg
            Element -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Element
e
            Element -> HydrationRunnerT t m Element
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
e
          Just Node
node -> (JSVal -> Element) -> Node -> HydrationRunnerT t m (Maybe Element)
forall obj obj' (m :: * -> *).
(Coercible obj JSVal, IsGObject obj', MonadJSM m) =>
(JSVal -> obj') -> obj -> m (Maybe obj')
DOM.castTo JSVal -> Element
DOM.Element Node
node HydrationRunnerT t m (Maybe Element)
-> (Maybe Element -> HydrationRunnerT t m Element)
-> HydrationRunnerT t m Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe Element
Nothing -> Maybe Node -> HydrationRunnerT t m Element
go (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node) -- this node is not an element, skip
            Just Element
e -> Element -> HydrationRunnerT t m Bool
shouldSkip Element
e HydrationRunnerT t m Bool
-> (Bool -> HydrationRunnerT t m Element)
-> HydrationRunnerT t m Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Bool
True -> Maybe Node -> HydrationRunnerT t m Element
go (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node) -- this element should be skipped by hydration
              Bool
False -> do
                Text
t <- Element -> HydrationRunnerT t m Text
forall (m :: * -> *) self result.
(MonadDOM m, IsElement self, FromJSString result) =>
self -> m result
Element.getTagName Element
e
                -- TODO: check attributes?
                if Text -> Text
T.toCaseFold Text
elementTag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toCaseFold Text
t
                  then Element -> HydrationRunnerT t m Element
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
e
                  -- we came to some other statically rendered element, so something has gone wrong
                  else do
                    StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
 -> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
 -> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
s -> HydrationState
s { _hydrationState_failed :: Bool
_hydrationState_failed = Bool
True }
                    Element
n <- Document
-> Text
-> ElementConfig er t HydrationDomSpace
-> HydrationRunnerT t m Element
forall k k (m :: * -> *) (er :: EventTag -> *) (t :: k) (s :: k).
MonadJSM m =>
Document -> Text -> ElementConfig er t s -> m Element
makeElement Document
doc Text
elementTag ElementConfig er t HydrationDomSpace
cfg
                    Element -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Element
n
                    Element -> HydrationRunnerT t m Element
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
n
    Element
e <- Maybe Node -> HydrationRunnerT t m Element
go Maybe Node
lastHydrationNode
    Maybe Node -> HydrationRunnerT t m ()
forall (m :: * -> *) t.
Monad m =>
Maybe Node -> HydrationRunnerT t m ()
setPreviousNode (Maybe Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Element -> Node
forall o. IsNode o => o -> Node
toNode Element
e
    -- Update the parent node used by the children
    IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IORef Node -> Node -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Node
parentRef (Node -> IO ()) -> Node -> IO ()
forall a b. (a -> b) -> a -> b
$ Element -> Node
forall o. IsNode o => o -> Node
toNode Element
e
    IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IORef Element -> Element -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Element
e' Element
e
    -- Setup events, store the result so we can wait on it later
    DMap EventName (EventFilterTriggerRef t er)
refs <- Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t HydrationDomSpace
-> HydrationRunnerT
     t m (DMap EventName (EventFilterTriggerRef t er))
forall k (s :: k) (m :: * -> *) (er :: EventTag -> *) t.
(Reflex t, MonadJSM m, MonadReflexCreateTrigger t m,
 DomRenderHook t m, EventSpec s ~ GhcjsEventSpec) =>
Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t s
-> m (DMap EventName (EventFilterTriggerRef t er))
wrap Chan [DSum (EventTriggerRef t) TriggerInvocation]
events Element
e RawElementConfig er t HydrationDomSpace
rawCfg
    IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ MVar (Element, DMap EventName (EventFilterTriggerRef t er))
-> (Element, DMap EventName (EventFilterTriggerRef t er)) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Element, DMap EventName (EventFilterTriggerRef t er))
wrapResult (Element
e, DMap EventName (EventFilterTriggerRef t er)
refs)
    HydrationRunnerT t m ()
-> Maybe Node -> Node -> HydrationRunnerT t m ()
forall (m :: * -> *) t a.
(MonadJSM m, Monad m) =>
HydrationRunnerT t m a
-> Maybe Node -> Node -> HydrationRunnerT t m a
localRunner HydrationRunnerT t m ()
childDom Maybe Node
forall a. Maybe a
Nothing (Node -> HydrationRunnerT t m ())
-> Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Element -> Node
forall o. IsNode o => o -> Node
toNode Element
e
  -- We need the EventSelector to switch to the real event handler after activation
  EventSelector t (WrapArg er EventName)
es <- (forall a.
 WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
     HydrationDomSpace t m (EventSelector t (WrapArg er EventName))
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger ((forall a.
  WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
 -> HydrationDomBuilderT
      HydrationDomSpace t m (EventSelector t (WrapArg er EventName)))
-> (forall a.
    WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
     HydrationDomSpace t m (EventSelector t (WrapArg er EventName))
forall a b. (a -> b) -> a -> b
$ \(WrapArg en) EventTrigger t a
t -> do
    MVar (IO ())
cleanup <- IO (MVar (IO ()))
forall a. IO (MVar a)
newEmptyMVar
    ThreadId
threadId <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
      -- Wait on the data we need from the delayed action
      (Element
e, DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs) <- MVar (Element, DMap EventName (EventFilterTriggerRef t er))
-> IO (Element, DMap EventName (EventFilterTriggerRef t er))
forall a. MVar a -> IO a
readMVar MVar (Element, DMap EventName (EventFilterTriggerRef t er))
wrapResult
      IO (IO ()) -> (IO () -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
        -- Run the setup, acquiring the cleanup action
        (JSContextRef
-> RawElementConfig er t HydrationDomSpace
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName (er a1)
-> EventTrigger t (er a1)
-> IO (IO ())
forall k (s :: k) (er :: EventTag -> *) t x.
(EventSpec s ~ GhcjsEventSpec) =>
JSContextRef
-> RawElementConfig er t s
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName x
-> EventTrigger t x
-> IO (IO ())
triggerBody JSContextRef
ctx RawElementConfig er t HydrationDomSpace
rawCfg Chan [DSum (EventTriggerRef t) TriggerInvocation]
events DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs Element
e (EventName a1 -> WrapArg er EventName (er a1)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName a1
en) EventTrigger t a
EventTrigger t (er a1)
t)
        -- Run the cleanup, if we have it - but only when an exception is
        -- raised (we might get killed between acquiring the cleanup action
        -- from 'triggerBody' and putting it in the MVar)
        IO () -> IO ()
forall a. a -> a
id
        -- Try to put this action into the cleanup MVar
        (MVar (IO ()) -> IO () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (IO ())
cleanup)
    IO () -> IO (IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO () -> IO (IO ())) -> IO () -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ do
      MVar (IO ()) -> IO (Maybe (IO ()))
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar (IO ())
cleanup IO (Maybe (IO ())) -> (Maybe (IO ()) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (IO ())
Nothing -> ThreadId -> IO ()
killThread ThreadId
threadId
        Just IO ()
c -> IO ()
c
  ((Element er HydrationDomSpace t, a), IORef Element)
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     ((Element er HydrationDomSpace t, a), IORef Element)
forall (m :: * -> *) a. Monad m => a -> m a
return ((EventSelector t (WrapArg er EventName)
-> RawElement HydrationDomSpace -> Element er HydrationDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element EventSelector t (WrapArg er EventName)
es (), a
result), IORef Element
e')

{-# SPECIALIZE hydrateElement
  :: Text
  -> ElementConfig er DomTimeline HydrationDomSpace
  -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM a
  -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM ((Element er HydrationDomSpace DomTimeline, a), IORef DOM.Element)
  #-}

{-# INLINE inputElementImmediate #-}
inputElementImmediate
  :: ( RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, EventSpec s ~ GhcjsEventSpec
     , MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
     , MonadRef m, Ref m ~ IORef )
  => InputElementConfig er t s -> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
inputElementImmediate :: InputElementConfig er t s
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
inputElementImmediate InputElementConfig er t s
cfg = do
  (e :: Element er GhcjsDomSpace t
e@(Element EventSelector t (WrapArg er EventName)
eventSelector RawElement GhcjsDomSpace
domElement), ()) <- Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ())
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
 MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
"input" (InputElementConfig er t s -> ElementConfig er t s
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> ElementConfig er t s
_inputElementConfig_elementConfig InputElementConfig er t s
cfg) (HydrationDomBuilderT s t m ()
 -> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ()))
-> HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ())
forall a b. (a -> b) -> a -> b
$ () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  let domInputElement :: HTMLInputElement
domInputElement = (JSVal -> HTMLInputElement) -> Element -> HTMLInputElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLInputElement
DOM.HTMLInputElement Element
RawElement GhcjsDomSpace
domElement
  HTMLInputElement -> Text -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLInputElement -> val -> m ()
Input.setValue HTMLInputElement
domInputElement (Text -> HydrationDomBuilderT s t m ())
-> Text -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ InputElementConfig er t s
cfg InputElementConfig er t s
-> Getting Text (InputElementConfig er t s) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (InputElementConfig er t s) Text
forall k1 k2 (er :: EventTag -> *) (t :: k1) (s :: k2).
Lens' (InputElementConfig er t s) Text
inputElementConfig_initialValue
  Text
v0 <- HTMLInputElement -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLInputElement -> m result
Input.getValue HTMLInputElement
domInputElement
  let getMyValue :: JSM Text
getMyValue = HTMLInputElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLInputElement -> m result
Input.getValue HTMLInputElement
domInputElement
  Event t Text
valueChangedByUI <- Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ JSM Text -> JSM Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getMyValue JSM Text -> Event t (er 'InputTag) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'InputTag) -> Event t (er 'InputTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select EventSelector t (WrapArg er EventName)
eventSelector (EventName 'InputTag -> WrapArg er EventName (er 'InputTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'InputTag
Input)
  Event t Text
valueChangedBySetValue <- case InputElementConfig er t s -> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Maybe (Event t Text)
_inputElementConfig_setValue InputElementConfig er t s
cfg of
    Maybe (Event t Text)
Nothing -> Event t Text -> HydrationDomBuilderT s t m (Event t Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Event t Text
forall k (t :: k) a. Reflex t => Event t a
never
    Just Event t Text
eSetValue -> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM Text) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM Text) -> Event t (JSM Text))
-> (Text -> JSM Text) -> Event t (JSM Text)
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
      HTMLInputElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLInputElement -> val -> m ()
Input.setValue HTMLInputElement
domInputElement Text
v'
      JSM Text
getMyValue -- We get the value after setting it in case the browser has mucked with it somehow
  Dynamic t Text
v <- Text -> Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
v0 (Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text))
-> Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ [Event t Text] -> Event t Text
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
    [ Event t Text
valueChangedBySetValue
    , Event t Text
valueChangedByUI
    ]
  HTMLInputElement -> Bool -> HydrationDomBuilderT s t m ()
forall (m :: * -> *).
MonadDOM m =>
HTMLInputElement -> Bool -> m ()
Input.setChecked HTMLInputElement
domInputElement (Bool -> HydrationDomBuilderT s t m ())
-> Bool -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ InputElementConfig er t s -> Bool
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Bool
_inputElementConfig_initialChecked InputElementConfig er t s
cfg
  Event t Bool
checkedChangedByUI <- HTMLInputElement
-> (HTMLInputElement
    -> EventM HTMLInputElement MouseEvent () -> JSM (JSM ()))
-> EventM HTMLInputElement MouseEvent Bool
-> HydrationDomBuilderT s t m (Event t Bool)
forall t (m :: * -> *) e event a.
(TriggerEvent t m, MonadJSM m) =>
e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event a
-> m (Event t a)
wrapDomEvent HTMLInputElement
domInputElement (HTMLInputElement
-> EventName HTMLInputElement MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName HTMLInputElement MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.click) (EventM HTMLInputElement MouseEvent Bool
 -> HydrationDomBuilderT s t m (Event t Bool))
-> EventM HTMLInputElement MouseEvent Bool
-> HydrationDomBuilderT s t m (Event t Bool)
forall a b. (a -> b) -> a -> b
$ do
    HTMLInputElement -> EventM HTMLInputElement MouseEvent Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement
  Event t (Maybe Bool)
checkedChangedBySetChecked <- case InputElementConfig er t s -> Maybe (Event t Bool)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Maybe (Event t Bool)
_inputElementConfig_setChecked InputElementConfig er t s
cfg of
    Maybe (Event t Bool)
Nothing -> Event t (Maybe Bool)
-> HydrationDomBuilderT s t m (Event t (Maybe Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return Event t (Maybe Bool)
forall k (t :: k) a. Reflex t => Event t a
never
    Just Event t Bool
eNewchecked -> Event t (JSM (Maybe Bool))
-> HydrationDomBuilderT s t m (Event t (Maybe Bool))
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM (Maybe Bool))
 -> HydrationDomBuilderT s t m (Event t (Maybe Bool)))
-> Event t (JSM (Maybe Bool))
-> HydrationDomBuilderT s t m (Event t (Maybe Bool))
forall a b. (a -> b) -> a -> b
$ Event t Bool
-> (Bool -> JSM (Maybe Bool)) -> Event t (JSM (Maybe Bool))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Bool
eNewchecked ((Bool -> JSM (Maybe Bool)) -> Event t (JSM (Maybe Bool)))
-> (Bool -> JSM (Maybe Bool)) -> Event t (JSM (Maybe Bool))
forall a b. (a -> b) -> a -> b
$ \Bool
newChecked -> do
      Bool
oldChecked <- HTMLInputElement -> JSM Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement
      HTMLInputElement -> Bool -> JSM ()
forall (m :: * -> *).
MonadDOM m =>
HTMLInputElement -> Bool -> m ()
Input.setChecked HTMLInputElement
domInputElement Bool
newChecked
      Maybe Bool -> JSM (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bool -> JSM (Maybe Bool)) -> Maybe Bool -> JSM (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ if Bool
newChecked Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
oldChecked
                  then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
newChecked
                  else Maybe Bool
forall a. Maybe a
Nothing
  Dynamic t Bool
c <- Bool -> Event t Bool -> HydrationDomBuilderT s t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (InputElementConfig er t s -> Bool
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Bool
_inputElementConfig_initialChecked InputElementConfig er t s
cfg) (Event t Bool -> HydrationDomBuilderT s t m (Dynamic t Bool))
-> Event t Bool -> HydrationDomBuilderT s t m (Dynamic t Bool)
forall a b. (a -> b) -> a -> b
$ [Event t Bool] -> Event t Bool
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
    [ (Maybe Bool -> Maybe Bool) -> Event t (Maybe Bool) -> Event t Bool
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe Maybe Bool -> Maybe Bool
forall a. a -> a
id Event t (Maybe Bool)
checkedChangedBySetChecked
    , Event t Bool
checkedChangedByUI
    ]
  Dynamic t Bool
hasFocus <- Element er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (Dynamic t Bool)
forall k k (m :: * -> *) (d :: k) (t :: k) (er :: EventTag -> *).
(HasDocument m, MonadJSM m, IsNode (RawElement d), MonadHold t m,
 Reflex t,
 IsDocumentOrShadowRoot (RawDocument (DomBuilderSpace m))) =>
Element er d t -> m (Dynamic t Bool)
mkHasFocus Element er GhcjsDomSpace t
e
  Dynamic t [File]
files <- [File]
-> Event t [File] -> HydrationDomBuilderT s t m (Dynamic t [File])
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn [File]
forall a. Monoid a => a
mempty (Event t [File] -> HydrationDomBuilderT s t m (Dynamic t [File]))
-> (EventM HTMLInputElement Event [File]
    -> HydrationDomBuilderT s t m (Event t [File]))
-> EventM HTMLInputElement Event [File]
-> HydrationDomBuilderT s t m (Dynamic t [File])
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< HTMLInputElement
-> (HTMLInputElement
    -> EventM HTMLInputElement Event () -> JSM (JSM ()))
-> EventM HTMLInputElement Event [File]
-> HydrationDomBuilderT s t m (Event t [File])
forall t (m :: * -> *) e event a.
(TriggerEvent t m, MonadJSM m) =>
e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event a
-> m (Event t a)
wrapDomEvent HTMLInputElement
domInputElement (HTMLInputElement
-> EventName HTMLInputElement Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName HTMLInputElement Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.change) (EventM HTMLInputElement Event [File]
 -> HydrationDomBuilderT s t m (Dynamic t [File]))
-> EventM HTMLInputElement Event [File]
-> HydrationDomBuilderT s t m (Dynamic t [File])
forall a b. (a -> b) -> a -> b
$ do
    Maybe FileList
mfiles <- HTMLInputElement -> ReaderT Event JSM (Maybe FileList)
forall (m :: * -> *).
MonadDOM m =>
HTMLInputElement -> m (Maybe FileList)
Input.getFiles HTMLInputElement
domInputElement
    let getMyFiles :: FileList -> m [File]
getMyFiles FileList
xs = ([Maybe File] -> [File]) -> m [Maybe File] -> m [File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe File] -> [File]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe File] -> m [File])
-> (Word -> m [Maybe File]) -> Word -> m [File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> m (Maybe File)) -> [Word] -> m [Maybe File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FileList -> Word -> m (Maybe File)
forall (m :: * -> *).
MonadDOM m =>
FileList -> Word -> m (Maybe File)
FileList.item FileList
xs) ([Word] -> m [Maybe File])
-> (Word -> [Word]) -> Word -> m [Maybe File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Word] -> [Word]) -> [Word] -> Int -> [Word]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [Word] -> [Word]
forall a. Int -> [a] -> [a]
take [Word
0..] (Int -> [Word]) -> (Word -> Int) -> Word -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> m [File]) -> m Word -> m [File]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FileList -> m Word
forall (m :: * -> *). MonadDOM m => FileList -> m Word
FileList.getLength FileList
xs
    EventM HTMLInputElement Event [File]
-> (FileList -> EventM HTMLInputElement Event [File])
-> Maybe FileList
-> EventM HTMLInputElement Event [File]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([File] -> EventM HTMLInputElement Event [File]
forall (m :: * -> *) a. Monad m => a -> m a
return []) FileList -> EventM HTMLInputElement Event [File]
forall (m :: * -> *). MonadJSM m => FileList -> m [File]
getMyFiles Maybe FileList
mfiles
  Dynamic t Bool
checked <- Dynamic t Bool -> HydrationDomBuilderT s t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn Dynamic t Bool
c
  InputElement er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
forall (m :: * -> *) a. Monad m => a -> m a
return (InputElement er GhcjsDomSpace t
 -> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t))
-> InputElement er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
forall a b. (a -> b) -> a -> b
$ InputElement :: forall k k (er :: EventTag -> *) (d :: k) (t :: k).
Dynamic t Text
-> Dynamic t Bool
-> Event t Bool
-> Event t Text
-> Dynamic t Bool
-> Element er d t
-> RawInputElement d
-> Dynamic t [File]
-> InputElement er d t
InputElement
    { _inputElement_value :: Dynamic t Text
_inputElement_value = Dynamic t Text
v
    , _inputElement_checked :: Dynamic t Bool
_inputElement_checked = Dynamic t Bool
checked
    , _inputElement_checkedChange :: Event t Bool
_inputElement_checkedChange =  Event t Bool
checkedChangedByUI
    , _inputElement_input :: Event t Text
_inputElement_input = Event t Text
valueChangedByUI
    , _inputElement_hasFocus :: Dynamic t Bool
_inputElement_hasFocus = Dynamic t Bool
hasFocus
    , _inputElement_element :: Element er GhcjsDomSpace t
_inputElement_element = Element er GhcjsDomSpace t
e
    , _inputElement_raw :: RawInputElement GhcjsDomSpace
_inputElement_raw = HTMLInputElement
RawInputElement GhcjsDomSpace
domInputElement
    , _inputElement_files :: Dynamic t [File]
_inputElement_files = Dynamic t [File]
files
    }

{-# INLINE inputElementInternal #-}
inputElementInternal
  :: ( MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
     , MonadRef m, Ref m ~ IORef )
  => InputElementConfig er t HydrationDomSpace -> HydrationDomBuilderT HydrationDomSpace t m (InputElement er HydrationDomSpace t)
inputElementInternal :: InputElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
     HydrationDomSpace t m (InputElement er HydrationDomSpace t)
inputElementInternal InputElementConfig er t HydrationDomSpace
cfg = HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode
    -> HydrationDomBuilderT
         HydrationDomSpace t m (InputElement er HydrationDomSpace t))
-> HydrationDomBuilderT
     HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT
  HydrationDomSpace t m (InputElement er GhcjsDomSpace t)
-> (InputElement er GhcjsDomSpace t
    -> InputElement er HydrationDomSpace t)
-> HydrationDomBuilderT
     HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (InputElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
     HydrationDomSpace t m (InputElement er GhcjsDomSpace t)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
 MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
 MonadRef m, Ref m ~ IORef) =>
InputElementConfig er t s
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
inputElementImmediate InputElementConfig er t HydrationDomSpace
cfg) ((InputElement er GhcjsDomSpace t
  -> InputElement er HydrationDomSpace t)
 -> HydrationDomBuilderT
      HydrationDomSpace t m (InputElement er HydrationDomSpace t))
-> (InputElement er GhcjsDomSpace t
    -> InputElement er HydrationDomSpace t)
-> HydrationDomBuilderT
     HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ \InputElement er GhcjsDomSpace t
result -> InputElement er GhcjsDomSpace t
result
    { _inputElement_element :: Element er HydrationDomSpace t
_inputElement_element = EventSelector t (WrapArg er EventName)
-> RawElement HydrationDomSpace -> Element er HydrationDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element (Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events (Element er GhcjsDomSpace t
 -> EventSelector t (WrapArg er EventName))
-> Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName)
forall a b. (a -> b) -> a -> b
$ InputElement er GhcjsDomSpace t -> Element er GhcjsDomSpace t
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
InputElement er d t -> Element er d t
_inputElement_element InputElement er GhcjsDomSpace t
result) ()
    , _inputElement_raw :: RawInputElement HydrationDomSpace
_inputElement_raw = ()
    }
  HydrationMode
HydrationMode_Hydrating -> do
  ((Element er HydrationDomSpace t
e, ()
_), IORef Element
domElementRef) <- Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     ((Element er HydrationDomSpace t, ()), IORef Element)
forall (er :: EventTag -> *) t (m :: * -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     ((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
"input" (InputElementConfig er t HydrationDomSpace
cfg InputElementConfig er t HydrationDomSpace
-> Getting
     (ElementConfig er t HydrationDomSpace)
     (InputElementConfig er t HydrationDomSpace)
     (ElementConfig er t HydrationDomSpace)
-> ElementConfig er t HydrationDomSpace
forall s a. s -> Getting a s a -> a
^. Getting
  (ElementConfig er t HydrationDomSpace)
  (InputElementConfig er t HydrationDomSpace)
  (ElementConfig er t HydrationDomSpace)
forall k1 k2 k3 (er :: EventTag -> *) (t :: k1) (s :: k2)
       (er2 :: EventTag -> *) (s2 :: k3).
Lens
  (InputElementConfig er t s)
  (InputElementConfig er2 t s2)
  (ElementConfig er t s)
  (ElementConfig er2 t s2)
inputElementConfig_elementConfig) (HydrationDomBuilderT HydrationDomSpace t m ()
 -> HydrationDomBuilderT
      HydrationDomSpace
      t
      m
      ((Element er HydrationDomSpace t, ()), IORef Element))
-> HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     ((Element er HydrationDomSpace t, ()), IORef Element)
forall a b. (a -> b) -> a -> b
$ () -> HydrationDomBuilderT HydrationDomSpace t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  (Event t Text
valueChangedByUI, Text -> IO ()
triggerChangeByUI) <- HydrationDomBuilderT
  HydrationDomSpace t m (Event t Text, Text -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  (Event t Text
valueChangedBySetValue, Text -> IO ()
triggerChangeBySetValue) <- HydrationDomBuilderT
  HydrationDomSpace t m (Event t Text, Text -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  (Event t Bool
focusChange, Bool -> IO ()
triggerFocusChange) <- HydrationDomBuilderT
  HydrationDomSpace t m (Event t Bool, Bool -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  (Event t Bool
checkedChangedByUI, Bool -> IO ()
triggerCheckedChangedByUI) <- HydrationDomBuilderT
  HydrationDomSpace t m (Event t Bool, Bool -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  (Event t Bool
checkedChangedBySetChecked, Bool -> IO ()
triggerCheckedChangedBySetChecked) <- HydrationDomBuilderT
  HydrationDomSpace t m (Event t Bool, Bool -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  (Event t [File]
fileChange, [File] -> IO ()
triggerFileChange) <- HydrationDomBuilderT
  HydrationDomSpace t m (Event t [File], [File] -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  Document
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  -- Expected initial value from config
  let v0 :: Text
v0 = InputElementConfig er t HydrationDomSpace -> Text
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Text
_inputElementConfig_initialValue InputElementConfig er t HydrationDomSpace
cfg
      c0 :: Bool
c0 = InputElementConfig er t HydrationDomSpace -> Bool
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Bool
_inputElementConfig_initialChecked InputElementConfig er t HydrationDomSpace
cfg
      valuesAtSwitchover :: m (Behavior t Text, Behavior t Bool)
valuesAtSwitchover = do
        Behavior t Text
v <- m (Behavior t Text)
-> (Event t Text -> m (Behavior t Text))
-> Maybe (Event t Text)
-> m (Behavior t Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Text -> m (Behavior t Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text -> m (Behavior t Text))
-> Behavior t Text -> m (Behavior t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Behavior t Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v0) (Text -> Event t Text -> m (Behavior t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Text
v0) (InputElementConfig er t HydrationDomSpace -> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Maybe (Event t Text)
_inputElementConfig_setValue InputElementConfig er t HydrationDomSpace
cfg)
        Behavior t Bool
c <- m (Behavior t Bool)
-> (Event t Bool -> m (Behavior t Bool))
-> Maybe (Event t Bool)
-> m (Behavior t Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Bool -> m (Behavior t Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Bool -> m (Behavior t Bool))
-> Behavior t Bool -> m (Behavior t Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Behavior t Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
c0) (Bool -> Event t Bool -> m (Behavior t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Bool
c0) (InputElementConfig er t HydrationDomSpace -> Maybe (Event t Bool)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Maybe (Event t Bool)
_inputElementConfig_setChecked InputElementConfig er t HydrationDomSpace
cfg)
        (Behavior t Text, Behavior t Bool)
-> m (Behavior t Text, Behavior t Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text
v, Behavior t Bool
c)
  m (Behavior t Text, Behavior t Bool)
-> ((Behavior t Text, Behavior t Bool) -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup m (Behavior t Text, Behavior t Bool)
valuesAtSwitchover (((Behavior t Text, Behavior t Bool) -> HydrationRunnerT t m ())
 -> HydrationDomBuilderT HydrationDomSpace t m ())
-> ((Behavior t Text, Behavior t Bool) -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ \(Behavior t Text
switchoverValue', Behavior t Bool
switchoverChecked') -> do
    Text
switchoverValue <- Behavior t Text -> HydrationRunnerT t m Text
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
switchoverValue'
    Bool
switchoverChecked <- Behavior t Bool -> HydrationRunnerT t m Bool
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Bool
switchoverChecked'
    Element
domElement <- IO Element -> HydrationRunnerT t m Element
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Element -> HydrationRunnerT t m Element)
-> IO Element -> HydrationRunnerT t m Element
forall a b. (a -> b) -> a -> b
$ IORef Element -> IO Element
forall a. IORef a -> IO a
readIORef IORef Element
domElementRef
    let domInputElement :: HTMLInputElement
domInputElement = (JSVal -> HTMLInputElement) -> Element -> HTMLInputElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLInputElement
DOM.HTMLInputElement Element
domElement
        getValue :: JSM Text
getValue = HTMLInputElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLInputElement -> m result
Input.getValue HTMLInputElement
domInputElement
    -- When the value has been updated by setValue before switchover, we must
    -- send an update here to remain in sync. This is because the later
    -- requestDomAction based on the setValue event will not capture events
    -- happening before postBuild, because this code runs after switchover.
    Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
v0 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
switchoverValue) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeBySetValue Text
switchoverValue
    -- The user could have altered the value before switchover. This must be
    -- triggered after the setValue one in order for the events to be in the
    -- correct order.
    JSM Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getValue HydrationRunnerT t m Text
-> (Text -> HydrationRunnerT t m ()) -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
realValue -> Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
realValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
switchoverValue) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeByUI Text
realValue
    -- Watch for user interaction and trigger event accordingly
    Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (JSM Text -> JSM Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getValue JSM Text -> (Text -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (Text -> IO ()) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
triggerChangeByUI) JSM () -> Event t (er 'InputTag) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'InputTag) -> Event t (er 'InputTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'InputTag -> WrapArg er EventName (er 'InputTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'InputTag
Input)
    Maybe (Event t Text)
-> (Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (InputElementConfig er t HydrationDomSpace -> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Maybe (Event t Text)
_inputElementConfig_setValue InputElementConfig er t HydrationDomSpace
cfg) ((Event t Text -> HydrationRunnerT t m ())
 -> HydrationRunnerT t m ())
-> (Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ \Event t Text
eSetValue ->
      Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM ()) -> Event t (JSM ()))
-> (Text -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
        HTMLInputElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLInputElement -> val -> m ()
Input.setValue HTMLInputElement
domInputElement Text
v'
        Text
v <- JSM Text
getValue -- We get the value after setting it in case the browser has mucked with it somehow
        IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeBySetValue Text
v
    let focusChange' :: Event t Bool
focusChange' = [Event t Bool] -> Event t Bool
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
          [ Bool
False Bool -> Event t (er 'BlurTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'BlurTag) -> Event t (er 'BlurTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'BlurTag -> WrapArg er EventName (er 'BlurTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'BlurTag
Blur)
          , Bool
True Bool -> Event t (er 'FocusTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'FocusTag) -> Event t (er 'FocusTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'FocusTag -> WrapArg er EventName (er 'FocusTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'FocusTag
Focus)
          ]
    IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> (Bool -> IO ()) -> Bool -> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerFocusChange (Bool -> HydrationRunnerT t m ())
-> HydrationRunnerT t m Bool -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Node -> Maybe Node -> HydrationRunnerT t m Bool
forall (m :: * -> *) self other.
(MonadDOM m, IsNode self, IsNode other) =>
self -> Maybe other -> m Bool
Node.isSameNode (Element -> Node
forall o. IsNode o => o -> Node
toNode Element
domElement) (Maybe Node -> HydrationRunnerT t m Bool)
-> (Maybe Element -> Maybe Node)
-> Maybe Element
-> HydrationRunnerT t m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Node) -> Maybe Element -> Maybe Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Node
forall o. IsNode o => o -> Node
toNode (Maybe Element -> HydrationRunnerT t m Bool)
-> HydrationRunnerT t m (Maybe Element)
-> HydrationRunnerT t m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Document -> HydrationRunnerT t m (Maybe Element)
forall (m :: * -> *) self.
(MonadDOM m, IsDocumentOrShadowRoot self) =>
self -> m (Maybe Element)
Document.getActiveElement Document
doc
    Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (Bool -> IO ()) -> Bool -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerFocusChange (Bool -> JSM ()) -> Event t Bool -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t Bool
focusChange'
    -- When the checked state has been updated by setChecked before
    -- switchover, we must send an update here to remain in sync. This is
    -- because the later requestDomAction based on the setChecked event will not
    -- capture events happening before postBuild, because this code runs after
    -- switchover.
    Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
c0 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
switchoverChecked) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO ()
triggerCheckedChangedBySetChecked Bool
switchoverChecked
    -- The user could have clicked the checkbox before switchover, we only
    -- detect cases where they flipped the state. This must be triggered after
    -- the setValue one in order for the events to be in the correct order.
    JSM Bool -> HydrationRunnerT t m Bool
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (HTMLInputElement -> JSM Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement) HydrationRunnerT t m Bool
-> (Bool -> HydrationRunnerT t m ()) -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
realChecked -> Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
realChecked Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
switchoverChecked) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$
      IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO ()
triggerCheckedChangedByUI Bool
realChecked
    JSM ()
_ <- JSM (JSM ()) -> HydrationRunnerT t m (JSM ())
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM (JSM ()) -> HydrationRunnerT t m (JSM ()))
-> JSM (JSM ()) -> HydrationRunnerT t m (JSM ())
forall a b. (a -> b) -> a -> b
$ HTMLInputElement
domInputElement HTMLInputElement
-> EventName HTMLInputElement MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName HTMLInputElement MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.click (EventM HTMLInputElement MouseEvent () -> JSM (JSM ()))
-> EventM HTMLInputElement MouseEvent () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
      IO () -> EventM HTMLInputElement MouseEvent ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM HTMLInputElement MouseEvent ())
-> (Bool -> IO ()) -> Bool -> EventM HTMLInputElement MouseEvent ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerCheckedChangedByUI (Bool -> EventM HTMLInputElement MouseEvent ())
-> EventM HTMLInputElement MouseEvent Bool
-> EventM HTMLInputElement MouseEvent ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HTMLInputElement -> EventM HTMLInputElement MouseEvent Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement
    Maybe (Event t Bool)
-> (Event t Bool -> HydrationRunnerT t m (Event t ()))
-> HydrationRunnerT t m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (InputElementConfig er t HydrationDomSpace -> Maybe (Event t Bool)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Maybe (Event t Bool)
_inputElementConfig_setChecked InputElementConfig er t HydrationDomSpace
cfg) ((Event t Bool -> HydrationRunnerT t m (Event t ()))
 -> HydrationRunnerT t m ())
-> (Event t Bool -> HydrationRunnerT t m (Event t ()))
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ \Event t Bool
eNewchecked ->
      Event t (JSM ()) -> HydrationRunnerT t m (Event t ())
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM ()) -> HydrationRunnerT t m (Event t ()))
-> Event t (JSM ()) -> HydrationRunnerT t m (Event t ())
forall a b. (a -> b) -> a -> b
$ Event t Bool -> (Bool -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Bool
eNewchecked ((Bool -> JSM ()) -> Event t (JSM ()))
-> (Bool -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \Bool
newChecked -> do
        Bool
oldChecked <- HTMLInputElement -> JSM Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement
        HTMLInputElement -> Bool -> JSM ()
forall (m :: * -> *).
MonadDOM m =>
HTMLInputElement -> Bool -> m ()
Input.setChecked HTMLInputElement
domInputElement Bool
newChecked
        Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
newChecked Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
oldChecked) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO ()
triggerCheckedChangedBySetChecked Bool
newChecked
    JSM ()
_ <- JSM (JSM ()) -> HydrationRunnerT t m (JSM ())
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM (JSM ()) -> HydrationRunnerT t m (JSM ()))
-> JSM (JSM ()) -> HydrationRunnerT t m (JSM ())
forall a b. (a -> b) -> a -> b
$ HTMLInputElement
domInputElement HTMLInputElement
-> EventName HTMLInputElement Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName HTMLInputElement Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.change (EventM HTMLInputElement Event () -> JSM (JSM ()))
-> EventM HTMLInputElement Event () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
      Maybe FileList
mfiles <- HTMLInputElement -> ReaderT Event JSM (Maybe FileList)
forall (m :: * -> *).
MonadDOM m =>
HTMLInputElement -> m (Maybe FileList)
Input.getFiles HTMLInputElement
domInputElement
      let getMyFiles :: FileList -> m [File]
getMyFiles FileList
xs = ([Maybe File] -> [File]) -> m [Maybe File] -> m [File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe File] -> [File]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe File] -> m [File])
-> (Word -> m [Maybe File]) -> Word -> m [File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> m (Maybe File)) -> [Word] -> m [Maybe File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FileList -> Word -> m (Maybe File)
forall (m :: * -> *).
MonadDOM m =>
FileList -> Word -> m (Maybe File)
FileList.item FileList
xs) ([Word] -> m [Maybe File])
-> (Word -> [Word]) -> Word -> m [Maybe File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Word] -> [Word]) -> [Word] -> Int -> [Word]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [Word] -> [Word]
forall a. Int -> [a] -> [a]
take [Word
0..] (Int -> [Word]) -> (Word -> Int) -> Word -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> m [File]) -> m Word -> m [File]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FileList -> m Word
forall (m :: * -> *). MonadDOM m => FileList -> m Word
FileList.getLength FileList
xs
      IO () -> EventM HTMLInputElement Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM HTMLInputElement Event ())
-> ([File] -> IO ()) -> [File] -> EventM HTMLInputElement Event ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [File] -> IO ()
triggerFileChange ([File] -> EventM HTMLInputElement Event ())
-> EventM HTMLInputElement Event [File]
-> EventM HTMLInputElement Event ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EventM HTMLInputElement Event [File]
-> (FileList -> EventM HTMLInputElement Event [File])
-> Maybe FileList
-> EventM HTMLInputElement Event [File]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([File] -> EventM HTMLInputElement Event [File]
forall (m :: * -> *) a. Monad m => a -> m a
return []) FileList -> EventM HTMLInputElement Event [File]
forall (m :: * -> *). MonadJSM m => FileList -> m [File]
getMyFiles Maybe FileList
mfiles
    () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Dynamic t Bool
checked' <- Bool
-> Event t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
c0 (Event t Bool
 -> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool))
-> Event t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall a b. (a -> b) -> a -> b
$ [Event t Bool] -> Event t Bool
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
    [ Event t Bool
checkedChangedBySetChecked
    , Event t Bool
checkedChangedByUI
    ]
  Dynamic t Bool
checked <- Dynamic t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn Dynamic t Bool
checked'
  let initialFocus :: Bool
initialFocus = Bool
False -- Assume it isn't focused, but we update the actual focus state at switchover
  Dynamic t Bool
hasFocus <- Dynamic t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn (Dynamic t Bool
 -> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool))
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool
-> Event t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
initialFocus Event t Bool
focusChange
  Dynamic t Text
v <- Text
-> Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
v0 (Event t Text
 -> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text))
-> Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ [Event t Text] -> Event t Text
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
    [ Event t Text
valueChangedBySetValue
    , Event t Text
valueChangedByUI
    ]
  Dynamic t [File]
files <- [File]
-> Event t [File]
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t [File])
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn [File]
forall a. Monoid a => a
mempty Event t [File]
fileChange
  InputElement er HydrationDomSpace t
-> HydrationDomBuilderT
     HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall (m :: * -> *) a. Monad m => a -> m a
return (InputElement er HydrationDomSpace t
 -> HydrationDomBuilderT
      HydrationDomSpace t m (InputElement er HydrationDomSpace t))
-> InputElement er HydrationDomSpace t
-> HydrationDomBuilderT
     HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ InputElement :: forall k k (er :: EventTag -> *) (d :: k) (t :: k).
Dynamic t Text
-> Dynamic t Bool
-> Event t Bool
-> Event t Text
-> Dynamic t Bool
-> Element er d t
-> RawInputElement d
-> Dynamic t [File]
-> InputElement er d t
InputElement
    { _inputElement_value :: Dynamic t Text
_inputElement_value = Dynamic t Text
v
    , _inputElement_checked :: Dynamic t Bool
_inputElement_checked = Dynamic t Bool
checked
    , _inputElement_checkedChange :: Event t Bool
_inputElement_checkedChange = Event t Bool
checkedChangedByUI
    , _inputElement_input :: Event t Text
_inputElement_input = Event t Text
valueChangedByUI
    , _inputElement_hasFocus :: Dynamic t Bool
_inputElement_hasFocus = Dynamic t Bool
hasFocus
    , _inputElement_element :: Element er HydrationDomSpace t
_inputElement_element = Element er HydrationDomSpace t
e
    , _inputElement_raw :: RawInputElement HydrationDomSpace
_inputElement_raw = ()
    , _inputElement_files :: Dynamic t [File]
_inputElement_files = Dynamic t [File]
files
    }

{-# INLINE textAreaElementImmediate #-}
textAreaElementImmediate
  :: ( RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, EventSpec s ~ GhcjsEventSpec
     , MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
     , MonadRef m, Ref m ~ IORef )
  => TextAreaElementConfig er t s -> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
textAreaElementImmediate :: TextAreaElementConfig er t s
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
textAreaElementImmediate TextAreaElementConfig er t s
cfg = do
  (e :: Element er GhcjsDomSpace t
e@(Element EventSelector t (WrapArg er EventName)
eventSelector RawElement GhcjsDomSpace
domElement), ()
_) <- Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ())
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
 MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
"textarea" (TextAreaElementConfig er t s
cfg TextAreaElementConfig er t s
-> Getting
     (ElementConfig er t s)
     (TextAreaElementConfig er t s)
     (ElementConfig er t s)
-> ElementConfig er t s
forall s a. s -> Getting a s a -> a
^. Getting
  (ElementConfig er t s)
  (TextAreaElementConfig er t s)
  (ElementConfig er t s)
forall k1 k2 k3 (er :: EventTag -> *) (t :: k1) (m :: k2)
       (er2 :: EventTag -> *) (m2 :: k3).
Lens
  (TextAreaElementConfig er t m)
  (TextAreaElementConfig er2 t m2)
  (ElementConfig er t m)
  (ElementConfig er2 t m2)
textAreaElementConfig_elementConfig) (HydrationDomBuilderT s t m ()
 -> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ()))
-> HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ())
forall a b. (a -> b) -> a -> b
$ () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  let domTextAreaElement :: HTMLTextAreaElement
domTextAreaElement = (JSVal -> HTMLTextAreaElement) -> Element -> HTMLTextAreaElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLTextAreaElement
DOM.HTMLTextAreaElement Element
RawElement GhcjsDomSpace
domElement
  HTMLTextAreaElement -> Text -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLTextAreaElement -> val -> m ()
TextArea.setValue HTMLTextAreaElement
domTextAreaElement (Text -> HydrationDomBuilderT s t m ())
-> Text -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ TextAreaElementConfig er t s
cfg TextAreaElementConfig er t s
-> Getting Text (TextAreaElementConfig er t s) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (TextAreaElementConfig er t s) Text
forall k1 k2 (er :: EventTag -> *) (t :: k1) (m :: k2).
Lens' (TextAreaElementConfig er t m) Text
textAreaElementConfig_initialValue
  Text
v0 <- HTMLTextAreaElement -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLTextAreaElement -> m result
TextArea.getValue HTMLTextAreaElement
domTextAreaElement
  let getMyValue :: JSM Text
getMyValue = HTMLTextAreaElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLTextAreaElement -> m result
TextArea.getValue HTMLTextAreaElement
domTextAreaElement
  Event t Text
valueChangedByUI <- Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ JSM Text -> JSM Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getMyValue JSM Text -> Event t (er 'InputTag) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'InputTag) -> Event t (er 'InputTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select EventSelector t (WrapArg er EventName)
eventSelector (EventName 'InputTag -> WrapArg er EventName (er 'InputTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'InputTag
Input)
  Event t Text
valueChangedBySetValue <- case TextAreaElementConfig er t s -> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
TextAreaElementConfig er t m -> Maybe (Event t Text)
_textAreaElementConfig_setValue TextAreaElementConfig er t s
cfg of
    Maybe (Event t Text)
Nothing -> Event t Text -> HydrationDomBuilderT s t m (Event t Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Event t Text
forall k (t :: k) a. Reflex t => Event t a
never
    Just Event t Text
eSetValue -> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM Text) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM Text) -> Event t (JSM Text))
-> (Text -> JSM Text) -> Event t (JSM Text)
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
      HTMLTextAreaElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLTextAreaElement -> val -> m ()
TextArea.setValue HTMLTextAreaElement
domTextAreaElement Text
v'
      JSM Text
getMyValue -- We get the value after setting it in case the browser has mucked with it somehow
  Dynamic t Text
v <- Text -> Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
v0 (Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text))
-> Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ [Event t Text] -> Event t Text
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
    [ Event t Text
valueChangedBySetValue
    , Event t Text
valueChangedByUI
    ]
  Dynamic t Bool
hasFocus <- Element er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (Dynamic t Bool)
forall k k (m :: * -> *) (d :: k) (t :: k) (er :: EventTag -> *).
(HasDocument m, MonadJSM m, IsNode (RawElement d), MonadHold t m,
 Reflex t,
 IsDocumentOrShadowRoot (RawDocument (DomBuilderSpace m))) =>
Element er d t -> m (Dynamic t Bool)
mkHasFocus Element er GhcjsDomSpace t
e
  TextAreaElement er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
forall (m :: * -> *) a. Monad m => a -> m a
return (TextAreaElement er GhcjsDomSpace t
 -> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t))
-> TextAreaElement er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
forall a b. (a -> b) -> a -> b
$ TextAreaElement :: forall k k (er :: EventTag -> *) (d :: k) (t :: k).
Dynamic t Text
-> Event t Text
-> Dynamic t Bool
-> Element er d t
-> RawTextAreaElement d
-> TextAreaElement er d t
TextAreaElement
    { _textAreaElement_value :: Dynamic t Text
_textAreaElement_value = Dynamic t Text
v
    , _textAreaElement_input :: Event t Text
_textAreaElement_input = Event t Text
valueChangedByUI
    , _textAreaElement_hasFocus :: Dynamic t Bool
_textAreaElement_hasFocus = Dynamic t Bool
hasFocus
    , _textAreaElement_element :: Element er GhcjsDomSpace t
_textAreaElement_element = Element er GhcjsDomSpace t
e
    , _textAreaElement_raw :: RawTextAreaElement GhcjsDomSpace
_textAreaElement_raw = HTMLTextAreaElement
RawTextAreaElement GhcjsDomSpace
domTextAreaElement
    }

{-# INLINE textAreaElementInternal #-}
textAreaElementInternal
  :: ( MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
     , MonadRef m, Ref m ~ IORef )
    => TextAreaElementConfig er t HydrationDomSpace -> HydrationDomBuilderT HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
textAreaElementInternal :: TextAreaElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
textAreaElementInternal TextAreaElementConfig er t HydrationDomSpace
cfg = HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode
    -> HydrationDomBuilderT
         HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t))
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT
  HydrationDomSpace t m (TextAreaElement er GhcjsDomSpace t)
-> (TextAreaElement er GhcjsDomSpace t
    -> TextAreaElement er HydrationDomSpace t)
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (TextAreaElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextAreaElement er GhcjsDomSpace t)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
 MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
 MonadRef m, Ref m ~ IORef) =>
TextAreaElementConfig er t s
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
textAreaElementImmediate TextAreaElementConfig er t HydrationDomSpace
cfg) ((TextAreaElement er GhcjsDomSpace t
  -> TextAreaElement er HydrationDomSpace t)
 -> HydrationDomBuilderT
      HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t))
-> (TextAreaElement er GhcjsDomSpace t
    -> TextAreaElement er HydrationDomSpace t)
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ \TextAreaElement er GhcjsDomSpace t
result -> TextAreaElement er GhcjsDomSpace t
result
    { _textAreaElement_element :: Element er HydrationDomSpace t
_textAreaElement_element = EventSelector t (WrapArg er EventName)
-> RawElement HydrationDomSpace -> Element er HydrationDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element (Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events (Element er GhcjsDomSpace t
 -> EventSelector t (WrapArg er EventName))
-> Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName)
forall a b. (a -> b) -> a -> b
$ TextAreaElement er GhcjsDomSpace t -> Element er GhcjsDomSpace t
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
TextAreaElement er d t -> Element er d t
_textAreaElement_element TextAreaElement er GhcjsDomSpace t
result) ()
    , _textAreaElement_raw :: RawTextAreaElement HydrationDomSpace
_textAreaElement_raw = ()
    }
  HydrationMode
HydrationMode_Hydrating -> do
  ((Element er HydrationDomSpace t
e, ()
_), IORef Element
domElementRef) <- Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     ((Element er HydrationDomSpace t, ()), IORef Element)
forall (er :: EventTag -> *) t (m :: * -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     ((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
"textarea" (TextAreaElementConfig er t HydrationDomSpace
cfg TextAreaElementConfig er t HydrationDomSpace
-> Getting
     (ElementConfig er t HydrationDomSpace)
     (TextAreaElementConfig er t HydrationDomSpace)
     (ElementConfig er t HydrationDomSpace)
-> ElementConfig er t HydrationDomSpace
forall s a. s -> Getting a s a -> a
^. Getting
  (ElementConfig er t HydrationDomSpace)
  (TextAreaElementConfig er t HydrationDomSpace)
  (ElementConfig er t HydrationDomSpace)
forall k1 k2 k3 (er :: EventTag -> *) (t :: k1) (m :: k2)
       (er2 :: EventTag -> *) (m2 :: k3).
Lens
  (TextAreaElementConfig er t m)
  (TextAreaElementConfig er2 t m2)
  (ElementConfig er t m)
  (ElementConfig er2 t m2)
textAreaElementConfig_elementConfig) (HydrationDomBuilderT HydrationDomSpace t m ()
 -> HydrationDomBuilderT
      HydrationDomSpace
      t
      m
      ((Element er HydrationDomSpace t, ()), IORef Element))
-> HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     ((Element er HydrationDomSpace t, ()), IORef Element)
forall a b. (a -> b) -> a -> b
$ () -> HydrationDomBuilderT HydrationDomSpace t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  (Event t Text
valueChangedByUI, Text -> IO ()
triggerChangeByUI) <- HydrationDomBuilderT
  HydrationDomSpace t m (Event t Text, Text -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  (Event t Text
valueChangedBySetValue, Text -> IO ()
triggerChangeBySetValue) <- HydrationDomBuilderT
  HydrationDomSpace t m (Event t Text, Text -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  (Event t Bool
focusChange, Bool -> IO ()
triggerFocusChange) <- HydrationDomBuilderT
  HydrationDomSpace t m (Event t Bool, Bool -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  Document
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  -- Expected initial value from config
  let v0 :: Text
v0 = TextAreaElementConfig er t HydrationDomSpace -> Text
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
TextAreaElementConfig er t m -> Text
_textAreaElementConfig_initialValue TextAreaElementConfig er t HydrationDomSpace
cfg
      valueAtSwitchover :: m (Behavior t Text)
valueAtSwitchover = m (Behavior t Text)
-> (Event t Text -> m (Behavior t Text))
-> Maybe (Event t Text)
-> m (Behavior t Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Text -> m (Behavior t Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text -> m (Behavior t Text))
-> Behavior t Text -> m (Behavior t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Behavior t Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v0) (Text -> Event t Text -> m (Behavior t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Text
v0) (TextAreaElementConfig er t HydrationDomSpace
-> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
TextAreaElementConfig er t m -> Maybe (Event t Text)
_textAreaElementConfig_setValue TextAreaElementConfig er t HydrationDomSpace
cfg)
  m (Behavior t Text)
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup m (Behavior t Text)
valueAtSwitchover ((Behavior t Text -> HydrationRunnerT t m ())
 -> HydrationDomBuilderT HydrationDomSpace t m ())
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ \Behavior t Text
switchoverValue' -> do
    Text
switchoverValue <- Behavior t Text -> HydrationRunnerT t m Text
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
switchoverValue'
    Element
domElement <- IO Element -> HydrationRunnerT t m Element
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Element -> HydrationRunnerT t m Element)
-> IO Element -> HydrationRunnerT t m Element
forall a b. (a -> b) -> a -> b
$ IORef Element -> IO Element
forall a. IORef a -> IO a
readIORef IORef Element
domElementRef
    let domTextAreaElement :: HTMLTextAreaElement
domTextAreaElement = (JSVal -> HTMLTextAreaElement) -> Element -> HTMLTextAreaElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLTextAreaElement
DOM.HTMLTextAreaElement Element
domElement
        getValue :: JSM Text
getValue = HTMLTextAreaElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLTextAreaElement -> m result
TextArea.getValue HTMLTextAreaElement
domTextAreaElement
    -- When the value has been updated by setValue before switchover, we must
    -- send an update here to remain in sync. This is because the later
    -- requestDomAction based on the setValue event will not capture events
    -- happening before postBuild, because this code runs after switchover.
    Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
v0 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
switchoverValue) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeBySetValue Text
switchoverValue
    -- The user could have altered the value before switchover. This must be
    -- triggered after the setValue one in order for the events to be in the
    -- correct order.
    JSM Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getValue HydrationRunnerT t m Text
-> (Text -> HydrationRunnerT t m ()) -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
realValue -> Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
realValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
switchoverValue) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeByUI Text
realValue
    -- Watch for user interaction and trigger event accordingly
    Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (JSM Text -> JSM Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getValue JSM Text -> (Text -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (Text -> IO ()) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
triggerChangeByUI) JSM () -> Event t (er 'InputTag) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'InputTag) -> Event t (er 'InputTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'InputTag -> WrapArg er EventName (er 'InputTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'InputTag
Input)
    Maybe (Event t Text)
-> (Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (TextAreaElementConfig er t HydrationDomSpace
-> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
TextAreaElementConfig er t m -> Maybe (Event t Text)
_textAreaElementConfig_setValue TextAreaElementConfig er t HydrationDomSpace
cfg) ((Event t Text -> HydrationRunnerT t m ())
 -> HydrationRunnerT t m ())
-> (Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ \Event t Text
eSetValue ->
      Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM ()) -> Event t (JSM ()))
-> (Text -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
        HTMLTextAreaElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLTextAreaElement -> val -> m ()
TextArea.setValue HTMLTextAreaElement
domTextAreaElement Text
v'
        Text
v <- JSM Text
getValue -- We get the value after setting it in case the browser has mucked with it somehow
        IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeBySetValue Text
v
    let focusChange' :: Event t Bool
focusChange' = [Event t Bool] -> Event t Bool
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
          [ Bool
False Bool -> Event t (er 'BlurTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'BlurTag) -> Event t (er 'BlurTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'BlurTag -> WrapArg er EventName (er 'BlurTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'BlurTag
Blur)
          , Bool
True Bool -> Event t (er 'FocusTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'FocusTag) -> Event t (er 'FocusTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'FocusTag -> WrapArg er EventName (er 'FocusTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'FocusTag
Focus)
          ]
    IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> (Bool -> IO ()) -> Bool -> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerFocusChange (Bool -> HydrationRunnerT t m ())
-> HydrationRunnerT t m Bool -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Node -> Maybe Node -> HydrationRunnerT t m Bool
forall (m :: * -> *) self other.
(MonadDOM m, IsNode self, IsNode other) =>
self -> Maybe other -> m Bool
Node.isSameNode (Element -> Node
forall o. IsNode o => o -> Node
toNode Element
domElement) (Maybe Node -> HydrationRunnerT t m Bool)
-> (Maybe Element -> Maybe Node)
-> Maybe Element
-> HydrationRunnerT t m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Node) -> Maybe Element -> Maybe Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Node
forall o. IsNode o => o -> Node
toNode (Maybe Element -> HydrationRunnerT t m Bool)
-> HydrationRunnerT t m (Maybe Element)
-> HydrationRunnerT t m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Document -> HydrationRunnerT t m (Maybe Element)
forall (m :: * -> *) self.
(MonadDOM m, IsDocumentOrShadowRoot self) =>
self -> m (Maybe Element)
Document.getActiveElement Document
doc
    Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (Bool -> IO ()) -> Bool -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerFocusChange (Bool -> JSM ()) -> Event t Bool -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t Bool
focusChange'
  let initialFocus :: Bool
initialFocus = Bool
False -- Assume it isn't focused, but we update the actual focus state at switchover
  Dynamic t Bool
hasFocus <- Dynamic t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn (Dynamic t Bool
 -> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool))
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool
-> Event t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
initialFocus Event t Bool
focusChange
  Dynamic t Text
v <- Text
-> Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
v0 (Event t Text
 -> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text))
-> Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ [Event t Text] -> Event t Text
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
    [ Event t Text
valueChangedBySetValue
    , Event t Text
valueChangedByUI
    ]
  TextAreaElement er HydrationDomSpace t
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall (m :: * -> *) a. Monad m => a -> m a
return (TextAreaElement er HydrationDomSpace t
 -> HydrationDomBuilderT
      HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t))
-> TextAreaElement er HydrationDomSpace t
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ TextAreaElement :: forall k k (er :: EventTag -> *) (d :: k) (t :: k).
Dynamic t Text
-> Event t Text
-> Dynamic t Bool
-> Element er d t
-> RawTextAreaElement d
-> TextAreaElement er d t
TextAreaElement
    { _textAreaElement_value :: Dynamic t Text
_textAreaElement_value = Dynamic t Text
v
    , _textAreaElement_input :: Event t Text
_textAreaElement_input = Event t Text
valueChangedByUI
    , _textAreaElement_hasFocus :: Dynamic t Bool
_textAreaElement_hasFocus = Dynamic t Bool
hasFocus
    , _textAreaElement_element :: Element er HydrationDomSpace t
_textAreaElement_element = Element er HydrationDomSpace t
e
    , _textAreaElement_raw :: RawTextAreaElement HydrationDomSpace
_textAreaElement_raw = ()
    }

{-# INLINE selectElementImmediate #-}
selectElementImmediate
  :: ( EventSpec s ~ GhcjsEventSpec, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document
     , MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m )
  => SelectElementConfig er t s
  -> HydrationDomBuilderT s t m a
  -> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
selectElementImmediate :: SelectElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
selectElementImmediate SelectElementConfig er t s
cfg HydrationDomBuilderT s t m a
child = do
  (e :: Element er GhcjsDomSpace t
e@(Element EventSelector t (WrapArg er EventName)
eventSelector RawElement GhcjsDomSpace
domElement), a
result) <- Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
 MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
"select" (SelectElementConfig er t s
cfg SelectElementConfig er t s
-> Getting
     (ElementConfig er t s)
     (SelectElementConfig er t s)
     (ElementConfig er t s)
-> ElementConfig er t s
forall s a. s -> Getting a s a -> a
^. Getting
  (ElementConfig er t s)
  (SelectElementConfig er t s)
  (ElementConfig er t s)
forall k1 k2 k3 (er :: EventTag -> *) (t :: k1) (m :: k2)
       (er2 :: EventTag -> *) (m2 :: k3).
Lens
  (SelectElementConfig er t m)
  (SelectElementConfig er2 t m2)
  (ElementConfig er t m)
  (ElementConfig er2 t m2)
selectElementConfig_elementConfig) HydrationDomBuilderT s t m a
child
  let domSelectElement :: HTMLSelectElement
domSelectElement = (JSVal -> HTMLSelectElement) -> Element -> HTMLSelectElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLSelectElement
DOM.HTMLSelectElement Element
RawElement GhcjsDomSpace
domElement
  HTMLSelectElement -> Text -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLSelectElement -> val -> m ()
Select.setValue HTMLSelectElement
domSelectElement (Text -> HydrationDomBuilderT s t m ())
-> Text -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ SelectElementConfig er t s
cfg SelectElementConfig er t s
-> Getting Text (SelectElementConfig er t s) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (SelectElementConfig er t s) Text
forall k1 k2 (er :: EventTag -> *) (t :: k1) (m :: k2).
Lens' (SelectElementConfig er t m) Text
selectElementConfig_initialValue
  Text
v0 <- HTMLSelectElement -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLSelectElement -> m result
Select.getValue HTMLSelectElement
domSelectElement
  let getMyValue :: JSM Text
getMyValue = HTMLSelectElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLSelectElement -> m result
Select.getValue HTMLSelectElement
domSelectElement
  Event t Text
valueChangedByUI <- Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ JSM Text -> JSM Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getMyValue JSM Text -> Event t (er 'ChangeTag) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'ChangeTag) -> Event t (er 'ChangeTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select EventSelector t (WrapArg er EventName)
eventSelector (EventName 'ChangeTag -> WrapArg er EventName (er 'ChangeTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'ChangeTag
Change)
  Event t Text
valueChangedBySetValue <- case SelectElementConfig er t s -> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
SelectElementConfig er t m -> Maybe (Event t Text)
_selectElementConfig_setValue SelectElementConfig er t s
cfg of
    Maybe (Event t Text)
Nothing -> Event t Text -> HydrationDomBuilderT s t m (Event t Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Event t Text
forall k (t :: k) a. Reflex t => Event t a
never
    Just Event t Text
eSetValue -> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM Text) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM Text) -> Event t (JSM Text))
-> (Text -> JSM Text) -> Event t (JSM Text)
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
      HTMLSelectElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLSelectElement -> val -> m ()
Select.setValue HTMLSelectElement
domSelectElement Text
v'
      JSM Text
getMyValue -- We get the value after setting it in case the browser has mucked with it somehow
  Dynamic t Text
v <- Text -> Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
v0 (Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text))
-> Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ [Event t Text] -> Event t Text
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
    [ Event t Text
valueChangedBySetValue
    , Event t Text
valueChangedByUI
    ]
  Dynamic t Bool
hasFocus <- Element er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (Dynamic t Bool)
forall k k (m :: * -> *) (d :: k) (t :: k) (er :: EventTag -> *).
(HasDocument m, MonadJSM m, IsNode (RawElement d), MonadHold t m,
 Reflex t,
 IsDocumentOrShadowRoot (RawDocument (DomBuilderSpace m))) =>
Element er d t -> m (Dynamic t Bool)
mkHasFocus Element er GhcjsDomSpace t
e
  let wrapped :: SelectElement er GhcjsDomSpace t
wrapped = SelectElement :: forall k k (er :: EventTag -> *) (d :: k) (t :: k).
Element er d t
-> Dynamic t Text
-> Event t Text
-> Dynamic t Bool
-> RawSelectElement d
-> SelectElement er d t
SelectElement
        { _selectElement_value :: Dynamic t Text
_selectElement_value = Dynamic t Text
v
        , _selectElement_change :: Event t Text
_selectElement_change = Event t Text
valueChangedByUI
        , _selectElement_hasFocus :: Dynamic t Bool
_selectElement_hasFocus = Dynamic t Bool
hasFocus
        , _selectElement_element :: Element er GhcjsDomSpace t
_selectElement_element = Element er GhcjsDomSpace t
e
        , _selectElement_raw :: RawSelectElement GhcjsDomSpace
_selectElement_raw = HTMLSelectElement
RawSelectElement GhcjsDomSpace
domSelectElement
        }
  (SelectElement er GhcjsDomSpace t, a)
-> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SelectElement er GhcjsDomSpace t
wrapped, a
result)

{-# INLINE selectElementInternal #-}
selectElementInternal
  :: ( MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
     , MonadRef m, Ref m ~ IORef )
    => SelectElementConfig er t HydrationDomSpace
    -> HydrationDomBuilderT HydrationDomSpace t m a
    -> HydrationDomBuilderT HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
selectElementInternal :: SelectElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
selectElementInternal SelectElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child = HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode
    -> HydrationDomBuilderT
         HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a))
-> HydrationDomBuilderT
     HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT
  HydrationDomSpace t m (SelectElement er GhcjsDomSpace t, a)
-> ((SelectElement er GhcjsDomSpace t, a)
    -> (SelectElement er HydrationDomSpace t, a))
-> HydrationDomBuilderT
     HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (SelectElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace t m (SelectElement er GhcjsDomSpace t, a)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(EventSpec s ~ GhcjsEventSpec,
 RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
 MonadHold t m) =>
SelectElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
selectElementImmediate SelectElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child) (((SelectElement er GhcjsDomSpace t, a)
  -> (SelectElement er HydrationDomSpace t, a))
 -> HydrationDomBuilderT
      HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a))
-> ((SelectElement er GhcjsDomSpace t, a)
    -> (SelectElement er HydrationDomSpace t, a))
-> HydrationDomBuilderT
     HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall a b. (a -> b) -> a -> b
$ \(SelectElement er GhcjsDomSpace t
e, a
result) -> (SelectElement er GhcjsDomSpace t
e
    { _selectElement_element :: Element er HydrationDomSpace t
_selectElement_element = EventSelector t (WrapArg er EventName)
-> RawElement HydrationDomSpace -> Element er HydrationDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element (Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events (Element er GhcjsDomSpace t
 -> EventSelector t (WrapArg er EventName))
-> Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName)
forall a b. (a -> b) -> a -> b
$ SelectElement er GhcjsDomSpace t -> Element er GhcjsDomSpace t
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
SelectElement er d t -> Element er d t
_selectElement_element SelectElement er GhcjsDomSpace t
e) ()
    , _selectElement_raw :: RawSelectElement HydrationDomSpace
_selectElement_raw = ()
    }, a
result)
  HydrationMode
HydrationMode_Hydrating -> do
  ((Element er HydrationDomSpace t
e, a
result), IORef Element
domElementRef) <- Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     ((Element er HydrationDomSpace t, a), IORef Element)
forall (er :: EventTag -> *) t (m :: * -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     ((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
"select" (SelectElementConfig er t HydrationDomSpace
cfg SelectElementConfig er t HydrationDomSpace
-> Getting
     (ElementConfig er t HydrationDomSpace)
     (SelectElementConfig er t HydrationDomSpace)
     (ElementConfig er t HydrationDomSpace)
-> ElementConfig er t HydrationDomSpace
forall s a. s -> Getting a s a -> a
^. Getting
  (ElementConfig er t HydrationDomSpace)
  (SelectElementConfig er t HydrationDomSpace)
  (ElementConfig er t HydrationDomSpace)
forall k1 k2 k3 (er :: EventTag -> *) (t :: k1) (m :: k2)
       (er2 :: EventTag -> *) (m2 :: k3).
Lens
  (SelectElementConfig er t m)
  (SelectElementConfig er2 t m2)
  (ElementConfig er t m)
  (ElementConfig er2 t m2)
selectElementConfig_elementConfig) HydrationDomBuilderT HydrationDomSpace t m a
child
  (Event t Text
valueChangedByUI, Text -> IO ()
triggerChangeByUI) <- HydrationDomBuilderT
  HydrationDomSpace t m (Event t Text, Text -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  (Event t Text
valueChangedBySetValue, Text -> IO ()
triggerChangeBySetValue) <- HydrationDomBuilderT
  HydrationDomSpace t m (Event t Text, Text -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  (Event t Bool
focusChange, Bool -> IO ()
triggerFocusChange) <- HydrationDomBuilderT
  HydrationDomSpace t m (Event t Bool, Bool -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  Document
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  -- Expected initial value from config
  let v0 :: Text
v0 = SelectElementConfig er t HydrationDomSpace -> Text
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
SelectElementConfig er t m -> Text
_selectElementConfig_initialValue SelectElementConfig er t HydrationDomSpace
cfg
  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
    Element
domElement <- IO Element -> HydrationRunnerT t m Element
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Element -> HydrationRunnerT t m Element)
-> IO Element -> HydrationRunnerT t m Element
forall a b. (a -> b) -> a -> b
$ IORef Element -> IO Element
forall a. IORef a -> IO a
readIORef IORef Element
domElementRef
    let domSelectElement :: HTMLSelectElement
domSelectElement = (JSVal -> HTMLSelectElement) -> Element -> HTMLSelectElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLSelectElement
DOM.HTMLSelectElement Element
domElement
        getValue :: JSM Text
getValue = HTMLSelectElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLSelectElement -> m result
Select.getValue HTMLSelectElement
domSelectElement
    -- The browser might have messed with the value, or the user could have
    -- altered it before activation, so we set it if it isn't what we expect
    JSM Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getValue HydrationRunnerT t m Text
-> (Text -> HydrationRunnerT t m ()) -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
v0' -> do
      Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
v0' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
v0) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeByUI Text
v0'
    -- Watch for user interaction and trigger event accordingly
    Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (JSM Text -> JSM Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getValue JSM Text -> (Text -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (Text -> IO ()) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
triggerChangeByUI) JSM () -> Event t (er 'ChangeTag) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'ChangeTag) -> Event t (er 'ChangeTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'ChangeTag -> WrapArg er EventName (er 'ChangeTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'ChangeTag
Change)
    Maybe (Event t Text)
-> (Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (SelectElementConfig er t HydrationDomSpace -> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
SelectElementConfig er t m -> Maybe (Event t Text)
_selectElementConfig_setValue SelectElementConfig er t HydrationDomSpace
cfg) ((Event t Text -> HydrationRunnerT t m ())
 -> HydrationRunnerT t m ())
-> (Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ \Event t Text
eSetValue ->
      Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM ()) -> Event t (JSM ()))
-> (Text -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
        HTMLSelectElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLSelectElement -> val -> m ()
Select.setValue HTMLSelectElement
domSelectElement Text
v'
        Text
v <- JSM Text
getValue -- We get the value after setting it in case the browser has mucked with it somehow
        IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeBySetValue Text
v
    let focusChange' :: Event t Bool
focusChange' = [Event t Bool] -> Event t Bool
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
          [ Bool
False Bool -> Event t (er 'BlurTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'BlurTag) -> Event t (er 'BlurTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'BlurTag -> WrapArg er EventName (er 'BlurTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'BlurTag
Blur)
          , Bool
True Bool -> Event t (er 'FocusTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'FocusTag) -> Event t (er 'FocusTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'FocusTag -> WrapArg er EventName (er 'FocusTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'FocusTag
Focus)
          ]
    IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> (Bool -> IO ()) -> Bool -> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerFocusChange (Bool -> HydrationRunnerT t m ())
-> HydrationRunnerT t m Bool -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Node -> Maybe Node -> HydrationRunnerT t m Bool
forall (m :: * -> *) self other.
(MonadDOM m, IsNode self, IsNode other) =>
self -> Maybe other -> m Bool
Node.isSameNode (Element -> Node
forall o. IsNode o => o -> Node
toNode Element
domElement) (Maybe Node -> HydrationRunnerT t m Bool)
-> (Maybe Element -> Maybe Node)
-> Maybe Element
-> HydrationRunnerT t m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Node) -> Maybe Element -> Maybe Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Node
forall o. IsNode o => o -> Node
toNode (Maybe Element -> HydrationRunnerT t m Bool)
-> HydrationRunnerT t m (Maybe Element)
-> HydrationRunnerT t m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Document -> HydrationRunnerT t m (Maybe Element)
forall (m :: * -> *) self.
(MonadDOM m, IsDocumentOrShadowRoot self) =>
self -> m (Maybe Element)
Document.getActiveElement Document
doc
    Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (Bool -> IO ()) -> Bool -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerFocusChange (Bool -> JSM ()) -> Event t Bool -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t Bool
focusChange'
  let initialFocus :: Bool
initialFocus = Bool
False -- Assume it isn't focused, but we update the actual focus state at switchover
  Dynamic t Bool
hasFocus <- Dynamic t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn (Dynamic t Bool
 -> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool))
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool
-> Event t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
initialFocus Event t Bool
focusChange
  Dynamic t Text
v <- Text
-> Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
v0 (Event t Text
 -> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text))
-> Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ [Event t Text] -> Event t Text
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
    [ Event t Text
valueChangedBySetValue
    , Event t Text
valueChangedByUI
    ]
  (SelectElement er HydrationDomSpace t, a)
-> HydrationDomBuilderT
     HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SelectElement er HydrationDomSpace t, a)
 -> HydrationDomBuilderT
      HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a))
-> (SelectElement er HydrationDomSpace t, a)
-> HydrationDomBuilderT
     HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall a b. (a -> b) -> a -> b
$ (,a
result) (SelectElement er HydrationDomSpace t
 -> (SelectElement er HydrationDomSpace t, a))
-> SelectElement er HydrationDomSpace t
-> (SelectElement er HydrationDomSpace t, a)
forall a b. (a -> b) -> a -> b
$ SelectElement :: forall k k (er :: EventTag -> *) (d :: k) (t :: k).
Element er d t
-> Dynamic t Text
-> Event t Text
-> Dynamic t Bool
-> RawSelectElement d
-> SelectElement er d t
SelectElement
    { _selectElement_value :: Dynamic t Text
_selectElement_value = Dynamic t Text
v
    , _selectElement_change :: Event t Text
_selectElement_change = Event t Text
valueChangedByUI
    , _selectElement_hasFocus :: Dynamic t Bool
_selectElement_hasFocus = Dynamic t Bool
hasFocus
    , _selectElement_element :: Element er HydrationDomSpace t
_selectElement_element = Element er HydrationDomSpace t
e
    , _selectElement_raw :: RawSelectElement HydrationDomSpace
_selectElement_raw = ()
    }

{-# INLINE textNodeImmediate #-}
textNodeImmediate
  :: (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, MonadJSM m, Reflex t, MonadFix m)
  => TextNodeConfig t -> HydrationDomBuilderT s t m DOM.Text
textNodeImmediate :: TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate (TextNodeConfig !Text
t Maybe (Event t Text)
mSetContents) = do
  Node
p <- HydrationDomBuilderT s t m Node
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
  Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  Text
n <- Document -> Text -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc Text
t
  Node -> Text -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
appendChild_ Node
p Text
n
  (Event t Text -> HydrationDomBuilderT s t m ())
-> Maybe (Event t Text) -> HydrationDomBuilderT s t m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ())
-> (Event t Text -> Event t (JSM ()))
-> Event t Text
-> HydrationDomBuilderT s t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> JSM ()) -> Event t Text -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Maybe Text -> JSM ()
forall (m :: * -> *) self val.
(MonadDOM m, IsNode self, ToJSString val) =>
self -> Maybe val -> m ()
setNodeValue Text
n (Maybe Text -> JSM ()) -> (Text -> Maybe Text) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just)) Maybe (Event t Text)
mSetContents
  Text -> HydrationDomBuilderT s t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
n

{-# SPECIALIZE textNodeImmediate
  :: TextNodeConfig DomTimeline
  -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM DOM.Text
  #-}

{-# SPECIALIZE textNodeImmediate
  :: TextNodeConfig DomTimeline
  -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM DOM.Text
  #-}

{-# INLINE textNodeInternal #-}
textNodeInternal
  :: (Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m, Reflex t)
  => TextNodeConfig t -> HydrationDomBuilderT HydrationDomSpace t m (TextNode HydrationDomSpace t)
textNodeInternal :: TextNodeConfig t
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextNode HydrationDomSpace t)
textNodeInternal tc :: TextNodeConfig t
tc@(TextNodeConfig !Text
t Maybe (Event t Text)
mSetContents) = do
  Document
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode -> HydrationDomBuilderT HydrationDomSpace t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT HydrationDomSpace t m Text
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (HydrationDomBuilderT HydrationDomSpace t m Text
 -> HydrationDomBuilderT HydrationDomSpace t m ())
-> HydrationDomBuilderT HydrationDomSpace t m Text
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ TextNodeConfig t -> HydrationDomBuilderT HydrationDomSpace t m Text
forall k (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate TextNodeConfig t
tc
    HydrationMode
HydrationMode_Hydrating -> m (Behavior t Text)
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (m (Behavior t Text)
-> (Event t Text -> m (Behavior t Text))
-> Maybe (Event t Text)
-> m (Behavior t Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Text -> m (Behavior t Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text -> m (Behavior t Text))
-> Behavior t Text -> m (Behavior t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Behavior t Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t) (Text -> Event t Text -> m (Behavior t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Text
t) Maybe (Event t Text)
mSetContents) ((Behavior t Text -> HydrationRunnerT t m ())
 -> HydrationDomBuilderT HydrationDomSpace t m ())
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ \Behavior t Text
currentText -> do
      Text
n <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) t.
MonadJSM m =>
Document -> Text -> HydrationRunnerT t m Text
hydrateTextNode Document
doc (Text -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Behavior t Text -> HydrationRunnerT t m Text
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
currentText
      (Event t Text -> HydrationRunnerT t m ())
-> Maybe (Event t Text) -> HydrationRunnerT t m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> (Event t Text -> Event t (JSM ()))
-> Event t Text
-> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> JSM ()) -> Event t Text -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Maybe Text -> JSM ()
forall (m :: * -> *) self val.
(MonadDOM m, IsNode self, ToJSString val) =>
self -> Maybe val -> m ()
setNodeValue Text
n (Maybe Text -> JSM ()) -> (Text -> Maybe Text) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just)) Maybe (Event t Text)
mSetContents
  TextNode HydrationDomSpace t
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextNode HydrationDomSpace t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextNode HydrationDomSpace t
 -> HydrationDomBuilderT
      HydrationDomSpace t m (TextNode HydrationDomSpace t))
-> TextNode HydrationDomSpace t
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextNode HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ RawTextNode HydrationDomSpace -> TextNode HydrationDomSpace t
forall k k (d :: k) (t :: k). RawTextNode d -> TextNode d t
TextNode ()

{-# SPECIALIZE textNodeInternal
  :: TextNodeConfig DomTimeline
  -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (TextNode HydrationDomSpace DomTimeline)
  #-}

-- | The static builder mashes adjacent text nodes into one node: we check the
-- text content of each node we come to, comparing it to the content we
-- expect. We also have a special case for empty text nodes - we always create
-- the and add them after the previous node reference.
{-# INLINE hydrateTextNode #-}
hydrateTextNode :: MonadJSM m => Document -> Text -> HydrationRunnerT t m DOM.Text
hydrateTextNode :: Document -> Text -> HydrationRunnerT t m Text
hydrateTextNode Document
doc t :: Text
t@Text
"" = do
  Text
tn <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc Text
t
  Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
tn
  Text -> HydrationRunnerT t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
tn
hydrateTextNode Document
doc Text
t = do
  Text
n <- HydrationRunnerT t m (HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (HydrationRunnerT t m (HydrationRunnerT t m Text)
 -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m (HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node -> HydrationRunnerT t m Text
go (Node -> Maybe Node -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m Node
-> HydrationRunnerT t m (Maybe Node -> HydrationRunnerT t m Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent HydrationRunnerT t m (Maybe Node -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m (Maybe Node)
-> HydrationRunnerT t m (HydrationRunnerT t m Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) t.
Monad m =>
HydrationRunnerT t m (Maybe Node)
getPreviousNode
  Maybe Node -> HydrationRunnerT t m ()
forall (m :: * -> *) t.
Monad m =>
Maybe Node -> HydrationRunnerT t m ()
setPreviousNode (Maybe Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Text -> Node
forall o. IsNode o => o -> Node
toNode Text
n
  Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
n
  where
    go :: Node -> Maybe Node -> HydrationRunnerT t m Text
go Node
parent Maybe Node
mLastNode = HydrationRunnerT t m (Maybe Node)
-> (Node -> HydrationRunnerT t m (Maybe Node))
-> Maybe Node
-> HydrationRunnerT t m (Maybe Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getFirstChild Node
parent) Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling Maybe Node
mLastNode HydrationRunnerT t m (Maybe Node)
-> (Maybe Node -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe Node
Nothing -> do
        StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
 -> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
 -> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
s -> HydrationState
s { _hydrationState_failed :: Bool
_hydrationState_failed = Bool
True }
        Text
n <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc Text
t
        Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
n
        Text -> HydrationRunnerT t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
n
      Just Node
node -> (JSVal -> Text) -> Node -> HydrationRunnerT t m (Maybe Text)
forall obj obj' (m :: * -> *).
(Coercible obj JSVal, IsGObject obj', MonadJSM m) =>
(JSVal -> obj') -> obj -> m (Maybe obj')
DOM.castTo JSVal -> Text
DOM.Text Node
node HydrationRunnerT t m (Maybe Text)
-> (Maybe Text -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Text
Nothing -> Node -> Maybe Node -> HydrationRunnerT t m Text
go Node
parent (Maybe Node -> HydrationRunnerT t m Text)
-> Maybe Node -> HydrationRunnerT t m Text
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node
        Just Text
originalNode -> do
          Text
originalText <- Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self result.
(MonadDOM m, IsNode self, FromJSString result) =>
self -> m result
Node.getTextContentUnchecked Text
originalNode
          case Text -> Text -> Maybe Text
T.stripPrefix Text
t Text
originalText of
            Just Text
"" -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
originalNode
            Just Text
_ -> do
              -- If we have the right prefix, we split the text node into a node containing the
              -- required text and a subsequent sibling node containing the rest of the text.
              Text -> Word -> HydrationRunnerT t m ()
forall (m :: * -> *) self.
(MonadDOM m, IsText self) =>
self -> Word -> m ()
DOM.splitText_ Text
originalNode (Word -> HydrationRunnerT t m ())
-> Word -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
t
              Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
originalNode
            Maybe Text
Nothing -> do
              StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
 -> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
 -> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
s -> HydrationState
s { _hydrationState_failed :: Bool
_hydrationState_failed = Bool
True }
              Text
n <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc Text
t
              Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
n
              Text -> HydrationRunnerT t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
n

{-# INLINE commentNodeImmediate #-}
commentNodeImmediate
  :: (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, MonadJSM m, Reflex t, MonadFix m)
  => CommentNodeConfig t -> HydrationDomBuilderT s t m DOM.Comment
commentNodeImmediate :: CommentNodeConfig t -> HydrationDomBuilderT s t m Comment
commentNodeImmediate (CommentNodeConfig !Text
t Maybe (Event t Text)
mSetContents) = do
  Node
p <- HydrationDomBuilderT s t m Node
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
  Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  Comment
n <- Document -> Text -> HydrationDomBuilderT s t m Comment
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Comment
createComment Document
doc Text
t
  Node -> Comment -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
appendChild_ Node
p Comment
n
  (Event t Text -> HydrationDomBuilderT s t m ())
-> Maybe (Event t Text) -> HydrationDomBuilderT s t m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ())
-> (Event t Text -> Event t (JSM ()))
-> Event t Text
-> HydrationDomBuilderT s t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> JSM ()) -> Event t Text -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Comment -> Maybe Text -> JSM ()
forall (m :: * -> *) self val.
(MonadDOM m, IsNode self, ToJSString val) =>
self -> Maybe val -> m ()
setNodeValue Comment
n (Maybe Text -> JSM ()) -> (Text -> Maybe Text) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just)) Maybe (Event t Text)
mSetContents
  Comment -> HydrationDomBuilderT s t m Comment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
n

{-# INLINE commentNodeInternal #-}
commentNodeInternal
  :: (Ref m ~ IORef, MonadRef m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadJSM m, MonadFix m, Reflex t, Adjustable t m, MonadHold t m, MonadSample t m)
  => CommentNodeConfig t -> HydrationDomBuilderT HydrationDomSpace t m (CommentNode HydrationDomSpace t)
commentNodeInternal :: CommentNodeConfig t
-> HydrationDomBuilderT
     HydrationDomSpace t m (CommentNode HydrationDomSpace t)
commentNodeInternal tc :: CommentNodeConfig t
tc@(CommentNodeConfig Text
t0 Maybe (Event t Text)
mSetContents) = do
  Document
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode -> HydrationDomBuilderT HydrationDomSpace t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT
  HydrationDomSpace t m (CommentNode HydrationDomSpace t)
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (HydrationDomBuilderT
   HydrationDomSpace t m (CommentNode HydrationDomSpace t)
 -> HydrationDomBuilderT HydrationDomSpace t m ())
-> HydrationDomBuilderT
     HydrationDomSpace t m (CommentNode HydrationDomSpace t)
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ CommentNodeConfig t
-> HydrationDomBuilderT
     HydrationDomSpace t m (CommentNode HydrationDomSpace t)
forall (m :: * -> *) t.
(Ref m ~ IORef, MonadRef m, PerformEvent t m,
 MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadJSM m,
 MonadFix m, Reflex t, Adjustable t m, MonadHold t m,
 MonadSample t m) =>
CommentNodeConfig t
-> HydrationDomBuilderT
     HydrationDomSpace t m (CommentNode HydrationDomSpace t)
commentNodeInternal CommentNodeConfig t
tc
    HydrationMode
HydrationMode_Hydrating -> m (Behavior t Text)
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (m (Behavior t Text)
-> (Event t Text -> m (Behavior t Text))
-> Maybe (Event t Text)
-> m (Behavior t Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Text -> m (Behavior t Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text -> m (Behavior t Text))
-> Behavior t Text -> m (Behavior t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Behavior t Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t0) (Text -> Event t Text -> m (Behavior t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Text
t0) Maybe (Event t Text)
mSetContents) ((Behavior t Text -> HydrationRunnerT t m ())
 -> HydrationDomBuilderT HydrationDomSpace t m ())
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ \Behavior t Text
bt -> do
      Text
t <- Behavior t Text -> HydrationRunnerT t m Text
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
bt
      HydrationRunnerT t m Comment -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (HydrationRunnerT t m Comment -> HydrationRunnerT t m ())
-> HydrationRunnerT t m Comment -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ 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
t Maybe (Event t Text)
mSetContents
  CommentNode HydrationDomSpace t
-> HydrationDomBuilderT
     HydrationDomSpace t m (CommentNode HydrationDomSpace t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommentNode HydrationDomSpace t
 -> HydrationDomBuilderT
      HydrationDomSpace t m (CommentNode HydrationDomSpace t))
-> CommentNode HydrationDomSpace t
-> HydrationDomBuilderT
     HydrationDomSpace t m (CommentNode HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ RawCommentNode HydrationDomSpace -> CommentNode HydrationDomSpace t
forall k k (d :: k) (t :: k). RawCommentNode d -> CommentNode d t
CommentNode ()

{-# INLINE hydrateComment #-}
hydrateComment :: (MonadJSM m, Reflex t, MonadFix m) => Document -> Text -> Maybe (Event t Text) -> HydrationRunnerT t m DOM.Comment
hydrateComment :: Document
-> Text -> Maybe (Event t Text) -> HydrationRunnerT t m Comment
hydrateComment Document
doc Text
t Maybe (Event t Text)
mSetContents = do
  Node
parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
  let go :: Maybe Node -> HydrationRunnerT t m Comment
go Maybe Node
mLastNode = HydrationRunnerT t m (Maybe Node)
-> (Node -> HydrationRunnerT t m (Maybe Node))
-> Maybe Node
-> HydrationRunnerT t m (Maybe Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getFirstChild Node
parent) Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling Maybe Node
mLastNode HydrationRunnerT t m (Maybe Node)
-> (Maybe Node -> HydrationRunnerT t m Comment)
-> HydrationRunnerT t m Comment
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Node
Nothing -> do
          Comment
c <- Document -> Text -> HydrationRunnerT t m Comment
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Comment
createComment Document
doc Text
t
          Comment -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Comment
c
          Comment -> HydrationRunnerT t m Comment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe Comment
Nothing -> Maybe Node -> HydrationRunnerT t m Comment
go (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
          Just Comment
c -> do
            Text
t' <- Comment -> HydrationRunnerT t m Text
forall (m :: * -> *) self result.
(MonadDOM m, IsNode self, FromJSString result) =>
self -> m result
Node.getTextContentUnchecked Comment
c
            if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t'
              then Comment -> HydrationRunnerT t m Comment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
c
              else do
                Comment
c' <- Document -> Text -> HydrationRunnerT t m Comment
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Comment
createComment Document
doc Text
t
                Comment -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Comment
c'
                Comment -> HydrationRunnerT t m Comment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
c'
  Comment
n <- Maybe Node -> HydrationRunnerT t m Comment
go (Maybe Node -> HydrationRunnerT t m Comment)
-> HydrationRunnerT t m (Maybe Node)
-> HydrationRunnerT t m Comment
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) t.
Monad m =>
HydrationRunnerT t m (Maybe Node)
getPreviousNode
  Maybe Node -> HydrationRunnerT t m ()
forall (m :: * -> *) t.
Monad m =>
Maybe Node -> HydrationRunnerT t m ()
setPreviousNode (Maybe Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Comment -> Node
forall o. IsNode o => o -> Node
toNode Comment
n
  (Event t Text -> HydrationRunnerT t m ())
-> Maybe (Event t Text) -> HydrationRunnerT t m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> (Event t Text -> Event t (JSM ()))
-> Event t Text
-> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> JSM ()) -> Event t Text -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Comment -> Maybe Text -> JSM ()
forall (m :: * -> *) self val.
(MonadDOM m, IsNode self, ToJSString val) =>
self -> Maybe val -> m ()
setNodeValue Comment
n (Maybe Text -> JSM ()) -> (Text -> Maybe Text) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just)) Maybe (Event t Text)
mSetContents
  Comment -> HydrationRunnerT t m Comment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
n

-- | We leave markers in the static builder as comments, and rip these comments
-- out at hydration time, replacing them with empty text nodes.
{-# INLINABLE skipToAndReplaceComment #-}
skipToAndReplaceComment
  :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)
  => Text
  -> IORef (Maybe Text)
  -> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text, IORef (Maybe Text))
skipToAndReplaceComment :: Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
     s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToAndReplaceComment Text
prefix IORef (Maybe Text)
key0Ref = HydrationDomBuilderT s t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT s t m HydrationMode
-> (HydrationMode
    -> HydrationDomBuilderT
         s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text)))
-> HydrationDomBuilderT
     s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  HydrationMode
HydrationMode_Immediate -> do
    -- If we're in immediate mode, we don't try to replace an existing comment,
    -- and just return a dummy key
    Text
t <- TextNodeConfig t -> HydrationDomBuilderT s t m Text
forall k (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate (TextNodeConfig t -> HydrationDomBuilderT s t m Text)
-> TextNodeConfig t -> HydrationDomBuilderT s t m Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Event t Text) -> TextNodeConfig t
forall k (t :: k). Text -> Maybe (Event t Text) -> TextNodeConfig t
TextNodeConfig (Text
"" :: Text) Maybe (Event t Text)
forall a. Maybe a
Nothing
    Node -> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT s t m ())
-> Node -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Text -> Node
forall o. IsNode o => o -> Node
toNode Text
t
    IORef Text
textNodeRef <- IO (IORef Text) -> HydrationDomBuilderT s t m (IORef Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Text) -> HydrationDomBuilderT s t m (IORef Text))
-> IO (IORef Text) -> HydrationDomBuilderT s t m (IORef Text)
forall a b. (a -> b) -> a -> b
$ Text -> IO (IORef Text)
forall a. a -> IO (IORef a)
newIORef Text
t
    IORef (Maybe Text)
keyRef <- IO (IORef (Maybe Text))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe Text))
 -> HydrationDomBuilderT s t m (IORef (Maybe Text)))
-> IO (IORef (Maybe Text))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Maybe Text -> IO (IORef (Maybe Text))
forall a. a -> IO (IORef a)
newIORef Maybe Text
forall a. Maybe a
Nothing
    (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> HydrationDomBuilderT
     s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (), IORef Text
textNodeRef, IORef (Maybe Text)
keyRef)
  HydrationMode
HydrationMode_Hydrating -> do
    Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
    IORef Text
textNodeRef <- IO (IORef Text) -> HydrationDomBuilderT s t m (IORef Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Text) -> HydrationDomBuilderT s t m (IORef Text))
-> IO (IORef Text) -> HydrationDomBuilderT s t m (IORef Text)
forall a b. (a -> b) -> a -> b
$ Text -> IO (IORef Text)
forall a. a -> IO (IORef a)
newIORef (Text -> IO (IORef Text)) -> Text -> IO (IORef Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. HasCallStack => String -> a
error String
"textNodeRef not yet initialized"
    IORef (Maybe Text)
keyRef <- IO (IORef (Maybe Text))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe Text))
 -> HydrationDomBuilderT s t m (IORef (Maybe Text)))
-> IO (IORef (Maybe Text))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Maybe Text -> IO (IORef (Maybe Text))
forall a. a -> IO (IORef a)
newIORef (Maybe Text -> IO (IORef (Maybe Text)))
-> Maybe Text -> IO (IORef (Maybe Text))
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text
forall a. HasCallStack => String -> a
error String
"keyRef not yet initialized"
    let
      go :: Maybe Text -> Maybe Node -> HydrationRunnerT t m (Text, Maybe Text)
go Maybe Text
Nothing Maybe Node
_ = do
        Text
tn <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
        Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
tn
        StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
 -> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
 -> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
s -> HydrationState
s { _hydrationState_failed :: Bool
_hydrationState_failed = Bool
True }
        (Text, Maybe Text) -> HydrationRunnerT t m (Text, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
tn, Maybe Text
forall a. Maybe a
Nothing)
      go (Just Text
key0) Maybe Node
mLastNode = do
        Node
parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
        HydrationRunnerT t m (Maybe Node)
-> (Node -> HydrationRunnerT t m (Maybe Node))
-> Maybe Node
-> HydrationRunnerT t m (Maybe Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getFirstChild Node
parent) Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling Maybe Node
mLastNode HydrationRunnerT t m (Maybe Node)
-> (Maybe Node -> HydrationRunnerT t m (Text, Maybe Text))
-> HydrationRunnerT t m (Text, Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe Node
Nothing -> Maybe Text -> Maybe Node -> HydrationRunnerT t m (Text, Maybe Text)
go Maybe Text
forall a. Maybe a
Nothing Maybe Node
forall a. Maybe a
Nothing
          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 (Text, Maybe Text))
-> HydrationRunnerT t m (Text, Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just Comment
comment -> do
              Text
commentText <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
forall a. HasCallStack => String -> a
error String
"Cannot get text content of comment node") (Maybe Text -> Text)
-> HydrationRunnerT t m (Maybe Text) -> HydrationRunnerT t m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Comment -> HydrationRunnerT t m (Maybe Text)
forall (m :: * -> *) self result.
(MonadDOM m, IsNode self, FromJSString result) =>
self -> m (Maybe result)
Node.getTextContent Comment
comment
              case Text -> Text -> Maybe Text
T.stripPrefix (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key0) Text
commentText of -- 'key0' may be @""@ in which case we're just finding the actual key; TODO: Don't be clever.
                Just Text
key -> do
                  -- Replace the comment with an (invisible) text node
                  Text
tn <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
                  Node -> Text -> Comment -> HydrationRunnerT t m ()
forall (m :: * -> *) self node child.
(MonadDOM m, IsNode self, IsNode node, IsNode child) =>
self -> node -> child -> m ()
Node.replaceChild_ Node
parent Text
tn Comment
comment
                  (Text, Maybe Text) -> HydrationRunnerT t m (Text, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
tn, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key)
                Maybe Text
Nothing -> do
                  Maybe Text -> Maybe Node -> HydrationRunnerT t m (Text, Maybe Text)
go (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key0) (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
            Maybe Comment
Nothing -> do
              Maybe Text -> Maybe Node -> HydrationRunnerT t m (Text, Maybe Text)
go (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key0) (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
      switchComment :: HydrationRunnerT t m ()
switchComment = do
        Maybe Text
key0 <- IO (Maybe Text) -> HydrationRunnerT t m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> HydrationRunnerT t m (Maybe Text))
-> IO (Maybe Text) -> HydrationRunnerT t m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe Text) -> IO (Maybe Text)
forall a. IORef a -> IO a
readIORef IORef (Maybe Text)
key0Ref
        (Text
tn, Maybe Text
key) <- Maybe Text -> Maybe Node -> HydrationRunnerT t m (Text, Maybe Text)
go Maybe Text
key0 (Maybe Node -> HydrationRunnerT t m (Text, Maybe Text))
-> HydrationRunnerT t m (Maybe Node)
-> HydrationRunnerT t m (Text, Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) t.
Monad m =>
HydrationRunnerT t m (Maybe Node)
getPreviousNode
        Maybe Node -> HydrationRunnerT t m ()
forall (m :: * -> *) t.
Monad m =>
Maybe Node -> HydrationRunnerT t m ()
setPreviousNode (Maybe Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Text -> Node
forall o. IsNode o => o -> Node
toNode Text
tn
        IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ do
          IORef Text -> Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Text
textNodeRef Text
tn
          IORef (Maybe Text) -> Maybe Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Text)
keyRef Maybe Text
key
    (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> HydrationDomBuilderT
     s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HydrationRunnerT t m ()
switchComment, IORef Text
textNodeRef, IORef (Maybe Text)
keyRef)

{-# INLINABLE skipToReplaceStart #-}
skipToReplaceStart :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text, IORef (Maybe Text))
skipToReplaceStart :: HydrationDomBuilderT
  s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToReplaceStart = Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
     s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall k (m :: * -> *) t (s :: k).
(MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m,
 RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document) =>
Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
     s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToAndReplaceComment Text
"replace-start" (IORef (Maybe Text)
 -> HydrationDomBuilderT
      s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text)))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
-> HydrationDomBuilderT
     s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (IORef (Maybe Text))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe Text -> IO (IORef (Maybe Text))
forall a. a -> IO (IORef a)
newIORef (Maybe Text -> IO (IORef (Maybe Text)))
-> Maybe Text -> IO (IORef (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"") -- TODO: Don't rely on clever usage @""@ to make this work.

{-# INLINABLE skipToReplaceEnd #-}
skipToReplaceEnd :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => IORef (Maybe Text) -> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text)
skipToReplaceEnd :: IORef (Maybe Text)
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef Text)
skipToReplaceEnd IORef (Maybe Text)
key = ((HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
 -> (HydrationRunnerT t m (), IORef Text))
-> HydrationDomBuilderT
     s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(HydrationRunnerT t m ()
m,IORef Text
e,IORef (Maybe Text)
_) -> (HydrationRunnerT t m ()
m,IORef Text
e)) (HydrationDomBuilderT
   s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
 -> HydrationDomBuilderT
      s t m (HydrationRunnerT t m (), IORef Text))
-> HydrationDomBuilderT
     s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef Text)
forall a b. (a -> b) -> a -> b
$ Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
     s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall k (m :: * -> *) t (s :: k).
(MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m,
 RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document) =>
Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
     s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToAndReplaceComment Text
"replace-end" IORef (Maybe Text)
key

instance SupportsHydrationDomBuilder t m => NotReady t (HydrationDomBuilderT s t m) where
  notReadyUntil :: Event t a -> HydrationDomBuilderT s t m ()
notReadyUntil Event t a
e = do
    Event t a
eOnce <- Event t a -> HydrationDomBuilderT s t m (Event t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
Event t a -> m (Event t a)
headE Event t a
e
    IORef Word
unreadyChildren <- HydrationDomBuilderT s t m (IORef Word)
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT s t m (IORef Word)
askUnreadyChildren
    JSM ()
commitAction <- HydrationDomBuilderT s t m (JSM ())
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT s t m (JSM ())
askCommitAction
    IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> (Word -> Word) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Word
unreadyChildren Word -> Word
forall a. Enum a => a -> a
succ
    let ready :: JSM ()
ready = do
          Word
old <- IO Word -> JSM Word
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> JSM Word) -> IO Word -> JSM Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
unreadyChildren
          let new :: Word
new = Word -> Word
forall a. Enum a => a -> a
pred Word
old
          IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> Word -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Word
unreadyChildren (Word -> IO ()) -> Word -> IO ()
forall a b. (a -> b) -> a -> b
$! Word
new
          Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
new Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) JSM ()
commitAction
    Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ())
-> Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ JSM ()
ready JSM () -> Event t a -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t a
eOnce
  notReady :: HydrationDomBuilderT s t m ()
notReady = do
    IORef Word
unreadyChildren <- HydrationDomBuilderT s t m (IORef Word)
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT s t m (IORef Word)
askUnreadyChildren
    IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> (Word -> Word) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Word
unreadyChildren Word -> Word
forall a. Enum a => a -> a
succ

data HydrationDomSpace

instance DomSpace HydrationDomSpace where
  type EventSpec HydrationDomSpace = GhcjsEventSpec
  type RawDocument HydrationDomSpace = DOM.Document
  type RawTextNode HydrationDomSpace = ()
  type RawCommentNode HydrationDomSpace = ()
  type RawElement HydrationDomSpace = ()
  type RawInputElement HydrationDomSpace = ()
  type RawTextAreaElement HydrationDomSpace = ()
  type RawSelectElement HydrationDomSpace = ()
  addEventSpecFlags :: proxy HydrationDomSpace
-> EventName en
-> (Maybe (er en) -> EventFlags)
-> EventSpec HydrationDomSpace er
-> EventSpec HydrationDomSpace er
addEventSpecFlags proxy HydrationDomSpace
_ EventName en
en Maybe (er en) -> EventFlags
f EventSpec HydrationDomSpace er
es = EventSpec HydrationDomSpace er
GhcjsEventSpec er
es
    { _ghcjsEventSpec_filters :: DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters =
        let f' :: Maybe (GhcjsEventFilter er en) -> Maybe (GhcjsEventFilter er en)
f' = GhcjsEventFilter er en -> Maybe (GhcjsEventFilter er en)
forall a. a -> Maybe a
Just (GhcjsEventFilter er en -> Maybe (GhcjsEventFilter er en))
-> (Maybe (GhcjsEventFilter er en) -> GhcjsEventFilter er en)
-> Maybe (GhcjsEventFilter er en)
-> Maybe (GhcjsEventFilter er en)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
forall (er :: EventTag -> *) (en :: EventTag).
(GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
GhcjsEventFilter ((GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
 -> GhcjsEventFilter er en)
-> (Maybe (GhcjsEventFilter er en)
    -> GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> Maybe (GhcjsEventFilter er en)
-> GhcjsEventFilter er en
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
              Maybe (GhcjsEventFilter er en)
Nothing -> \GhcjsDomEvent en
evt -> do
                Maybe (er en)
mEventResult <- GhcjsEventHandler er
-> (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
forall (er :: EventTag -> *).
GhcjsEventHandler er
-> forall (en :: EventTag).
   (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
unGhcjsEventHandler (GhcjsEventSpec er -> GhcjsEventHandler er
forall (er :: EventTag -> *).
GhcjsEventSpec er -> GhcjsEventHandler er
_ghcjsEventSpec_handler EventSpec HydrationDomSpace er
GhcjsEventSpec er
es) (EventName en
en, GhcjsDomEvent en
evt)
                (EventFlags, JSM (Maybe (er en)))
-> JSM (EventFlags, JSM (Maybe (er en)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (er en) -> EventFlags
f Maybe (er en)
mEventResult, Maybe (er en) -> JSM (Maybe (er en))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (er en)
mEventResult)
              Just (GhcjsEventFilter GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter) -> \GhcjsDomEvent en
evt -> do
                (EventFlags
oldFlags, JSM (Maybe (er en))
oldContinuation) <- GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter GhcjsDomEvent en
evt
                Maybe (er en)
mEventResult <- JSM (Maybe (er en))
oldContinuation
                let newFlags :: EventFlags
newFlags = EventFlags
oldFlags EventFlags -> EventFlags -> EventFlags
forall a. Semigroup a => a -> a -> a
<> Maybe (er en) -> EventFlags
f Maybe (er en)
mEventResult
                (EventFlags, JSM (Maybe (er en)))
-> JSM (EventFlags, JSM (Maybe (er en)))
forall (m :: * -> *) a. Monad m => a -> m a
return (EventFlags
newFlags, Maybe (er en) -> JSM (Maybe (er en))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (er en)
mEventResult)
        in (Maybe (GhcjsEventFilter er en) -> Maybe (GhcjsEventFilter er en))
-> EventName en
-> DMap EventName (GhcjsEventFilter er)
-> DMap EventName (GhcjsEventFilter er)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
(Maybe (f v) -> Maybe (f v)) -> k2 v -> DMap k2 f -> DMap k2 f
DMap.alter Maybe (GhcjsEventFilter er en) -> Maybe (GhcjsEventFilter er en)
f' EventName en
en (DMap EventName (GhcjsEventFilter er)
 -> DMap EventName (GhcjsEventFilter er))
-> DMap EventName (GhcjsEventFilter er)
-> DMap EventName (GhcjsEventFilter er)
forall a b. (a -> b) -> a -> b
$ GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
forall (er :: EventTag -> *).
GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters EventSpec HydrationDomSpace er
GhcjsEventSpec er
es
    }

instance SupportsHydrationDomBuilder t m => DomBuilder t (HydrationDomBuilderT HydrationDomSpace t m) where
  type DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m) = HydrationDomSpace
  {-# INLINABLE element #-}
  element :: Text
-> ElementConfig
     er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (Element
        er
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
        t,
      a)
element = Text
-> ElementConfig
     er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (Element
        er
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
        t,
      a)
forall (m :: * -> *) t (er :: EventTag -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace t m (Element er HydrationDomSpace t, a)
elementInternal
  {-# INLINABLE textNode #-}
  textNode :: TextNodeConfig t
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (TextNode
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t)
textNode = TextNodeConfig t
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (TextNode
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t)
forall t (m :: * -> *).
(Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m,
 Reflex t) =>
TextNodeConfig t
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextNode HydrationDomSpace t)
textNodeInternal
  {-# INLINABLE commentNode #-}
  commentNode :: CommentNodeConfig t
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (CommentNode
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t)
commentNode = CommentNodeConfig t
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (CommentNode
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t)
forall (m :: * -> *) t.
(Ref m ~ IORef, MonadRef m, PerformEvent t m,
 MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadJSM m,
 MonadFix m, Reflex t, Adjustable t m, MonadHold t m,
 MonadSample t m) =>
CommentNodeConfig t
-> HydrationDomBuilderT
     HydrationDomSpace t m (CommentNode HydrationDomSpace t)
commentNodeInternal
  {-# INLINABLE inputElement #-}
  inputElement :: InputElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (InputElement
        er
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
        t)
inputElement = InputElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (InputElement
        er
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
        t)
forall (m :: * -> *) t (er :: EventTag -> *).
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
 MonadHold t m, MonadRef m, Ref m ~ IORef) =>
InputElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
     HydrationDomSpace t m (InputElement er HydrationDomSpace t)
inputElementInternal
  {-# INLINABLE textAreaElement #-}
  textAreaElement :: TextAreaElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (TextAreaElement
        er
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
        t)
textAreaElement = TextAreaElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (TextAreaElement
        er
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
        t)
forall (m :: * -> *) t (er :: EventTag -> *).
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
 MonadHold t m, MonadRef m, Ref m ~ IORef) =>
TextAreaElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
textAreaElementInternal
  {-# INLINABLE selectElement #-}
  selectElement :: SelectElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (SelectElement
        er
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
        t,
      a)
selectElement = SelectElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (SelectElement
        er
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
        t,
      a)
forall (m :: * -> *) t (er :: EventTag -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
 MonadHold t m, MonadRef m, Ref m ~ IORef) =>
SelectElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
selectElementInternal
  placeRawElement :: RawElement
  (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m ()
placeRawElement () = () -> HydrationDomBuilderT HydrationDomSpace t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  wrapRawElement :: RawElement
  (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> RawElementConfig
     er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (Element
        er
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
        t)
wrapRawElement () RawElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
_cfg = Element er HydrationDomSpace t
-> HydrationDomBuilderT
     HydrationDomSpace t m (Element er HydrationDomSpace t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Element er HydrationDomSpace t
 -> HydrationDomBuilderT
      HydrationDomSpace t m (Element er HydrationDomSpace t))
-> Element er HydrationDomSpace t
-> HydrationDomBuilderT
     HydrationDomSpace t m (Element er HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ EventSelector t (WrapArg er EventName)
-> RawElement HydrationDomSpace -> Element er HydrationDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element ((forall a. WrapArg er EventName a -> Event t a)
-> EventSelector t (WrapArg er EventName)
forall k (t :: k) (k1 :: * -> *).
(forall a. k1 a -> Event t a) -> EventSelector t k1
EventSelector ((forall a. WrapArg er EventName a -> Event t a)
 -> EventSelector t (WrapArg er EventName))
-> (forall a. WrapArg er EventName a -> Event t a)
-> EventSelector t (WrapArg er EventName)
forall a b. (a -> b) -> a -> b
$ Event t a -> WrapArg er EventName a -> Event t a
forall a b. a -> b -> a
const Event t a
forall k (t :: k) a. Reflex t => Event t a
never) ()

instance SupportsHydrationDomBuilder t m => DomBuilder t (HydrationDomBuilderT GhcjsDomSpace t m) where
  type DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m) = GhcjsDomSpace
  {-# INLINABLE element #-}
  element :: Text
-> ElementConfig
     er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (Element
        er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t,
      a)
element = Text
-> ElementConfig
     er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (Element
        er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t,
      a)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
 MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate
  {-# INLINABLE textNode #-}
  textNode :: TextNodeConfig t
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (TextNode
        (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
textNode = (Text -> TextNode GhcjsDomSpace t)
-> HydrationDomBuilderT GhcjsDomSpace t m Text
-> HydrationDomBuilderT
     GhcjsDomSpace t m (TextNode GhcjsDomSpace t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TextNode GhcjsDomSpace t
forall k k (d :: k) (t :: k). RawTextNode d -> TextNode d t
TextNode (HydrationDomBuilderT GhcjsDomSpace t m Text
 -> HydrationDomBuilderT
      GhcjsDomSpace t m (TextNode GhcjsDomSpace t))
-> (TextNodeConfig t
    -> HydrationDomBuilderT GhcjsDomSpace t m Text)
-> TextNodeConfig t
-> HydrationDomBuilderT
     GhcjsDomSpace t m (TextNode GhcjsDomSpace t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text
forall k (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate
  {-# INLINABLE commentNode #-}
  commentNode :: CommentNodeConfig t
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (CommentNode
        (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
commentNode = (Comment -> CommentNode GhcjsDomSpace t)
-> HydrationDomBuilderT GhcjsDomSpace t m Comment
-> HydrationDomBuilderT
     GhcjsDomSpace t m (CommentNode GhcjsDomSpace t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Comment -> CommentNode GhcjsDomSpace t
forall k k (d :: k) (t :: k). RawCommentNode d -> CommentNode d t
CommentNode (HydrationDomBuilderT GhcjsDomSpace t m Comment
 -> HydrationDomBuilderT
      GhcjsDomSpace t m (CommentNode GhcjsDomSpace t))
-> (CommentNodeConfig t
    -> HydrationDomBuilderT GhcjsDomSpace t m Comment)
-> CommentNodeConfig t
-> HydrationDomBuilderT
     GhcjsDomSpace t m (CommentNode GhcjsDomSpace t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentNodeConfig t
-> HydrationDomBuilderT GhcjsDomSpace t m Comment
forall k (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 MonadJSM m, Reflex t, MonadFix m) =>
CommentNodeConfig t -> HydrationDomBuilderT s t m Comment
commentNodeImmediate
  {-# INLINABLE inputElement #-}
  inputElement :: InputElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (InputElement
        er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
inputElement = InputElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (InputElement
        er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
 MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
 MonadRef m, Ref m ~ IORef) =>
InputElementConfig er t s
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
inputElementImmediate
  {-# INLINABLE textAreaElement #-}
  textAreaElement :: TextAreaElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (TextAreaElement
        er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
textAreaElement = TextAreaElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (TextAreaElement
        er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
 MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
 MonadRef m, Ref m ~ IORef) =>
TextAreaElementConfig er t s
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
textAreaElementImmediate
  {-# INLINABLE selectElement #-}
  selectElement :: SelectElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (SelectElement
        er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t,
      a)
selectElement = SelectElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (SelectElement
        er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t,
      a)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(EventSpec s ~ GhcjsEventSpec,
 RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
 MonadHold t m) =>
SelectElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
selectElementImmediate
  placeRawElement :: RawElement
  (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m ()
placeRawElement = Node -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall k (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT GhcjsDomSpace t m ())
-> (Element -> Node)
-> Element
-> HydrationDomBuilderT GhcjsDomSpace t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Node
forall o. IsNode o => o -> Node
toNode
  wrapRawElement :: RawElement
  (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> RawElementConfig
     er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (Element
        er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
wrapRawElement RawElement
  (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
e RawElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
rawCfg = do
    Chan [DSum (EventTriggerRef t) TriggerInvocation]
events <- HydrationDomBuilderT
  GhcjsDomSpace
  t
  m
  (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT
  s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents
    JSContextRef
ctx <- HydrationDomBuilderT GhcjsDomSpace t m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
    DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs <- Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t GhcjsDomSpace
-> HydrationDomBuilderT
     GhcjsDomSpace t m (DMap EventName (EventFilterTriggerRef t er))
forall k (s :: k) (m :: * -> *) (er :: EventTag -> *) t.
(Reflex t, MonadJSM m, MonadReflexCreateTrigger t m,
 DomRenderHook t m, EventSpec s ~ GhcjsEventSpec) =>
Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t s
-> m (DMap EventName (EventFilterTriggerRef t er))
wrap Chan [DSum (EventTriggerRef t) TriggerInvocation]
events Element
RawElement
  (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
e RawElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
RawElementConfig er t GhcjsDomSpace
rawCfg
    EventSelector t (WrapArg er EventName)
es <- (forall a.
 WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
     GhcjsDomSpace t m (EventSelector t (WrapArg er EventName))
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger ((forall a.
  WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
 -> HydrationDomBuilderT
      GhcjsDomSpace t m (EventSelector t (WrapArg er EventName)))
-> (forall a.
    WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
     GhcjsDomSpace t m (EventSelector t (WrapArg er EventName))
forall a b. (a -> b) -> a -> b
$ JSContextRef
-> RawElementConfig er t GhcjsDomSpace
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName a
-> EventTrigger t a
-> IO (IO ())
forall k (s :: k) (er :: EventTag -> *) t x.
(EventSpec s ~ GhcjsEventSpec) =>
JSContextRef
-> RawElementConfig er t s
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName x
-> EventTrigger t x
-> IO (IO ())
triggerBody JSContextRef
ctx RawElementConfig
  er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
RawElementConfig er t GhcjsDomSpace
rawCfg Chan [DSum (EventTriggerRef t) TriggerInvocation]
events DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs Element
RawElement
  (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
e
    Element er GhcjsDomSpace t
-> HydrationDomBuilderT
     GhcjsDomSpace t m (Element er GhcjsDomSpace t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Element er GhcjsDomSpace t
 -> HydrationDomBuilderT
      GhcjsDomSpace t m (Element er GhcjsDomSpace t))
-> Element er GhcjsDomSpace t
-> HydrationDomBuilderT
     GhcjsDomSpace t m (Element er GhcjsDomSpace t)
forall a b. (a -> b) -> a -> b
$ EventSelector t (WrapArg er EventName)
-> RawElement GhcjsDomSpace -> Element er GhcjsDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element EventSelector t (WrapArg er EventName)
es RawElement
  (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
RawElement GhcjsDomSpace
e

data FragmentState
  = FragmentState_Unmounted
  | FragmentState_Mounted (DOM.Text, DOM.Text)

data ImmediateDomFragment = ImmediateDomFragment
  { ImmediateDomFragment -> DocumentFragment
_immediateDomFragment_document :: DOM.DocumentFragment
  , ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state :: IORef FragmentState
  }

extractFragment :: MonadJSM m => ImmediateDomFragment -> m ()
extractFragment :: ImmediateDomFragment -> m ()
extractFragment ImmediateDomFragment
fragment = do
  FragmentState
state <- IO FragmentState -> m FragmentState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FragmentState -> m FragmentState)
-> IO FragmentState -> m FragmentState
forall a b. (a -> b) -> a -> b
$ IORef FragmentState -> IO FragmentState
forall a. IORef a -> IO a
readIORef (IORef FragmentState -> IO FragmentState)
-> IORef FragmentState -> IO FragmentState
forall a b. (a -> b) -> a -> b
$ ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state ImmediateDomFragment
fragment
  case FragmentState
state of
    FragmentState
FragmentState_Unmounted -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    FragmentState_Mounted (Text
before, Text
after) -> do
      DocumentFragment -> Text -> Text -> m ()
forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
DocumentFragment -> start -> end -> m ()
extractBetweenExclusive (ImmediateDomFragment -> DocumentFragment
_immediateDomFragment_document ImmediateDomFragment
fragment) Text
before Text
after
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef FragmentState -> FragmentState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state ImmediateDomFragment
fragment) FragmentState
FragmentState_Unmounted

instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomBuilderT GhcjsDomSpace t m) where
  type DomFragment (HydrationDomBuilderT GhcjsDomSpace t m) = ImmediateDomFragment
  buildDomFragment :: HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (DomFragment (HydrationDomBuilderT GhcjsDomSpace t m), a)
buildDomFragment HydrationDomBuilderT GhcjsDomSpace t m a
w = do
    DocumentFragment
df <- Document -> HydrationDomBuilderT GhcjsDomSpace t m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment (Document
 -> HydrationDomBuilderT GhcjsDomSpace t m DocumentFragment)
-> HydrationDomBuilderT GhcjsDomSpace t m Document
-> HydrationDomBuilderT GhcjsDomSpace t m DocumentFragment
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HydrationDomBuilderT GhcjsDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
    a
result <- ((HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
 -> HydrationDomBuilderT GhcjsDomSpace t m a
 -> HydrationDomBuilderT GhcjsDomSpace t m a)
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT GhcjsDomSpace t m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT GhcjsDomSpace t m a
forall k (m :: * -> *) t (s :: k) a.
Monad m =>
(HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
localEnv HydrationDomBuilderT GhcjsDomSpace t m a
w ((HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
 -> HydrationDomBuilderT GhcjsDomSpace t m a)
-> (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT GhcjsDomSpace t m a
forall a b. (a -> b) -> a -> b
$ \HydrationDomBuilderEnv t m
env -> HydrationDomBuilderEnv t m
env
      { _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
      }
    IORef FragmentState
state <- IO (IORef FragmentState)
-> HydrationDomBuilderT GhcjsDomSpace t m (IORef FragmentState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef FragmentState)
 -> HydrationDomBuilderT GhcjsDomSpace t m (IORef FragmentState))
-> IO (IORef FragmentState)
-> HydrationDomBuilderT GhcjsDomSpace t m (IORef FragmentState)
forall a b. (a -> b) -> a -> b
$ FragmentState -> IO (IORef FragmentState)
forall a. a -> IO (IORef a)
newIORef FragmentState
FragmentState_Unmounted
    (ImmediateDomFragment, a)
-> HydrationDomBuilderT GhcjsDomSpace t m (ImmediateDomFragment, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocumentFragment -> IORef FragmentState -> ImmediateDomFragment
ImmediateDomFragment DocumentFragment
df IORef FragmentState
state, a
result)
  mountDomFragment :: DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
-> Event t (DomFragment (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m ()
mountDomFragment DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
fragment Event t (DomFragment (HydrationDomBuilderT GhcjsDomSpace t m))
setFragment = do
    Node
parent <- HydrationDomBuilderT GhcjsDomSpace t m Node
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
    ImmediateDomFragment -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall (m :: * -> *). MonadJSM m => ImmediateDomFragment -> m ()
extractFragment DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
ImmediateDomFragment
fragment
    Text
before <- TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text
forall k (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate (TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text)
-> TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Event t Text) -> TextNodeConfig t
forall k (t :: k). Text -> Maybe (Event t Text) -> TextNodeConfig t
TextNodeConfig (Text
"" :: Text) Maybe (Event t Text)
forall a. Maybe a
Nothing
    Node
-> DocumentFragment -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
appendChild_ Node
parent (DocumentFragment -> HydrationDomBuilderT GhcjsDomSpace t m ())
-> DocumentFragment -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ ImmediateDomFragment -> DocumentFragment
_immediateDomFragment_document DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
ImmediateDomFragment
fragment
    Text
after <- TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text
forall k (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document,
 MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate (TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text)
-> TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Event t Text) -> TextNodeConfig t
forall k (t :: k). Text -> Maybe (Event t Text) -> TextNodeConfig t
TextNodeConfig (Text
"" :: Text) Maybe (Event t Text)
forall a. Maybe a
Nothing
    Dynamic t (ImmediateDomFragment, Maybe ImmediateDomFragment)
xs <- (ImmediateDomFragment
 -> (ImmediateDomFragment, Maybe ImmediateDomFragment)
 -> (ImmediateDomFragment, Maybe ImmediateDomFragment))
-> (ImmediateDomFragment, Maybe ImmediateDomFragment)
-> Event t ImmediateDomFragment
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (Dynamic t (ImmediateDomFragment, Maybe ImmediateDomFragment))
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn (\ImmediateDomFragment
new (ImmediateDomFragment
previous, Maybe ImmediateDomFragment
_) -> (ImmediateDomFragment
new, ImmediateDomFragment -> Maybe ImmediateDomFragment
forall a. a -> Maybe a
Just ImmediateDomFragment
previous)) (DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
ImmediateDomFragment
fragment, Maybe ImmediateDomFragment
forall a. Maybe a
Nothing) Event t (DomFragment (HydrationDomBuilderT GhcjsDomSpace t m))
Event t ImmediateDomFragment
setFragment
    Event t (JSM ()) -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT GhcjsDomSpace t m ())
-> Event t (JSM ()) -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ Event t (ImmediateDomFragment, Maybe ImmediateDomFragment)
-> ((ImmediateDomFragment, Maybe ImmediateDomFragment) -> JSM ())
-> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (Dynamic t (ImmediateDomFragment, Maybe ImmediateDomFragment)
-> Event t (ImmediateDomFragment, Maybe ImmediateDomFragment)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (ImmediateDomFragment, Maybe ImmediateDomFragment)
xs) (((ImmediateDomFragment, Maybe ImmediateDomFragment) -> JSM ())
 -> Event t (JSM ()))
-> ((ImmediateDomFragment, Maybe ImmediateDomFragment) -> JSM ())
-> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \(ImmediateDomFragment
childFragment, Just ImmediateDomFragment
previousFragment) -> do
      ImmediateDomFragment -> JSM ()
forall (m :: * -> *). MonadJSM m => ImmediateDomFragment -> m ()
extractFragment ImmediateDomFragment
previousFragment
      ImmediateDomFragment -> JSM ()
forall (m :: * -> *). MonadJSM m => ImmediateDomFragment -> m ()
extractFragment ImmediateDomFragment
childFragment
      DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
insertBefore (ImmediateDomFragment -> DocumentFragment
_immediateDomFragment_document ImmediateDomFragment
childFragment) Text
after
      IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef FragmentState -> FragmentState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state ImmediateDomFragment
childFragment) (FragmentState -> IO ()) -> FragmentState -> IO ()
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> FragmentState
FragmentState_Mounted (Text
before, Text
after)
    IO () -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT GhcjsDomSpace t m ())
-> IO () -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ IORef FragmentState -> FragmentState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
ImmediateDomFragment
fragment) (FragmentState -> IO ()) -> FragmentState -> IO ()
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> FragmentState
FragmentState_Mounted (Text
before, Text
after)

instance (Reflex t, Monad m, Adjustable t m, MonadHold t m, MonadFix m) => Adjustable t (DomRenderHookT t m) where
  runWithReplace :: DomRenderHookT t m a
-> Event t (DomRenderHookT t m b)
-> DomRenderHookT t m (a, Event t b)
runWithReplace DomRenderHookT t m a
a0 Event t (DomRenderHookT t m b)
a' = RequesterT t JSM Identity (TriggerEventT t m) (a, Event t b)
-> DomRenderHookT t m (a, Event t b)
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) (a, Event t b)
 -> DomRenderHookT t m (a, Event t b))
-> RequesterT t JSM Identity (TriggerEventT t m) (a, Event t b)
-> DomRenderHookT t m (a, Event t b)
forall a b. (a -> b) -> a -> b
$ RequesterT t JSM Identity (TriggerEventT t m) a
-> Event t (RequesterT t JSM Identity (TriggerEventT t m) b)
-> RequesterT t JSM Identity (TriggerEventT t m) (a, Event t b)
forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace (DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT DomRenderHookT t m a
a0) ((DomRenderHookT t m b
 -> RequesterT t JSM Identity (TriggerEventT t m) b)
-> Event t (DomRenderHookT t m b)
-> Event t (RequesterT t JSM Identity (TriggerEventT t m) b)
forall k (t :: k) a b.
Reflex t =>
(a -> b) -> Event t a -> Event t b
fmapCheap DomRenderHookT t m b
-> RequesterT t JSM Identity (TriggerEventT t m) b
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT Event t (DomRenderHookT t m b)
a')
  traverseIntMapWithKeyWithAdjust :: (Int -> v -> DomRenderHookT t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> DomRenderHookT t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust Int -> v -> DomRenderHookT t m v'
f IntMap v
m = RequesterT
  t
  JSM
  Identity
  (TriggerEventT t m)
  (IntMap v', Event t (PatchIntMap v'))
-> DomRenderHookT t m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
   t
   JSM
   Identity
   (TriggerEventT t m)
   (IntMap v', Event t (PatchIntMap v'))
 -> DomRenderHookT t m (IntMap v', Event t (PatchIntMap v')))
-> (Event t (PatchIntMap v)
    -> RequesterT
         t
         JSM
         Identity
         (TriggerEventT t m)
         (IntMap v', Event t (PatchIntMap v')))
-> Event t (PatchIntMap v)
-> DomRenderHookT t m (IntMap v', Event t (PatchIntMap v'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> v -> RequesterT t JSM Identity (TriggerEventT t m) v')
-> IntMap v
-> Event t (PatchIntMap v)
-> RequesterT
     t
     JSM
     Identity
     (TriggerEventT t m)
     (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Int -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust (\Int
k -> DomRenderHookT t m v'
-> RequesterT t JSM Identity (TriggerEventT t m) v'
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT (DomRenderHookT t m v'
 -> RequesterT t JSM Identity (TriggerEventT t m) v')
-> (v -> DomRenderHookT t m v')
-> v
-> RequesterT t JSM Identity (TriggerEventT t m) v'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> v -> DomRenderHookT t m v'
f Int
k) IntMap v
m
  traverseDMapWithKeyWithAdjust :: (forall a. k a -> v a -> DomRenderHookT t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust forall a. k a -> v a -> DomRenderHookT t m (v' a)
f DMap k v
m = RequesterT
  t
  JSM
  Identity
  (TriggerEventT t m)
  (DMap k v', Event t (PatchDMap k v'))
-> DomRenderHookT t m (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
   t
   JSM
   Identity
   (TriggerEventT t m)
   (DMap k v', Event t (PatchDMap k v'))
 -> DomRenderHookT t m (DMap k v', Event t (PatchDMap k v')))
-> (Event t (PatchDMap k v)
    -> RequesterT
         t
         JSM
         Identity
         (TriggerEventT t m)
         (DMap k v', Event t (PatchDMap k v')))
-> Event t (PatchDMap k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMap k v'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 k a -> v a -> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> RequesterT
     t
     JSM
     Identity
     (TriggerEventT t m)
     (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust (\k a
k -> DomRenderHookT t m (v' a)
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a)
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT (DomRenderHookT t m (v' a)
 -> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> (v a -> DomRenderHookT t m (v' a))
-> v a
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k a -> v a -> DomRenderHookT t m (v' a)
forall a. k a -> v a -> DomRenderHookT t m (v' a)
f k a
k) DMap k v
m
  traverseDMapWithKeyWithAdjustWithMove :: (forall a. k a -> v a -> DomRenderHookT t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove forall a. k a -> v a -> DomRenderHookT t m (v' a)
f DMap k v
m = RequesterT
  t
  JSM
  Identity
  (TriggerEventT t m)
  (DMap k v', Event t (PatchDMapWithMove k v'))
-> DomRenderHookT t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
   t
   JSM
   Identity
   (TriggerEventT t m)
   (DMap k v', Event t (PatchDMapWithMove k v'))
 -> DomRenderHookT
      t m (DMap k v', Event t (PatchDMapWithMove k v')))
-> (Event t (PatchDMapWithMove k v)
    -> RequesterT
         t
         JSM
         Identity
         (TriggerEventT t m)
         (DMap k v', Event t (PatchDMapWithMove k v')))
-> Event t (PatchDMapWithMove k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 k a -> v a -> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> RequesterT
     t
     JSM
     Identity
     (TriggerEventT t m)
     (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove (\k a
k -> DomRenderHookT t m (v' a)
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a)
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT (DomRenderHookT t m (v' a)
 -> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> (v a -> DomRenderHookT t m (v' a))
-> v a
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k a -> v a -> DomRenderHookT t m (v' a)
forall a. k a -> v a -> DomRenderHookT t m (v' a)
f k a
k) DMap k v
m

instance (Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => Adjustable t (HydrationDomBuilderT s t m) where
  {-# INLINABLE runWithReplace #-}
  runWithReplace :: HydrationDomBuilderT s t m a
-> Event t (HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m (a, Event t b)
runWithReplace HydrationDomBuilderT s t m a
a0 Event t (HydrationDomBuilderT s t m b)
a' = do
    HydrationDomBuilderEnv t m
initialEnv <- ReaderT
  (HydrationDomBuilderEnv t m)
  (DomRenderHookT t m)
  (HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s 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
    let hydrating :: IORef HydrationMode
hydrating = HydrationDomBuilderEnv t m -> IORef HydrationMode
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode HydrationDomBuilderEnv t m
initialEnv
    (HydrationRunnerT t m ()
hydrateStart, IORef Text
before, IORef (Maybe Text)
beforeKey) <- HydrationDomBuilderT
  s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall k (m :: * -> *) t (s :: k).
(MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m,
 RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document) =>
HydrationDomBuilderT
  s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToReplaceStart
    let parentUnreadyChildren :: IORef Word
parentUnreadyChildren = HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren HydrationDomBuilderEnv t m
initialEnv
    IORef Bool
haveEverBeenReady <- IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool))
-> IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
    IORef Int
currentCohort <- IO (IORef Int) -> HydrationDomBuilderT s t m (IORef Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Int) -> HydrationDomBuilderT s t m (IORef Int))
-> IO (IORef Int) -> HydrationDomBuilderT s t m (IORef Int)
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef (-Int
1 :: Int) -- Equal to the cohort currently in the DOM
    let myCommitAction :: JSM ()
myCommitAction = do
          IO Bool -> JSM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
haveEverBeenReady) JSM Bool -> (Bool -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
True -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Bool
False -> do
              IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
              Word
old <- IO Word -> JSM Word
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> JSM Word) -> IO Word -> JSM Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
parentUnreadyChildren
              let new :: Word
new = Word -> Word
forall a. Enum a => a -> a
pred Word
old
              IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> Word -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Word
parentUnreadyChildren (Word -> IO ()) -> Word -> IO ()
forall a b. (a -> b) -> a -> b
$! Word
new
              Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
new Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> JSM ()
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> JSM ()
_hydrationDomBuilderEnv_commitAction HydrationDomBuilderEnv t m
initialEnv
    -- We draw 'after' in this roundabout way to avoid using MonadFix
    Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
    Node
parent <- HydrationDomBuilderT s t m Node
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
    (HydrationRunnerT t m ()
hydrateEnd, IORef Text
after) <- IORef (Maybe Text)
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef Text)
forall k (m :: * -> *) t (s :: k).
(MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m,
 RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document) =>
IORef (Maybe Text)
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef Text)
skipToReplaceEnd IORef (Maybe Text)
beforeKey
    let drawInitialChild :: DomRenderHookT t m (HydrationRunnerT t m (), a)
drawInitialChild = do
          HydrationMode
h <- IO HydrationMode -> DomRenderHookT t m HydrationMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HydrationMode -> DomRenderHookT t m HydrationMode)
-> IO HydrationMode -> DomRenderHookT t m HydrationMode
forall a b. (a -> b) -> a -> b
$ IORef HydrationMode -> IO HydrationMode
forall a. IORef a -> IO a
readIORef IORef HydrationMode
hydrating
          Node
p' <- case HydrationMode
h of
            HydrationMode
HydrationMode_Hydrating -> Node -> DomRenderHookT t m Node
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
parent
            HydrationMode
HydrationMode_Immediate -> DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode (DocumentFragment -> Node)
-> DomRenderHookT t m DocumentFragment -> DomRenderHookT t m Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Document -> DomRenderHookT t m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment Document
doc
          IORef Word
unreadyChildren <- IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Word) -> DomRenderHookT t m (IORef Word))
-> IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall a b. (a -> b) -> a -> b
$ Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef Word
0
          let a0' :: HydrationDomBuilderT s t m a
a0' = case HydrationMode
h of
                HydrationMode
HydrationMode_Hydrating -> HydrationDomBuilderT s t m a
a0
                HydrationMode
HydrationMode_Immediate -> do
                  a
a <- HydrationDomBuilderT s t m a
a0
                  Node -> Text -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
insertBefore Node
p' (Text -> HydrationDomBuilderT s t m ())
-> HydrationDomBuilderT s t m Text -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Text -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Text -> IO Text
forall a. IORef a -> IO a
readIORef IORef Text
after)
                  a -> HydrationDomBuilderT s t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
          IORef (HydrationRunnerT t m ())
delayed <- case HydrationMode
h of
            HydrationMode
HydrationMode_Hydrating -> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HydrationRunnerT t m ()))
 -> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a. a -> IO (IORef a)
newIORef (HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ())))
-> HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            HydrationMode
HydrationMode_Immediate -> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IORef (HydrationRunnerT t m ())
 -> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed HydrationDomBuilderEnv t m
initialEnv
          a
result <- ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT HydrationDomBuilderT s t m a
a0') HydrationDomBuilderEnv t m
initialEnv
            { _hydrationDomBuilderEnv_unreadyChildren :: IORef Word
_hydrationDomBuilderEnv_unreadyChildren = IORef Word
unreadyChildren
            , _hydrationDomBuilderEnv_commitAction :: JSM ()
_hydrationDomBuilderEnv_commitAction = JSM ()
myCommitAction
            , _hydrationDomBuilderEnv_parent :: Either Node (IORef Node)
_hydrationDomBuilderEnv_parent = Node -> Either Node (IORef Node)
forall a b. a -> Either a b
Left Node
p'
            , _hydrationDomBuilderEnv_delayed :: IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed = IORef (HydrationRunnerT t m ())
delayed
            }
          HydrationRunnerT t m ()
dom <- case HydrationMode
h of
            HydrationMode
HydrationMode_Hydrating -> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HydrationRunnerT t m ())
 -> DomRenderHookT t m (HydrationRunnerT t m ()))
-> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ IORef (HydrationRunnerT t m ()) -> IO (HydrationRunnerT t m ())
forall a. IORef a -> IO a
readIORef IORef (HydrationRunnerT t m ())
delayed
            HydrationMode
HydrationMode_Immediate -> HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HydrationRunnerT t m ()
 -> DomRenderHookT t m (HydrationRunnerT t m ()))
-> HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          IO () -> DomRenderHookT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DomRenderHookT t m ()) -> IO () -> DomRenderHookT t m ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
unreadyChildren IO Word -> (Word -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Word
0 -> IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
            Word
_ -> IORef Word -> (Word -> Word) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Word
parentUnreadyChildren Word -> Word
forall a. Enum a => a -> a
succ
          (HydrationRunnerT t m (), a)
-> DomRenderHookT t m (HydrationRunnerT t m (), a)
forall (m :: * -> *) a. Monad m => a -> m a
return (HydrationRunnerT t m ()
dom, a
result)
    Event t (Int, HydrationDomBuilderT s t m b)
a'' <- Event t (HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT
     s t m (Event t (Int, HydrationDomBuilderT s t m b))
forall k (t :: k) (m :: * -> *) b a.
(Reflex t, MonadHold t m, MonadFix m, Num b) =>
Event t a -> m (Event t (b, a))
numberOccurrences Event t (HydrationDomBuilderT s t m b)
a'
    ((HydrationRunnerT t m ()
hydrate0, a
result0), Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
child') <- ReaderT
  (HydrationDomBuilderEnv t m)
  (DomRenderHookT t m)
  ((HydrationRunnerT t m (), a),
   Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> HydrationDomBuilderT
     s
     t
     m
     ((HydrationRunnerT t m (), a),
      Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
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)
   ((HydrationRunnerT t m (), a),
    Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
 -> HydrationDomBuilderT
      s
      t
      m
      ((HydrationRunnerT t m (), a),
       Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     ((HydrationRunnerT t m (), a),
      Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> HydrationDomBuilderT
     s
     t
     m
     ((HydrationRunnerT t m (), a),
      Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall a b. (a -> b) -> a -> b
$ DomRenderHookT
  t
  m
  ((HydrationRunnerT t m (), a),
   Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     ((HydrationRunnerT t m (), a),
      Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT
   t
   m
   ((HydrationRunnerT t m (), a),
    Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
 -> ReaderT
      (HydrationDomBuilderEnv t m)
      (DomRenderHookT t m)
      ((HydrationRunnerT t m (), a),
       Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)))
-> DomRenderHookT
     t
     m
     ((HydrationRunnerT t m (), a),
      Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     ((HydrationRunnerT t m (), a),
      Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall a b. (a -> b) -> a -> b
$ DomRenderHookT t m (HydrationRunnerT t m (), a)
-> Event
     t
     (DomRenderHookT
        t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> DomRenderHookT
     t
     m
     ((HydrationRunnerT t m (), a),
      Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace DomRenderHookT t m (HydrationRunnerT t m (), a)
drawInitialChild (Event
   t
   (DomRenderHookT
      t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
 -> DomRenderHookT
      t
      m
      ((HydrationRunnerT t m (), a),
       Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)))
-> Event
     t
     (DomRenderHookT
        t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> DomRenderHookT
     t
     m
     ((HydrationRunnerT t m (), a),
      Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall a b. (a -> b) -> a -> b
$ Event t (Int, HydrationDomBuilderT s t m b)
-> ((Int, HydrationDomBuilderT s t m b)
    -> DomRenderHookT
         t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> Event
     t
     (DomRenderHookT
        t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (Int, HydrationDomBuilderT s t m b)
a'' (((Int, HydrationDomBuilderT s t m b)
  -> DomRenderHookT
       t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
 -> Event
      t
      (DomRenderHookT
         t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)))
-> ((Int, HydrationDomBuilderT s t m b)
    -> DomRenderHookT
         t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> Event
     t
     (DomRenderHookT
        t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall a b. (a -> b) -> a -> b
$ \(Int
cohortId, HydrationDomBuilderT s t m b
child) -> do
      HydrationMode
h <- IO HydrationMode -> DomRenderHookT t m HydrationMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HydrationMode -> DomRenderHookT t m HydrationMode)
-> IO HydrationMode -> DomRenderHookT t m HydrationMode
forall a b. (a -> b) -> a -> b
$ IORef HydrationMode -> IO HydrationMode
forall a. IORef a -> IO a
readIORef IORef HydrationMode
hydrating
      Node
p' <- case HydrationMode
h of
        HydrationMode
HydrationMode_Hydrating -> Node -> DomRenderHookT t m Node
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
parent
        HydrationMode
HydrationMode_Immediate -> DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode (DocumentFragment -> Node)
-> DomRenderHookT t m DocumentFragment -> DomRenderHookT t m Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Document -> DomRenderHookT t m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment Document
doc
      IORef Word
unreadyChildren <- IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Word) -> DomRenderHookT t m (IORef Word))
-> IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall a b. (a -> b) -> a -> b
$ Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef Word
0
      let commitAction :: JSM ()
commitAction = do
            Int
c <- IO Int -> JSM Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> JSM Int) -> IO Int -> JSM Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
currentCohort
            Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cohortId) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do -- If a newer cohort has already been committed, just ignore this
              !Text
before' <- IO Text -> JSM Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> JSM Text) -> IO Text -> JSM Text
forall a b. (a -> b) -> a -> b
$ IORef Text -> IO Text
forall a. IORef a -> IO a
readIORef IORef Text
before
              !Text
after' <- IO Text -> JSM Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> JSM Text) -> IO Text -> JSM Text
forall a b. (a -> b) -> a -> b
$ IORef Text -> IO Text
forall a. IORef a -> IO a
readIORef IORef Text
after
              Text -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
deleteBetweenExclusive Text
before' Text
after'
              Node -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
insertBefore Node
p' Text
after'
              IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
currentCohort Int
cohortId
              JSM ()
myCommitAction
      IORef (HydrationRunnerT t m ())
delayed <- case HydrationMode
h of
        HydrationMode
HydrationMode_Hydrating -> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HydrationRunnerT t m ()))
 -> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a. a -> IO (IORef a)
newIORef (HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ())))
-> HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        HydrationMode
HydrationMode_Immediate -> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IORef (HydrationRunnerT t m ())
 -> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed HydrationDomBuilderEnv t m
initialEnv
      b
result <- ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) b
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (HydrationDomBuilderT s t m b
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) b
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT HydrationDomBuilderT s t m b
child) (HydrationDomBuilderEnv t m -> DomRenderHookT t m b)
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m b
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m
initialEnv
            { _hydrationDomBuilderEnv_unreadyChildren :: IORef Word
_hydrationDomBuilderEnv_unreadyChildren = IORef Word
unreadyChildren
            , _hydrationDomBuilderEnv_commitAction :: JSM ()
_hydrationDomBuilderEnv_commitAction = case HydrationMode
h of
              HydrationMode
HydrationMode_Hydrating -> JSM ()
myCommitAction
              HydrationMode
HydrationMode_Immediate -> JSM ()
commitAction
            , _hydrationDomBuilderEnv_parent :: Either Node (IORef Node)
_hydrationDomBuilderEnv_parent = Node -> Either Node (IORef Node)
forall a b. a -> Either a b
Left Node
p'
            , _hydrationDomBuilderEnv_delayed :: IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed = IORef (HydrationRunnerT t m ())
delayed
            }
      HydrationRunnerT t m ()
dom <- case HydrationMode
h of
        HydrationMode
HydrationMode_Hydrating -> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HydrationRunnerT t m ())
 -> DomRenderHookT t m (HydrationRunnerT t m ()))
-> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ IORef (HydrationRunnerT t m ()) -> IO (HydrationRunnerT t m ())
forall a. IORef a -> IO a
readIORef IORef (HydrationRunnerT t m ())
delayed
        HydrationMode
HydrationMode_Immediate -> HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HydrationRunnerT t m ()
 -> DomRenderHookT t m (HydrationRunnerT t m ()))
-> HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Word
uc <- IO Word -> DomRenderHookT t m Word
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> DomRenderHookT t m Word)
-> IO Word -> DomRenderHookT t m Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
unreadyChildren
      let commitActionToRunNow :: Maybe (JSM ())
commitActionToRunNow = if Word
uc Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
            then JSM () -> Maybe (JSM ())
forall a. a -> Maybe a
Just (JSM () -> Maybe (JSM ())) -> JSM () -> Maybe (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM ()
commitAction
            else Maybe (JSM ())
forall a. Maybe a
Nothing -- A child will run it when unreadyChildren is decremented to 0
          actions :: Either (HydrationRunnerT t m ()) (Maybe (JSM ()))
actions = case HydrationMode
h of
            HydrationMode
HydrationMode_Hydrating -> HydrationRunnerT t m ()
-> Either (HydrationRunnerT t m ()) (Maybe (JSM ()))
forall a b. a -> Either a b
Left HydrationRunnerT t m ()
dom
            HydrationMode
HydrationMode_Immediate -> Maybe (JSM ()) -> Either (HydrationRunnerT t m ()) (Maybe (JSM ()))
forall a b. b -> Either a b
Right Maybe (JSM ())
commitActionToRunNow
      (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
-> DomRenderHookT
     t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (HydrationRunnerT t m ()) (Maybe (JSM ()))
actions, b
result)
    let (Event t (HydrationRunnerT t m ())
hydrate', Event t (Maybe (JSM ()))
commitAction) = Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())))
-> (Event t (HydrationRunnerT t m ()), Event t (Maybe (JSM ())))
forall k (t :: k) a b.
Reflex t =>
Event t (Either a b) -> (Event t a, Event t b)
fanEither (Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())))
 -> (Event t (HydrationRunnerT t m ()), Event t (Maybe (JSM ()))))
-> Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())))
-> (Event t (HydrationRunnerT t m ()), Event t (Maybe (JSM ())))
forall a b. (a -> b) -> a -> b
$ ((Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
 -> Either (HydrationRunnerT t m ()) (Maybe (JSM ())))
-> Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
-> Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
-> Either (HydrationRunnerT t m ()) (Maybe (JSM ()))
forall a b. (a, b) -> a
fst Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
child'
    m (Behavior t (HydrationRunnerT t m ()))
-> (Behavior t (HydrationRunnerT t m ())
    -> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (HydrationRunnerT t m ()
-> Event t (HydrationRunnerT t m ())
-> m (Behavior t (HydrationRunnerT t m ()))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold HydrationRunnerT t m ()
hydrate0 Event t (HydrationRunnerT t m ())
hydrate') ((Behavior t (HydrationRunnerT t m ()) -> HydrationRunnerT t m ())
 -> HydrationDomBuilderT s t m ())
-> (Behavior t (HydrationRunnerT t m ())
    -> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ \Behavior t (HydrationRunnerT t m ())
contents -> do
      HydrationRunnerT t m ()
hydrateStart
      HydrationRunnerT t m (HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (HydrationRunnerT t m (HydrationRunnerT t m ())
 -> HydrationRunnerT t m ())
-> HydrationRunnerT t m (HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Behavior t (HydrationRunnerT t m ())
-> HydrationRunnerT t m (HydrationRunnerT t m ())
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t (HydrationRunnerT t m ())
contents
      HydrationRunnerT t m ()
hydrateEnd
    Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ())
-> Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ (Maybe (JSM ()) -> Maybe (JSM ()))
-> Event t (Maybe (JSM ())) -> Event t (JSM ())
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe Maybe (JSM ()) -> Maybe (JSM ())
forall a. a -> a
id Event t (Maybe (JSM ()))
commitAction
    (a, Event t b) -> HydrationDomBuilderT s t m (a, Event t b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
result0, (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b) -> b
forall a b. (a, b) -> b
snd ((Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b) -> b)
-> Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
-> Event t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
child')

  {-# INLINABLE traverseIntMapWithKeyWithAdjust #-}
  traverseIntMapWithKeyWithAdjust :: (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust = (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
forall k (s :: k) t (m :: * -> *) v v'.
(Adjustable t m, MonadJSM m, MonadFix m, PrimMonad m,
 MonadHold t m,
 RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document) =>
(Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust'
  {-# INLINABLE traverseDMapWithKeyWithAdjust #-}
  traverseDMapWithKeyWithAdjust :: (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust = (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
forall k (s :: k) t (m :: * -> *) (k :: * -> *) (v :: * -> *)
       (v' :: * -> *).
(Adjustable t m, MonadHold t m, MonadFix m, MonadJSM m,
 PrimMonad m, GCompare k,
 RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document) =>
(forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust'
  {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}
  traverseDMapWithKeyWithAdjustWithMove :: (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> HydrationDomBuilderT
     s t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove = do
    let updateChildUnreadiness :: PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness (PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p :: PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')) DMap k (Constant (IORef (ChildReadyState (Some k))))
old = do
          let new :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseChild t m (Some k)) v') a -> IO (PatchDMapWithMove.NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
              new :: k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
new k a
k = (From k (Compose (TraverseChild t m (Some k)) v') a
 -> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
forall k1 (f :: * -> *) (k2 :: k1 -> *) (v :: k1 -> *) (a :: k1)
       (v' :: k1 -> *).
Functor f =>
(From k2 v a -> f (From k2 v' a))
-> NodeInfo k2 v a -> f (NodeInfo k2 v' a)
PatchDMapWithMove.nodeInfoMapFromM ((From k (Compose (TraverseChild t m (Some k)) v') a
  -> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
 -> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
 -> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a))
-> (From k (Compose (TraverseChild t m (Some k)) v') a
    -> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a b. (a -> b) -> a -> b
$ \case
                PatchDMapWithMove.From_Insert (Compose (TraverseChild (Left TraverseChildHydration t m
_hydration) v' a
_)) -> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall (m :: * -> *) a. Monad m => a -> m a
return From k (Constant (IORef (ChildReadyState (Some k)))) a
forall a (k :: a -> *) (v :: a -> *) (b :: a). From k v b
PatchDMapWithMove.From_Delete
                PatchDMapWithMove.From_Insert (Compose (TraverseChild (Right TraverseChildImmediate (Some k)
immediate) v' a
_)) -> do
                  IORef (ChildReadyState (Some k)) -> IO (ChildReadyState (Some k))
forall a. IORef a -> IO a
readIORef (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate) IO (ChildReadyState (Some k))
-> (ChildReadyState (Some k)
    -> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    ChildReadyState (Some k)
ChildReadyState_Ready -> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall (m :: * -> *) a. Monad m => a -> m a
return From k (Constant (IORef (ChildReadyState (Some k)))) a
forall a (k :: a -> *) (v :: a -> *) (b :: a). From k v b
PatchDMapWithMove.From_Delete
                    ChildReadyState_Unready Maybe (Some k)
_ -> do
                      IORef (ChildReadyState (Some k))
-> ChildReadyState (Some k) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate) (ChildReadyState (Some k) -> IO ())
-> ChildReadyState (Some k) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Some k) -> ChildReadyState (Some k)
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe (Some k) -> ChildReadyState (Some k))
-> Maybe (Some k) -> ChildReadyState (Some k)
forall a b. (a -> b) -> a -> b
$ Some k -> Maybe (Some k)
forall a. a -> Maybe a
Just (Some k -> Maybe (Some k)) -> Some k -> Maybe (Some k)
forall a b. (a -> b) -> a -> b
$ k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k
                      From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (From k (Constant (IORef (ChildReadyState (Some k)))) a
 -> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a b. (a -> b) -> a -> b
$ Constant (IORef (ChildReadyState (Some k))) a
-> From k (Constant (IORef (ChildReadyState (Some k)))) a
forall a (v :: a -> *) (b :: a) (k :: a -> *). v b -> From k v b
PatchDMapWithMove.From_Insert (Constant (IORef (ChildReadyState (Some k))) a
 -> From k (Constant (IORef (ChildReadyState (Some k)))) a)
-> Constant (IORef (ChildReadyState (Some k))) a
-> From k (Constant (IORef (ChildReadyState (Some k)))) a
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState (Some k))
-> Constant (IORef (ChildReadyState (Some k))) a
forall k a (b :: k). a -> Constant a b
Constant (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate)
                From k (Compose (TraverseChild t m (Some k)) v') a
PatchDMapWithMove.From_Delete -> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall (m :: * -> *) a. Monad m => a -> m a
return From k (Constant (IORef (ChildReadyState (Some k)))) a
forall a (k :: a -> *) (v :: a -> *) (b :: a). From k v b
PatchDMapWithMove.From_Delete
                PatchDMapWithMove.From_Move k a
fromKey -> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (From k (Constant (IORef (ChildReadyState (Some k)))) a
 -> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a b. (a -> b) -> a -> b
$ k a -> From k (Constant (IORef (ChildReadyState (Some k)))) a
forall a (k :: a -> *) (b :: a) (v :: a -> *). k b -> From k v b
PatchDMapWithMove.From_Move k a
fromKey
              deleteOrMove :: forall a. k a -> Product (Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k) a -> IO (Constant () a)
              deleteOrMove :: k a
-> Product
     (Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k) a
-> IO (Constant () a)
deleteOrMove k a
_ (Pair (Constant IORef (ChildReadyState (Some k))
sRef) (ComposeMaybe Maybe (k a)
mToKey)) = do
                IORef (ChildReadyState (Some k))
-> ChildReadyState (Some k) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState (Some k))
sRef (ChildReadyState (Some k) -> IO ())
-> ChildReadyState (Some k) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Some k) -> ChildReadyState (Some k)
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe (Some k) -> ChildReadyState (Some k))
-> Maybe (Some k) -> ChildReadyState (Some k)
forall a b. (a -> b) -> a -> b
$ k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some (k a -> Some k) -> Maybe (k a) -> Maybe (Some k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (k a)
mToKey -- This will be Nothing if deleting, and Just if moving, so it works out in both cases
                Constant () a -> IO (Constant () a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant () a -> IO (Constant () a))
-> Constant () a -> IO (Constant () a)
forall a b. (a -> b) -> a -> b
$ () -> Constant () a
forall k a (b :: k). a -> Constant a b
Constant ()
          PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k))))
p' <- (DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))))
 -> PatchDMapWithMove
      k (Constant (IORef (ChildReadyState (Some k)))))
-> IO
     (DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
     (PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k)))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))))
-> PatchDMapWithMove
     k (Constant (IORef (ChildReadyState (Some k))))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *).
DMap k2 (NodeInfo k2 v) -> PatchDMapWithMove k2 v
unsafePatchDMapWithMove (IO
   (DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
 -> IO
      (PatchDMapWithMove
         k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
     (DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
     (PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ (forall v.
 k v
 -> NodeInfo k (Compose (TraverseChild t m (Some k)) v') v
 -> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) v))
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
-> IO
     (DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
       (g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey forall v.
k v
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') v
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) v)
new (DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
 -> IO
      (DMap
         k (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))))))
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
-> IO
     (DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
forall a b. (a -> b) -> a -> b
$ PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *).
PatchDMapWithMove k2 v -> DMap k2 (NodeInfo k2 v)
unPatchDMapWithMove PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p
          DMap k (Constant ())
_ <- (forall v.
 k v
 -> Product
      (Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k) v
 -> IO (Constant () v))
-> DMap
     k
     (Product
        (Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k))
-> IO (DMap k (Constant ()))
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
       (g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey forall v.
k v
-> Product
     (Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k) v
-> IO (Constant () v)
deleteOrMove (DMap
   k
   (Product
      (Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k))
 -> IO (DMap k (Constant ())))
-> DMap
     k
     (Product
        (Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k))
-> IO (DMap k (Constant ()))
forall a b. (a -> b) -> a -> b
$ PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> DMap
     k
     (Product
        (Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *) (v' :: k1 -> *).
GCompare k2 =>
PatchDMapWithMove k2 v
-> DMap k2 v' -> DMap k2 (Product v' (ComposeMaybe k2))
PatchDMapWithMove.getDeletionsAndMoves PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p DMap k (Constant (IORef (ChildReadyState (Some k))))
old
          DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall (m :: * -> *) a. Monad m => a -> m a
return (DMap k (Constant (IORef (ChildReadyState (Some k))))
 -> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k))))
-> PatchTarget
     (PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k)))))
-> PatchTarget
     (PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k)))))
forall p. Patch p => p -> PatchTarget p -> PatchTarget p
applyAlways PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k))))
p' DMap k (Constant (IORef (ChildReadyState (Some k))))
PatchTarget
  (PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k)))))
old
    (forall (vv :: * -> *) (vv' :: * -> *).
 (forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
 -> DMap k vv
 -> Event t (PatchDMapWithMove k vv)
 -> DomRenderHookT
      t m (DMap k vv', Event t (PatchDMapWithMove k vv')))
-> (forall (vv :: * -> *) (vv' :: * -> *).
    (forall a. vv a -> vv' a)
    -> PatchDMapWithMove k vv -> PatchDMapWithMove k vv')
-> (PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
    -> DMap k (Constant (IORef (ChildReadyState (Some k))))
    -> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
    -> Text
    -> PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
    -> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> HydrationDomBuilderT
     s t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall k k t (m :: * -> *) (k :: k -> *)
       (p :: (k -> *) -> (k -> *) -> *) (v :: k -> *) (v' :: k -> *)
       (s :: k).
(Adjustable t m, MonadHold t m, GCompare k, MonadIO m, MonadJSM m,
 PrimMonad m, MonadFix m, Patch (p k v), Patch (p k (Constant Int)),
 PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int),
 Patch (p k (Compose (TraverseChild t m (Some k)) v')),
 PatchTarget (p k (Compose (TraverseChild t m (Some k)) v'))
 ~ DMap k (Compose (TraverseChild t m (Some k)) v'),
 Monoid (p k (Compose (TraverseChild t m (Some k)) v')),
 RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document) =>
(forall (vv :: k -> *) (vv' :: k -> *).
 (forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
 -> DMap k vv
 -> Event t (p k vv)
 -> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
-> (forall (vv :: k -> *) (vv' :: k -> *).
    (forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv')
-> (p k (Compose (TraverseChild t m (Some k)) v')
    -> DMap k (Constant (IORef (ChildReadyState (Some k))))
    -> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
    -> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> (forall (a :: k).
    k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (p k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (p k v'))
hoistTraverseWithKeyWithAdjust forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (PatchDMapWithMove k vv)
-> DomRenderHookT
     t m (DMap k vv', Event t (PatchDMapWithMove k vv'))
traverseDMapWithKeyWithAdjustWithMove forall k1 (k2 :: k1 -> *) (v :: k1 -> *) (v' :: k1 -> *).
(forall (a :: k1). v a -> v' a)
-> PatchDMapWithMove k2 v -> PatchDMapWithMove k2 v'
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a)
-> PatchDMapWithMove k vv -> PatchDMapWithMove k vv'
mapPatchDMapWithMove PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness ((IORef (Map (Some k) Text)
  -> Text
  -> PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
  -> JSM ())
 -> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
 -> DMap k v
 -> Event t (PatchDMapWithMove k v)
 -> HydrationDomBuilderT
      s t m (DMap k v', Event t (PatchDMapWithMove k v')))
-> (IORef (Map (Some k) Text)
    -> Text
    -> PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
    -> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> HydrationDomBuilderT
     s t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall a b. (a -> b) -> a -> b
$ \IORef (Map (Some k) Text)
placeholders Text
lastPlaceholder (PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p_ :: PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')) -> do
      let p :: DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
p = PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *).
PatchDMapWithMove k2 v -> DMap k2 (NodeInfo k2 v)
unPatchDMapWithMove PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p_
      Map (Some k) Text
phsBefore <- IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map (Some k) Text) -> JSM (Map (Some k) Text))
-> IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> IO (Map (Some k) Text)
forall a. IORef a -> IO a
readIORef IORef (Map (Some k) Text)
placeholders
      let collectIfMoved :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseChild t m (Some k)) v') a -> JSM (Constant (Maybe DOM.DocumentFragment) a)
          collectIfMoved :: k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> JSM (Constant (Maybe DocumentFragment) a)
collectIfMoved k a
k NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
e = do
            let mThisPlaceholder :: Maybe Text
mThisPlaceholder = Some k -> Map (Some k) Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k) Map (Some k) Text
phsBefore -- Will be Nothing if this element wasn't present before
                nextPlaceholder :: Text
nextPlaceholder = Text -> ((Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
lastPlaceholder (Some k, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Some k -> Map (Some k) Text -> Maybe (Some k, Text)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGT (k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k) Map (Some k) Text
phsBefore
            case Maybe (k a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (k a) -> Bool) -> Maybe (k a) -> Bool
forall a b. (a -> b) -> a -> b
$ ComposeMaybe k a -> Maybe (k a)
forall k (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe (ComposeMaybe k a -> Maybe (k a))
-> ComposeMaybe k a -> Maybe (k a)
forall a b. (a -> b) -> a -> b
$ NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> ComposeMaybe k a
forall k1 (k2 :: k1 -> *) (v :: k1 -> *) (a :: k1).
NodeInfo k2 v a -> To k2 a
PatchDMapWithMove._nodeInfo_to NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
e of
              Bool
False -> do
                (Text -> JSM ()) -> Maybe Text -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`deleteUpTo` Text
nextPlaceholder) Maybe Text
mThisPlaceholder
                Constant (Maybe DocumentFragment) a
-> JSM (Constant (Maybe DocumentFragment) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant (Maybe DocumentFragment) a
 -> JSM (Constant (Maybe DocumentFragment) a))
-> Constant (Maybe DocumentFragment) a
-> JSM (Constant (Maybe DocumentFragment) a)
forall a b. (a -> b) -> a -> b
$ Maybe DocumentFragment -> Constant (Maybe DocumentFragment) a
forall k a (b :: k). a -> Constant a b
Constant Maybe DocumentFragment
forall a. Maybe a
Nothing
              Bool
True -> do
                Maybe DocumentFragment -> Constant (Maybe DocumentFragment) a
forall k a (b :: k). a -> Constant a b
Constant (Maybe DocumentFragment -> Constant (Maybe DocumentFragment) a)
-> JSM (Maybe DocumentFragment)
-> JSM (Constant (Maybe DocumentFragment) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> JSM DocumentFragment)
-> Maybe Text -> JSM (Maybe DocumentFragment)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Text -> JSM DocumentFragment
forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
start -> end -> m DocumentFragment
`collectUpTo` Text
nextPlaceholder) Maybe Text
mThisPlaceholder
      DMap k (Constant (Maybe DocumentFragment))
collected <- (forall v.
 k v
 -> NodeInfo k (Compose (TraverseChild t m (Some k)) v') v
 -> JSM (Constant (Maybe DocumentFragment) v))
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
-> JSM (DMap k (Constant (Maybe DocumentFragment)))
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
       (g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey forall v.
k v
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') v
-> JSM (Constant (Maybe DocumentFragment) v)
collectIfMoved DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
p
      let !phsAfter :: Map (Some k) Text
phsAfter = Map (Some k) Text -> Maybe (Map (Some k) Text) -> Map (Some k) Text
forall a. a -> Maybe a -> a
fromMaybe Map (Some k) Text
phsBefore (Maybe (Map (Some k) Text) -> Map (Some k) Text)
-> Maybe (Map (Some k) Text) -> Map (Some k) Text
forall a b. (a -> b) -> a -> b
$ PatchMapWithMove (Some k) Text
-> PatchTarget (PatchMapWithMove (Some k) Text)
-> Maybe (PatchTarget (PatchMapWithMove (Some k) Text))
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply PatchMapWithMove (Some k) Text
filtered Map (Some k) Text
PatchTarget (PatchMapWithMove (Some k) Text)
phsBefore
          weakened :: PatchMapWithMove (Some k) (Either (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
          weakened :: PatchMapWithMove
  (Some k)
  (Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened = (forall a.
 Compose (TraverseChild t m (Some k)) v' a
 -> Either
      (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> PatchMapWithMove
     (Some k)
     (Either
        (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *) v'.
(forall (a :: k1). v a -> v')
-> PatchDMapWithMove k2 v -> PatchMapWithMove (Some k2) v'
weakenPatchDMapWithMoveWith (TraverseChild t m (Some k) (v' a)
-> Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode (TraverseChild t m (Some k) (v' a)
 -> Either
      (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> (Compose (TraverseChild t m (Some k)) v' a
    -> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p_
          filtered :: PatchMapWithMove (Some k) DOM.Text
          filtered :: PatchMapWithMove (Some k) Text
filtered = Map (Some k) (NodeInfo (Some k) Text)
-> PatchMapWithMove (Some k) Text
forall k v. Map k (NodeInfo k v) -> PatchMapWithMove k v
PatchMapWithMove (Map (Some k) (NodeInfo (Some k) Text)
 -> PatchMapWithMove (Some k) Text)
-> Map (Some k) (NodeInfo (Some k) Text)
-> PatchMapWithMove (Some k) Text
forall a b. (a -> b) -> a -> b
$ ((NodeInfo
    (Some k)
    (Either
       (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
  -> Maybe (NodeInfo (Some k) Text))
 -> Map
      (Some k)
      (NodeInfo
         (Some k)
         (Either
            (TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
 -> Map (Some k) (NodeInfo (Some k) Text))
-> Map
     (Some k)
     (NodeInfo
        (Some k)
        (Either
           (TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> (NodeInfo
      (Some k)
      (Either
         (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
    -> Maybe (NodeInfo (Some k) Text))
-> Map (Some k) (NodeInfo (Some k) Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (NodeInfo
   (Some k)
   (Either
      (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
 -> Maybe (NodeInfo (Some k) Text))
-> Map
     (Some k)
     (NodeInfo
        (Some k)
        (Either
           (TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> Map (Some k) (NodeInfo (Some k) Text)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (PatchMapWithMove
  (Some k)
  (Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Map
     (Some k)
     (NodeInfo
        (Some k)
        (Either
           (TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
forall k v. PatchMapWithMove k v -> Map k (NodeInfo k v)
unPatchMapWithMove PatchMapWithMove
  (Some k)
  (Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened) ((NodeInfo
    (Some k)
    (Either
       (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
  -> Maybe (NodeInfo (Some k) Text))
 -> Map (Some k) (NodeInfo (Some k) Text))
-> (NodeInfo
      (Some k)
      (Either
         (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
    -> Maybe (NodeInfo (Some k) Text))
-> Map (Some k) (NodeInfo (Some k) Text)
forall a b. (a -> b) -> a -> b
$ \(PatchMapWithMove.NodeInfo From
  (Some k)
  (Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
from Maybe (Some k)
to) -> (From (Some k) Text -> Maybe (Some k) -> NodeInfo (Some k) Text)
-> Maybe (Some k) -> From (Some k) Text -> NodeInfo (Some k) Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip From (Some k) Text -> Maybe (Some k) -> NodeInfo (Some k) Text
forall k v. From k v -> To k -> NodeInfo k v
PatchMapWithMove.NodeInfo Maybe (Some k)
to (From (Some k) Text -> NodeInfo (Some k) Text)
-> Maybe (From (Some k) Text) -> Maybe (NodeInfo (Some k) Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case From
  (Some k)
  (Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
from of
            PatchMapWithMove.From_Insert (Left TraverseChildHydration t m
_hydration) -> Maybe (From (Some k) Text)
forall a. Maybe a
Nothing
            PatchMapWithMove.From_Insert (Right TraverseChildImmediate (Some k)
immediate) -> From (Some k) Text -> Maybe (From (Some k) Text)
forall a. a -> Maybe a
Just (From (Some k) Text -> Maybe (From (Some k) Text))
-> From (Some k) Text -> Maybe (From (Some k) Text)
forall a b. (a -> b) -> a -> b
$ Text -> From (Some k) Text
forall k v. v -> From k v
PatchMapWithMove.From_Insert (Text -> From (Some k) Text) -> Text -> From (Some k) Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate (Some k) -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate (Some k)
immediate
            From
  (Some k)
  (Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
PatchMapWithMove.From_Delete -> From (Some k) Text -> Maybe (From (Some k) Text)
forall a. a -> Maybe a
Just (From (Some k) Text -> Maybe (From (Some k) Text))
-> From (Some k) Text -> Maybe (From (Some k) Text)
forall a b. (a -> b) -> a -> b
$ From (Some k) Text
forall k v. From k v
PatchMapWithMove.From_Delete
            PatchMapWithMove.From_Move Some k
k -> From (Some k) Text -> Maybe (From (Some k) Text)
forall a. a -> Maybe a
Just (From (Some k) Text -> Maybe (From (Some k) Text))
-> From (Some k) Text -> Maybe (From (Some k) Text)
forall a b. (a -> b) -> a -> b
$ Some k -> From (Some k) Text
forall k v. k -> From k v
PatchMapWithMove.From_Move Some k
k
      let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseChild t m (Some k)) v') a -> JSM (Constant () a)
          placeFragment :: k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> JSM (Constant () a)
placeFragment k a
k NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
e = do
            let nextPlaceholder :: Text
nextPlaceholder = Text -> ((Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
lastPlaceholder (Some k, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Some k -> Map (Some k) Text -> Maybe (Some k, Text)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGT (k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k) Map (Some k) Text
phsAfter
            case NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> From k (Compose (TraverseChild t m (Some k)) v') a
forall k1 (k2 :: k1 -> *) (v :: k1 -> *) (a :: k1).
NodeInfo k2 v a -> From k2 v a
PatchDMapWithMove._nodeInfo_from NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
e of
              PatchDMapWithMove.From_Insert (Compose (TraverseChild Either
  (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
x v' a
_)) -> case Either
  (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
x of
                Left TraverseChildHydration t m
_ -> () -> JSM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                Right TraverseChildImmediate (Some k)
immediate -> TraverseChildImmediate (Some k) -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate (Some k)
immediate DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`insertBefore` Text
nextPlaceholder
              From k (Compose (TraverseChild t m (Some k)) v') a
PatchDMapWithMove.From_Delete -> do
                () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              PatchDMapWithMove.From_Move k a
fromKey -> do
                Just (Constant mdf) <- Maybe (Constant (Maybe DocumentFragment) a)
-> JSM (Maybe (Constant (Maybe DocumentFragment) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Constant (Maybe DocumentFragment) a)
 -> JSM (Maybe (Constant (Maybe DocumentFragment) a)))
-> Maybe (Constant (Maybe DocumentFragment) a)
-> JSM (Maybe (Constant (Maybe DocumentFragment) a))
forall a b. (a -> b) -> a -> b
$ k a
-> DMap k (Constant (Maybe DocumentFragment))
-> Maybe (Constant (Maybe DocumentFragment) a)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup k a
fromKey DMap k (Constant (Maybe DocumentFragment))
collected
                (DocumentFragment -> JSM ()) -> Maybe DocumentFragment -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`insertBefore` Text
nextPlaceholder) Maybe DocumentFragment
mdf
            Constant () a -> JSM (Constant () a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant () a -> JSM (Constant () a))
-> Constant () a -> JSM (Constant () a)
forall a b. (a -> b) -> a -> b
$ () -> Constant () a
forall k a (b :: k). a -> Constant a b
Constant ()
      (DSum k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
 -> JSM ())
-> [DSum k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))]
-> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(k a
k :=> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
v) -> JSM (Constant () a) -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM (Constant () a) -> JSM ()) -> JSM (Constant () a) -> JSM ()
forall a b. (a -> b) -> a -> b
$ k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> JSM (Constant () a)
forall a.
k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> JSM (Constant () a)
placeFragment k a
k NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
v) ([DSum k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))]
 -> JSM ())
-> [DSum k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))]
-> JSM ()
forall a b. (a -> b) -> a -> b
$ DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
-> [DSum k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toDescList DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
p -- We need to go in reverse order here, to make sure the placeholders are in the right spot at the right time
      IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> Map (Some k) Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map (Some k) Text)
placeholders (Map (Some k) Text -> IO ()) -> Map (Some k) Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Map (Some k) Text
phsAfter

{-# INLINABLE traverseDMapWithKeyWithAdjust' #-}
traverseDMapWithKeyWithAdjust'
  :: forall s t m (k :: * -> *) v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadJSM m, PrimMonad m, GCompare k, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)
  => (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
  -> DMap k v
  -> Event t (PatchDMap k v)
  -> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust' :: (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust' = do
  let updateChildUnreadiness :: PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness (PatchDMap k (Compose (TraverseChild t m (Some k)) v')
p :: PatchDMap k (Compose (TraverseChild t m (Some k)) v')) DMap k (Constant (IORef (ChildReadyState (Some k))))
old = do
        let new :: forall a. k a -> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') a -> IO (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
            new :: k a
-> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') a
-> IO
     (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
new k a
k (ComposeMaybe Maybe (Compose (TraverseChild t m (Some k)) v' a)
m) = Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a
forall k (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (Maybe (Constant (IORef (ChildReadyState (Some k))) a)
 -> ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
-> IO
     (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe (Compose (TraverseChild t m (Some k)) v' a)
m of
              Maybe (Compose (TraverseChild t m (Some k)) v' a)
Nothing -> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a. Maybe a
Nothing
              Just (Compose (TraverseChild (Left TraverseChildHydration t m
_hydration) v' a
_)) -> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a. Maybe a
Nothing
              Just (Compose (TraverseChild (Right TraverseChildImmediate (Some k)
immediate) v' a
_)) -> do
                IORef (ChildReadyState (Some k)) -> IO (ChildReadyState (Some k))
forall a. IORef a -> IO a
readIORef (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate) IO (ChildReadyState (Some k))
-> (ChildReadyState (Some k)
    -> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a)))
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  ChildReadyState (Some k)
ChildReadyState_Ready -> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a. Maybe a
Nothing -- Delete this child, since it's ready
                  ChildReadyState_Unready Maybe (Some k)
_ -> do
                    IORef (ChildReadyState (Some k))
-> ChildReadyState (Some k) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate) (ChildReadyState (Some k) -> IO ())
-> ChildReadyState (Some k) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Some k) -> ChildReadyState (Some k)
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe (Some k) -> ChildReadyState (Some k))
-> Maybe (Some k) -> ChildReadyState (Some k)
forall a b. (a -> b) -> a -> b
$ Some k -> Maybe (Some k)
forall a. a -> Maybe a
Just (Some k -> Maybe (Some k)) -> Some k -> Maybe (Some k)
forall a b. (a -> b) -> a -> b
$ k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k
                    Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Constant (IORef (ChildReadyState (Some k))) a)
 -> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a)))
-> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall a b. (a -> b) -> a -> b
$ Constant (IORef (ChildReadyState (Some k))) a
-> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a. a -> Maybe a
Just (Constant (IORef (ChildReadyState (Some k))) a
 -> Maybe (Constant (IORef (ChildReadyState (Some k))) a))
-> Constant (IORef (ChildReadyState (Some k))) a
-> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState (Some k))
-> Constant (IORef (ChildReadyState (Some k))) a
forall k a (b :: k). a -> Constant a b
Constant (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate)
            delete :: p -> Constant (IORef (ChildReadyState a)) b -> IO (Constant () b)
delete p
_ (Constant IORef (ChildReadyState a)
sRef) = do
              IORef (ChildReadyState a) -> ChildReadyState a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState a)
sRef (ChildReadyState a -> IO ()) -> ChildReadyState a -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe a -> ChildReadyState a
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready Maybe a
forall a. Maybe a
Nothing
              Constant () b -> IO (Constant () b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant () b -> IO (Constant () b))
-> Constant () b -> IO (Constant () b)
forall a b. (a -> b) -> a -> b
$ () -> Constant () b
forall k a (b :: k). a -> Constant a b
Constant ()
        PatchDMap k (Constant (IORef (ChildReadyState (Some k))))
p' <- (DMap
   k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))))
 -> PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
-> IO
     (DMap
        k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
-> IO (PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DMap k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))))
-> PatchDMap k (Constant (IORef (ChildReadyState (Some k))))
forall k (k1 :: k -> *) (v :: k -> *).
DMap k1 (ComposeMaybe v) -> PatchDMap k1 v
PatchDMap (IO
   (DMap
      k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
 -> IO (PatchDMap k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
     (DMap
        k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
-> IO (PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ (forall v.
 k v
 -> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') v
 -> IO
      (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v))
-> DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> IO
     (DMap
        k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
       (g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey forall v.
k v
-> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') v
-> IO
     (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v)
new (DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
 -> IO
      (DMap
         k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))))))
-> DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> IO
     (DMap
        k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
forall a b. (a -> b) -> a -> b
$ PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *).
PatchDMap k2 v -> DMap k2 (ComposeMaybe v)
unPatchDMap PatchDMap k (Compose (TraverseChild t m (Some k)) v')
p
        DMap k (Constant ())
_ <- (forall v.
 k v
 -> Constant (IORef (ChildReadyState (Some k))) v
 -> IO (Constant () v))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant ()))
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
       (g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey forall v.
k v
-> Constant (IORef (ChildReadyState (Some k))) v
-> IO (Constant () v)
forall k k p a (b :: k) (b :: k).
p -> Constant (IORef (ChildReadyState a)) b -> IO (Constant () b)
delete (DMap k (Constant (IORef (ChildReadyState (Some k))))
 -> IO (DMap k (Constant ())))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant ()))
forall a b. (a -> b) -> a -> b
$ PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *) (v' :: k1 -> *).
GCompare k2 =>
PatchDMap k2 v -> DMap k2 v' -> DMap k2 v'
PatchDMap.getDeletions PatchDMap k (Compose (TraverseChild t m (Some k)) v')
p DMap k (Constant (IORef (ChildReadyState (Some k))))
old
        DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall (m :: * -> *) a. Monad m => a -> m a
return (DMap k (Constant (IORef (ChildReadyState (Some k))))
 -> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ PatchDMap k (Constant (IORef (ChildReadyState (Some k))))
-> PatchTarget
     (PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
-> PatchTarget
     (PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
forall p. Patch p => p -> PatchTarget p -> PatchTarget p
applyAlways PatchDMap k (Constant (IORef (ChildReadyState (Some k))))
p' DMap k (Constant (IORef (ChildReadyState (Some k))))
PatchTarget
  (PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
old
  (forall (vv :: * -> *) (vv' :: * -> *).
 (forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
 -> DMap k vv
 -> Event t (PatchDMap k vv)
 -> DomRenderHookT t m (DMap k vv', Event t (PatchDMap k vv')))
-> (forall (vv :: * -> *) (vv' :: * -> *).
    (forall a. vv a -> vv' a) -> PatchDMap k vv -> PatchDMap k vv')
-> (PatchDMap k (Compose (TraverseChild t m (Some k)) v')
    -> DMap k (Constant (IORef (ChildReadyState (Some k))))
    -> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
    -> Text
    -> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
    -> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
forall k k t (m :: * -> *) (k :: k -> *)
       (p :: (k -> *) -> (k -> *) -> *) (v :: k -> *) (v' :: k -> *)
       (s :: k).
(Adjustable t m, MonadHold t m, GCompare k, MonadIO m, MonadJSM m,
 PrimMonad m, MonadFix m, Patch (p k v), Patch (p k (Constant Int)),
 PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int),
 Patch (p k (Compose (TraverseChild t m (Some k)) v')),
 PatchTarget (p k (Compose (TraverseChild t m (Some k)) v'))
 ~ DMap k (Compose (TraverseChild t m (Some k)) v'),
 Monoid (p k (Compose (TraverseChild t m (Some k)) v')),
 RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document) =>
(forall (vv :: k -> *) (vv' :: k -> *).
 (forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
 -> DMap k vv
 -> Event t (p k vv)
 -> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
-> (forall (vv :: k -> *) (vv' :: k -> *).
    (forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv')
-> (p k (Compose (TraverseChild t m (Some k)) v')
    -> DMap k (Constant (IORef (ChildReadyState (Some k))))
    -> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
    -> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> (forall (a :: k).
    k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (p k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (p k v'))
hoistTraverseWithKeyWithAdjust forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (PatchDMap k vv)
-> DomRenderHookT t m (DMap k vv', Event t (PatchDMap k vv'))
traverseDMapWithKeyWithAdjust forall k1 (v :: k1 -> *) (v' :: k1 -> *) (k2 :: k1 -> *).
(forall (a :: k1). v a -> v' a)
-> PatchDMap k2 v -> PatchDMap k2 v'
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a) -> PatchDMap k vv -> PatchDMap k vv'
mapPatchDMap PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness ((IORef (Map (Some k) Text)
  -> Text
  -> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
  -> JSM ())
 -> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
 -> DMap k v
 -> Event t (PatchDMap k v)
 -> HydrationDomBuilderT
      s t m (DMap k v', Event t (PatchDMap k v')))
-> (IORef (Map (Some k) Text)
    -> Text
    -> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
    -> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
forall a b. (a -> b) -> a -> b
$ \IORef (Map (Some k) Text)
placeholders Text
lastPlaceholder (PatchDMap DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
patch) -> do
    Map (Some k) Text
phs <- IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map (Some k) Text) -> JSM (Map (Some k) Text))
-> IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> IO (Map (Some k) Text)
forall a. IORef a -> IO a
readIORef IORef (Map (Some k) Text)
placeholders
    [DSum k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))]
-> (DSum k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
    -> JSM ())
-> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> [DSum
      k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
patch) ((DSum k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
  -> JSM ())
 -> JSM ())
-> (DSum k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
    -> JSM ())
-> JSM ()
forall a b. (a -> b) -> a -> b
$ \(k a
k :=> ComposeMaybe Maybe (Compose (TraverseChild t m (Some k)) v' a)
mv) -> do
      let nextPlaceholder :: Text
nextPlaceholder = Text -> ((Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
lastPlaceholder (Some k, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Some k -> Map (Some k) Text -> Maybe (Some k, Text)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGT (k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k) Map (Some k) Text
phs
      -- Delete old node
      Maybe Text -> (Text -> JSM ()) -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Some k -> Map (Some k) Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k) Map (Some k) Text
phs) ((Text -> JSM ()) -> JSM ()) -> (Text -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \Text
thisPlaceholder -> do
        Text
thisPlaceholder Text -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`deleteUpTo` Text
nextPlaceholder
      -- Insert new node
      Maybe (Compose (TraverseChild t m (Some k)) v' a)
-> (Compose (TraverseChild t m (Some k)) v' a -> JSM ()) -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Compose (TraverseChild t m (Some k)) v' a)
mv ((Compose (TraverseChild t m (Some k)) v' a -> JSM ()) -> JSM ())
-> (Compose (TraverseChild t m (Some k)) v' a -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \(Compose (TraverseChild Either
  (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
e v' a
_)) -> case Either
  (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
e of
        Left TraverseChildHydration t m
_hydration -> () -> JSM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Right TraverseChildImmediate (Some k)
immediate -> do
          TraverseChildImmediate (Some k) -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate (Some k)
immediate DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`insertBefore` Text
nextPlaceholder
    let weakened :: PatchMap (Some k) (Either (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
        weakened :: PatchMap
  (Some k)
  (Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened = (forall a.
 Compose (TraverseChild t m (Some k)) v' a
 -> Either
      (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> PatchMap
     (Some k)
     (Either
        (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
forall k1 (v :: k1 -> *) v' (k2 :: k1 -> *).
(forall (a :: k1). v a -> v')
-> PatchDMap k2 v -> PatchMap (Some k2) v'
weakenPatchDMapWith (TraverseChild t m (Some k) (v' a)
-> Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode (TraverseChild t m (Some k) (v' a)
 -> Either
      (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> (Compose (TraverseChild t m (Some k)) v' a
    -> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (PatchDMap k (Compose (TraverseChild t m (Some k)) v')
 -> PatchMap
      (Some k)
      (Either
         (TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> PatchMap
     (Some k)
     (Either
        (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
forall a b. (a -> b) -> a -> b
$ DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
forall k (k1 :: k -> *) (v :: k -> *).
DMap k1 (ComposeMaybe v) -> PatchDMap k1 v
PatchDMap DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
patch
        filtered :: PatchMap (Some k) DOM.Text
        filtered :: PatchMap (Some k) Text
filtered = Map (Some k) (Maybe Text) -> PatchMap (Some k) Text
forall k v. Map k (Maybe v) -> PatchMap k v
PatchMap (Map (Some k) (Maybe Text) -> PatchMap (Some k) Text)
-> Map (Some k) (Maybe Text) -> PatchMap (Some k) Text
forall a b. (a -> b) -> a -> b
$ ((Maybe
    (Either
       (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
  -> Maybe (Maybe Text))
 -> Map
      (Some k)
      (Maybe
         (Either
            (TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
 -> Map (Some k) (Maybe Text))
-> Map
     (Some k)
     (Maybe
        (Either
           (TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> (Maybe
      (Either
         (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
    -> Maybe (Maybe Text))
-> Map (Some k) (Maybe Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe
   (Either
      (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
 -> Maybe (Maybe Text))
-> Map
     (Some k)
     (Maybe
        (Either
           (TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> Map (Some k) (Maybe Text)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (PatchMap
  (Some k)
  (Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Map
     (Some k)
     (Maybe
        (Either
           (TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
forall k v. PatchMap k v -> Map k (Maybe v)
unPatchMap PatchMap
  (Some k)
  (Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened) ((Maybe
    (Either
       (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
  -> Maybe (Maybe Text))
 -> Map (Some k) (Maybe Text))
-> (Maybe
      (Either
         (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
    -> Maybe (Maybe Text))
-> Map (Some k) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \case
          Maybe
  (Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
Nothing -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
forall a. Maybe a
Nothing -- deletion
          Just (Left TraverseChildHydration t m
_) -> Maybe (Maybe Text)
forall a. Maybe a
Nothing
          Just (Right TraverseChildImmediate (Some k)
immediate) -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Maybe Text -> Maybe (Maybe Text))
-> Maybe Text -> Maybe (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate (Some k) -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate (Some k)
immediate
    IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> Map (Some k) Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map (Some k) Text)
placeholders (Map (Some k) Text -> IO ()) -> Map (Some k) Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Map (Some k) Text -> Maybe (Map (Some k) Text) -> Map (Some k) Text
forall a. a -> Maybe a -> a
fromMaybe Map (Some k) Text
phs (Maybe (Map (Some k) Text) -> Map (Some k) Text)
-> Maybe (Map (Some k) Text) -> Map (Some k) Text
forall a b. (a -> b) -> a -> b
$ PatchMap (Some k) Text
-> PatchTarget (PatchMap (Some k) Text)
-> Maybe (PatchTarget (PatchMap (Some k) Text))
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply PatchMap (Some k) Text
filtered Map (Some k) Text
PatchTarget (PatchMap (Some k) Text)
phs

{-# INLINABLE traverseIntMapWithKeyWithAdjust' #-}
traverseIntMapWithKeyWithAdjust'
  :: forall s t m v v'. (Adjustable t m, MonadJSM m, MonadFix m, PrimMonad m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)
  => (IntMap.Key -> v -> HydrationDomBuilderT s t m v')
  -> IntMap v
  -> Event t (PatchIntMap v)
  -> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust' :: (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust' = do
  let updateChildUnreadiness :: PatchIntMap (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
updateChildUnreadiness (p :: PatchIntMap (TraverseChild t m Int v')
p@(PatchIntMap IntMap (Maybe (TraverseChild t m Int v'))
pInner) :: PatchIntMap (TraverseChild t m Int v')) IntMap (IORef (ChildReadyState Int))
old = do
        let new :: IntMap.Key -> Maybe (TraverseChild t m Int v') -> IO (Maybe (IORef (ChildReadyState Int)))
            new :: Int
-> Maybe (TraverseChild t m Int v')
-> IO (Maybe (IORef (ChildReadyState Int)))
new Int
k Maybe (TraverseChild t m Int v')
m = case Maybe (TraverseChild t m Int v')
m of
              Maybe (TraverseChild t m Int v')
Nothing -> Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IORef (ChildReadyState Int))
forall a. Maybe a
Nothing
              Just (TraverseChild (Left TraverseChildHydration t m
_hydration) v'
_) -> Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (IORef (ChildReadyState Int))
forall a. Maybe a
Nothing
              Just (TraverseChild (Right TraverseChildImmediate Int
immediate) v'
_) -> do
                let sRef :: IORef (ChildReadyState Int)
sRef = TraverseChildImmediate Int -> IORef (ChildReadyState Int)
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate Int
immediate
                IORef (ChildReadyState Int) -> IO (ChildReadyState Int)
forall a. IORef a -> IO a
readIORef IORef (ChildReadyState Int)
sRef IO (ChildReadyState Int)
-> (ChildReadyState Int
    -> IO (Maybe (IORef (ChildReadyState Int))))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  ChildReadyState Int
ChildReadyState_Ready -> Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IORef (ChildReadyState Int))
forall a. Maybe a
Nothing -- Delete this child, since it's ready
                  ChildReadyState_Unready Maybe Int
_ -> do
                    IORef (ChildReadyState Int) -> ChildReadyState Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState Int)
sRef (ChildReadyState Int -> IO ()) -> ChildReadyState Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Int -> ChildReadyState Int
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe Int -> ChildReadyState Int)
-> Maybe Int -> ChildReadyState Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
k
                    Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IORef (ChildReadyState Int))
 -> IO (Maybe (IORef (ChildReadyState Int))))
-> Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState Int) -> Maybe (IORef (ChildReadyState Int))
forall a. a -> Maybe a
Just IORef (ChildReadyState Int)
sRef
            delete :: p -> IORef (ChildReadyState a) -> IO ()
delete p
_ IORef (ChildReadyState a)
sRef = do
              IORef (ChildReadyState a) -> ChildReadyState a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState a)
sRef (ChildReadyState a -> IO ()) -> ChildReadyState a -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe a -> ChildReadyState a
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready Maybe a
forall a. Maybe a
Nothing
              () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        PatchIntMap (IORef (ChildReadyState Int))
p' <- IntMap (Maybe (IORef (ChildReadyState Int)))
-> PatchIntMap (IORef (ChildReadyState Int))
forall a. IntMap (Maybe a) -> PatchIntMap a
PatchIntMap (IntMap (Maybe (IORef (ChildReadyState Int)))
 -> PatchIntMap (IORef (ChildReadyState Int)))
-> IO (IntMap (Maybe (IORef (ChildReadyState Int))))
-> IO (PatchIntMap (IORef (ChildReadyState Int)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int
 -> Maybe (TraverseChild t m Int v')
 -> IO (Maybe (IORef (ChildReadyState Int))))
-> IntMap (Maybe (TraverseChild t m Int v'))
-> IO (IntMap (Maybe (IORef (ChildReadyState Int))))
forall (t :: * -> *) a b.
Applicative t =>
(Int -> a -> t b) -> IntMap a -> t (IntMap b)
IntMap.traverseWithKey Int
-> Maybe (TraverseChild t m Int v')
-> IO (Maybe (IORef (ChildReadyState Int)))
new IntMap (Maybe (TraverseChild t m Int v'))
pInner
        IntMap ()
_ <- (Int -> IORef (ChildReadyState Int) -> IO ())
-> IntMap (IORef (ChildReadyState Int)) -> IO (IntMap ())
forall (t :: * -> *) a b.
Applicative t =>
(Int -> a -> t b) -> IntMap a -> t (IntMap b)
IntMap.traverseWithKey Int -> IORef (ChildReadyState Int) -> IO ()
forall p a. p -> IORef (ChildReadyState a) -> IO ()
delete (IntMap (IORef (ChildReadyState Int)) -> IO (IntMap ()))
-> IntMap (IORef (ChildReadyState Int)) -> IO (IntMap ())
forall a b. (a -> b) -> a -> b
$ PatchIntMap (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IntMap (IORef (ChildReadyState Int))
forall v v'. PatchIntMap v -> IntMap v' -> IntMap v'
FastMutableIntMap.getDeletions PatchIntMap (TraverseChild t m Int v')
p IntMap (IORef (ChildReadyState Int))
old
        IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap (IORef (ChildReadyState Int))
 -> IO (IntMap (IORef (ChildReadyState Int))))
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
forall a b. (a -> b) -> a -> b
$ PatchIntMap (IORef (ChildReadyState Int))
-> PatchTarget (PatchIntMap (IORef (ChildReadyState Int)))
-> PatchTarget (PatchIntMap (IORef (ChildReadyState Int)))
forall p. Patch p => p -> PatchTarget p -> PatchTarget p
applyAlways PatchIntMap (IORef (ChildReadyState Int))
p' IntMap (IORef (ChildReadyState Int))
PatchTarget (PatchIntMap (IORef (ChildReadyState Int)))
old
  ((Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
 -> IntMap v
 -> Event t (PatchIntMap v)
 -> DomRenderHookT
      t
      m
      (IntMap (TraverseChild t m Int v'),
       Event t (PatchIntMap (TraverseChild t m Int v'))))
-> (PatchIntMap (TraverseChild t m Int v')
    -> IntMap (IORef (ChildReadyState Int))
    -> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap Text)
    -> Text -> PatchIntMap (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
forall k t (m :: * -> *) (p :: * -> *) v' (s :: k) v.
(Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m,
 PrimMonad m, Monoid (p (TraverseChild t m Int v')), Functor p,
 PatchTarget (p (HydrationRunnerT t m ()))
 ~ IntMap (HydrationRunnerT t m ()),
 PatchTarget (p (TraverseChild t m Int v'))
 ~ IntMap (TraverseChild t m Int v'),
 Patch (p (HydrationRunnerT t m ())),
 Patch (p (TraverseChild t m Int v')),
 RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
 ~ Document) =>
((Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
 -> IntMap v
 -> Event t (p v)
 -> DomRenderHookT
      t
      m
      (IntMap (TraverseChild t m Int v'),
       Event t (p (TraverseChild t m Int v'))))
-> (p (TraverseChild t m Int v')
    -> IntMap (IORef (ChildReadyState Int))
    -> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap Text)
    -> Text -> p (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (p v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (p v'))
hoistTraverseIntMapWithKeyWithAdjust (Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (PatchIntMap v)
-> DomRenderHookT
     t
     m
     (IntMap (TraverseChild t m Int v'),
      Event t (PatchIntMap (TraverseChild t m Int v')))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Int -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust PatchIntMap (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
updateChildUnreadiness ((IORef (IntMap Text)
  -> Text -> PatchIntMap (TraverseChild t m Int v') -> JSM ())
 -> (Int -> v -> HydrationDomBuilderT s t m v')
 -> IntMap v
 -> Event t (PatchIntMap v)
 -> HydrationDomBuilderT
      s t m (IntMap v', Event t (PatchIntMap v')))
-> (IORef (IntMap Text)
    -> Text -> PatchIntMap (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
forall a b. (a -> b) -> a -> b
$ \IORef (IntMap Text)
placeholders Text
lastPlaceholder (PatchIntMap IntMap (Maybe (TraverseChild t m Int v'))
p) -> do
    IntMap Text
phs <- IO (IntMap Text) -> JSM (IntMap Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IntMap Text) -> JSM (IntMap Text))
-> IO (IntMap Text) -> JSM (IntMap Text)
forall a b. (a -> b) -> a -> b
$ IORef (IntMap Text) -> IO (IntMap Text)
forall a. IORef a -> IO a
readIORef IORef (IntMap Text)
placeholders
    [(Int, Maybe (TraverseChild t m Int v'))]
-> ((Int, Maybe (TraverseChild t m Int v')) -> JSM ()) -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (IntMap (Maybe (TraverseChild t m Int v'))
-> [(Int, Maybe (TraverseChild t m Int v'))]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap (Maybe (TraverseChild t m Int v'))
p) (((Int, Maybe (TraverseChild t m Int v')) -> JSM ()) -> JSM ())
-> ((Int, Maybe (TraverseChild t m Int v')) -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \(Int
k, Maybe (TraverseChild t m Int v')
mv) -> do
      let nextPlaceholder :: Text
nextPlaceholder = Text -> ((Int, Text) -> Text) -> Maybe (Int, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
lastPlaceholder (Int, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Int, Text) -> Text) -> Maybe (Int, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Int -> IntMap Text -> Maybe (Int, Text)
forall a. Int -> IntMap a -> Maybe (Int, a)
IntMap.lookupGT Int
k IntMap Text
phs
      -- Delete old node
      Maybe Text -> (Text -> JSM ()) -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int -> IntMap Text -> Maybe Text
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
k IntMap Text
phs) ((Text -> JSM ()) -> JSM ()) -> (Text -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \Text
thisPlaceholder -> Text
thisPlaceholder Text -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`deleteUpTo` Text
nextPlaceholder
      -- Insert new node
      Maybe (TraverseChild t m Int v')
-> (TraverseChild t m Int v' -> JSM ()) -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (TraverseChild t m Int v')
mv ((TraverseChild t m Int v' -> JSM ()) -> JSM ())
-> (TraverseChild t m Int v' -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \(TraverseChild Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
e v'
_) -> case Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
e of
        Left TraverseChildHydration t m
_hydration -> () -> JSM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Right TraverseChildImmediate Int
immediate -> do
          TraverseChildImmediate Int -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate Int
immediate DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`insertBefore` Text
nextPlaceholder
    let filtered :: PatchIntMap DOM.Text
        filtered :: PatchIntMap Text
filtered = IntMap (Maybe Text) -> PatchIntMap Text
forall a. IntMap (Maybe a) -> PatchIntMap a
PatchIntMap (IntMap (Maybe Text) -> PatchIntMap Text)
-> IntMap (Maybe Text) -> PatchIntMap Text
forall a b. (a -> b) -> a -> b
$ ((Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
 -> IntMap (Maybe (TraverseChild t m Int v'))
 -> IntMap (Maybe Text))
-> IntMap (Maybe (TraverseChild t m Int v'))
-> (Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
-> IntMap (Maybe Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
-> IntMap (Maybe (TraverseChild t m Int v')) -> IntMap (Maybe Text)
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe IntMap (Maybe (TraverseChild t m Int v'))
p ((Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
 -> IntMap (Maybe Text))
-> (Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
-> IntMap (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \case
          Maybe (TraverseChild t m Int v')
Nothing -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
forall a. Maybe a
Nothing -- deletion
          Just TraverseChild t m Int v'
tc
            | Right TraverseChildImmediate Int
immediate <- TraverseChild t m Int v'
-> Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode TraverseChild t m Int v'
tc -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Maybe Text -> Maybe (Maybe Text))
-> Maybe Text -> Maybe (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate Int -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate Int
immediate
            | Bool
otherwise -> Maybe (Maybe Text)
forall a. Maybe a
Nothing
    IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef (IntMap Text) -> IntMap Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap Text)
placeholders (IntMap Text -> IO ()) -> IntMap Text -> IO ()
forall a b. (a -> b) -> a -> b
$! IntMap Text -> Maybe (IntMap Text) -> IntMap Text
forall a. a -> Maybe a -> a
fromMaybe IntMap Text
phs (Maybe (IntMap Text) -> IntMap Text)
-> Maybe (IntMap Text) -> IntMap Text
forall a b. (a -> b) -> a -> b
$ PatchIntMap Text
-> PatchTarget (PatchIntMap Text)
-> Maybe (PatchTarget (PatchIntMap Text))
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply PatchIntMap Text
filtered IntMap Text
PatchTarget (PatchIntMap Text)
phs

{-# SPECIALIZE traverseIntMapWithKeyWithAdjust'
  :: (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM v')
  -> IntMap v
  -> Event DomTimeline (PatchIntMap v)
  -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
  #-}

{-# SPECIALIZE traverseIntMapWithKeyWithAdjust'
  :: (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM v')
  -> IntMap v
  -> Event DomTimeline (PatchIntMap v)
  -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
  #-}

data ChildReadyState a
   = ChildReadyState_Ready
   | ChildReadyState_Unready !(Maybe a)
   deriving (Int -> ChildReadyState a -> ShowS
[ChildReadyState a] -> ShowS
ChildReadyState a -> String
(Int -> ChildReadyState a -> ShowS)
-> (ChildReadyState a -> String)
-> ([ChildReadyState a] -> ShowS)
-> Show (ChildReadyState a)
forall a. Show a => Int -> ChildReadyState a -> ShowS
forall a. Show a => [ChildReadyState a] -> ShowS
forall a. Show a => ChildReadyState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChildReadyState a] -> ShowS
$cshowList :: forall a. Show a => [ChildReadyState a] -> ShowS
show :: ChildReadyState a -> String
$cshow :: forall a. Show a => ChildReadyState a -> String
showsPrec :: Int -> ChildReadyState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ChildReadyState a -> ShowS
Show, ReadPrec [ChildReadyState a]
ReadPrec (ChildReadyState a)
Int -> ReadS (ChildReadyState a)
ReadS [ChildReadyState a]
(Int -> ReadS (ChildReadyState a))
-> ReadS [ChildReadyState a]
-> ReadPrec (ChildReadyState a)
-> ReadPrec [ChildReadyState a]
-> Read (ChildReadyState a)
forall a. Read a => ReadPrec [ChildReadyState a]
forall a. Read a => ReadPrec (ChildReadyState a)
forall a. Read a => Int -> ReadS (ChildReadyState a)
forall a. Read a => ReadS [ChildReadyState a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChildReadyState a]
$creadListPrec :: forall a. Read a => ReadPrec [ChildReadyState a]
readPrec :: ReadPrec (ChildReadyState a)
$creadPrec :: forall a. Read a => ReadPrec (ChildReadyState a)
readList :: ReadS [ChildReadyState a]
$creadList :: forall a. Read a => ReadS [ChildReadyState a]
readsPrec :: Int -> ReadS (ChildReadyState a)
$creadsPrec :: forall a. Read a => Int -> ReadS (ChildReadyState a)
Read, ChildReadyState a -> ChildReadyState a -> Bool
(ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> Eq (ChildReadyState a)
forall a. Eq a => ChildReadyState a -> ChildReadyState a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChildReadyState a -> ChildReadyState a -> Bool
$c/= :: forall a. Eq a => ChildReadyState a -> ChildReadyState a -> Bool
== :: ChildReadyState a -> ChildReadyState a -> Bool
$c== :: forall a. Eq a => ChildReadyState a -> ChildReadyState a -> Bool
Eq, Eq (ChildReadyState a)
Eq (ChildReadyState a)
-> (ChildReadyState a -> ChildReadyState a -> Ordering)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> ChildReadyState a)
-> (ChildReadyState a -> ChildReadyState a -> ChildReadyState a)
-> Ord (ChildReadyState a)
ChildReadyState a -> ChildReadyState a -> Bool
ChildReadyState a -> ChildReadyState a -> Ordering
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ChildReadyState a)
forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> Ordering
forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
min :: ChildReadyState a -> ChildReadyState a -> ChildReadyState a
$cmin :: forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
max :: ChildReadyState a -> ChildReadyState a -> ChildReadyState a
$cmax :: forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
>= :: ChildReadyState a -> ChildReadyState a -> Bool
$c>= :: forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
> :: ChildReadyState a -> ChildReadyState a -> Bool
$c> :: forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
<= :: ChildReadyState a -> ChildReadyState a -> Bool
$c<= :: forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
< :: ChildReadyState a -> ChildReadyState a -> Bool
$c< :: forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
compare :: ChildReadyState a -> ChildReadyState a -> Ordering
$ccompare :: forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (ChildReadyState a)
Ord)

insertAfterPreviousNode :: (Monad m, MonadJSM m) => DOM.IsNode node => node -> HydrationRunnerT t m ()
insertAfterPreviousNode :: node -> HydrationRunnerT t m ()
insertAfterPreviousNode node
node = do
  Node
parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
  Maybe Node
nextNode <- HydrationRunnerT t m (Maybe Node)
-> (Node -> HydrationRunnerT t m (Maybe Node))
-> Maybe Node
-> HydrationRunnerT t m (Maybe Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getFirstChild Node
parent) Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling (Maybe Node -> HydrationRunnerT t m (Maybe Node))
-> HydrationRunnerT t m (Maybe Node)
-> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) t.
Monad m =>
HydrationRunnerT t m (Maybe Node)
getPreviousNode
  Node -> node -> Maybe Node -> HydrationRunnerT t m ()
forall (m :: * -> *) self node child.
(MonadDOM m, IsNode self, IsNode node, IsNode child) =>
self -> node -> Maybe child -> m ()
Node.insertBefore_ Node
parent node
node Maybe Node
nextNode
  Maybe Node -> HydrationRunnerT t m ()
forall (m :: * -> *) t.
Monad m =>
Maybe Node -> HydrationRunnerT t m ()
setPreviousNode (Maybe Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ node -> Node
forall o. IsNode o => o -> Node
toNode node
node

{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}
hoistTraverseWithKeyWithAdjust
  ::
  ( Adjustable t m
  , MonadHold t m
  , GCompare k
  , MonadIO m
  , MonadJSM m
  , PrimMonad m
  , MonadFix m
  , Patch (p k v)
  , Patch (p k (Constant Int))
  , PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)
  , Patch (p k (Compose (TraverseChild t m (Some k)) v'))
  , PatchTarget (p k (Compose (TraverseChild t m (Some k)) v')) ~ DMap k (Compose (TraverseChild t m (Some k)) v')
  , Monoid (p k (Compose (TraverseChild t m (Some k)) v'))
  , RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document
  )
  => (forall vv vv'.
         (forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
      -> DMap k vv
      -> Event t (p k vv)
      -> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
  -- ^ The base monad's traversal
  -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv')
  -- ^ A way of mapping over the patch type
  -> (p k (Compose (TraverseChild t m (Some k)) v') -> DMap k (Constant (IORef (ChildReadyState (Some k)))) -> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
  -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state
  -> (IORef (Map.Map (Some k) DOM.Text) -> DOM.Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
  -- ^ Apply a patch to the DOM
  -> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
  -> DMap k v
  -> Event t (p k v)
  -> HydrationDomBuilderT s t m (DMap k v', Event t (p k v'))
hoistTraverseWithKeyWithAdjust :: (forall (vv :: k -> *) (vv' :: k -> *).
 (forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
 -> DMap k vv
 -> Event t (p k vv)
 -> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
-> (forall (vv :: k -> *) (vv' :: k -> *).
    (forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv')
-> (p k (Compose (TraverseChild t m (Some k)) v')
    -> DMap k (Constant (IORef (ChildReadyState (Some k))))
    -> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
    -> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> (forall (a :: k).
    k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (p k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (p k v'))
hoistTraverseWithKeyWithAdjust forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> DomRenderHookT t m (DMap k vv', Event t (p k vv'))
base forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv'
mapPatch p k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness IORef (Map (Some k) Text)
-> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ()
applyDomUpdate_ forall (a :: k). k a -> v a -> HydrationDomBuilderT s t m (v' a)
f DMap k v
dm0 Event t (p k v)
dm' = do
  Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  HydrationDomBuilderEnv t m
initialEnv <- ReaderT
  (HydrationDomBuilderEnv t m)
  (DomRenderHookT t m)
  (HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s 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
  let parentUnreadyChildren :: IORef Word
parentUnreadyChildren = HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren HydrationDomBuilderEnv t m
initialEnv
  IORef
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState (Some k)))), p k (Compose (TraverseChild t m (Some k)) v')) <- IO
  (IORef
     (DMap k (Constant (IORef (ChildReadyState (Some k)))),
      p k (Compose (TraverseChild t m (Some k)) v')))
-> HydrationDomBuilderT
     s
     t
     m
     (IORef
        (DMap k (Constant (IORef (ChildReadyState (Some k)))),
         p k (Compose (TraverseChild t m (Some k)) v')))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (IORef
      (DMap k (Constant (IORef (ChildReadyState (Some k)))),
       p k (Compose (TraverseChild t m (Some k)) v')))
 -> HydrationDomBuilderT
      s
      t
      m
      (IORef
         (DMap k (Constant (IORef (ChildReadyState (Some k)))),
          p k (Compose (TraverseChild t m (Some k)) v'))))
-> IO
     (IORef
        (DMap k (Constant (IORef (ChildReadyState (Some k)))),
         p k (Compose (TraverseChild t m (Some k)) v')))
-> HydrationDomBuilderT
     s
     t
     m
     (IORef
        (DMap k (Constant (IORef (ChildReadyState (Some k)))),
         p k (Compose (TraverseChild t m (Some k)) v')))
forall a b. (a -> b) -> a -> b
$ (DMap k (Constant (IORef (ChildReadyState (Some k)))),
 p k (Compose (TraverseChild t m (Some k)) v'))
-> IO
     (IORef
        (DMap k (Constant (IORef (ChildReadyState (Some k)))),
         p k (Compose (TraverseChild t m (Some k)) v')))
forall a. a -> IO (IORef a)
newIORef (DMap k (Constant (IORef (ChildReadyState (Some k)))),
 p k (Compose (TraverseChild t m (Some k)) v'))
forall a. Monoid a => a
mempty
  IORef Bool
haveEverBeenReady <- IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool))
-> IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  IORef (Map (Some k) Text)
placeholders <- IO (IORef (Map (Some k) Text))
-> HydrationDomBuilderT s t m (IORef (Map (Some k) Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Map (Some k) Text))
 -> HydrationDomBuilderT s t m (IORef (Map (Some k) Text)))
-> IO (IORef (Map (Some k) Text))
-> HydrationDomBuilderT s t m (IORef (Map (Some k) Text))
forall a b. (a -> b) -> a -> b
$ Map (Some k) Text -> IO (IORef (Map (Some k) Text))
forall a. a -> IO (IORef a)
newIORef Map (Some k) Text
forall k a. Map k a
Map.empty
  Text
lastPlaceholder <- Document -> Text -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
  let applyDomUpdate :: p k (Compose (TraverseChild t m (Some k)) v') -> JSM ()
applyDomUpdate p k (Compose (TraverseChild t m (Some k)) v')
p = do
        IORef (Map (Some k) Text)
-> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ()
applyDomUpdate_ IORef (Map (Some k) Text)
placeholders Text
lastPlaceholder p k (Compose (TraverseChild t m (Some k)) v')
p
        JSM ()
markSelfReady
        IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
-> (DMap k (Constant (IORef (ChildReadyState (Some k)))),
    p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange ((DMap k (Constant (IORef (ChildReadyState (Some k)))),
  p k (Compose (TraverseChild t m (Some k)) v'))
 -> IO ())
-> (DMap k (Constant (IORef (ChildReadyState (Some k)))),
    p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ()
forall a b. (a -> b) -> a -> b
$! (DMap k (Constant (IORef (ChildReadyState (Some k)))),
 p k (Compose (TraverseChild t m (Some k)) v'))
forall a. Monoid a => a
mempty
      markSelfReady :: JSM ()
markSelfReady = do
        IO Bool -> JSM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
haveEverBeenReady) JSM Bool -> (Bool -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Bool
False -> do
            IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
            Word
old <- IO Word -> JSM Word
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> JSM Word) -> IO Word -> JSM Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
parentUnreadyChildren
            let new :: Word
new = Word -> Word
forall a. Enum a => a -> a
pred Word
old
            IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> Word -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Word
parentUnreadyChildren (Word -> IO ()) -> Word -> IO ()
forall a b. (a -> b) -> a -> b
$! Word
new
            Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
new Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> JSM ()
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> JSM ()
_hydrationDomBuilderEnv_commitAction HydrationDomBuilderEnv t m
initialEnv
      markChildReady :: IORef (ChildReadyState (Some k)) -> JSM ()
      markChildReady :: IORef (ChildReadyState (Some k)) -> JSM ()
markChildReady IORef (ChildReadyState (Some k))
childReadyState = do
        IO (ChildReadyState (Some k)) -> JSM (ChildReadyState (Some k))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (ChildReadyState (Some k)) -> IO (ChildReadyState (Some k))
forall a. IORef a -> IO a
readIORef IORef (ChildReadyState (Some k))
childReadyState) JSM (ChildReadyState (Some k))
-> (ChildReadyState (Some k) -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          ChildReadyState (Some k)
ChildReadyState_Ready -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          ChildReadyState_Unready Maybe (Some k)
countedAt -> do
            IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState (Some k))
-> ChildReadyState (Some k) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState (Some k))
childReadyState ChildReadyState (Some k)
forall a. ChildReadyState a
ChildReadyState_Ready
            case Maybe (Some k)
countedAt of
              Maybe (Some k)
Nothing -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Just (Some k a
k) -> do -- This child has been counted as unready, so we need to remove it from the unready set
                (DMap k (Constant (IORef (ChildReadyState (Some k))))
oldUnready, p k (Compose (TraverseChild t m (Some k)) v')
p) <- IO
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
     (DMap k (Constant (IORef (ChildReadyState (Some k)))),
      p k (Compose (TraverseChild t m (Some k)) v'))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (DMap k (Constant (IORef (ChildReadyState (Some k)))),
    p k (Compose (TraverseChild t m (Some k)) v'))
 -> JSM
      (DMap k (Constant (IORef (ChildReadyState (Some k)))),
       p k (Compose (TraverseChild t m (Some k)) v')))
-> IO
     (DMap k (Constant (IORef (ChildReadyState (Some k)))),
      p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
     (DMap k (Constant (IORef (ChildReadyState (Some k)))),
      p k (Compose (TraverseChild t m (Some k)) v'))
forall a b. (a -> b) -> a -> b
$ IORef
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
-> IO
     (DMap k (Constant (IORef (ChildReadyState (Some k)))),
      p k (Compose (TraverseChild t m (Some k)) v'))
forall a. IORef a -> IO a
readIORef IORef
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange
                Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ DMap k (Constant (IORef (ChildReadyState (Some k)))) -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k (Constant (IORef (ChildReadyState (Some k))))
oldUnready) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do -- This shouldn't actually ever be null
                  let newUnready :: DMap k (Constant (IORef (ChildReadyState (Some k))))
newUnready = k a
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> DMap k2 f
DMap.delete k a
k DMap k (Constant (IORef (ChildReadyState (Some k))))
oldUnready
                  IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
-> (DMap k (Constant (IORef (ChildReadyState (Some k)))),
    p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange (DMap k (Constant (IORef (ChildReadyState (Some k))))
newUnready, p k (Compose (TraverseChild t m (Some k)) v')
p)
                  Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DMap k (Constant (IORef (ChildReadyState (Some k)))) -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k (Constant (IORef (ChildReadyState (Some k))))
newUnready) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
                    p k (Compose (TraverseChild t m (Some k)) v') -> JSM ()
applyDomUpdate p k (Compose (TraverseChild t m (Some k)) v')
p
  (DMap k (Compose (TraverseChild t m (Some k)) v')
children0 :: DMap k (Compose (TraverseChild t m (Some k)) v'), Event t (p k (Compose (TraverseChild t m (Some k)) v'))
children' :: Event t (p k (Compose (TraverseChild t m (Some k)) v')))
    <- ReaderT
  (HydrationDomBuilderEnv t m)
  (DomRenderHookT t m)
  (DMap k (Compose (TraverseChild t m (Some k)) v'),
   Event t (p k (Compose (TraverseChild t m (Some k)) v')))
-> HydrationDomBuilderT
     s
     t
     m
     (DMap k (Compose (TraverseChild t m (Some k)) v'),
      Event t (p k (Compose (TraverseChild t m (Some k)) v')))
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)
   (DMap k (Compose (TraverseChild t m (Some k)) v'),
    Event t (p k (Compose (TraverseChild t m (Some k)) v')))
 -> HydrationDomBuilderT
      s
      t
      m
      (DMap k (Compose (TraverseChild t m (Some k)) v'),
       Event t (p k (Compose (TraverseChild t m (Some k)) v'))))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (DMap k (Compose (TraverseChild t m (Some k)) v'),
      Event t (p k (Compose (TraverseChild t m (Some k)) v')))
-> HydrationDomBuilderT
     s
     t
     m
     (DMap k (Compose (TraverseChild t m (Some k)) v'),
      Event t (p k (Compose (TraverseChild t m (Some k)) v')))
forall a b. (a -> b) -> a -> b
$ DomRenderHookT
  t
  m
  (DMap k (Compose (TraverseChild t m (Some k)) v'),
   Event t (p k (Compose (TraverseChild t m (Some k)) v')))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (DMap k (Compose (TraverseChild t m (Some k)) v'),
      Event t (p k (Compose (TraverseChild t m (Some k)) v')))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT
   t
   m
   (DMap k (Compose (TraverseChild t m (Some k)) v'),
    Event t (p k (Compose (TraverseChild t m (Some k)) v')))
 -> ReaderT
      (HydrationDomBuilderEnv t m)
      (DomRenderHookT t m)
      (DMap k (Compose (TraverseChild t m (Some k)) v'),
       Event t (p k (Compose (TraverseChild t m (Some k)) v'))))
-> DomRenderHookT
     t
     m
     (DMap k (Compose (TraverseChild t m (Some k)) v'),
      Event t (p k (Compose (TraverseChild t m (Some k)) v')))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (DMap k (Compose (TraverseChild t m (Some k)) v'),
      Event t (p k (Compose (TraverseChild t m (Some k)) v')))
forall a b. (a -> b) -> a -> b
$ (forall (a :: k).
 k a
 -> v a
 -> DomRenderHookT t m (Compose (TraverseChild t m (Some k)) v' a))
-> DMap k v
-> Event t (p k v)
-> DomRenderHookT
     t
     m
     (DMap k (Compose (TraverseChild t m (Some k)) v'),
      Event t (p k (Compose (TraverseChild t m (Some k)) v')))
forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> DomRenderHookT t m (DMap k vv', Event t (p k vv'))
base (\k a
k v a
v -> HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState (Some k)) -> JSM ())
-> HydrationDomBuilderT s t m (v' a)
-> DomRenderHookT t m (Compose (TraverseChild t m (Some k)) v' a)
forall k k1 (m :: * -> *) t k (s :: k) (f :: k1 -> *) (a :: k1).
(MonadJSM m, Reflex t) =>
HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (f a)
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
drawChildUpdate HydrationDomBuilderEnv t m
initialEnv IORef (ChildReadyState (Some k)) -> JSM ()
markChildReady (HydrationDomBuilderT s t m (v' a)
 -> DomRenderHookT t m (Compose (TraverseChild t m (Some k)) v' a))
-> HydrationDomBuilderT s t m (v' a)
-> DomRenderHookT t m (Compose (TraverseChild t m (Some k)) v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> HydrationDomBuilderT s t m (v' a)
forall (a :: k). k a -> v a -> HydrationDomBuilderT s t m (v' a)
f k a
k v a
v) DMap k v
dm0 Event t (p k v)
dm'
  let processChild :: tag a
-> Compose (TraverseChild t m (Some tag)) g a
-> IO
     (ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
processChild tag a
k (Compose (TraverseChild Either
  (TraverseChildHydration t m) (TraverseChildImmediate (Some tag))
e g a
_)) = case Either
  (TraverseChildHydration t m) (TraverseChildImmediate (Some tag))
e of
        Left TraverseChildHydration t m
_ -> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
-> IO
     (ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
 -> IO
      (ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a))
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
-> IO
     (ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
forall a b. (a -> b) -> a -> b
$ Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
forall k (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
forall a. Maybe a
Nothing
        Right TraverseChildImmediate (Some tag)
immediate -> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
forall k (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
 -> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
-> IO
     (ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
          IORef (ChildReadyState (Some tag))
-> IO (ChildReadyState (Some tag))
forall a. IORef a -> IO a
readIORef (TraverseChildImmediate (Some tag)
-> IORef (ChildReadyState (Some tag))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some tag)
immediate) IO (ChildReadyState (Some tag))
-> (ChildReadyState (Some tag)
    -> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a)))
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            ChildReadyState (Some tag)
ChildReadyState_Ready -> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
forall a. Maybe a
Nothing
            ChildReadyState_Unready Maybe (Some tag)
_ -> do
              IORef (ChildReadyState (Some tag))
-> ChildReadyState (Some tag) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TraverseChildImmediate (Some tag)
-> IORef (ChildReadyState (Some tag))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some tag)
immediate) (ChildReadyState (Some tag) -> IO ())
-> ChildReadyState (Some tag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Some tag) -> ChildReadyState (Some tag)
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe (Some tag) -> ChildReadyState (Some tag))
-> Maybe (Some tag) -> ChildReadyState (Some tag)
forall a b. (a -> b) -> a -> b
$ Some tag -> Maybe (Some tag)
forall a. a -> Maybe a
Just (Some tag -> Maybe (Some tag)) -> Some tag -> Maybe (Some tag)
forall a b. (a -> b) -> a -> b
$ tag a -> Some tag
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some tag a
k
              Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
 -> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a)))
-> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
forall a b. (a -> b) -> a -> b
$ Constant (IORef (ChildReadyState (Some tag))) a
-> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
forall a. a -> Maybe a
Just (Constant (IORef (ChildReadyState (Some tag))) a
 -> Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
-> Constant (IORef (ChildReadyState (Some tag))) a
-> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState (Some tag))
-> Constant (IORef (ChildReadyState (Some tag))) a
forall k a (b :: k). a -> Constant a b
Constant (TraverseChildImmediate (Some tag)
-> IORef (ChildReadyState (Some tag))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some tag)
immediate)
  DMap k (Constant (IORef (ChildReadyState (Some k))))
initialUnready <- IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
-> HydrationDomBuilderT
     s t m (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
 -> HydrationDomBuilderT
      s t m (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
-> HydrationDomBuilderT
     s t m (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ (forall (v :: k).
 k v
 -> ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v
 -> Maybe (Constant (IORef (ChildReadyState (Some k))) v))
-> DMap
     k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> Maybe (g v))
-> DMap k2 f -> DMap k2 g
DMap.mapMaybeWithKey (\k v
_ -> ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v
-> Maybe (Constant (IORef (ChildReadyState (Some k))) v)
forall k (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe) (DMap
   k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))))
 -> DMap k (Constant (IORef (ChildReadyState (Some k)))))
-> IO
     (DMap
        k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (v :: k).
 k v
 -> Compose (TraverseChild t m (Some k)) v' v
 -> IO
      (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v))
-> DMap k (Compose (TraverseChild t m (Some k)) v')
-> IO
     (DMap
        k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
       (g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey forall (v :: k).
k v
-> Compose (TraverseChild t m (Some k)) v' v
-> IO
     (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v)
forall k k1 k (tag :: k -> *) (a :: k) t (m :: * -> *)
       (g :: k1 -> *) (a :: k1) (a :: k).
tag a
-> Compose (TraverseChild t m (Some tag)) g a
-> IO
     (ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
processChild DMap k (Compose (TraverseChild t m (Some k)) v')
children0
  IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ if DMap k (Constant (IORef (ChildReadyState (Some k)))) -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k (Constant (IORef (ChildReadyState (Some k))))
initialUnready
    then IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
    else do
      IORef Word -> (Word -> Word) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Word
parentUnreadyChildren Word -> Word
forall a. Enum a => a -> a
succ
      IORef
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
-> (DMap k (Constant (IORef (ChildReadyState (Some k)))),
    p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange (DMap k (Constant (IORef (ChildReadyState (Some k))))
initialUnready, p k (Compose (TraverseChild t m (Some k)) v')
forall a. Monoid a => a
mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time
  HydrationDomBuilderT s t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT s t m HydrationMode
-> (HydrationMode -> HydrationDomBuilderT s t m ())
-> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    HydrationMode
HydrationMode_Hydrating -> m (Incremental t (p k (Compose (TraverseChild t m (Some k)) v')))
-> (Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
    -> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (PatchTarget (p k (Compose (TraverseChild t m (Some k)) v'))
-> Event t (p k (Compose (TraverseChild t m (Some k)) v'))
-> m (Incremental
        t (p k (Compose (TraverseChild t m (Some k)) v')))
forall k (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental DMap k (Compose (TraverseChild t m (Some k)) v')
PatchTarget (p k (Compose (TraverseChild t m (Some k)) v'))
children0 Event t (p k (Compose (TraverseChild t m (Some k)) v'))
children') ((Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
  -> HydrationRunnerT t m ())
 -> HydrationDomBuilderT s t m ())
-> (Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
    -> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ \Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
children -> do
      DMap k (Compose (TraverseChild t m (Some k)) v')
dm :: DMap k (Compose (TraverseChild t m (Some k)) v') <- Behavior t (DMap k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT
     t m (DMap k (Compose (TraverseChild t m (Some k)) v'))
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t (DMap k (Compose (TraverseChild t m (Some k)) v'))
 -> HydrationRunnerT
      t m (DMap k (Compose (TraverseChild t m (Some k)) v')))
-> Behavior t (DMap k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT
     t m (DMap k (Compose (TraverseChild t m (Some k)) v'))
forall a b. (a -> b) -> a -> b
$ Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
-> Behavior
     t (PatchTarget (p k (Compose (TraverseChild t m (Some k)) v')))
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Behavior t (PatchTarget p)
currentIncremental Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
children
      Map (Some k) Text
phs <- Map (Some k) (HydrationRunnerT t m Text)
-> HydrationRunnerT t m (Map (Some k) Text)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Map (Some k) (HydrationRunnerT t m Text)
 -> HydrationRunnerT t m (Map (Some k) Text))
-> Map (Some k) (HydrationRunnerT t m Text)
-> HydrationRunnerT t m (Map (Some k) Text)
forall a b. (a -> b) -> a -> b
$ (forall (a :: k).
 Compose (TraverseChild t m (Some k)) v' a
 -> HydrationRunnerT t m Text)
-> DMap k (Compose (TraverseChild t m (Some k)) v')
-> Map (Some k) (HydrationRunnerT t m Text)
forall k1 (v :: k1 -> *) v' (k2 :: k1 -> *).
(forall (a :: k1). v a -> v') -> DMap k2 v -> Map (Some k2) v'
weakenDMapWith ((TraverseChildHydration t m -> HydrationRunnerT t m Text)
-> (TraverseChildImmediate (Some k) -> HydrationRunnerT t m Text)
-> Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
-> HydrationRunnerT t m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TraverseChildHydration t m -> HydrationRunnerT t m Text
forall t (m :: * -> *).
TraverseChildHydration t m -> HydrationRunnerT t m Text
_traverseChildHydration_delayed (Text -> HydrationRunnerT t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HydrationRunnerT t m Text)
-> (TraverseChildImmediate (Some k) -> Text)
-> TraverseChildImmediate (Some k)
-> HydrationRunnerT t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChildImmediate (Some k) -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder) (Either
   (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
 -> HydrationRunnerT t m Text)
-> (Compose (TraverseChild t m (Some k)) v' a
    -> Either
         (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Compose (TraverseChild t m (Some k)) v' a
-> HydrationRunnerT t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChild t m (Some k) (v' a)
-> Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode (TraverseChild t m (Some k) (v' a)
 -> Either
      (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> (Compose (TraverseChild t m (Some k)) v' a
    -> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) DMap k (Compose (TraverseChild t m (Some k)) v')
dm
      IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> Map (Some k) Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map (Some k) Text)
placeholders (Map (Some k) Text -> IO ()) -> Map (Some k) Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Map (Some k) Text
phs
      Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
lastPlaceholder
    HydrationMode
HydrationMode_Immediate -> do
      let activate :: TraverseChildImmediate k -> HydrationDomBuilderT s t m Text
activate TraverseChildImmediate k
i = do
            Node -> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT s t m ())
-> Node -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode (DocumentFragment -> Node) -> DocumentFragment -> Node
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate k -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate k
i
            Text -> HydrationDomBuilderT s t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HydrationDomBuilderT s t m Text)
-> Text -> HydrationDomBuilderT s t m Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate k -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate k
i
      Map (Some k) Text
phs <- Map (Some k) (HydrationDomBuilderT s t m Text)
-> HydrationDomBuilderT s t m (Map (Some k) Text)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Map (Some k) (HydrationDomBuilderT s t m Text)
 -> HydrationDomBuilderT s t m (Map (Some k) Text))
-> Map (Some k) (HydrationDomBuilderT s t m Text)
-> HydrationDomBuilderT s t m (Map (Some k) Text)
forall a b. (a -> b) -> a -> b
$ (forall (a :: k).
 Compose (TraverseChild t m (Some k)) v' a
 -> HydrationDomBuilderT s t m Text)
-> DMap k (Compose (TraverseChild t m (Some k)) v')
-> Map (Some k) (HydrationDomBuilderT s t m Text)
forall k1 (v :: k1 -> *) v' (k2 :: k1 -> *).
(forall (a :: k1). v a -> v') -> DMap k2 v -> Map (Some k2) v'
weakenDMapWith ((TraverseChildHydration t m -> HydrationDomBuilderT s t m Text)
-> (TraverseChildImmediate (Some k)
    -> HydrationDomBuilderT s t m Text)
-> Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
-> HydrationDomBuilderT s t m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String
-> TraverseChildHydration t m -> HydrationDomBuilderT s t m Text
forall a. HasCallStack => String -> a
error String
"impossible") TraverseChildImmediate (Some k) -> HydrationDomBuilderT s t m Text
forall k (m :: * -> *) k (s :: k) t.
MonadJSM m =>
TraverseChildImmediate k -> HydrationDomBuilderT s t m Text
activate (Either
   (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
 -> HydrationDomBuilderT s t m Text)
-> (Compose (TraverseChild t m (Some k)) v' a
    -> Either
         (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Compose (TraverseChild t m (Some k)) v' a
-> HydrationDomBuilderT s t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChild t m (Some k) (v' a)
-> Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode (TraverseChild t m (Some k) (v' a)
 -> Either
      (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> (Compose (TraverseChild t m (Some k)) v' a
    -> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> Either
     (TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) DMap k (Compose (TraverseChild t m (Some k)) v')
children0
      IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> Map (Some k) Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map (Some k) Text)
placeholders (Map (Some k) Text -> IO ()) -> Map (Some k) Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Map (Some k) Text
phs
      Node -> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT s t m ())
-> Node -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Text -> Node
forall o. IsNode o => o -> Node
toNode Text
lastPlaceholder
  Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ())
-> Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Event t (p k (Compose (TraverseChild t m (Some k)) v'))
-> (p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p k (Compose (TraverseChild t m (Some k)) v'))
children' ((p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
 -> Event t (JSM ()))
-> (p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \p k (Compose (TraverseChild t m (Some k)) v')
p -> do
    (DMap k (Constant (IORef (ChildReadyState (Some k))))
oldUnready, p k (Compose (TraverseChild t m (Some k)) v')
oldP) <- IO
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
     (DMap k (Constant (IORef (ChildReadyState (Some k)))),
      p k (Compose (TraverseChild t m (Some k)) v'))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (DMap k (Constant (IORef (ChildReadyState (Some k)))),
    p k (Compose (TraverseChild t m (Some k)) v'))
 -> JSM
      (DMap k (Constant (IORef (ChildReadyState (Some k)))),
       p k (Compose (TraverseChild t m (Some k)) v')))
-> IO
     (DMap k (Constant (IORef (ChildReadyState (Some k)))),
      p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
     (DMap k (Constant (IORef (ChildReadyState (Some k)))),
      p k (Compose (TraverseChild t m (Some k)) v'))
forall a b. (a -> b) -> a -> b
$ IORef
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
-> IO
     (DMap k (Constant (IORef (ChildReadyState (Some k)))),
      p k (Compose (TraverseChild t m (Some k)) v'))
forall a. IORef a -> IO a
readIORef IORef
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange
    DMap k (Constant (IORef (ChildReadyState (Some k))))
newUnready <- IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
-> JSM (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
 -> JSM (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
-> JSM (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ p k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness p k (Compose (TraverseChild t m (Some k)) v')
p DMap k (Constant (IORef (ChildReadyState (Some k))))
oldUnready
    let !newP :: p k (Compose (TraverseChild t m (Some k)) v')
newP = p k (Compose (TraverseChild t m (Some k)) v')
p p k (Compose (TraverseChild t m (Some k)) v')
-> p k (Compose (TraverseChild t m (Some k)) v')
-> p k (Compose (TraverseChild t m (Some k)) v')
forall a. Semigroup a => a -> a -> a
<> p k (Compose (TraverseChild t m (Some k)) v')
oldP
    IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
-> (DMap k (Constant (IORef (ChildReadyState (Some k)))),
    p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
  (DMap k (Constant (IORef (ChildReadyState (Some k)))),
   p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange (DMap k (Constant (IORef (ChildReadyState (Some k))))
newUnready, p k (Compose (TraverseChild t m (Some k)) v')
newP)
    Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DMap k (Constant (IORef (ChildReadyState (Some k)))) -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k (Constant (IORef (ChildReadyState (Some k))))
newUnready) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
      p k (Compose (TraverseChild t m (Some k)) v') -> JSM ()
applyDomUpdate p k (Compose (TraverseChild t m (Some k)) v')
newP
  let result0 :: DMap k v'
result0 = (forall (v :: k).
 Compose (TraverseChild t m (Some k)) v' v -> v' v)
-> DMap k (Compose (TraverseChild t m (Some k)) v') -> DMap k v'
forall k1 (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v) -> DMap k2 f -> DMap k2 g
DMap.map (TraverseChild t m (Some k) (v' v) -> v' v
forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result (TraverseChild t m (Some k) (v' v) -> v' v)
-> (Compose (TraverseChild t m (Some k)) v' v
    -> TraverseChild t m (Some k) (v' v))
-> Compose (TraverseChild t m (Some k)) v' v
-> v' v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' v
-> TraverseChild t m (Some k) (v' v)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) DMap k (Compose (TraverseChild t m (Some k)) v')
children0
      result' :: Event t (p k v')
result' = Event t (p k (Compose (TraverseChild t m (Some k)) v'))
-> (p k (Compose (TraverseChild t m (Some k)) v') -> p k v')
-> Event t (p k v')
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p k (Compose (TraverseChild t m (Some k)) v'))
children' ((p k (Compose (TraverseChild t m (Some k)) v') -> p k v')
 -> Event t (p k v'))
-> (p k (Compose (TraverseChild t m (Some k)) v') -> p k v')
-> Event t (p k v')
forall a b. (a -> b) -> a -> b
$ (forall (v :: k).
 Compose (TraverseChild t m (Some k)) v' v -> v' v)
-> p k (Compose (TraverseChild t m (Some k)) v') -> p k v'
forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv'
mapPatch ((forall (v :: k).
  Compose (TraverseChild t m (Some k)) v' v -> v' v)
 -> p k (Compose (TraverseChild t m (Some k)) v') -> p k v')
-> (forall (v :: k).
    Compose (TraverseChild t m (Some k)) v' v -> v' v)
-> p k (Compose (TraverseChild t m (Some k)) v')
-> p k v'
forall a b. (a -> b) -> a -> b
$ TraverseChild t m (Some k) (v' a) -> v' a
forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result (TraverseChild t m (Some k) (v' a) -> v' a)
-> (Compose (TraverseChild t m (Some k)) v' a
    -> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> v' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
  (DMap k v', Event t (p k v'))
-> HydrationDomBuilderT s t m (DMap k v', Event t (p k v'))
forall (m :: * -> *) a. Monad m => a -> m a
return (DMap k v'
result0, Event t (p k v')
result')

{-# INLINE hoistTraverseIntMapWithKeyWithAdjust #-}
hoistTraverseIntMapWithKeyWithAdjust ::
  ( Adjustable t m
  , MonadHold t m
  , MonadJSM m
  , MonadFix m
  , PrimMonad m
  , Monoid (p (TraverseChild t m Int v'))
  , Functor p
  , PatchTarget (p (HydrationRunnerT t m ())) ~ IntMap (HydrationRunnerT t m ())
  , PatchTarget (p (TraverseChild t m Int v')) ~ IntMap (TraverseChild t m Int v')
  , Patch (p (HydrationRunnerT t m ()))
  , Patch (p (TraverseChild t m Int v'))
  , RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document
  )
  => ((IntMap.Key -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
    -> IntMap v
    -> Event t (p v)
    -> DomRenderHookT t m (IntMap (TraverseChild t m Int v'), Event t (p (TraverseChild t m Int v'))))
  -- ^ The base monad's traversal
  -> (p (TraverseChild t m Int v')
    -> IntMap (IORef (ChildReadyState Int))
    -> IO (IntMap (IORef (ChildReadyState Int))))
  -- ^ Given a patch for the children DOM elements, produce a patch for the childrens' unreadiness state
  -> (IORef (IntMap DOM.Text)
    -> DOM.Text
    -> p (TraverseChild t m Int v')
    -> JSM ())
  -- ^ Apply a patch to the DOM
  -> (IntMap.Key -> v -> HydrationDomBuilderT s t m v')
  -> IntMap v
  -> Event t (p v)
  -> HydrationDomBuilderT s t m (IntMap v', Event t (p v'))
hoistTraverseIntMapWithKeyWithAdjust :: ((Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
 -> IntMap v
 -> Event t (p v)
 -> DomRenderHookT
      t
      m
      (IntMap (TraverseChild t m Int v'),
       Event t (p (TraverseChild t m Int v'))))
-> (p (TraverseChild t m Int v')
    -> IntMap (IORef (ChildReadyState Int))
    -> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap Text)
    -> Text -> p (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (p v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (p v'))
hoistTraverseIntMapWithKeyWithAdjust (Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (p v)
-> DomRenderHookT
     t
     m
     (IntMap (TraverseChild t m Int v'),
      Event t (p (TraverseChild t m Int v')))
base p (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
updateChildUnreadiness IORef (IntMap Text)
-> Text -> p (TraverseChild t m Int v') -> JSM ()
applyDomUpdate_ Int -> v -> HydrationDomBuilderT s t m v'
f IntMap v
dm0 Event t (p v)
dm' = do
  Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  HydrationDomBuilderEnv t m
initialEnv <- ReaderT
  (HydrationDomBuilderEnv t m)
  (DomRenderHookT t m)
  (HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s 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
  let parentUnreadyChildren :: IORef Word
parentUnreadyChildren = HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren HydrationDomBuilderEnv t m
initialEnv
  IORef
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
pendingChange :: IORef (IntMap (IORef (ChildReadyState Int)), p (TraverseChild t m Int v')) <- IO
  (IORef
     (IntMap (IORef (ChildReadyState Int)),
      p (TraverseChild t m Int v')))
-> HydrationDomBuilderT
     s
     t
     m
     (IORef
        (IntMap (IORef (ChildReadyState Int)),
         p (TraverseChild t m Int v')))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (IORef
      (IntMap (IORef (ChildReadyState Int)),
       p (TraverseChild t m Int v')))
 -> HydrationDomBuilderT
      s
      t
      m
      (IORef
         (IntMap (IORef (ChildReadyState Int)),
          p (TraverseChild t m Int v'))))
-> IO
     (IORef
        (IntMap (IORef (ChildReadyState Int)),
         p (TraverseChild t m Int v')))
-> HydrationDomBuilderT
     s
     t
     m
     (IORef
        (IntMap (IORef (ChildReadyState Int)),
         p (TraverseChild t m Int v')))
forall a b. (a -> b) -> a -> b
$ (IntMap (IORef (ChildReadyState Int)),
 p (TraverseChild t m Int v'))
-> IO
     (IORef
        (IntMap (IORef (ChildReadyState Int)),
         p (TraverseChild t m Int v')))
forall a. a -> IO (IORef a)
newIORef (IntMap (IORef (ChildReadyState Int)),
 p (TraverseChild t m Int v'))
forall a. Monoid a => a
mempty
  IORef Bool
haveEverBeenReady <- IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool))
-> IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  IORef (IntMap Text)
placeholders <- IO (IORef (IntMap Text))
-> HydrationDomBuilderT s t m (IORef (IntMap Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (IntMap Text))
 -> HydrationDomBuilderT s t m (IORef (IntMap Text)))
-> IO (IORef (IntMap Text))
-> HydrationDomBuilderT s t m (IORef (IntMap Text))
forall a b. (a -> b) -> a -> b
$ IntMap Text -> IO (IORef (IntMap Text))
forall a. a -> IO (IORef a)
newIORef IntMap Text
forall a. IntMap a
IntMap.empty
  Text
lastPlaceholder <- Document -> Text -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
  let applyDomUpdate :: p (TraverseChild t m Int v') -> JSM ()
applyDomUpdate p (TraverseChild t m Int v')
p = do
        IORef (IntMap Text)
-> Text -> p (TraverseChild t m Int v') -> JSM ()
applyDomUpdate_ IORef (IntMap Text)
placeholders Text
lastPlaceholder p (TraverseChild t m Int v')
p
        JSM ()
markSelfReady
        IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
-> (IntMap (IORef (ChildReadyState Int)),
    p (TraverseChild t m Int v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
pendingChange ((IntMap (IORef (ChildReadyState Int)),
  p (TraverseChild t m Int v'))
 -> IO ())
-> (IntMap (IORef (ChildReadyState Int)),
    p (TraverseChild t m Int v'))
-> IO ()
forall a b. (a -> b) -> a -> b
$! (IntMap (IORef (ChildReadyState Int)),
 p (TraverseChild t m Int v'))
forall a. Monoid a => a
mempty
      markSelfReady :: JSM ()
markSelfReady = do
        IO Bool -> JSM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
haveEverBeenReady) JSM Bool -> (Bool -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Bool
False -> do
            IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
            Word
old <- IO Word -> JSM Word
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> JSM Word) -> IO Word -> JSM Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
parentUnreadyChildren
            let new :: Word
new = Word -> Word
forall a. Enum a => a -> a
pred Word
old
            IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> Word -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Word
parentUnreadyChildren (Word -> IO ()) -> Word -> IO ()
forall a b. (a -> b) -> a -> b
$! Word
new
            Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
new Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> JSM ()
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> JSM ()
_hydrationDomBuilderEnv_commitAction HydrationDomBuilderEnv t m
initialEnv
      markChildReady :: IORef (ChildReadyState Int) -> JSM ()
      markChildReady :: IORef (ChildReadyState Int) -> JSM ()
markChildReady IORef (ChildReadyState Int)
childReadyState = do
        IO (ChildReadyState Int) -> JSM (ChildReadyState Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (ChildReadyState Int) -> IO (ChildReadyState Int)
forall a. IORef a -> IO a
readIORef IORef (ChildReadyState Int)
childReadyState) JSM (ChildReadyState Int)
-> (ChildReadyState Int -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          ChildReadyState Int
ChildReadyState_Ready -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          ChildReadyState_Unready Maybe Int
countedAt -> do
            IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState Int) -> ChildReadyState Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState Int)
childReadyState ChildReadyState Int
forall a. ChildReadyState a
ChildReadyState_Ready
            case Maybe Int
countedAt of
              Maybe Int
Nothing -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              Just Int
k -> do -- This child has been counted as unready, so we need to remove it from the unready set
                (IntMap (IORef (ChildReadyState Int))
oldUnready, p (TraverseChild t m Int v')
p) <- IO
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
-> JSM
     (IntMap (IORef (ChildReadyState Int)),
      p (TraverseChild t m Int v'))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (IntMap (IORef (ChildReadyState Int)),
    p (TraverseChild t m Int v'))
 -> JSM
      (IntMap (IORef (ChildReadyState Int)),
       p (TraverseChild t m Int v')))
-> IO
     (IntMap (IORef (ChildReadyState Int)),
      p (TraverseChild t m Int v'))
-> JSM
     (IntMap (IORef (ChildReadyState Int)),
      p (TraverseChild t m Int v'))
forall a b. (a -> b) -> a -> b
$ IORef
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
-> IO
     (IntMap (IORef (ChildReadyState Int)),
      p (TraverseChild t m Int v'))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
pendingChange
                Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntMap (IORef (ChildReadyState Int)) -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap (IORef (ChildReadyState Int))
oldUnready) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do -- This shouldn't actually ever be null
                  let newUnready :: IntMap (IORef (ChildReadyState Int))
newUnready = Int
-> IntMap (IORef (ChildReadyState Int))
-> IntMap (IORef (ChildReadyState Int))
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
k IntMap (IORef (ChildReadyState Int))
oldUnready
                  IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
-> (IntMap (IORef (ChildReadyState Int)),
    p (TraverseChild t m Int v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
pendingChange (IntMap (IORef (ChildReadyState Int))
newUnready, p (TraverseChild t m Int v')
p)
                  Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IntMap (IORef (ChildReadyState Int)) -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap (IORef (ChildReadyState Int))
newUnready) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
                    p (TraverseChild t m Int v') -> JSM ()
applyDomUpdate p (TraverseChild t m Int v')
p
  (IntMap (TraverseChild t m Int v')
children0 :: IntMap (TraverseChild t m Int v'), Event t (p (TraverseChild t m Int v'))
children' :: Event t (p (TraverseChild t m Int v')))
    <- ReaderT
  (HydrationDomBuilderEnv t m)
  (DomRenderHookT t m)
  (IntMap (TraverseChild t m Int v'),
   Event t (p (TraverseChild t m Int v')))
-> HydrationDomBuilderT
     s
     t
     m
     (IntMap (TraverseChild t m Int v'),
      Event t (p (TraverseChild t m Int v')))
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)
   (IntMap (TraverseChild t m Int v'),
    Event t (p (TraverseChild t m Int v')))
 -> HydrationDomBuilderT
      s
      t
      m
      (IntMap (TraverseChild t m Int v'),
       Event t (p (TraverseChild t m Int v'))))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (IntMap (TraverseChild t m Int v'),
      Event t (p (TraverseChild t m Int v')))
-> HydrationDomBuilderT
     s
     t
     m
     (IntMap (TraverseChild t m Int v'),
      Event t (p (TraverseChild t m Int v')))
forall a b. (a -> b) -> a -> b
$ DomRenderHookT
  t
  m
  (IntMap (TraverseChild t m Int v'),
   Event t (p (TraverseChild t m Int v')))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (IntMap (TraverseChild t m Int v'),
      Event t (p (TraverseChild t m Int v')))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT
   t
   m
   (IntMap (TraverseChild t m Int v'),
    Event t (p (TraverseChild t m Int v')))
 -> ReaderT
      (HydrationDomBuilderEnv t m)
      (DomRenderHookT t m)
      (IntMap (TraverseChild t m Int v'),
       Event t (p (TraverseChild t m Int v'))))
-> DomRenderHookT
     t
     m
     (IntMap (TraverseChild t m Int v'),
      Event t (p (TraverseChild t m Int v')))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (IntMap (TraverseChild t m Int v'),
      Event t (p (TraverseChild t m Int v')))
forall a b. (a -> b) -> a -> b
$ (Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (p v)
-> DomRenderHookT
     t
     m
     (IntMap (TraverseChild t m Int v'),
      Event t (p (TraverseChild t m Int v')))
base (\Int
k v
v -> HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState Int) -> JSM ())
-> HydrationDomBuilderT s t m v'
-> DomRenderHookT t m (TraverseChild t m Int v')
forall k (m :: * -> *) t k (s :: k) v.
(MonadIO m, MonadJSM m, Reflex t) =>
HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m v
-> DomRenderHookT t m (TraverseChild t m k v)
drawChildUpdateInt HydrationDomBuilderEnv t m
initialEnv IORef (ChildReadyState Int) -> JSM ()
markChildReady (HydrationDomBuilderT s t m v'
 -> DomRenderHookT t m (TraverseChild t m Int v'))
-> HydrationDomBuilderT s t m v'
-> DomRenderHookT t m (TraverseChild t m Int v')
forall a b. (a -> b) -> a -> b
$ Int -> v -> HydrationDomBuilderT s t m v'
f Int
k v
v) IntMap v
dm0 Event t (p v)
dm'
  let processChild :: k
-> TraverseChild t m k a -> IO (Maybe (IORef (ChildReadyState k)))
processChild k
k (TraverseChild Either (TraverseChildHydration t m) (TraverseChildImmediate k)
e a
_) = case Either (TraverseChildHydration t m) (TraverseChildImmediate k)
e of
        Left TraverseChildHydration t m
_ -> Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (IORef (ChildReadyState k))
forall a. Maybe a
Nothing
        Right TraverseChildImmediate k
immediate -> do
          IORef (ChildReadyState k) -> IO (ChildReadyState k)
forall a. IORef a -> IO a
readIORef (TraverseChildImmediate k -> IORef (ChildReadyState k)
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate k
immediate) IO (ChildReadyState k)
-> (ChildReadyState k -> IO (Maybe (IORef (ChildReadyState k))))
-> IO (Maybe (IORef (ChildReadyState k)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            ChildReadyState k
ChildReadyState_Ready -> Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IORef (ChildReadyState k))
forall a. Maybe a
Nothing
            ChildReadyState_Unready Maybe k
_ -> do
              IORef (ChildReadyState k) -> ChildReadyState k -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TraverseChildImmediate k -> IORef (ChildReadyState k)
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate k
immediate) (ChildReadyState k -> IO ()) -> ChildReadyState k -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe k -> ChildReadyState k
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe k -> ChildReadyState k) -> Maybe k -> ChildReadyState k
forall a b. (a -> b) -> a -> b
$ k -> Maybe k
forall a. a -> Maybe a
Just k
k
              Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IORef (ChildReadyState k))
 -> IO (Maybe (IORef (ChildReadyState k))))
-> Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k)))
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState k) -> Maybe (IORef (ChildReadyState k))
forall a. a -> Maybe a
Just (TraverseChildImmediate k -> IORef (ChildReadyState k)
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate k
immediate)
  IntMap (IORef (ChildReadyState Int))
initialUnready <- IO (IntMap (IORef (ChildReadyState Int)))
-> HydrationDomBuilderT
     s t m (IntMap (IORef (ChildReadyState Int)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IntMap (IORef (ChildReadyState Int)))
 -> HydrationDomBuilderT
      s t m (IntMap (IORef (ChildReadyState Int))))
-> IO (IntMap (IORef (ChildReadyState Int)))
-> HydrationDomBuilderT
     s t m (IntMap (IORef (ChildReadyState Int)))
forall a b. (a -> b) -> a -> b
$ (Maybe (IORef (ChildReadyState Int))
 -> Maybe (IORef (ChildReadyState Int)))
-> IntMap (Maybe (IORef (ChildReadyState Int)))
-> IntMap (IORef (ChildReadyState Int))
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe Maybe (IORef (ChildReadyState Int))
-> Maybe (IORef (ChildReadyState Int))
forall a. a -> a
id (IntMap (Maybe (IORef (ChildReadyState Int)))
 -> IntMap (IORef (ChildReadyState Int)))
-> IO (IntMap (Maybe (IORef (ChildReadyState Int))))
-> IO (IntMap (IORef (ChildReadyState Int)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int
 -> TraverseChild t m Int v'
 -> IO (Maybe (IORef (ChildReadyState Int))))
-> IntMap (TraverseChild t m Int v')
-> IO (IntMap (Maybe (IORef (ChildReadyState Int))))
forall (t :: * -> *) a b.
Applicative t =>
(Int -> a -> t b) -> IntMap a -> t (IntMap b)
IntMap.traverseWithKey Int
-> TraverseChild t m Int v'
-> IO (Maybe (IORef (ChildReadyState Int)))
forall k t (m :: * -> *) a.
k
-> TraverseChild t m k a -> IO (Maybe (IORef (ChildReadyState k)))
processChild IntMap (TraverseChild t m Int v')
children0
  IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ if IntMap (IORef (ChildReadyState Int)) -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap (IORef (ChildReadyState Int))
initialUnready
    then IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
    else do
      IORef Word -> (Word -> Word) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Word
parentUnreadyChildren Word -> Word
forall a. Enum a => a -> a
succ
      IORef
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
-> (IntMap (IORef (ChildReadyState Int)),
    p (TraverseChild t m Int v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
pendingChange (IntMap (IORef (ChildReadyState Int))
initialUnready, p (TraverseChild t m Int v')
forall a. Monoid a => a
mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time
  HydrationDomBuilderT s t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT s t m HydrationMode
-> (HydrationMode -> HydrationDomBuilderT s t m ())
-> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    HydrationMode
HydrationMode_Hydrating -> m (Incremental t (p (TraverseChild t m Int v')))
-> (Incremental t (p (TraverseChild t m Int v'))
    -> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (PatchTarget (p (TraverseChild t m Int v'))
-> Event t (p (TraverseChild t m Int v'))
-> m (Incremental t (p (TraverseChild t m Int v')))
forall k (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental IntMap (TraverseChild t m Int v')
PatchTarget (p (TraverseChild t m Int v'))
children0 Event t (p (TraverseChild t m Int v'))
children') ((Incremental t (p (TraverseChild t m Int v'))
  -> HydrationRunnerT t m ())
 -> HydrationDomBuilderT s t m ())
-> (Incremental t (p (TraverseChild t m Int v'))
    -> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ \Incremental t (p (TraverseChild t m Int v'))
children -> do
      IntMap (TraverseChild t m Int v')
dm :: IntMap (TraverseChild t m Int v') <- Behavior t (IntMap (TraverseChild t m Int v'))
-> HydrationRunnerT t m (IntMap (TraverseChild t m Int v'))
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t (IntMap (TraverseChild t m Int v'))
 -> HydrationRunnerT t m (IntMap (TraverseChild t m Int v')))
-> Behavior t (IntMap (TraverseChild t m Int v'))
-> HydrationRunnerT t m (IntMap (TraverseChild t m Int v'))
forall a b. (a -> b) -> a -> b
$ Incremental t (p (TraverseChild t m Int v'))
-> Behavior t (PatchTarget (p (TraverseChild t m Int v')))
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Behavior t (PatchTarget p)
currentIncremental Incremental t (p (TraverseChild t m Int v'))
children
      IntMap Text
phs <- (TraverseChild t m Int v' -> HydrationRunnerT t m Text)
-> IntMap (TraverseChild t m Int v')
-> HydrationRunnerT t m (IntMap Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((TraverseChildHydration t m -> HydrationRunnerT t m Text)
-> (TraverseChildImmediate Int -> HydrationRunnerT t m Text)
-> Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
-> HydrationRunnerT t m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TraverseChildHydration t m -> HydrationRunnerT t m Text
forall t (m :: * -> *).
TraverseChildHydration t m -> HydrationRunnerT t m Text
_traverseChildHydration_delayed (Text -> HydrationRunnerT t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HydrationRunnerT t m Text)
-> (TraverseChildImmediate Int -> Text)
-> TraverseChildImmediate Int
-> HydrationRunnerT t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChildImmediate Int -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder) (Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
 -> HydrationRunnerT t m Text)
-> (TraverseChild t m Int v'
    -> Either
         (TraverseChildHydration t m) (TraverseChildImmediate Int))
-> TraverseChild t m Int v'
-> HydrationRunnerT t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChild t m Int v'
-> Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode) IntMap (TraverseChild t m Int v')
dm
      IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IORef (IntMap Text) -> IntMap Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap Text)
placeholders (IntMap Text -> IO ()) -> IntMap Text -> IO ()
forall a b. (a -> b) -> a -> b
$! IntMap Text
phs
      Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
lastPlaceholder
    HydrationMode
HydrationMode_Immediate -> do
      let activate :: TraverseChildImmediate k -> HydrationDomBuilderT s t m Text
activate TraverseChildImmediate k
i = do
            Node -> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT s t m ())
-> Node -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode (DocumentFragment -> Node) -> DocumentFragment -> Node
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate k -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate k
i
            Text -> HydrationDomBuilderT s t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HydrationDomBuilderT s t m Text)
-> Text -> HydrationDomBuilderT s t m Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate k -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate k
i
      IntMap Text
phs <- (TraverseChild t m Int v' -> HydrationDomBuilderT s t m Text)
-> IntMap (TraverseChild t m Int v')
-> HydrationDomBuilderT s t m (IntMap Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((TraverseChildHydration t m -> HydrationDomBuilderT s t m Text)
-> (TraverseChildImmediate Int -> HydrationDomBuilderT s t m Text)
-> Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
-> HydrationDomBuilderT s t m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String
-> TraverseChildHydration t m -> HydrationDomBuilderT s t m Text
forall a. HasCallStack => String -> a
error String
"impossible") TraverseChildImmediate Int -> HydrationDomBuilderT s t m Text
forall k (m :: * -> *) k (s :: k) t.
MonadJSM m =>
TraverseChildImmediate k -> HydrationDomBuilderT s t m Text
activate (Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
 -> HydrationDomBuilderT s t m Text)
-> (TraverseChild t m Int v'
    -> Either
         (TraverseChildHydration t m) (TraverseChildImmediate Int))
-> TraverseChild t m Int v'
-> HydrationDomBuilderT s t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChild t m Int v'
-> Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode) IntMap (TraverseChild t m Int v')
children0
      IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ IORef (IntMap Text) -> IntMap Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap Text)
placeholders (IntMap Text -> IO ()) -> IntMap Text -> IO ()
forall a b. (a -> b) -> a -> b
$! IntMap Text
phs
      Node -> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT s t m ())
-> Node -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Text -> Node
forall o. IsNode o => o -> Node
toNode Text
lastPlaceholder
  Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ())
-> Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Event t (p (TraverseChild t m Int v'))
-> (p (TraverseChild t m Int v') -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p (TraverseChild t m Int v'))
children' ((p (TraverseChild t m Int v') -> JSM ()) -> Event t (JSM ()))
-> (p (TraverseChild t m Int v') -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \p (TraverseChild t m Int v')
p -> do
    (IntMap (IORef (ChildReadyState Int))
oldUnready, p (TraverseChild t m Int v')
oldP) <- IO
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
-> JSM
     (IntMap (IORef (ChildReadyState Int)),
      p (TraverseChild t m Int v'))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (IntMap (IORef (ChildReadyState Int)),
    p (TraverseChild t m Int v'))
 -> JSM
      (IntMap (IORef (ChildReadyState Int)),
       p (TraverseChild t m Int v')))
-> IO
     (IntMap (IORef (ChildReadyState Int)),
      p (TraverseChild t m Int v'))
-> JSM
     (IntMap (IORef (ChildReadyState Int)),
      p (TraverseChild t m Int v'))
forall a b. (a -> b) -> a -> b
$ IORef
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
-> IO
     (IntMap (IORef (ChildReadyState Int)),
      p (TraverseChild t m Int v'))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
pendingChange
    IntMap (IORef (ChildReadyState Int))
newUnready <- IO (IntMap (IORef (ChildReadyState Int)))
-> JSM (IntMap (IORef (ChildReadyState Int)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IntMap (IORef (ChildReadyState Int)))
 -> JSM (IntMap (IORef (ChildReadyState Int))))
-> IO (IntMap (IORef (ChildReadyState Int)))
-> JSM (IntMap (IORef (ChildReadyState Int)))
forall a b. (a -> b) -> a -> b
$ p (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
updateChildUnreadiness p (TraverseChild t m Int v')
p IntMap (IORef (ChildReadyState Int))
oldUnready
    let !newP :: p (TraverseChild t m Int v')
newP = p (TraverseChild t m Int v')
p p (TraverseChild t m Int v')
-> p (TraverseChild t m Int v') -> p (TraverseChild t m Int v')
forall a. Semigroup a => a -> a -> a
<> p (TraverseChild t m Int v')
oldP
    IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
-> (IntMap (IORef (ChildReadyState Int)),
    p (TraverseChild t m Int v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
pendingChange (IntMap (IORef (ChildReadyState Int))
newUnready, p (TraverseChild t m Int v')
newP)
    Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IntMap (IORef (ChildReadyState Int)) -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap (IORef (ChildReadyState Int))
newUnready) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
      p (TraverseChild t m Int v') -> JSM ()
applyDomUpdate p (TraverseChild t m Int v')
newP
  let result0 :: IntMap v'
result0 = (TraverseChild t m Int v' -> v')
-> IntMap (TraverseChild t m Int v') -> IntMap v'
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map TraverseChild t m Int v' -> v'
forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result IntMap (TraverseChild t m Int v')
children0
      result' :: Event t (p v')
result' = Event t (p (TraverseChild t m Int v'))
-> (p (TraverseChild t m Int v') -> p v') -> Event t (p v')
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p (TraverseChild t m Int v'))
children' ((p (TraverseChild t m Int v') -> p v') -> Event t (p v'))
-> (p (TraverseChild t m Int v') -> p v') -> Event t (p v')
forall a b. (a -> b) -> a -> b
$ (TraverseChild t m Int v' -> v')
-> p (TraverseChild t m Int v') -> p v'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TraverseChild t m Int v' -> v')
 -> p (TraverseChild t m Int v') -> p v')
-> (TraverseChild t m Int v' -> v')
-> p (TraverseChild t m Int v')
-> p v'
forall a b. (a -> b) -> a -> b
$ TraverseChild t m Int v' -> v'
forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result
  (IntMap v', Event t (p v'))
-> HydrationDomBuilderT s t m (IntMap v', Event t (p v'))
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap v'
result0, Event t (p v')
result')

{-# SPECIALIZE hoistTraverseIntMapWithKeyWithAdjust
  :: ((IntMap.Key -> v -> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM Int v'))
    -> IntMap v
    -> Event DomTimeline (PatchIntMap v)
    -> DomRenderHookT DomTimeline HydrationM (IntMap (TraverseChild DomTimeline HydrationM Int v'), Event DomTimeline (PatchIntMap (TraverseChild DomTimeline HydrationM Int v'))))
  -> (PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
    -> IntMap (IORef (ChildReadyState Int))
    -> IO (IntMap (IORef (ChildReadyState Int))))
  -> (IORef (IntMap DOM.Text)
    -> DOM.Text
    -> PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
    -> JSM ())
  -> (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM v')
  -> IntMap v
  -> Event DomTimeline (PatchIntMap v)
  -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
  #-}

{-# SPECIALIZE hoistTraverseIntMapWithKeyWithAdjust
  :: ((IntMap.Key -> v -> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM Int v'))
    -> IntMap v
    -> Event DomTimeline (PatchIntMap v)
    -> DomRenderHookT DomTimeline HydrationM (IntMap (TraverseChild DomTimeline HydrationM Int v'), Event DomTimeline (PatchIntMap (TraverseChild DomTimeline HydrationM Int v'))))
  -> (PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
    -> IntMap (IORef (ChildReadyState Int))
    -> IO (IntMap (IORef (ChildReadyState Int))))
  -> (IORef (IntMap DOM.Text)
    -> DOM.Text
    -> PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
    -> JSM ())
  -> (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM v')
  -> IntMap v
  -> Event DomTimeline (PatchIntMap v)
  -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
  #-}

data TraverseChildImmediate k = TraverseChildImmediate
  { TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment :: {-# UNPACK #-} !DOM.DocumentFragment
  -- ^ Child is appended to this fragment
  , TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder :: {-# UNPACK #-} !DOM.Text
  -- ^ Placeholder reference
  , TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState :: {-# UNPACK #-} !(IORef (ChildReadyState k))
  }

newtype TraverseChildHydration t m = TraverseChildHydration
  { TraverseChildHydration t m -> HydrationRunnerT t m Text
_traverseChildHydration_delayed :: HydrationRunnerT t m DOM.Text
  -- ^ Action to run at switchover, returns the placeholder
  }

data TraverseChild t m k a = TraverseChild
  { TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode :: !(Either (TraverseChildHydration t m) (TraverseChildImmediate k))
  , TraverseChild t m k a -> a
_traverseChild_result :: !a
  } deriving a -> TraverseChild t m k b -> TraverseChild t m k a
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
(forall a b.
 (a -> b) -> TraverseChild t m k a -> TraverseChild t m k b)
-> (forall a b.
    a -> TraverseChild t m k b -> TraverseChild t m k a)
-> Functor (TraverseChild t m k)
forall a b. a -> TraverseChild t m k b -> TraverseChild t m k a
forall a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
forall t (m :: * -> *) k a b.
a -> TraverseChild t m k b -> TraverseChild t m k a
forall t (m :: * -> *) k a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TraverseChild t m k b -> TraverseChild t m k a
$c<$ :: forall t (m :: * -> *) k a b.
a -> TraverseChild t m k b -> TraverseChild t m k a
fmap :: (a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
$cfmap :: forall t (m :: * -> *) k a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
Functor

{-# INLINABLE drawChildUpdate #-}
drawChildUpdate :: (MonadJSM m, Reflex t)
  => HydrationDomBuilderEnv t m
  -> (IORef (ChildReadyState k) -> JSM ()) -- This will NOT be called if the child is ready at initialization time; instead, the ChildReadyState return value will be ChildReadyState_Ready
  -> HydrationDomBuilderT s t m (f a)
  -> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
drawChildUpdate :: HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (f a)
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
drawChildUpdate HydrationDomBuilderEnv t m
initialEnv IORef (ChildReadyState k) -> JSM ()
markReady HydrationDomBuilderT s t m (f a)
child = do
  let doc :: Document
doc = HydrationDomBuilderEnv t m -> Document
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> Document
_hydrationDomBuilderEnv_document HydrationDomBuilderEnv t m
initialEnv
  IORef Word
unreadyChildren <- IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Word) -> DomRenderHookT t m (IORef Word))
-> IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall a b. (a -> b) -> a -> b
$ Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef Word
0
  IO HydrationMode -> DomRenderHookT t m HydrationMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef HydrationMode -> IO HydrationMode
forall a. IORef a -> IO a
readIORef (IORef HydrationMode -> IO HydrationMode)
-> IORef HydrationMode -> IO HydrationMode
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> IORef HydrationMode
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode HydrationDomBuilderEnv t m
initialEnv) DomRenderHookT t m HydrationMode
-> (HydrationMode
    -> DomRenderHookT t m (Compose (TraverseChild t m k) f a))
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    HydrationMode
HydrationMode_Hydrating -> do
      IORef (HydrationRunnerT t m ())
childDelayedRef <- IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HydrationRunnerT t m ()))
 -> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a. a -> IO (IORef a)
newIORef (HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ())))
-> HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      f a
result <- ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (f a)
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m (f a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (HydrationDomBuilderT s t m (f a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (f a)
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT HydrationDomBuilderT s t m (f a)
child) HydrationDomBuilderEnv t m
initialEnv
        { _hydrationDomBuilderEnv_unreadyChildren :: IORef Word
_hydrationDomBuilderEnv_unreadyChildren = IORef Word
unreadyChildren
        , _hydrationDomBuilderEnv_delayed :: IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed = IORef (HydrationRunnerT t m ())
childDelayedRef
        }
      HydrationRunnerT t m ()
childDelayed <- IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HydrationRunnerT t m ())
 -> DomRenderHookT t m (HydrationRunnerT t m ()))
-> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ IORef (HydrationRunnerT t m ()) -> IO (HydrationRunnerT t m ())
forall a. IORef a -> IO a
readIORef IORef (HydrationRunnerT t m ())
childDelayedRef
      Compose (TraverseChild t m k) f a
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Compose (TraverseChild t m k) f a
 -> DomRenderHookT t m (Compose (TraverseChild t m k) f a))
-> Compose (TraverseChild t m k) f a
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
forall a b. (a -> b) -> a -> b
$ TraverseChild t m k (f a) -> Compose (TraverseChild t m k) f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (TraverseChild t m k (f a) -> Compose (TraverseChild t m k) f a)
-> TraverseChild t m k (f a) -> Compose (TraverseChild t m k) f a
forall a b. (a -> b) -> a -> b
$ TraverseChild :: forall t (m :: * -> *) k a.
Either (TraverseChildHydration t m) (TraverseChildImmediate k)
-> a -> TraverseChild t m k a
TraverseChild
        { _traverseChild_result :: f a
_traverseChild_result = f a
result
        , _traverseChild_mode :: Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode = TraverseChildHydration t m
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
forall a b. a -> Either a b
Left TraverseChildHydration :: forall t (m :: * -> *).
HydrationRunnerT t m Text -> TraverseChildHydration t m
TraverseChildHydration
          { _traverseChildHydration_delayed :: HydrationRunnerT t m Text
_traverseChildHydration_delayed = do
            Text
placeholder <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
            Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
placeholder
            HydrationRunnerT t m ()
childDelayed
            Text -> HydrationRunnerT t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
placeholder
          }
        }
    HydrationMode
HydrationMode_Immediate -> do
      IORef (ChildReadyState k)
childReadyState <- IO (IORef (ChildReadyState k))
-> DomRenderHookT t m (IORef (ChildReadyState k))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (ChildReadyState k))
 -> DomRenderHookT t m (IORef (ChildReadyState k)))
-> IO (IORef (ChildReadyState k))
-> DomRenderHookT t m (IORef (ChildReadyState k))
forall a b. (a -> b) -> a -> b
$ ChildReadyState k -> IO (IORef (ChildReadyState k))
forall a. a -> IO (IORef a)
newIORef (ChildReadyState k -> IO (IORef (ChildReadyState k)))
-> ChildReadyState k -> IO (IORef (ChildReadyState k))
forall a b. (a -> b) -> a -> b
$ Maybe k -> ChildReadyState k
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready Maybe k
forall a. Maybe a
Nothing
      DocumentFragment
df <- Document -> DomRenderHookT t m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment Document
doc
      Text
placeholder <- Document -> Text -> DomRenderHookT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
      DocumentFragment -> Text -> DomRenderHookT t m ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
Node.appendChild_ DocumentFragment
df Text
placeholder
      f a
result <- ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (f a)
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m (f a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (HydrationDomBuilderT s t m (f a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (f a)
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT HydrationDomBuilderT s t m (f a)
child) HydrationDomBuilderEnv t m
initialEnv
        { _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 = IORef (ChildReadyState k) -> JSM ()
markReady IORef (ChildReadyState k)
childReadyState
        }
      Word
u <- IO Word -> DomRenderHookT t m Word
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> DomRenderHookT t m Word)
-> IO Word -> DomRenderHookT t m Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
unreadyChildren
      Bool -> DomRenderHookT t m () -> DomRenderHookT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
u Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) (DomRenderHookT t m () -> DomRenderHookT t m ())
-> DomRenderHookT t m () -> DomRenderHookT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> DomRenderHookT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DomRenderHookT t m ()) -> IO () -> DomRenderHookT t m ()
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState k) -> ChildReadyState k -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState k)
childReadyState ChildReadyState k
forall a. ChildReadyState a
ChildReadyState_Ready
      Compose (TraverseChild t m k) f a
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Compose (TraverseChild t m k) f a
 -> DomRenderHookT t m (Compose (TraverseChild t m k) f a))
-> Compose (TraverseChild t m k) f a
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
forall a b. (a -> b) -> a -> b
$ TraverseChild t m k (f a) -> Compose (TraverseChild t m k) f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (TraverseChild t m k (f a) -> Compose (TraverseChild t m k) f a)
-> TraverseChild t m k (f a) -> Compose (TraverseChild t m k) f a
forall a b. (a -> b) -> a -> b
$ TraverseChild :: forall t (m :: * -> *) k a.
Either (TraverseChildHydration t m) (TraverseChildImmediate k)
-> a -> TraverseChild t m k a
TraverseChild
        { _traverseChild_result :: f a
_traverseChild_result = f a
result
        , _traverseChild_mode :: Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode = TraverseChildImmediate k
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
forall a b. b -> Either a b
Right TraverseChildImmediate :: forall k.
DocumentFragment
-> Text -> IORef (ChildReadyState k) -> TraverseChildImmediate k
TraverseChildImmediate
          { _traverseChildImmediate_fragment :: DocumentFragment
_traverseChildImmediate_fragment = DocumentFragment
df
          , _traverseChildImmediate_placeholder :: Text
_traverseChildImmediate_placeholder = Text
placeholder
          , _traverseChildImmediate_childReadyState :: IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState = IORef (ChildReadyState k)
childReadyState
          }
        }

{-# SPECIALIZE drawChildUpdate
  :: HydrationDomBuilderEnv DomTimeline HydrationM
  -> (IORef (ChildReadyState Int) -> JSM ())
  -> HydrationDomBuilderT s DomTimeline HydrationM (Identity a)
  -> DomRenderHookT DomTimeline HydrationM (Compose (TraverseChild DomTimeline HydrationM Int) Identity a)
  #-}

{-# SPECIALIZE drawChildUpdate
  :: HydrationDomBuilderEnv DomTimeline HydrationM
  -> (IORef (ChildReadyState (Some k)) -> JSM ())
  -> HydrationDomBuilderT s DomTimeline HydrationM (f a)
  -> DomRenderHookT DomTimeline HydrationM (Compose (TraverseChild DomTimeline HydrationM (Some k)) f a)
  #-}

{-# INLINABLE drawChildUpdateInt #-}
drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)
  => HydrationDomBuilderEnv t m
  -> (IORef (ChildReadyState k) -> JSM ())
  -> HydrationDomBuilderT s t m v
  -> DomRenderHookT t m (TraverseChild t m k v)
drawChildUpdateInt :: HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m v
-> DomRenderHookT t m (TraverseChild t m k v)
drawChildUpdateInt HydrationDomBuilderEnv t m
env IORef (ChildReadyState k) -> JSM ()
mark HydrationDomBuilderT s t m v
m = (Identity v -> v)
-> TraverseChild t m k (Identity v) -> TraverseChild t m k v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity v -> v
forall a. Identity a -> a
runIdentity (TraverseChild t m k (Identity v) -> TraverseChild t m k v)
-> (Compose (TraverseChild t m k) Identity v
    -> TraverseChild t m k (Identity v))
-> Compose (TraverseChild t m k) Identity v
-> TraverseChild t m k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m k) Identity v
-> TraverseChild t m k (Identity v)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (TraverseChild t m k) Identity v -> TraverseChild t m k v)
-> DomRenderHookT t m (Compose (TraverseChild t m k) Identity v)
-> DomRenderHookT t m (TraverseChild t m k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (Identity v)
-> DomRenderHookT t m (Compose (TraverseChild t m k) Identity v)
forall k k1 (m :: * -> *) t k (s :: k) (f :: k1 -> *) (a :: k1).
(MonadJSM m, Reflex t) =>
HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (f a)
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
drawChildUpdate HydrationDomBuilderEnv t m
env IORef (ChildReadyState k) -> JSM ()
mark (v -> Identity v
forall a. a -> Identity a
Identity (v -> Identity v)
-> HydrationDomBuilderT s t m v
-> HydrationDomBuilderT s t m (Identity v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HydrationDomBuilderT s t m v
m)

{-# SPECIALIZE drawChildUpdateInt
  :: HydrationDomBuilderEnv DomTimeline HydrationM
  -> (IORef (ChildReadyState k) -> JSM ())
  -> HydrationDomBuilderT s DomTimeline HydrationM v
  -> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM k v)
  #-}

{-# INLINE mkHasFocus #-}
mkHasFocus
  :: (HasDocument m, MonadJSM m, IsNode (RawElement d), MonadHold t m, Reflex t, DOM.IsDocumentOrShadowRoot (RawDocument (DomBuilderSpace m)))
  => Element er d t -> m (Dynamic t Bool)
mkHasFocus :: Element er d t -> m (Dynamic t Bool)
mkHasFocus Element er d t
e = do
  RawDocument (DomBuilderSpace m)
doc <- m (RawDocument (DomBuilderSpace m))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  Bool
initialFocus <- Node -> Maybe Node -> m Bool
forall (m :: * -> *) self other.
(MonadDOM m, IsNode self, IsNode other) =>
self -> Maybe other -> m Bool
Node.isSameNode (RawElement d -> Node
forall o. IsNode o => o -> Node
toNode (RawElement d -> Node) -> RawElement d -> Node
forall a b. (a -> b) -> a -> b
$ Element er d t -> RawElement d
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> RawElement d
_element_raw Element er d t
e) (Maybe Node -> m Bool)
-> (Maybe Element -> Maybe Node) -> Maybe Element -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Node) -> Maybe Element -> Maybe Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Node
forall o. IsNode o => o -> Node
toNode (Maybe Element -> m Bool) -> m (Maybe Element) -> m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RawDocument (DomBuilderSpace m) -> m (Maybe Element)
forall (m :: * -> *) self.
(MonadDOM m, IsDocumentOrShadowRoot self) =>
self -> m (Maybe Element)
Document.getActiveElement RawDocument (DomBuilderSpace m)
doc
  Bool -> Event t Bool -> m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
initialFocus (Event t Bool -> m (Dynamic t Bool))
-> Event t Bool -> m (Dynamic t Bool)
forall a b. (a -> b) -> a -> b
$ [Event t Bool] -> Event t Bool
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
    [ Bool
False Bool -> Event t (er 'BlurTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'BlurTag) -> Event t (er 'BlurTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er d t -> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er d t
e) (EventName 'BlurTag -> WrapArg er EventName (er 'BlurTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'BlurTag
Blur)
    , Bool
True Bool -> Event t (er 'FocusTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'FocusTag) -> Event t (er 'FocusTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er d t -> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er d t
e) (EventName 'FocusTag -> WrapArg er EventName (er 'FocusTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'FocusTag
Focus)
    ]

insertBefore :: (MonadJSM m, IsNode new, IsNode existing) => new -> existing -> m ()
insertBefore :: new -> existing -> m ()
insertBefore new
new existing
existing = do
  Node
p <- existing -> m Node
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Node
getParentNodeUnchecked existing
existing
  Node -> new -> Maybe existing -> m ()
forall (m :: * -> *) self node child.
(MonadDOM m, IsNode self, IsNode node, IsNode child) =>
self -> node -> Maybe child -> m ()
Node.insertBefore_ Node
p new
new (existing -> Maybe existing
forall a. a -> Maybe a
Just existing
existing) -- If there's no parent, that means we've been removed from the DOM; this should not happen if the we're removing ourselves from the performEvent properly

type ImmediateDomBuilderT = HydrationDomBuilderT GhcjsDomSpace

instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT s t m) where
  type Performable (HydrationDomBuilderT s t m) = Performable m
  {-# INLINABLE performEvent_ #-}
  performEvent_ :: Event t (Performable (HydrationDomBuilderT s t m) ())
-> HydrationDomBuilderT s t m ()
performEvent_ Event t (Performable (HydrationDomBuilderT s t m) ())
e = m () -> HydrationDomBuilderT s t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> HydrationDomBuilderT s t m ())
-> m () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Event t (Performable m ()) -> m ()
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_ Event t (Performable m ())
Event t (Performable (HydrationDomBuilderT s t m) ())
e
  {-# INLINABLE performEvent #-}
  performEvent :: Event t (Performable (HydrationDomBuilderT s t m) a)
-> HydrationDomBuilderT s t m (Event t a)
performEvent Event t (Performable (HydrationDomBuilderT s t m) a)
e = m (Event t a) -> HydrationDomBuilderT s t m (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> HydrationDomBuilderT s t m (Event t a))
-> m (Event t a) -> HydrationDomBuilderT s t m (Event t a)
forall a b. (a -> b) -> a -> b
$ Event t (Performable m a) -> m (Event t a)
forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent Event t (Performable m a)
Event t (Performable (HydrationDomBuilderT s t m) a)
e

instance PostBuild t m => PostBuild t (HydrationDomBuilderT s t m) where
  {-# INLINABLE getPostBuild #-}
  getPostBuild :: HydrationDomBuilderT s t m (Event t ())
getPostBuild = m (Event t ()) -> HydrationDomBuilderT s t m (Event t ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild

instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationDomBuilderT s t m) where
  {-# INLINABLE newEventWithTrigger #-}
  newEventWithTrigger :: (EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT s t m (Event t a)
newEventWithTrigger = m (Event t a) -> HydrationDomBuilderT s t m (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> HydrationDomBuilderT s t m (Event t a))
-> ((EventTrigger t a -> IO (IO ())) -> m (Event t a))
-> (EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT s t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventTrigger t a -> IO (IO ())) -> m (Event t a)
forall t (m :: * -> *) a.
MonadReflexCreateTrigger t m =>
(EventTrigger t a -> IO (IO ())) -> m (Event t a)
newEventWithTrigger
  {-# INLINABLE newFanEventWithTrigger #-}
  newFanEventWithTrigger :: (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT s t m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f = m (EventSelector t k)
-> HydrationDomBuilderT s t m (EventSelector t k)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (EventSelector t k)
 -> HydrationDomBuilderT s t m (EventSelector t k))
-> m (EventSelector t k)
-> HydrationDomBuilderT s t m (EventSelector t k)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f

instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (HydrationDomBuilderT s t m) where
  {-# INLINABLE newTriggerEvent #-}
  newTriggerEvent :: HydrationDomBuilderT s t m (Event t a, a -> IO ())
newTriggerEvent = ReaderT
  (HydrationDomBuilderEnv t m)
  (DomRenderHookT t m)
  (Event t a, a -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO ())
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)
   (Event t a, a -> IO ())
 -> HydrationDomBuilderT s t m (Event t a, a -> IO ()))
-> (DomRenderHookT t m (Event t a, a -> IO ())
    -> ReaderT
         (HydrationDomBuilderEnv t m)
         (DomRenderHookT t m)
         (Event t a, a -> IO ()))
-> DomRenderHookT t m (Event t a, a -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a, a -> IO ())
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (Event t a, a -> IO ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a, a -> IO ())
 -> HydrationDomBuilderT s t m (Event t a, a -> IO ()))
-> DomRenderHookT t m (Event t a, a -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO ())
forall a b. (a -> b) -> a -> b
$ DomRenderHookT t m (Event t a, a -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  {-# INLINABLE newTriggerEventWithOnComplete #-}
  newTriggerEventWithOnComplete :: HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete = ReaderT
  (HydrationDomBuilderEnv t m)
  (DomRenderHookT t m)
  (Event t a, a -> IO () -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ())
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)
   (Event t a, a -> IO () -> IO ())
 -> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ()))
-> (DomRenderHookT t m (Event t a, a -> IO () -> IO ())
    -> ReaderT
         (HydrationDomBuilderEnv t m)
         (DomRenderHookT t m)
         (Event t a, a -> IO () -> IO ()))
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a, a -> IO () -> IO ())
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (Event t a, a -> IO () -> IO ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a, a -> IO () -> IO ())
 -> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ()))
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ())
forall a b. (a -> b) -> a -> b
$ DomRenderHookT t m (Event t a, a -> IO () -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete
  {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
  newEventWithLazyTriggerWithOnComplete :: ((a -> IO () -> IO ()) -> IO (IO ()))
-> HydrationDomBuilderT s t m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
f = ReaderT
  (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
-> HydrationDomBuilderT s t m (Event t a)
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) (Event t a)
 -> HydrationDomBuilderT s t m (Event t a))
-> (DomRenderHookT t m (Event t a)
    -> ReaderT
         (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a))
-> DomRenderHookT t m (Event t a)
-> HydrationDomBuilderT s t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a)
-> ReaderT
     (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a)
 -> HydrationDomBuilderT s t m (Event t a))
-> DomRenderHookT t m (Event t a)
-> HydrationDomBuilderT s t m (Event t a)
forall a b. (a -> b) -> a -> b
$ ((a -> IO () -> IO ()) -> IO (IO ()))
-> DomRenderHookT t m (Event t a)
forall t (m :: * -> *) a.
TriggerEvent t m =>
((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
f

instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (DomRenderHookT t m) where
  {-# INLINABLE newTriggerEvent #-}
  newTriggerEvent :: DomRenderHookT t m (Event t a, a -> IO ())
newTriggerEvent = RequesterT
  t JSM Identity (TriggerEventT t m) (Event t a, a -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO ())
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
   t JSM Identity (TriggerEventT t m) (Event t a, a -> IO ())
 -> DomRenderHookT t m (Event t a, a -> IO ()))
-> (TriggerEventT t m (Event t a, a -> IO ())
    -> RequesterT
         t JSM Identity (TriggerEventT t m) (Event t a, a -> IO ()))
-> TriggerEventT t m (Event t a, a -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT t m (Event t a, a -> IO ())
-> RequesterT
     t JSM Identity (TriggerEventT t m) (Event t a, a -> IO ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m (Event t a, a -> IO ())
 -> DomRenderHookT t m (Event t a, a -> IO ()))
-> TriggerEventT t m (Event t a, a -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO ())
forall a b. (a -> b) -> a -> b
$ TriggerEventT t m (Event t a, a -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  {-# INLINABLE newTriggerEventWithOnComplete #-}
  newTriggerEventWithOnComplete :: DomRenderHookT t m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete = RequesterT
  t JSM Identity (TriggerEventT t m) (Event t a, a -> IO () -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
   t JSM Identity (TriggerEventT t m) (Event t a, a -> IO () -> IO ())
 -> DomRenderHookT t m (Event t a, a -> IO () -> IO ()))
-> (TriggerEventT t m (Event t a, a -> IO () -> IO ())
    -> RequesterT
         t
         JSM
         Identity
         (TriggerEventT t m)
         (Event t a, a -> IO () -> IO ()))
-> TriggerEventT t m (Event t a, a -> IO () -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT t m (Event t a, a -> IO () -> IO ())
-> RequesterT
     t JSM Identity (TriggerEventT t m) (Event t a, a -> IO () -> IO ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m (Event t a, a -> IO () -> IO ())
 -> DomRenderHookT t m (Event t a, a -> IO () -> IO ()))
-> TriggerEventT t m (Event t a, a -> IO () -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
forall a b. (a -> b) -> a -> b
$ TriggerEventT t m (Event t a, a -> IO () -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete
  {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
  newEventWithLazyTriggerWithOnComplete :: ((a -> IO () -> IO ()) -> IO (IO ()))
-> DomRenderHookT t m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
f = RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
-> DomRenderHookT t m (Event t a)
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
 -> DomRenderHookT t m (Event t a))
-> (TriggerEventT t m (Event t a)
    -> RequesterT t JSM Identity (TriggerEventT t m) (Event t a))
-> TriggerEventT t m (Event t a)
-> DomRenderHookT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT t m (Event t a)
-> RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m (Event t a) -> DomRenderHookT t m (Event t a))
-> TriggerEventT t m (Event t a) -> DomRenderHookT t m (Event t a)
forall a b. (a -> b) -> a -> b
$ ((a -> IO () -> IO ()) -> IO (IO ()))
-> TriggerEventT t m (Event t a)
forall t (m :: * -> *) a.
TriggerEvent t m =>
((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
f

instance HasJSContext m => HasJSContext (HydrationDomBuilderT s t m) where
  type JSContextPhantom (HydrationDomBuilderT s t m) = JSContextPhantom m
  askJSContext :: HydrationDomBuilderT
  s
  t
  m
  (JSContextSingleton
     (JSContextPhantom (HydrationDomBuilderT s t m)))
askJSContext = m (JSContextSingleton (JSContextPhantom m))
-> HydrationDomBuilderT
     s t m (JSContextSingleton (JSContextPhantom m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (JSContextSingleton (JSContextPhantom m))
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext

instance MonadRef m => MonadRef (HydrationDomBuilderT s t m) where
  type Ref (HydrationDomBuilderT s t m) = Ref m
  {-# INLINABLE newRef #-}
  newRef :: a
-> HydrationDomBuilderT s t m (Ref (HydrationDomBuilderT s t m) a)
newRef = m (Ref m a) -> HydrationDomBuilderT s t m (Ref m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Ref m a) -> HydrationDomBuilderT s t m (Ref m a))
-> (a -> m (Ref m a)) -> a -> HydrationDomBuilderT s t m (Ref m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
  {-# INLINABLE readRef #-}
  readRef :: Ref (HydrationDomBuilderT s t m) a -> HydrationDomBuilderT s t m a
readRef = m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> (Ref m a -> m a) -> Ref m a -> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
  {-# INLINABLE writeRef #-}
  writeRef :: Ref (HydrationDomBuilderT s t m) a
-> a -> HydrationDomBuilderT s t m ()
writeRef Ref (HydrationDomBuilderT s t m) a
r = m () -> HydrationDomBuilderT s t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> HydrationDomBuilderT s t m ())
-> (a -> m ()) -> a -> HydrationDomBuilderT s t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> a -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef Ref m a
Ref (HydrationDomBuilderT s t m) a
r

instance MonadAtomicRef m => MonadAtomicRef (HydrationDomBuilderT s t m) where
  {-# INLINABLE atomicModifyRef #-}
  atomicModifyRef :: Ref (HydrationDomBuilderT s t m) a
-> (a -> (a, b)) -> HydrationDomBuilderT s t m b
atomicModifyRef Ref (HydrationDomBuilderT s t m) a
r = m b -> HydrationDomBuilderT s t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> HydrationDomBuilderT s t m b)
-> ((a -> (a, b)) -> m b)
-> (a -> (a, b))
-> HydrationDomBuilderT s t m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> (a -> (a, b)) -> m b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef Ref m a
Ref (HydrationDomBuilderT s t m) a
r

instance (HasJS x m, ReflexHost t) => HasJS x (HydrationDomBuilderT s t m) where
  type JSX (HydrationDomBuilderT s t m) = JSX m
  liftJS :: JSX (HydrationDomBuilderT s t m) a -> HydrationDomBuilderT s t m a
liftJS = m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> (JSX m a -> m a) -> JSX m a -> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSX m a -> m a
forall x (m :: * -> *) a. HasJS x m => JSX m a -> m a
liftJS

type family EventType en where
  EventType 'AbortTag = UIEvent
  EventType 'BlurTag = FocusEvent
  EventType 'ChangeTag = DOM.Event
  EventType 'ClickTag = MouseEvent
  EventType 'ContextmenuTag = MouseEvent
  EventType 'DblclickTag = MouseEvent
  EventType 'DragTag = MouseEvent
  EventType 'DragendTag = MouseEvent
  EventType 'DragenterTag = MouseEvent
  EventType 'DragleaveTag = MouseEvent
  EventType 'DragoverTag = MouseEvent
  EventType 'DragstartTag = MouseEvent
  EventType 'DropTag = MouseEvent
  EventType 'ErrorTag = UIEvent
  EventType 'FocusTag = FocusEvent
  EventType 'InputTag = DOM.Event
  EventType 'InvalidTag = DOM.Event
  EventType 'KeydownTag = KeyboardEvent
  EventType 'KeypressTag = KeyboardEvent
  EventType 'KeyupTag = KeyboardEvent
  EventType 'LoadTag = UIEvent
  EventType 'MousedownTag = MouseEvent
  EventType 'MouseenterTag = MouseEvent
  EventType 'MouseleaveTag = MouseEvent
  EventType 'MousemoveTag = MouseEvent
  EventType 'MouseoutTag = MouseEvent
  EventType 'MouseoverTag = MouseEvent
  EventType 'MouseupTag = MouseEvent
  EventType 'MousewheelTag = MouseEvent
  EventType 'ScrollTag = UIEvent
  EventType 'SelectTag = UIEvent
  EventType 'SubmitTag = DOM.Event
  EventType 'WheelTag = WheelEvent
  EventType 'BeforecutTag = ClipboardEvent
  EventType 'CutTag = ClipboardEvent
  EventType 'BeforecopyTag = ClipboardEvent
  EventType 'CopyTag = ClipboardEvent
  EventType 'BeforepasteTag = ClipboardEvent
  EventType 'PasteTag = ClipboardEvent
  EventType 'ResetTag = DOM.Event
  EventType 'SearchTag = DOM.Event
  EventType 'SelectstartTag = DOM.Event
  EventType 'TouchstartTag = TouchEvent
  EventType 'TouchmoveTag = TouchEvent
  EventType 'TouchendTag = TouchEvent
  EventType 'TouchcancelTag = TouchEvent

{-# INLINABLE defaultDomEventHandler #-}
defaultDomEventHandler :: IsElement e => e -> EventName en -> EventM e (EventType en) (Maybe (EventResult en))
defaultDomEventHandler :: e
-> EventName en -> EventM e (EventType en) (Maybe (EventResult en))
defaultDomEventHandler e
e EventName en
evt = (EventResultType en -> Maybe (EventResult en))
-> ReaderT (EventType en) JSM (EventResultType en)
-> EventM e (EventType en) (Maybe (EventResult en))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EventResult en -> Maybe (EventResult en)
forall a. a -> Maybe a
Just (EventResult en -> Maybe (EventResult en))
-> (EventResultType en -> EventResult en)
-> EventResultType en
-> Maybe (EventResult en)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventResultType en -> EventResult en
forall (en :: EventTag). EventResultType en -> EventResult en
EventResult) (ReaderT (EventType en) JSM (EventResultType en)
 -> EventM e (EventType en) (Maybe (EventResult en)))
-> ReaderT (EventType en) JSM (EventResultType en)
-> EventM e (EventType en) (Maybe (EventResult en))
forall a b. (a -> b) -> a -> b
$ case EventName en
evt of
  EventName en
Click -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Dblclick -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
  EventName en
Keypress -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e KeyboardEvent Word
getKeyEvent
  EventName en
Scroll -> Int -> EventResultType en
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> EventResultType en)
-> ReaderT (EventType en) JSM Int
-> ReaderT (EventType en) JSM (EventResultType en)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> ReaderT (EventType en) JSM Int
forall (m :: * -> *) self.
(MonadDOM m, IsElement self) =>
self -> m Int
getScrollTop e
e
  EventName en
Keydown -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e KeyboardEvent Word
getKeyEvent
  EventName en
Keyup -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e KeyboardEvent Word
getKeyEvent
  EventName en
Mousemove -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
  EventName en
Mouseup -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
  EventName en
Mousedown -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
  EventName en
Mouseenter -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Mouseleave -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Focus -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Blur -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Change -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Drag -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Dragend -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Dragenter -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Dragleave -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Dragover -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Dragstart -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Drop -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Abort -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Contextmenu -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Error -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Input -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Invalid -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Load -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Mouseout -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Mouseover -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Select -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Submit -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Beforecut -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Cut -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Beforecopy -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Copy -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Beforepaste -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Paste -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e ClipboardEvent (Maybe Text)
getPasteData
  EventName en
Reset -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Search -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Selectstart -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Touchstart -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
  EventName en
Touchmove -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
  EventName en
Touchend -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
  EventName en
Touchcancel -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
  EventName en
Mousewheel -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Wheel -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e WheelEvent WheelEventResult
getWheelEvent

{-# INLINABLE defaultDomWindowEventHandler #-}
defaultDomWindowEventHandler :: DOM.Window -> EventName en -> EventM DOM.Window (EventType en) (Maybe (EventResult en))
defaultDomWindowEventHandler :: Window
-> EventName en
-> EventM Window (EventType en) (Maybe (EventResult en))
defaultDomWindowEventHandler Window
w EventName en
evt = (EventResultType en -> Maybe (EventResult en))
-> ReaderT (EventType en) JSM (EventResultType en)
-> EventM Window (EventType en) (Maybe (EventResult en))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EventResult en -> Maybe (EventResult en)
forall a. a -> Maybe a
Just (EventResult en -> Maybe (EventResult en))
-> (EventResultType en -> EventResult en)
-> EventResultType en
-> Maybe (EventResult en)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventResultType en -> EventResult en
forall (en :: EventTag). EventResultType en -> EventResult en
EventResult) (ReaderT (EventType en) JSM (EventResultType en)
 -> EventM Window (EventType en) (Maybe (EventResult en)))
-> ReaderT (EventType en) JSM (EventResultType en)
-> EventM Window (EventType en) (Maybe (EventResult en))
forall a b. (a -> b) -> a -> b
$ case EventName en
evt of
  EventName en
Click -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Dblclick -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
  EventName en
Keypress -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e KeyboardEvent Word
getKeyEvent
  EventName en
Scroll -> Window -> ReaderT (EventType en) JSM Double
forall (m :: * -> *). MonadDOM m => Window -> m Double
Window.getScrollY Window
w
  EventName en
Keydown -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e KeyboardEvent Word
getKeyEvent
  EventName en
Keyup -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e KeyboardEvent Word
getKeyEvent
  EventName en
Mousemove -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
  EventName en
Mouseup -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
  EventName en
Mousedown -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
  EventName en
Mouseenter -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Mouseleave -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Focus -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Blur -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Change -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Drag -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Dragend -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Dragenter -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Dragleave -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Dragover -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Dragstart -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Drop -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Abort -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Contextmenu -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Error -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Input -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Invalid -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Load -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Mouseout -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Mouseover -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Select -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Submit -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Beforecut -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Cut -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Beforecopy -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Copy -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Beforepaste -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Paste -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e ClipboardEvent (Maybe Text)
getPasteData
  EventName en
Reset -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Search -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Selectstart -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Touchstart -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
  EventName en
Touchmove -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
  EventName en
Touchend -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
  EventName en
Touchcancel -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
  EventName en
Mousewheel -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  EventName en
Wheel -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e WheelEvent WheelEventResult
getWheelEvent

{-# INLINABLE withIsEvent #-}
withIsEvent :: EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent :: EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName en
en IsEvent (EventType en) => r
r = case EventName en
en of
  EventName en
Click -> r
IsEvent (EventType en) => r
r
  EventName en
Dblclick -> r
IsEvent (EventType en) => r
r
  EventName en
Keypress -> r
IsEvent (EventType en) => r
r
  EventName en
Scroll -> r
IsEvent (EventType en) => r
r
  EventName en
Keydown -> r
IsEvent (EventType en) => r
r
  EventName en
Keyup -> r
IsEvent (EventType en) => r
r
  EventName en
Mousemove -> r
IsEvent (EventType en) => r
r
  EventName en
Mouseup -> r
IsEvent (EventType en) => r
r
  EventName en
Mousedown -> r
IsEvent (EventType en) => r
r
  EventName en
Mouseenter -> r
IsEvent (EventType en) => r
r
  EventName en
Mouseleave -> r
IsEvent (EventType en) => r
r
  EventName en
Focus -> r
IsEvent (EventType en) => r
r
  EventName en
Blur -> r
IsEvent (EventType en) => r
r
  EventName en
Change -> r
IsEvent (EventType en) => r
r
  EventName en
Drag -> r
IsEvent (EventType en) => r
r
  EventName en
Dragend -> r
IsEvent (EventType en) => r
r
  EventName en
Dragenter -> r
IsEvent (EventType en) => r
r
  EventName en
Dragleave -> r
IsEvent (EventType en) => r
r
  EventName en
Dragover -> r
IsEvent (EventType en) => r
r
  EventName en
Dragstart -> r
IsEvent (EventType en) => r
r
  EventName en
Drop -> r
IsEvent (EventType en) => r
r
  EventName en
Abort -> r
IsEvent (EventType en) => r
r
  EventName en
Contextmenu -> r
IsEvent (EventType en) => r
r
  EventName en
Error -> r
IsEvent (EventType en) => r
r
  EventName en
Input -> r
IsEvent (EventType en) => r
r
  EventName en
Invalid -> r
IsEvent (EventType en) => r
r
  EventName en
Load -> r
IsEvent (EventType en) => r
r
  EventName en
Mouseout -> r
IsEvent (EventType en) => r
r
  EventName en
Mouseover -> r
IsEvent (EventType en) => r
r
  EventName en
Select -> r
IsEvent (EventType en) => r
r
  EventName en
Submit -> r
IsEvent (EventType en) => r
r
  EventName en
Beforecut -> r
IsEvent (EventType en) => r
r
  EventName en
Cut -> r
IsEvent (EventType en) => r
r
  EventName en
Beforecopy -> r
IsEvent (EventType en) => r
r
  EventName en
Copy -> r
IsEvent (EventType en) => r
r
  EventName en
Beforepaste -> r
IsEvent (EventType en) => r
r
  EventName en
Paste -> r
IsEvent (EventType en) => r
r
  EventName en
Reset -> r
IsEvent (EventType en) => r
r
  EventName en
Search -> r
IsEvent (EventType en) => r
r
  EventName en
Selectstart -> r
IsEvent (EventType en) => r
r
  EventName en
Touchstart -> r
IsEvent (EventType en) => r
r
  EventName en
Touchmove -> r
IsEvent (EventType en) => r
r
  EventName en
Touchend -> r
IsEvent (EventType en) => r
r
  EventName en
Touchcancel -> r
IsEvent (EventType en) => r
r
  EventName en
Mousewheel -> r
IsEvent (EventType en) => r
r
  EventName en
Wheel -> r
IsEvent (EventType en) => r
r

showEventName :: EventName en -> String
showEventName :: EventName en -> String
showEventName EventName en
en = case EventName en
en of
  EventName en
Abort -> String
"Abort"
  EventName en
Blur -> String
"Blur"
  EventName en
Change -> String
"Change"
  EventName en
Click -> String
"Click"
  EventName en
Contextmenu -> String
"Contextmenu"
  EventName en
Dblclick -> String
"Dblclick"
  EventName en
Drag -> String
"Drag"
  EventName en
Dragend -> String
"Dragend"
  EventName en
Dragenter -> String
"Dragenter"
  EventName en
Dragleave -> String
"Dragleave"
  EventName en
Dragover -> String
"Dragover"
  EventName en
Dragstart -> String
"Dragstart"
  EventName en
Drop -> String
"Drop"
  EventName en
Error -> String
"Error"
  EventName en
Focus -> String
"Focus"
  EventName en
Input -> String
"Input"
  EventName en
Invalid -> String
"Invalid"
  EventName en
Keydown -> String
"Keydown"
  EventName en
Keypress -> String
"Keypress"
  EventName en
Keyup -> String
"Keyup"
  EventName en
Load -> String
"Load"
  EventName en
Mousedown -> String
"Mousedown"
  EventName en
Mouseenter -> String
"Mouseenter"
  EventName en
Mouseleave -> String
"Mouseleave"
  EventName en
Mousemove -> String
"Mousemove"
  EventName en
Mouseout -> String
"Mouseout"
  EventName en
Mouseover -> String
"Mouseover"
  EventName en
Mouseup -> String
"Mouseup"
  EventName en
Mousewheel -> String
"Mousewheel"
  EventName en
Scroll -> String
"Scroll"
  EventName en
Select -> String
"Select"
  EventName en
Submit -> String
"Submit"
  EventName en
Wheel -> String
"Wheel"
  EventName en
Beforecut -> String
"Beforecut"
  EventName en
Cut -> String
"Cut"
  EventName en
Beforecopy -> String
"Beforecopy"
  EventName en
Copy -> String
"Copy"
  EventName en
Beforepaste -> String
"Beforepaste"
  EventName en
Paste -> String
"Paste"
  EventName en
Reset -> String
"Reset"
  EventName en
Search -> String
"Search"
  EventName en
Selectstart -> String
"Selectstart"
  EventName en
Touchstart -> String
"Touchstart"
  EventName en
Touchmove -> String
"Touchmove"
  EventName en
Touchend -> String
"Touchend"
  EventName en
Touchcancel -> String
"Touchcancel"

--TODO: Get rid of this hack
-- ElementEventTarget is here to allow us to treat SVG and HTML elements as the same thing; without it, we'll break any existing SVG code.
newtype ElementEventTarget = ElementEventTarget DOM.Element deriving (Coercible ElementEventTarget JSVal
ToJSVal ElementEventTarget
FromJSVal ElementEventTarget
ToJSVal ElementEventTarget
-> FromJSVal ElementEventTarget
-> Coercible ElementEventTarget JSVal
-> (ElementEventTarget -> JSM GType)
-> IsGObject ElementEventTarget
ElementEventTarget -> JSM GType
forall o.
ToJSVal o
-> FromJSVal o
-> Coercible o JSVal
-> (o -> JSM GType)
-> IsGObject o
typeGType :: ElementEventTarget -> JSM GType
$ctypeGType :: ElementEventTarget -> JSM GType
$cp3IsGObject :: Coercible ElementEventTarget JSVal
$cp2IsGObject :: FromJSVal ElementEventTarget
$cp1IsGObject :: ToJSVal ElementEventTarget
DOM.IsGObject, [ElementEventTarget] -> JSM JSVal
ElementEventTarget -> JSM JSVal
(ElementEventTarget -> JSM JSVal)
-> ([ElementEventTarget] -> JSM JSVal)
-> ToJSVal ElementEventTarget
forall a. (a -> JSM JSVal) -> ([a] -> JSM JSVal) -> ToJSVal a
toJSValListOf :: [ElementEventTarget] -> JSM JSVal
$ctoJSValListOf :: [ElementEventTarget] -> JSM JSVal
toJSVal :: ElementEventTarget -> JSM JSVal
$ctoJSVal :: ElementEventTarget -> JSM JSVal
DOM.ToJSVal, IsGObject ElementEventTarget
IsGObject ElementEventTarget -> IsSlotable ElementEventTarget
forall o. IsGObject o -> IsSlotable o
DOM.IsSlotable, IsGObject ElementEventTarget
IsGObject ElementEventTarget -> IsParentNode ElementEventTarget
forall o. IsGObject o -> IsParentNode o
DOM.IsParentNode, IsGObject ElementEventTarget
IsGObject ElementEventTarget
-> IsNonDocumentTypeChildNode ElementEventTarget
forall o. IsGObject o -> IsNonDocumentTypeChildNode o
DOM.IsNonDocumentTypeChildNode, IsGObject ElementEventTarget
IsGObject ElementEventTarget -> IsChildNode ElementEventTarget
forall o. IsGObject o -> IsChildNode o
DOM.IsChildNode, IsGObject ElementEventTarget
IsGObject ElementEventTarget -> IsAnimatable ElementEventTarget
forall o. IsGObject o -> IsAnimatable o
DOM.IsAnimatable, IsGObject ElementEventTarget
IsEventTarget ElementEventTarget
IsEventTarget ElementEventTarget
-> IsGObject ElementEventTarget -> IsNode ElementEventTarget
forall o. IsEventTarget o -> IsGObject o -> IsNode o
$cp2IsNode :: IsGObject ElementEventTarget
$cp1IsNode :: IsEventTarget ElementEventTarget
IsNode, IsGObject ElementEventTarget
IsAnimatable ElementEventTarget
IsChildNode ElementEventTarget
IsDocumentAndElementEventHandlers ElementEventTarget
IsEventTarget ElementEventTarget
IsNode ElementEventTarget
IsNonDocumentTypeChildNode ElementEventTarget
IsParentNode ElementEventTarget
IsSlotable ElementEventTarget
IsNode ElementEventTarget
-> IsEventTarget ElementEventTarget
-> IsSlotable ElementEventTarget
-> IsParentNode ElementEventTarget
-> IsNonDocumentTypeChildNode ElementEventTarget
-> IsDocumentAndElementEventHandlers ElementEventTarget
-> IsChildNode ElementEventTarget
-> IsAnimatable ElementEventTarget
-> IsGObject ElementEventTarget
-> IsElement ElementEventTarget
forall o.
IsNode o
-> IsEventTarget o
-> IsSlotable o
-> IsParentNode o
-> IsNonDocumentTypeChildNode o
-> IsDocumentAndElementEventHandlers o
-> IsChildNode o
-> IsAnimatable o
-> IsGObject o
-> IsElement o
$cp9IsElement :: IsGObject ElementEventTarget
$cp8IsElement :: IsAnimatable ElementEventTarget
$cp7IsElement :: IsChildNode ElementEventTarget
$cp6IsElement :: IsDocumentAndElementEventHandlers ElementEventTarget
$cp5IsElement :: IsNonDocumentTypeChildNode ElementEventTarget
$cp4IsElement :: IsParentNode ElementEventTarget
$cp3IsElement :: IsSlotable ElementEventTarget
$cp2IsElement :: IsEventTarget ElementEventTarget
$cp1IsElement :: IsNode ElementEventTarget
IsElement)
instance DOM.FromJSVal ElementEventTarget where
  fromJSVal :: JSVal -> JSM (Maybe ElementEventTarget)
fromJSVal = (Maybe Element -> Maybe ElementEventTarget)
-> JSM (Maybe Element) -> JSM (Maybe ElementEventTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Element -> ElementEventTarget)
-> Maybe Element -> Maybe ElementEventTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> ElementEventTarget
ElementEventTarget) (JSM (Maybe Element) -> JSM (Maybe ElementEventTarget))
-> (JSVal -> JSM (Maybe Element))
-> JSVal
-> JSM (Maybe ElementEventTarget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSM (Maybe Element)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
DOM.fromJSVal
instance DOM.IsEventTarget ElementEventTarget
instance DOM.IsGlobalEventHandlers ElementEventTarget
instance DOM.IsDocumentAndElementEventHandlers ElementEventTarget

{-# INLINABLE elementOnEventName #-}
elementOnEventName :: IsElement e => EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
elementOnEventName :: EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
elementOnEventName EventName en
en e
e_ = let e :: ElementEventTarget
e = Element -> ElementEventTarget
ElementEventTarget (e -> Element
forall o. IsElement o => o -> Element
DOM.toElement e
e_) in case EventName en
en of
  EventName en
Abort -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.abort
  EventName en
Blur -> ElementEventTarget
-> EventName ElementEventTarget FocusEvent
-> EventM ElementEventTarget FocusEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget FocusEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self FocusEvent
Events.blur
  EventName en
Change -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.change
  EventName en
Click -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.click
  EventName en
Contextmenu -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.contextMenu
  EventName en
Dblclick -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dblClick
  EventName en
Drag -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.drag
  EventName en
Dragend -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragEnd
  EventName en
Dragenter -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragEnter
  EventName en
Dragleave -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragLeave
  EventName en
Dragover -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragOver
  EventName en
Dragstart -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragStart
  EventName en
Drop -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.drop
  EventName en
Error -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.error
  EventName en
Focus -> ElementEventTarget
-> EventName ElementEventTarget FocusEvent
-> EventM ElementEventTarget FocusEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget FocusEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self FocusEvent
Events.focus
  EventName en
Input -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.input
  EventName en
Invalid -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.invalid
  EventName en
Keydown -> ElementEventTarget
-> EventName ElementEventTarget KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyDown
  EventName en
Keypress -> ElementEventTarget
-> EventName ElementEventTarget KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyPress
  EventName en
Keyup -> ElementEventTarget
-> EventName ElementEventTarget KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyUp
  EventName en
Load -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.load
  EventName en
Mousedown -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseDown
  EventName en
Mouseenter -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseEnter
  EventName en
Mouseleave -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseLeave
  EventName en
Mousemove -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseMove
  EventName en
Mouseout -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseOut
  EventName en
Mouseover -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseOver
  EventName en
Mouseup -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseUp
  EventName en
Mousewheel -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseWheel
  EventName en
Scroll -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.scroll
  EventName en
Select -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.select
  EventName en
Submit -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.submit
  EventName en
Wheel -> ElementEventTarget
-> EventName ElementEventTarget WheelEvent
-> EventM ElementEventTarget WheelEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget WheelEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self WheelEvent
Events.wheel
  EventName en
Beforecut -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.beforeCut
  EventName en
Cut -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.cut
  EventName en
Beforecopy -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.beforeCopy
  EventName en
Copy -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.copy
  EventName en
Beforepaste -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.beforePaste
  EventName en
Paste -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.paste
  EventName en
Reset -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.reset
  EventName en
Search -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.search
  EventName en
Selectstart -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsElement self, IsEventTarget self) =>
EventName self Event
Element.selectStart
  EventName en
Touchstart -> ElementEventTarget
-> EventName ElementEventTarget TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchStart
  EventName en
Touchmove -> ElementEventTarget
-> EventName ElementEventTarget TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchMove
  EventName en
Touchend -> ElementEventTarget
-> EventName ElementEventTarget TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchEnd
  EventName en
Touchcancel -> ElementEventTarget
-> EventName ElementEventTarget TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchCancel

{-# INLINABLE windowOnEventName #-}
windowOnEventName :: EventName en -> DOM.Window -> EventM DOM.Window (EventType en) () -> JSM (JSM ())
windowOnEventName :: EventName en
-> Window -> EventM Window (EventType en) () -> JSM (JSM ())
windowOnEventName EventName en
en Window
e = case EventName en
en of
  EventName en
Abort -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.abort
  EventName en
Blur -> Window
-> EventName Window FocusEvent
-> EventM ElementEventTarget FocusEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window FocusEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self FocusEvent
Events.blur
  EventName en
Change -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.change
  EventName en
Click -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.click
  EventName en
Contextmenu -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.contextMenu
  EventName en
Dblclick -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dblClick
  EventName en
Drag -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.drag
  EventName en
Dragend -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragEnd
  EventName en
Dragenter -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragEnter
  EventName en
Dragleave -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragLeave
  EventName en
Dragover -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragOver
  EventName en
Dragstart -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragStart
  EventName en
Drop -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.drop
  EventName en
Error -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.error
  EventName en
Focus -> Window
-> EventName Window FocusEvent
-> EventM ElementEventTarget FocusEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window FocusEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self FocusEvent
Events.focus
  EventName en
Input -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.input
  EventName en
Invalid -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.invalid
  EventName en
Keydown -> Window
-> EventName Window KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyDown
  EventName en
Keypress -> Window
-> EventName Window KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyPress
  EventName en
Keyup -> Window
-> EventName Window KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyUp
  EventName en
Load -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.load
  EventName en
Mousedown -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseDown
  EventName en
Mouseenter -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseEnter
  EventName en
Mouseleave -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseLeave
  EventName en
Mousemove -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseMove
  EventName en
Mouseout -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseOut
  EventName en
Mouseover -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseOver
  EventName en
Mouseup -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseUp
  EventName en
Mousewheel -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseWheel
  EventName en
Scroll -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.scroll
  EventName en
Select -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.select
  EventName en
Submit -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.submit
  EventName en
Wheel -> Window
-> EventName Window WheelEvent
-> EventM ElementEventTarget WheelEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window WheelEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self WheelEvent
Events.wheel
  EventName en
Beforecut -> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ())
 -> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ()))
-> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO
  EventName en
Cut -> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ())
 -> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ()))
-> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO
  EventName en
Beforecopy -> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ())
 -> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ()))
-> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO
  EventName en
Copy -> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ())
 -> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ()))
-> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO
  EventName en
Beforepaste -> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ())
 -> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ()))
-> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO
  EventName en
Paste -> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ())
 -> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ()))
-> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO
  EventName en
Reset -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.reset
  EventName en
Search -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.search
  EventName en
Selectstart -> JSM (JSM ()) -> EventM HTMLInputElement Event () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM HTMLInputElement Event () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM HTMLInputElement Event () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO
  EventName en
Touchstart -> Window
-> EventName Window TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchStart
  EventName en
Touchmove -> Window
-> EventName Window TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchMove
  EventName en
Touchend -> Window
-> EventName Window TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchEnd
  EventName en
Touchcancel -> Window
-> EventName Window TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchCancel

{-# INLINABLE wrapDomEvent #-}
wrapDomEvent :: (TriggerEvent t m, MonadJSM m) => e -> (e -> EventM e event () -> JSM (JSM ())) -> EventM e event a -> m (Event t a)
wrapDomEvent :: e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event a
-> m (Event t a)
wrapDomEvent e
el e -> EventM e event () -> JSM (JSM ())
elementOnevent EventM e event a
getValue = e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> m (Event t a)
forall t (m :: * -> *) e event a.
(TriggerEvent t m, MonadJSM m) =>
e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> m (Event t a)
wrapDomEventMaybe e
el e -> EventM e event () -> JSM (JSM ())
elementOnevent (EventM e event (Maybe a) -> m (Event t a))
-> EventM e event (Maybe a) -> m (Event t a)
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a) -> EventM e event a -> EventM e event (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just EventM e event a
getValue

{-# INLINABLE subscribeDomEvent #-}
subscribeDomEvent :: (EventM e event () -> JSM (JSM ()))
                  -> EventM e event (Maybe a)
                  -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
                  -> EventTrigger t a
                  -> JSM (JSM ())
subscribeDomEvent :: (EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> EventTrigger t a
-> JSM (JSM ())
subscribeDomEvent EventM e event () -> JSM (JSM ())
elementOnevent EventM e event (Maybe a)
getValue Chan [DSum (EventTriggerRef t) TriggerInvocation]
eventChan EventTrigger t a
et = EventM e event () -> JSM (JSM ())
elementOnevent (EventM e event () -> JSM (JSM ()))
-> EventM e event () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
  Maybe a
mv <- EventM e event (Maybe a)
getValue
  Maybe a -> (a -> EventM e event ()) -> EventM e event ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe a
mv ((a -> EventM e event ()) -> EventM e event ())
-> (a -> EventM e event ()) -> EventM e event ()
forall a b. (a -> b) -> a -> b
$ \a
v -> IO () -> EventM e event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM e event ()) -> IO () -> EventM e event ()
forall a b. (a -> b) -> a -> b
$ do
    --TODO: I don't think this is quite right: if a new trigger is created between when this is enqueued and when it fires, this may not work quite right
    IORef (Maybe (EventTrigger t a))
etr <- Maybe (EventTrigger t a) -> IO (IORef (Maybe (EventTrigger t a)))
forall a. a -> IO (IORef a)
newIORef (Maybe (EventTrigger t a) -> IO (IORef (Maybe (EventTrigger t a))))
-> Maybe (EventTrigger t a)
-> IO (IORef (Maybe (EventTrigger t a)))
forall a b. (a -> b) -> a -> b
$ EventTrigger t a -> Maybe (EventTrigger t a)
forall a. a -> Maybe a
Just EventTrigger t a
et
    Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> [DSum (EventTriggerRef t) TriggerInvocation] -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan [DSum (EventTriggerRef t) TriggerInvocation]
eventChan [IORef (Maybe (EventTrigger t a)) -> EventTriggerRef t a
forall t a. IORef (Maybe (EventTrigger t a)) -> EventTriggerRef t a
EventTriggerRef IORef (Maybe (EventTrigger t a))
etr EventTriggerRef t a
-> TriggerInvocation a
-> DSum (EventTriggerRef t) TriggerInvocation
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> a -> IO () -> TriggerInvocation a
forall a. a -> IO () -> TriggerInvocation a
TriggerInvocation a
v (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())]

{-# INLINABLE wrapDomEventMaybe #-}
wrapDomEventMaybe :: (TriggerEvent t m, MonadJSM m)
                  => e
                  -> (e -> EventM e event () -> JSM (JSM ()))
                  -> EventM e event (Maybe a)
                  -> m (Event t a)
wrapDomEventMaybe :: e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> m (Event t a)
wrapDomEventMaybe e
el e -> EventM e event () -> JSM (JSM ())
elementOnevent EventM e event (Maybe a)
getValue = do
  JSContextRef
ctx <- m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
  ((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
forall t (m :: * -> *) a.
TriggerEvent t m =>
((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
newEventWithLazyTriggerWithOnComplete (((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a))
-> ((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
forall a b. (a -> b) -> a -> b
$ \a -> IO () -> IO ()
trigger -> (JSM () -> JSContextRef -> IO ()
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM () -> IO ()) -> IO (JSM ()) -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSM (JSM ()) -> JSContextRef -> IO (JSM ())
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (e -> EventM e event () -> JSM (JSM ())
elementOnevent e
el (EventM e event () -> JSM (JSM ()))
-> EventM e event () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
    Maybe a
mv <- EventM e event (Maybe a)
getValue
    Maybe a -> (a -> EventM e event ()) -> EventM e event ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe a
mv ((a -> EventM e event ()) -> EventM e event ())
-> (a -> EventM e event ()) -> EventM e event ()
forall a b. (a -> b) -> a -> b
$ \a
v -> IO () -> EventM e event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM e event ()) -> IO () -> EventM e event ()
forall a b. (a -> b) -> a -> b
$ a -> IO () -> IO ()
trigger a
v (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

{-# INLINABLE wrapDomEventsMaybe #-}
wrapDomEventsMaybe :: (MonadJSM m, MonadReflexCreateTrigger t m)
                   => e
                   -> (forall en. IsEvent (EventType en) => EventName en -> EventM e (EventType en) (Maybe (f en)))
                   -> (forall en. EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ()))
                   -> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
wrapDomEventsMaybe :: e
-> (forall (en :: EventTag).
    IsEvent (EventType en) =>
    EventName en -> EventM e (EventType en) (Maybe (f en)))
-> (forall (en :: EventTag).
    EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ()))
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
wrapDomEventsMaybe e
target forall (en :: EventTag).
IsEvent (EventType en) =>
EventName en -> EventM e (EventType en) (Maybe (f en))
handlers forall (en :: EventTag).
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
onEventName = do
  JSContextRef
ctx <- HydrationDomBuilderT GhcjsDomSpace t m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
  Chan [DSum (EventTriggerRef t) TriggerInvocation]
eventChan <- HydrationDomBuilderT
  GhcjsDomSpace
  t
  m
  (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT
  s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents
  EventSelector t (WrapArg f EventName)
e <- m (EventSelector t (WrapArg f EventName))
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (EventSelector t (WrapArg f EventName))
 -> ImmediateDomBuilderT
      t m (EventSelector t (WrapArg f EventName)))
-> m (EventSelector t (WrapArg f EventName))
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
forall a b. (a -> b) -> a -> b
$ (forall a. WrapArg f EventName a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t (WrapArg f EventName))
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger ((forall a.
  WrapArg f EventName a -> EventTrigger t a -> IO (IO ()))
 -> m (EventSelector t (WrapArg f EventName)))
-> (forall a.
    WrapArg f EventName a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t (WrapArg f EventName))
forall a b. (a -> b) -> a -> b
$ \(WrapArg en) -> EventName a1
-> (IsEvent (EventType a1) => EventTrigger t (f a1) -> IO (IO ()))
-> EventTrigger t (f a1)
-> IO (IO ())
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName a1
en
    (((JSM () -> JSContextRef -> IO ()
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM () -> IO ()) -> IO (JSM ()) -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO (JSM ()) -> IO (IO ()))
-> (EventTrigger t (f a1) -> IO (JSM ()))
-> EventTrigger t (f a1)
-> IO (IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JSM (JSM ()) -> JSContextRef -> IO (JSM ())
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM (JSM ()) -> IO (JSM ()))
-> (EventTrigger t (f a1) -> JSM (JSM ()))
-> EventTrigger t (f a1)
-> IO (JSM ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventM Any (EventType a1) () -> JSM (JSM ()))
-> EventM Any (EventType a1) (Maybe (f a1))
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> EventTrigger t (f a1)
-> JSM (JSM ())
forall e event a t.
(EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> EventTrigger t a
-> JSM (JSM ())
subscribeDomEvent (EventName a1 -> e -> EventM Any (EventType a1) () -> JSM (JSM ())
forall (en :: EventTag).
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
onEventName EventName a1
en e
target) (EventName a1 -> EventM Any (EventType a1) (Maybe (f a1))
forall (en :: EventTag).
IsEvent (EventType en) =>
EventName en -> EventM e (EventType en) (Maybe (f en))
handlers EventName a1
en) Chan [DSum (EventTriggerRef t) TriggerInvocation]
eventChan)
  EventSelector t (WrapArg f EventName)
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
forall (m :: * -> *) a. Monad m => a -> m a
return (EventSelector t (WrapArg f EventName)
 -> ImmediateDomBuilderT
      t m (EventSelector t (WrapArg f EventName)))
-> EventSelector t (WrapArg f EventName)
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
forall a b. (a -> b) -> a -> b
$! EventSelector t (WrapArg f EventName)
e

{-# INLINABLE getKeyEvent #-}
getKeyEvent :: EventM e KeyboardEvent Word
getKeyEvent :: EventM e KeyboardEvent Word
getKeyEvent = do
  KeyboardEvent
e <- EventM Any KeyboardEvent KeyboardEvent
forall t e. EventM t e e
event
  Word
which <- KeyboardEvent -> EventM e KeyboardEvent Word
forall (m :: * -> *). MonadDOM m => KeyboardEvent -> m Word
KeyboardEvent.getWhich KeyboardEvent
e
  if Word
which Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 then Word -> EventM e KeyboardEvent Word
forall (m :: * -> *) a. Monad m => a -> m a
return Word
which else do
    Word
charCode <- KeyboardEvent -> EventM e KeyboardEvent Word
forall (m :: * -> *). MonadDOM m => KeyboardEvent -> m Word
getCharCode KeyboardEvent
e
    if Word
charCode Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 then Word -> EventM e KeyboardEvent Word
forall (m :: * -> *) a. Monad m => a -> m a
return Word
charCode else
      KeyboardEvent -> EventM e KeyboardEvent Word
forall (m :: * -> *). MonadDOM m => KeyboardEvent -> m Word
getKeyCode KeyboardEvent
e

{-# INLINABLE getMouseEventCoords #-}
getMouseEventCoords :: EventM e MouseEvent (Int, Int)
getMouseEventCoords :: EventM e MouseEvent (Int, Int)
getMouseEventCoords = do
  MouseEvent
e <- EventM Any MouseEvent MouseEvent
forall t e. EventM t e e
event
  (ReaderT MouseEvent JSM Int, ReaderT MouseEvent JSM Int)
-> EventM e MouseEvent (Int, Int)
forall (t :: * -> * -> *) (f :: * -> *) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequence (MouseEvent -> ReaderT MouseEvent JSM Int
forall (m :: * -> *) self.
(MonadDOM m, IsMouseEvent self) =>
self -> m Int
getClientX MouseEvent
e, MouseEvent -> ReaderT MouseEvent JSM Int
forall (m :: * -> *) self.
(MonadDOM m, IsMouseEvent self) =>
self -> m Int
getClientY MouseEvent
e)

{-# INLINABLE getPasteData #-}
getPasteData :: EventM e ClipboardEvent (Maybe Text)
getPasteData :: EventM e ClipboardEvent (Maybe Text)
getPasteData = do
  ClipboardEvent
e <- EventM Any ClipboardEvent ClipboardEvent
forall t e. EventM t e e
event
  Maybe DataTransfer
mdt <- ClipboardEvent -> ReaderT ClipboardEvent JSM (Maybe DataTransfer)
forall (m :: * -> *).
MonadDOM m =>
ClipboardEvent -> m (Maybe DataTransfer)
ClipboardEvent.getClipboardData ClipboardEvent
e
  case Maybe DataTransfer
mdt of
    Maybe DataTransfer
Nothing -> Maybe Text -> EventM e ClipboardEvent (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
    Just DataTransfer
dt -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> ReaderT ClipboardEvent JSM Text
-> EventM e ClipboardEvent (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataTransfer -> Text -> ReaderT ClipboardEvent JSM Text
forall (m :: * -> *) format result.
(MonadDOM m, ToJSString format, FromJSString result) =>
DataTransfer -> format -> m result
DataTransfer.getData DataTransfer
dt (Text
"text" :: Text)

{-# INLINABLE getTouchEvent #-}
getTouchEvent :: EventM e TouchEvent TouchEventResult
getTouchEvent :: EventM e TouchEvent TouchEventResult
getTouchEvent = do
  let touchResults :: TouchList -> m [TouchResult]
touchResults TouchList
ts = do
          Word
n <- TouchList -> m Word
forall (m :: * -> *). MonadDOM m => TouchList -> m Word
TouchList.getLength TouchList
ts
          [Word] -> (Word -> m TouchResult) -> m [TouchResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ((Word -> Bool) -> [Word] -> [Word]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
n) [Word
0..]) ((Word -> m TouchResult) -> m [TouchResult])
-> (Word -> m TouchResult) -> m [TouchResult]
forall a b. (a -> b) -> a -> b
$ \Word
ix -> do
            Touch
t <- TouchList -> Word -> m Touch
forall (m :: * -> *). MonadDOM m => TouchList -> Word -> m Touch
TouchList.item TouchList
ts Word
ix
            Word
identifier <- Touch -> m Word
forall (m :: * -> *). MonadDOM m => Touch -> m Word
Touch.getIdentifier Touch
t
            Int
screenX <- Touch -> m Int
forall (m :: * -> *). MonadDOM m => Touch -> m Int
Touch.getScreenX Touch
t
            Int
screenY <- Touch -> m Int
forall (m :: * -> *). MonadDOM m => Touch -> m Int
Touch.getScreenY Touch
t
            Int
clientX <- Touch -> m Int
forall (m :: * -> *). MonadDOM m => Touch -> m Int
Touch.getClientX Touch
t
            Int
clientY <- Touch -> m Int
forall (m :: * -> *). MonadDOM m => Touch -> m Int
Touch.getClientY Touch
t
            Int
pageX <- Touch -> m Int
forall (m :: * -> *). MonadDOM m => Touch -> m Int
Touch.getPageX Touch
t
            Int
pageY <- Touch -> m Int
forall (m :: * -> *). MonadDOM m => Touch -> m Int
Touch.getPageY Touch
t
            TouchResult -> m TouchResult
forall (m :: * -> *) a. Monad m => a -> m a
return TouchResult :: Word -> Int -> Int -> Int -> Int -> Int -> Int -> TouchResult
TouchResult
              { _touchResult_identifier :: Word
_touchResult_identifier = Word
identifier
              , _touchResult_screenX :: Int
_touchResult_screenX = Int
screenX
              , _touchResult_screenY :: Int
_touchResult_screenY = Int
screenY
              , _touchResult_clientX :: Int
_touchResult_clientX = Int
clientX
              , _touchResult_clientY :: Int
_touchResult_clientY = Int
clientY
              , _touchResult_pageX :: Int
_touchResult_pageX = Int
pageX
              , _touchResult_pageY :: Int
_touchResult_pageY = Int
pageY
              }
  TouchEvent
e <- EventM Any TouchEvent TouchEvent
forall t e. EventM t e e
event
  Bool
altKey <- TouchEvent -> ReaderT TouchEvent JSM Bool
forall (m :: * -> *). MonadDOM m => TouchEvent -> m Bool
TouchEvent.getAltKey TouchEvent
e
  Bool
ctrlKey <- TouchEvent -> ReaderT TouchEvent JSM Bool
forall (m :: * -> *). MonadDOM m => TouchEvent -> m Bool
TouchEvent.getCtrlKey TouchEvent
e
  Bool
shiftKey <- TouchEvent -> ReaderT TouchEvent JSM Bool
forall (m :: * -> *). MonadDOM m => TouchEvent -> m Bool
TouchEvent.getShiftKey TouchEvent
e
  Bool
metaKey <- TouchEvent -> ReaderT TouchEvent JSM Bool
forall (m :: * -> *). MonadDOM m => TouchEvent -> m Bool
TouchEvent.getMetaKey TouchEvent
e
  [TouchResult]
changedTouches <- TouchList -> ReaderT TouchEvent JSM [TouchResult]
forall (m :: * -> *). MonadJSM m => TouchList -> m [TouchResult]
touchResults (TouchList -> ReaderT TouchEvent JSM [TouchResult])
-> ReaderT TouchEvent JSM TouchList
-> ReaderT TouchEvent JSM [TouchResult]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TouchEvent -> ReaderT TouchEvent JSM TouchList
forall (m :: * -> *). MonadDOM m => TouchEvent -> m TouchList
TouchEvent.getChangedTouches TouchEvent
e
  [TouchResult]
targetTouches <- TouchList -> ReaderT TouchEvent JSM [TouchResult]
forall (m :: * -> *). MonadJSM m => TouchList -> m [TouchResult]
touchResults (TouchList -> ReaderT TouchEvent JSM [TouchResult])
-> ReaderT TouchEvent JSM TouchList
-> ReaderT TouchEvent JSM [TouchResult]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TouchEvent -> ReaderT TouchEvent JSM TouchList
forall (m :: * -> *). MonadDOM m => TouchEvent -> m TouchList
TouchEvent.getTargetTouches TouchEvent
e
  [TouchResult]
touches <- TouchList -> ReaderT TouchEvent JSM [TouchResult]
forall (m :: * -> *). MonadJSM m => TouchList -> m [TouchResult]
touchResults (TouchList -> ReaderT TouchEvent JSM [TouchResult])
-> ReaderT TouchEvent JSM TouchList
-> ReaderT TouchEvent JSM [TouchResult]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TouchEvent -> ReaderT TouchEvent JSM TouchList
forall (m :: * -> *). MonadDOM m => TouchEvent -> m TouchList
TouchEvent.getTouches TouchEvent
e
  TouchEventResult -> EventM e TouchEvent TouchEventResult
forall (m :: * -> *) a. Monad m => a -> m a
return (TouchEventResult -> EventM e TouchEvent TouchEventResult)
-> TouchEventResult -> EventM e TouchEvent TouchEventResult
forall a b. (a -> b) -> a -> b
$ TouchEventResult :: Bool
-> [TouchResult]
-> Bool
-> Bool
-> Bool
-> [TouchResult]
-> [TouchResult]
-> TouchEventResult
TouchEventResult
    { _touchEventResult_altKey :: Bool
_touchEventResult_altKey = Bool
altKey
    , _touchEventResult_changedTouches :: [TouchResult]
_touchEventResult_changedTouches = [TouchResult]
changedTouches
    , _touchEventResult_ctrlKey :: Bool
_touchEventResult_ctrlKey = Bool
ctrlKey
    , _touchEventResult_metaKey :: Bool
_touchEventResult_metaKey = Bool
metaKey
    , _touchEventResult_shiftKey :: Bool
_touchEventResult_shiftKey = Bool
shiftKey
    , _touchEventResult_targetTouches :: [TouchResult]
_touchEventResult_targetTouches = [TouchResult]
targetTouches
    , _touchEventResult_touches :: [TouchResult]
_touchEventResult_touches = [TouchResult]
touches
    }

{-# INLINABLE getWheelEvent #-}
getWheelEvent :: EventM e WheelEvent WheelEventResult
getWheelEvent :: EventM e WheelEvent WheelEventResult
getWheelEvent = do
  WheelEvent
e <- EventM Any WheelEvent WheelEvent
forall t e. EventM t e e
event
  Double
dx :: Double <- WheelEvent -> ReaderT WheelEvent JSM Double
forall (m :: * -> *). MonadDOM m => WheelEvent -> m Double
WheelEvent.getDeltaX WheelEvent
e
  Double
dy :: Double <- WheelEvent -> ReaderT WheelEvent JSM Double
forall (m :: * -> *). MonadDOM m => WheelEvent -> m Double
WheelEvent.getDeltaY WheelEvent
e
  Double
dz :: Double <- WheelEvent -> ReaderT WheelEvent JSM Double
forall (m :: * -> *). MonadDOM m => WheelEvent -> m Double
WheelEvent.getDeltaZ WheelEvent
e
  Word
deltaMode :: Word <- WheelEvent -> ReaderT WheelEvent JSM Word
forall (m :: * -> *). MonadDOM m => WheelEvent -> m Word
WheelEvent.getDeltaMode WheelEvent
e
  WheelEventResult -> EventM e WheelEvent WheelEventResult
forall (m :: * -> *) a. Monad m => a -> m a
return (WheelEventResult -> EventM e WheelEvent WheelEventResult)
-> WheelEventResult -> EventM e WheelEvent WheelEventResult
forall a b. (a -> b) -> a -> b
$ WheelEventResult :: Double -> Double -> Double -> DeltaMode -> WheelEventResult
WheelEventResult
    { _wheelEventResult_deltaX :: Double
_wheelEventResult_deltaX = Double
dx
    , _wheelEventResult_deltaY :: Double
_wheelEventResult_deltaY = Double
dy
    , _wheelEventResult_deltaZ :: Double
_wheelEventResult_deltaZ = Double
dz
    , _wheelEventResult_deltaMode :: DeltaMode
_wheelEventResult_deltaMode = case Word
deltaMode of
        Word
0 -> DeltaMode
DeltaPixel
        Word
1 -> DeltaMode
DeltaLine
        Word
2 -> DeltaMode
DeltaPage
        -- See https://developer.mozilla.org/en-US/docs/Web/API/WheelEvent/deltaMode
        Word
_ -> String -> DeltaMode
forall a. HasCallStack => String -> a
error String
"getWheelEvent: impossible encoding"
    }

instance MonadSample t m => MonadSample t (HydrationDomBuilderT s t m) where
  {-# INLINABLE sample #-}
  sample :: Behavior t a -> HydrationDomBuilderT s t m a
sample = m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> (Behavior t a -> m a)
-> Behavior t a
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior t a -> m a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample

instance MonadHold t m => MonadHold t (HydrationDomBuilderT s t m) where
  {-# INLINABLE hold #-}
  hold :: a -> Event t a -> HydrationDomBuilderT s t m (Behavior t a)
hold a
v0 Event t a
v' = m (Behavior t a) -> HydrationDomBuilderT s t m (Behavior t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Behavior t a) -> HydrationDomBuilderT s t m (Behavior t a))
-> m (Behavior t a) -> HydrationDomBuilderT s t m (Behavior t a)
forall a b. (a -> b) -> a -> b
$ a -> Event t a -> m (Behavior t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold a
v0 Event t a
v'
  {-# INLINABLE holdDyn #-}
  holdDyn :: a -> Event t a -> HydrationDomBuilderT s t m (Dynamic t a)
holdDyn a
v0 Event t a
v' = m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a))
-> m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a)
forall a b. (a -> b) -> a -> b
$ a -> Event t a -> m (Dynamic t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn a
v0 Event t a
v'
  {-# INLINABLE holdIncremental #-}
  holdIncremental :: PatchTarget p
-> Event t p -> HydrationDomBuilderT s t m (Incremental t p)
holdIncremental PatchTarget p
v0 Event t p
v' = m (Incremental t p) -> HydrationDomBuilderT s t m (Incremental t p)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Incremental t p)
 -> HydrationDomBuilderT s t m (Incremental t p))
-> m (Incremental t p)
-> HydrationDomBuilderT s t m (Incremental t p)
forall a b. (a -> b) -> a -> b
$ PatchTarget p -> Event t p -> m (Incremental t p)
forall k (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental PatchTarget p
v0 Event t p
v'
  {-# INLINABLE buildDynamic #-}
  buildDynamic :: PushM t a -> Event t a -> HydrationDomBuilderT s t m (Dynamic t a)
buildDynamic PushM t a
a0 = m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a))
-> (Event t a -> m (Dynamic t a))
-> Event t a
-> HydrationDomBuilderT s t m (Dynamic t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PushM t a -> Event t a -> m (Dynamic t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic PushM t a
a0
  {-# INLINABLE headE #-}
  headE :: Event t a -> HydrationDomBuilderT s t m (Event t a)
headE = m (Event t a) -> HydrationDomBuilderT s t m (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> HydrationDomBuilderT s t m (Event t a))
-> (Event t a -> m (Event t a))
-> Event t a
-> HydrationDomBuilderT s t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t a -> m (Event t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
Event t a -> m (Event t a)
headE

data WindowConfig t = WindowConfig -- No config options yet

instance Default (WindowConfig t) where
  def :: WindowConfig t
def = WindowConfig t
forall k (t :: k). WindowConfig t
WindowConfig

data Window t = Window
  { Window t -> EventSelector t (WrapArg EventResult EventName)
_window_events :: EventSelector t (WrapArg EventResult EventName)
  , Window t -> Window
_window_raw :: DOM.Window
  }

wrapWindow :: (MonadJSM m, MonadReflexCreateTrigger t m) => DOM.Window -> WindowConfig t -> HydrationDomBuilderT GhcjsDomSpace t m (Window t)
wrapWindow :: Window
-> WindowConfig t
-> HydrationDomBuilderT GhcjsDomSpace t m (Window t)
wrapWindow Window
wv WindowConfig t
_ = do
  EventSelector t (WrapArg EventResult EventName)
events <- Window
-> (forall (en :: EventTag).
    IsEvent (EventType en) =>
    EventName en
    -> EventM Window (EventType en) (Maybe (EventResult en)))
-> (forall (en :: EventTag).
    EventName en
    -> Window -> EventM e (EventType en) () -> JSM (JSM ()))
-> ImmediateDomBuilderT
     t m (EventSelector t (WrapArg EventResult EventName))
forall (m :: * -> *) t e (f :: EventTag -> *).
(MonadJSM m, MonadReflexCreateTrigger t m) =>
e
-> (forall (en :: EventTag).
    IsEvent (EventType en) =>
    EventName en -> EventM e (EventType en) (Maybe (f en)))
-> (forall (en :: EventTag).
    EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ()))
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
wrapDomEventsMaybe Window
wv (Window
-> EventName en
-> EventM Window (EventType en) (Maybe (EventResult en))
forall (en :: EventTag).
Window
-> EventName en
-> EventM Window (EventType en) (Maybe (EventResult en))
defaultDomWindowEventHandler Window
wv) forall (en :: EventTag).
EventName en
-> Window -> EventM e (EventType en) () -> JSM (JSM ())
windowOnEventName
  Window t -> HydrationDomBuilderT GhcjsDomSpace t m (Window t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Window t -> HydrationDomBuilderT GhcjsDomSpace t m (Window t))
-> Window t -> HydrationDomBuilderT GhcjsDomSpace t m (Window t)
forall a b. (a -> b) -> a -> b
$ Window :: forall k (t :: k).
EventSelector t (WrapArg EventResult EventName)
-> Window -> Window t
Window
    { _window_events :: EventSelector t (WrapArg EventResult EventName)
_window_events = EventSelector t (WrapArg EventResult EventName)
events
    , _window_raw :: Window
_window_raw = Window
wv
    }

#ifdef USE_TEMPLATE_HASKELL
makeLenses ''GhcjsEventSpec
#endif