{-# 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
import Control.Monad.Exception
import Control.Monad.Fix
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.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.Kind (Type)
import Data.Maybe
import Data.Some (Some(..))
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, Node, TouchEvent, WheelEvent, uncheckedCastTo)
import GHCJS.DOM.UIEvent
#ifndef ghcjs_HOST_OS
import Language.Javascript.JSaddle (call, eval) -- Avoid using eval in ghcjs. Use ffi instead
#endif
import Reflex.Adjustable.Class
import Reflex.Class as Reflex
import Reflex.Dom.Builder.Class
import Reflex.Dynamic
import Reflex.Host.Class
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' :: forall a. JSM a -> HydrationRunnerT t m a
liftJSM' = m a -> HydrationRunnerT t m a
forall (m :: * -> *) a. Monad m => m a -> HydrationRunnerT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationRunnerT t m 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 a. 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' :: forall a. JSM a -> HydrationDomBuilderT s t m a
liftJSM' = m a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a.
Monad m =>
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 a. 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' :: forall a. JSM a -> DomRenderHookT t m a
liftJSM' = m a -> DomRenderHookT t m a
forall (m :: * -> *) a. Monad m => 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 a. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
#endif

data HydrationDomBuilderEnv t m = HydrationDomBuilderEnv
  { forall t (m :: * -> *). HydrationDomBuilderEnv t m -> Document
_hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document
  -- ^ Reference to the document
  , forall t (m :: * -> *).
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
  , forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren :: {-# UNPACK #-} !(IORef Word)
  -- ^ Number of children who still aren't fully rendered
  , forall t (m :: * -> *). 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
  , forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode :: {-# UNPACK #-} !(IORef HydrationMode)
  -- ^ In hydration mode? Should be switched to `HydrationMode_Immediate` after hydration is finished
  , forall t (m :: * -> *). HydrationDomBuilderEnv t m -> Event t ()
_hydrationDomBuilderEnv_switchover :: !(Event t ())
  , forall t (m :: * -> *).
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 { forall {k} (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT :: ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a }
  deriving ((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
$cfmap :: forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
fmap :: forall a b.
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
$c<$ :: forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
<$ :: forall a b.
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
Functor, Functor (HydrationDomBuilderT s t m)
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)
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
$cpure :: forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
pure :: forall a. a -> HydrationDomBuilderT s t m a
$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
<*> :: forall a b.
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
$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
liftA2 :: forall a b c.
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
$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
*> :: forall a b.
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 a
<* :: forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
Applicative, Applicative (HydrationDomBuilderT s t m)
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)
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
$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
>>= :: forall a 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
-> 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
$creturn :: forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
return :: forall a. a -> HydrationDomBuilderT s t m a
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)
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
$cmfix :: forall k (s :: k) t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
mfix :: forall a.
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
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)
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
$cliftIO :: forall k (s :: k) t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationDomBuilderT s t m a
liftIO :: forall a. IO a -> HydrationDomBuilderT s t m a
MonadIO, Monad (HydrationDomBuilderT s t m)
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)
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
$cthrow :: forall k (s :: k) t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationDomBuilderT s t m a
throw :: forall e a. Exception e => e -> 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
catch :: forall e a.
Exception e =>
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> 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
finally :: forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
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 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
$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
mask :: 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
#endif
           )

instance PrimMonad m => PrimMonad (HydrationDomBuilderT s t m) where
  type PrimState (HydrationDomBuilderT s t m) = PrimState m
  primitive :: forall a.
(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 (m :: * -> *) a.
Monad m =>
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 a.
(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 :: forall (m :: * -> *) a.
Monad m =>
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) 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 (m :: * -> *) a. Monad m => 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 a.
(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 a.
(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 JSM x -> JSM x
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 :: forall a. 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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) m 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 a. 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_ :: forall a. 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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) m a
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 a. 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 { forall t (m :: * -> *) a.
HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
unHydrationRunnerT :: StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a }
  deriving ((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
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
fmap :: forall a b.
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
<$ :: forall a b. a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
Functor, Functor (HydrationRunnerT t m)
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)
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
$cpure :: forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
pure :: forall a. a -> HydrationRunnerT t m a
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
<*> :: forall a b.
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
liftA2 :: forall a b c.
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
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 b
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
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 a
Applicative, Applicative (HydrationRunnerT t m)
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)
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
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> (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
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
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 b
$creturn :: forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
return :: forall a. a -> HydrationRunnerT t m a
Monad, Monad (HydrationRunnerT t m)
Monad (HydrationRunnerT t m) =>
(forall a. (a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a)
-> MonadFix (HydrationRunnerT t m)
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
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
mfix :: forall a. (a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
MonadFix, Monad (HydrationRunnerT t m)
Monad (HydrationRunnerT t m) =>
(forall a. IO a -> HydrationRunnerT t m a)
-> MonadIO (HydrationRunnerT t m)
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
$cliftIO :: forall t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationRunnerT t m a
liftIO :: forall a. IO a -> HydrationRunnerT t m a
MonadIO, Monad (HydrationRunnerT t m)
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)
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
$cthrow :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationRunnerT t m a
throw :: forall e a. Exception e => e -> 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
catch :: forall e a.
Exception e =>
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
$cfinally :: forall t (m :: * -> *) a b.
MonadException m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
finally :: forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
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 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
$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
mask :: forall b.
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
 -> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
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 :: forall (m :: * -> *) t a.
(MonadJSM m, Monad m) =>
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
  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, s') <- HydrationRunnerT $ lift $ local (\Node
_ -> Node
parent) $ runStateT m (s0 { _hydrationState_previousNode = s })
  traverse_ removeSubsequentNodes $ _hydrationState_previousNode s'
  HydrationRunnerT $ modify' $ \HydrationState
hs -> HydrationState
hs { _hydrationState_failed = _hydrationState_failed s' }
  pure 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 :: forall (m :: * -> *) t a.
(MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m,
 MonadReflexCreateTrigger t m, MonadJSM m,
 MonadJSM (Performable m)) =>
HydrationRunnerT t m a
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationRunnerT HydrationRunnerT 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 a. a -> IO a
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 :: 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 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, 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)
  traverse_ removeSubsequentNodes $ _hydrationState_previousNode s'
  when (_hydrationState_failed s') $ liftIO $ putStrLn "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."
  when (_hydrationState_failed s') $ liftIO onFailure
  pure a



instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRunnerT t m) where
  {-# INLINABLE newEventWithTrigger #-}
  newEventWithTrigger :: forall a.
(EventTrigger t a -> IO (IO ()))
-> HydrationRunnerT t m (Event t a)
newEventWithTrigger = m (Event t a) -> HydrationRunnerT t m (Event t a)
forall (m :: * -> *) a. Monad m => m a -> HydrationRunnerT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (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 a. (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 (k :: * -> *).
GCompare k =>
(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 (m :: * -> *) a. Monad m => m a -> HydrationRunnerT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (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)
forall (k :: * -> *).
GCompare k =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger k a -> EventTrigger t a -> IO (IO ())
forall a. k a -> EventTrigger t a -> IO (IO ())
f

instance MonadTrans (HydrationRunnerT t) where
  {-# INLINABLE lift #-}
  lift :: forall (m :: * -> *) a. Monad m => 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 (m :: * -> *) a. Monad m => m a -> StateT HydrationState 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 (m :: * -> *) a. Monad m => m a -> ReaderT Node 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 (m :: * -> *) a. Monad m => 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 :: forall a. Behavior t a -> HydrationRunnerT t m a
sample = m a -> HydrationRunnerT t m a
forall (m :: * -> *) a. Monad m => m a -> HydrationRunnerT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationRunnerT t m 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 a. 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 a.
(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 a.
(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 JSM x -> JSM x
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 :: forall a. 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 (m :: * -> *) a. Monad m => m a -> StateT HydrationState m 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 (m :: * -> *) a. Monad m => m a -> ReaderT Node m 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 a. 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_ :: forall a. 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 (m :: * -> *) a. Monad m => m a -> StateT HydrationState m a
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 (m :: * -> *) a. Monad m => m a -> ReaderT Node m a
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 a. 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 :: forall {k} (m :: * -> *) a t (s :: k).
MonadIO m =>
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 a b.
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  HydrationMode
HydrationMode_Immediate -> () -> HydrationDomBuilderT s t m ()
forall a. a -> HydrationDomBuilderT s t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  HydrationMode
HydrationMode_Hydrating -> do
    s <- m a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
setup
    addHydrationStep (f s)

-- | Add a hydration step
{-# INLINABLE addHydrationStep #-}
addHydrationStep :: MonadIO m => HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
addHydrationStep :: forall {k} (m :: * -> *) t (s :: k).
MonadIO m =>
HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
addHydrationStep HydrationRunnerT t m ()
m = do
  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
  liftIO $ modifyIORef' delayedRef (>> m)

-- | Shared behavior for HydrationDomBuilderT and HydrationRunnerT
newtype DomRenderHookT t m a = DomRenderHookT { forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT :: RequesterT t JSM Identity (TriggerEventT t m) a }
  deriving ((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
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
fmap :: forall a b.
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> DomRenderHookT t m b -> DomRenderHookT t m a
<$ :: forall a b. a -> DomRenderHookT t m b -> DomRenderHookT t m a
Functor, Functor (DomRenderHookT t m)
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)
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
$cpure :: forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
pure :: forall a. a -> DomRenderHookT t m a
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
<*> :: forall a b.
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
liftA2 :: forall a b c.
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
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 b
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
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 a
Applicative, Applicative (DomRenderHookT t m)
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)
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
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> (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
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
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 b
$creturn :: forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
return :: forall a. a -> DomRenderHookT t m a
Monad, Monad (DomRenderHookT t m)
Monad (DomRenderHookT t m) =>
(forall a. (a -> DomRenderHookT t m a) -> DomRenderHookT t m a)
-> MonadFix (DomRenderHookT t m)
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
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> DomRenderHookT t m a) -> DomRenderHookT t m a
mfix :: forall a. (a -> DomRenderHookT t m a) -> DomRenderHookT t m a
MonadFix, Monad (DomRenderHookT t m)
Monad (DomRenderHookT t m) =>
(forall a. IO a -> DomRenderHookT t m a)
-> MonadIO (DomRenderHookT t m)
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
$cliftIO :: forall t (m :: * -> *) a. MonadIO m => IO a -> DomRenderHookT t m a
liftIO :: forall a. IO a -> DomRenderHookT t m a
MonadIO, Monad (DomRenderHookT t m)
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)
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
$cthrow :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> DomRenderHookT t m a
throw :: forall e a. Exception e => e -> 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
catch :: forall e a.
Exception e =>
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
$cfinally :: forall t (m :: * -> *) a b.
MonadException m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
finally :: forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
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 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
$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
mask :: forall b.
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
 -> DomRenderHookT t m b)
-> DomRenderHookT t m b
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 :: 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 (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 (result, req) <- runRequesterT a rsp
        rsp <- performEventAsync $ ffor req $ \RequesterData JSM
rm RequesterData Identity -> IO ()
f -> JSM () -> Performable (TriggerEventT t m) ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> Performable (TriggerEventT t m) ())
-> JSM () -> Performable (TriggerEventT t m) ()
forall a b. (a -> b) -> a -> b
$ (RequesterData Identity -> IO ())
-> JSM (RequesterData Identity) -> JSM ()
forall {a} {a}. (a -> IO a) -> JSM a -> 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 a b. (a -> b) -> JSM a -> JSM b
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
    return result
  where
    runInAnimationFrame :: (a -> IO a) -> JSM a -> JSM ()
runInAnimationFrame a -> IO a
f JSM a
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
        v <- JSM a -> JSM a
forall x. JSM x -> JSM x
synchronously JSM a
x
        void . liftIO $ f v

instance MonadTrans (DomRenderHookT t) where
  {-# INLINABLE lift #-}
  lift :: forall (m :: * -> *) a. Monad m => 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 (m :: * -> *) a.
Monad m =>
m a -> RequesterT t JSM Identity 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 (m :: * -> *) a. Monad m => 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 a.
(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
      (x, req) <- TriggerEventT t m (a, Event t (RequesterData JSM))
-> RequesterT
     t JSM Identity (TriggerEventT t m) (a, Event t (RequesterData JSM))
forall (m :: * -> *) a.
Monad m =>
m a -> RequesterT t JSM Identity m a
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
      return (ffor req $ \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 a b. (a -> b) -> JSM a -> JSM b
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, x)
  requestDomAction :: forall a. 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)
Event t (Request (RequesterT t JSM Identity (TriggerEventT t m)) 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_ :: forall a. 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) ()
Event t (Request (RequesterT t JSM Identity (TriggerEventT t m)) a)
-> RequesterT t JSM Identity (TriggerEventT t m) ()
forall a.
Event t (Request (RequesterT t JSM Identity (TriggerEventT t m)) 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 :: forall {k} (m :: * -> *) t (s :: k) a.
(MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m,
 MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef) =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderEnv t m
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationDomBuilderT (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)
  (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
-> HydrationDomBuilderT
     s t m (RawDocument (DomBuilderSpace (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)
   (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
 -> HydrationDomBuilderT
      s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
-> HydrationDomBuilderT
     s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
forall a b. (a -> b) -> a -> b
$ (HydrationDomBuilderEnv t m
 -> RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
-> ReaderT
     (HydrationDomBuilderEnv t m)
     (DomRenderHookT t m)
     (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> Document
HydrationDomBuilderEnv t m
-> RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> Document
_hydrationDomBuilderEnv_document

{-# INLINABLE askParent #-}
askParent :: Monad m => HydrationRunnerT t m DOM.Node
askParent :: forall (m :: * -> *) t. Monad m => 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 :: forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
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 a. a -> HydrationDomBuilderT s t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO Node -> HydrationDomBuilderT s t m Node
forall a. IO a -> HydrationDomBuilderT s t m a
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 :: forall {k} (m :: * -> *) (s :: k) t.
Monad m =>
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) m a
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 (m :: * -> *) a.
Monad m =>
m a -> RequesterT t JSM Identity m a
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 :: 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 -> 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 a.
(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 :: forall {k} (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append Node
n = do
  p <- HydrationDomBuilderT s t m Node
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
  liftJSM $ appendChild_ p n
  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
$c== :: HydrationMode -> HydrationMode -> Bool
== :: HydrationMode -> HydrationMode -> Bool
$c/= :: HydrationMode -> HydrationMode -> Bool
/= :: 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
$ccompare :: HydrationMode -> HydrationMode -> Ordering
compare :: HydrationMode -> HydrationMode -> Ordering
$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
>= :: HydrationMode -> HydrationMode -> Bool
$cmax :: HydrationMode -> HydrationMode -> HydrationMode
max :: HydrationMode -> HydrationMode -> HydrationMode
$cmin :: HydrationMode -> HydrationMode -> HydrationMode
min :: HydrationMode -> HydrationMode -> 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
$cshowsPrec :: Int -> HydrationMode -> ShowS
showsPrec :: Int -> HydrationMode -> ShowS
$cshow :: HydrationMode -> String
show :: HydrationMode -> String
$cshowList :: [HydrationMode] -> ShowS
showList :: [HydrationMode] -> ShowS
Show)

{-# INLINABLE getPreviousNode #-}
getPreviousNode :: Monad m => HydrationRunnerT t m (Maybe DOM.Node)
getPreviousNode :: forall (m :: * -> *) t.
Monad m =>
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 :: forall (m :: * -> *) t.
Monad m =>
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 = n })

{-# INLINABLE askUnreadyChildren #-}
askUnreadyChildren :: Monad m => HydrationDomBuilderT s t m (IORef Word)
askUnreadyChildren :: forall {k} (m :: * -> *) (s :: k) t.
Monad m =>
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 :: forall {k} (m :: * -> *) (s :: k) t.
Monad m =>
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 :: forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode = IO HydrationMode -> HydrationDomBuilderT s t m HydrationMode
forall a. IO a -> HydrationDomBuilderT s t m a
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 ()
#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 2021-11-06)
foreign import javascript unsafe
#if __GLASGOW_HASKELL__ < 900
  "(function() { var n = $1; while (n['nextSibling']) { n['parentNode']['removeChild'](n['nextSibling']); }; })()"
#else
  "(function(n) { while (n['nextSibling']) { n['parentNode']['removeChild'](n['nextSibling']); }; })"
#endif
  removeSubsequentNodes_ :: DOM.Node -> IO ()
removeSubsequentNodes n = liftJSM $ removeSubsequentNodes_ (toNode n)
#else
removeSubsequentNodes :: forall (m :: * -> *) n. (MonadJSM m, IsNode n) => 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
  f <- Text -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval (Text
"(function(n) { while (n.nextSibling) { (n.parentNode).removeChild(n.nextSibling); }; })" :: Text)
  void $ call f f [n]
#endif

-- | 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 :: forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> 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
  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
  extractBetweenExclusive df s 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 ()
#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 2021-11-06)
foreign import javascript unsafe
#if __GLASGOW_HASKELL__ < 900
  "(function() { var df = $1; var s = $2; var e = $3; var x; for(;;) { x = s['nextSibling']; if(e===x) { break; }; df['appendChild'](x); } })()"
#else
  "(function(df, s, e) { var x; for(;;) { x = s['nextSibling']; if(e===x) { break; }; df['appendChild'](x); } })"
#endif
  extractBetweenExclusive_ :: DOM.DocumentFragment -> DOM.Node -> DOM.Node -> IO ()
extractBetweenExclusive df s e = liftJSM $ extractBetweenExclusive_ df (toNode s) (toNode e)
#else
extractBetweenExclusive :: forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
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
  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)
  void $ call f f (df, s, e)
#endif

-- | 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 :: forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
deleteUpTo start
s end
e = do
  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
  extractUpTo df s 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
#if __GLASGOW_HASKELL__ < 900
  "(function() { var x = $2; while(x !== $3) { var y = x['nextSibling']; $1['appendChild'](x); x = y; } })()"
#else
  "(function(_, x, $3) { while(x !== $3) { var y = x['nextSibling']; $1['appendChild'](x); x = y; } })"
#endif
  extractUpTo_ :: DOM.DocumentFragment -> DOM.Node -> DOM.Node -> IO ()
extractUpTo df s e = liftJSM $ extractUpTo_ df (toNode s) (toNode e)
#else
extractUpTo :: forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
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
  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)
  void $ call f f (df, s, 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 :: forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
start -> end -> m DocumentFragment
collectUpTo start
s end
e = do
  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
  collectUpToGivenParent currentParent s e

{-# INLINABLE collectUpToGivenParent #-}
collectUpToGivenParent :: (MonadJSM m, IsNode parent, IsNode start, IsNode end) => parent -> start -> end -> m DOM.DocumentFragment
collectUpToGivenParent :: forall (m :: * -> *) parent start end.
(MonadJSM m, IsNode parent, IsNode start, IsNode end) =>
parent -> start -> end -> m DocumentFragment
collectUpToGivenParent parent
currentParent start
s end
e = do
  doc <- parent -> m Document
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Document
getOwnerDocumentUnchecked parent
currentParent
  df <- createDocumentFragment doc
  extractUpTo df s e
  return 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 :: forall {k1} (s :: k1) (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
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 {k1} {k2} (er :: EventTag -> *) (t :: k1) (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 a. Event t (JSM a) -> 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
  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 a b. (a -> b) -> JSM a -> JSM b
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 {k1} {k2} (er :: EventTag -> *) (t :: k1) (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
    triggerRef <- IO (IORef (Maybe (EventTrigger t (er a))))
-> JSM (IORef (Maybe (EventTrigger t (er a))))
forall a. IO a -> JSM 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
    _ <- elementOnEventName en e $ do --TODO: Something safer than this cast
      evt <- DOM.event
      (flags, k) <- liftJSM $ f $ GhcjsDomEvent evt
      when (_eventFlags_preventDefault flags) $ withIsEvent en DOM.preventDefault
      case _eventFlags_propagation flags of
        Propagation
Propagation_Continue -> () -> ReaderT (EventType a) JSM ()
forall a. a -> ReaderT (EventType a) JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Propagation
Propagation_Stop -> EventName a
-> (IsEvent (EventType a) => ReaderT (EventType a) JSM ())
-> ReaderT (EventType a) JSM ()
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName a
en ReaderT (EventType a) JSM ()
IsEvent (EventType a) => ReaderT (EventType a) JSM ()
forall e t. IsEvent e => EventM t e ()
DOM.stopPropagation
        Propagation
Propagation_StopImmediate -> EventName a
-> (IsEvent (EventType a) => ReaderT (EventType a) JSM ())
-> ReaderT (EventType a) JSM ()
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName a
en ReaderT (EventType a) JSM ()
IsEvent (EventType a) => ReaderT (EventType a) JSM ()
forall e t. IsEvent e => EventM t e ()
DOM.stopImmediatePropagation
      mv <- liftJSM k --TODO: Only do this when the event is subscribed
      liftIO $ forM_ mv $ \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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())]
    return $ en :=> EventFilterTriggerRef triggerRef
  return 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 :: forall {k1} (s :: k1) (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
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 a. a -> IO a
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 -> ReaderT (EventType a1) JSM () -> JSM (JSM ())
forall e (en :: EventTag).
IsElement e =>
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
elementOnEventName EventName a1
en Element
e (ReaderT (EventType a1) JSM () -> JSM (JSM ()))
-> ReaderT (EventType a1) JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
    evt <- EventM (ZonkAny 31) (EventType a1) (EventType a1)
forall t e. EventM t e e
DOM.event
    mv <- lift $ unGhcjsEventHandler handler (en, GhcjsDomEvent evt)
    case mv of
      Maybe (er a1)
Nothing -> () -> ReaderT (EventType a1) JSM ()
forall a. a -> ReaderT (EventType a1) JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just er a1
v -> IO () -> ReaderT (EventType a1) JSM ()
forall a. IO a -> ReaderT (EventType a1) JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (EventType a1) JSM ())
-> IO () -> ReaderT (EventType a1) JSM ()
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
        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
        writeChan events [EventTriggerRef ref :=> TriggerInvocation v (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 {k1} {k2} (er :: EventTag -> *) (t :: k1) (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 { forall a b. GhcjsDomHandler a b -> a -> JSM b
unGhcjsDomHandler :: a -> JSM b }

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

newtype GhcjsDomEvent en = GhcjsDomEvent { forall (en :: EventTag). 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 :: forall (proxy :: * -> *) (en :: EventTag) (er :: EventTag -> *).
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
es
    { _ghcjsEventSpec_filters =
        let 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
                mEventResult <- GhcjsEventHandler er
-> forall (en :: EventTag).
   (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)
                return (f mEventResult, return mEventResult)
              Just (GhcjsEventFilter GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter) -> \GhcjsDomEvent en
evt -> do
                (oldFlags, oldContinuation) <- GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter GhcjsDomEvent en
evt
                mEventResult <- oldContinuation
                let newFlags = EventFlags
oldFlags EventFlags -> EventFlags -> EventFlags
forall a. Semigroup a => a -> a -> a
<> Maybe (er en) -> EventFlags
f Maybe (er en)
mEventResult
                return (newFlags, return mEventResult)
        in DMap.alter f' en $ _ghcjsEventSpec_filters es
    }

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

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

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

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

newtype GhcjsEventHandler er = GhcjsEventHandler { forall (er :: EventTag -> *).
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
    { _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
        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 = (JSVal -> Element) -> EventTarget -> Element
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> Element
DOM.Element EventTarget
t
        runReaderT (defaultDomEventHandler e en) evt
    }

{-# INLINE makeElement #-}
makeElement :: MonadJSM m => Document -> Text -> ElementConfig er t s -> m DOM.Element
makeElement :: forall {k} {k1} (m :: * -> *) (er :: EventTag -> *) (t :: k)
       (s :: k1).
MonadJSM m =>
Document -> Text -> ElementConfig er t s -> m Element
makeElement Document
doc Text
elementTag ElementConfig er t s
cfg = do
  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)
Lens' (ElementConfig er t s) (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
  iforM_ (cfg ^. initialAttributes) $ \(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
  pure 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 :: 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 s
cfg HydrationDomBuilderT s t m a
child = do
  doc <- HydrationDomBuilderT s t m Document
HydrationDomBuilderT
  s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  ctx <- askJSM
  events <- askEvents
  parent <- getParent
  e <- makeElement doc elementTag cfg
  appendChild_ parent e
  -- Run the child builder with updated parent and previous sibling references
  result <- localEnv (\HydrationDomBuilderEnv t m
env -> HydrationDomBuilderEnv t m
env { _hydrationDomBuilderEnv_parent = Left $ toNode e }) child
  let 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
  eventTriggerRefs <- wrap events e rawCfg
  es <- newFanEventWithTrigger $ triggerBody ctx rawCfg events eventTriggerRefs e
  return (Element es e, 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 :: 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 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 a b.
HydrationDomBuilderT HydrationDomSpace t m a
-> (a -> HydrationDomBuilderT HydrationDomSpace t m b)
-> HydrationDomBuilderT HydrationDomSpace t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  HydrationMode
HydrationMode_Immediate -> do
    (Element es _, 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
    return (Element es (), 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 :: forall s. IsString s => s
skipHydrationAttribute = s
"data-hydration-skip"

-- | An attribute which signals that an element should be hydrated.
hydratableAttribute :: IsString s => s
hydratableAttribute :: forall s. IsString s => 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 :: 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 = do
  ctx <- HydrationDomBuilderT HydrationDomSpace t m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
  events <- askEvents
  -- Schedule everything for after postBuild, except for getting the result itself
  parentRef <- liftIO $ newIORef $ error "Parent not yet initialized"
  e' <- liftIO $ newIORef $ error "hydrateElement: Element not yet initialized"
  env <- HydrationDomBuilderT ask
  childDelayedRef <- liftIO $ newIORef $ pure ()
  let env' = HydrationDomBuilderEnv t m
env
        { _hydrationDomBuilderEnv_parent = Right parentRef
        , _hydrationDomBuilderEnv_delayed = childDelayedRef
        }
  result <- HydrationDomBuilderT $ lift $ runReaderT (unHydrationDomBuilderT child) env'
  wrapResult <- liftIO 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
e = do
        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)
        hydratable <- hasAttribute e (hydratableAttribute :: DOM.JSString)
        pure $ skip || not hydratable
  childDom <- liftIO $ readIORef childDelayedRef
  let 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
  doc <- askDocument
  addHydrationStep $ do
    parent <- askParent
    lastHydrationNode <- getPreviousNode
    let 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 a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe Node
Nothing -> do -- 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 = True }
            e <- Document
-> Text
-> ElementConfig er t HydrationDomSpace
-> HydrationRunnerT t m Element
forall {k} {k1} (m :: * -> *) (er :: EventTag -> *) (t :: k)
       (s :: k1).
MonadJSM m =>
Document -> Text -> ElementConfig er t s -> m Element
makeElement Document
doc Text
elementTag ElementConfig er t HydrationDomSpace
cfg
            insertAfterPreviousNode e
            pure 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 a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe 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 a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              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
                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 T.toCaseFold elementTag == T.toCaseFold t
                  then pure e
                  -- we came to some other statically rendered element, so something has gone wrong
                  else do
                    HydrationRunnerT $ modify' $ \HydrationState
s -> HydrationState
s { _hydrationState_failed = True }
                    n <- makeElement doc elementTag cfg
                    insertAfterPreviousNode n
                    pure n
    e <- go lastHydrationNode
    setPreviousNode $ Just $ toNode e
    -- Update the parent node used by the children
    liftIO $ writeIORef parentRef $ toNode e
    liftIO $ writeIORef e' e
    -- Setup events, store the result so we can wait on it later
    refs <- wrap events e rawCfg
    liftIO $ putMVar wrapResult (e, refs)
    localRunner childDom Nothing $ toNode e
  -- We need the EventSelector to switch to the real event handler after activation
  es <- newFanEventWithTrigger $ \(WrapArg EventName a1
en) EventTrigger t a
t -> do
    cleanup <- IO (MVar (IO ()))
forall a. IO (MVar a)
newEmptyMVar
    threadId <- forkIO $ do
      -- Wait on the data we need from the delayed action
      (e, eventTriggerRefs) <- readMVar wrapResult
      bracketOnError
        -- Run the setup, acquiring the cleanup action
        (triggerBody ctx rawCfg events eventTriggerRefs e (WrapArg en) 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)
        id
        -- Try to put this action into the cleanup MVar
        (putMVar cleanup)
    pure $ do
      tryReadMVar cleanup >>= \case
        Maybe (IO ())
Nothing -> ThreadId -> IO ()
killThread ThreadId
threadId
        Just IO ()
c -> IO ()
c
  return ((Element es (), result), 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 :: 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 s
cfg = do
  (e@(Element eventSelector 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 {k1} {k2} (er :: EventTag -> *) (t :: k1) (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 a. a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  let 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
  Input.setValue domInputElement $ cfg ^. inputElementConfig_initialValue
  v0 <- Input.getValue domInputElement
  let getMyValue = HTMLInputElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLInputElement -> m result
Input.getValue HTMLInputElement
domInputElement
  valueChangedByUI <- requestDomAction $ liftJSM getMyValue <$ Reflex.select eventSelector (WrapArg Input)
  valueChangedBySetValue <- case _inputElementConfig_setValue cfg of
    Maybe (Event t Text)
Nothing -> Event t Text -> HydrationDomBuilderT s t m (Event t Text)
forall a. a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Event t Text
forall a. Event t a
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 a. Event t (JSM a) -> HydrationDomBuilderT s t m (Event t a)
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
  v <- holdDyn v0 $ leftmost
    [ valueChangedBySetValue
    , valueChangedByUI
    ]
  Input.setChecked domInputElement $ _inputElementConfig_initialChecked cfg
  checkedChangedByUI <- wrapDomEvent domInputElement (`on` Events.click) $ do
    Input.getChecked domInputElement
  checkedChangedBySetChecked <- case _inputElementConfig_setChecked cfg of
    Maybe (Event t Bool)
Nothing -> Event t (Maybe Bool)
-> HydrationDomBuilderT s t m (Event t (Maybe Bool))
forall a. a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Event t (Maybe Bool)
forall a. Event t a
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 a. Event t (JSM a) -> HydrationDomBuilderT s t m (Event t a)
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
      oldChecked <- HTMLInputElement -> JSM Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement
      Input.setChecked domInputElement newChecked
      return $ if newChecked /= oldChecked
                  then Just newChecked
                  else Nothing
  c <- holdDyn (_inputElementConfig_initialChecked cfg) $ leftmost
    [ fmapMaybe id checkedChangedBySetChecked
    , checkedChangedByUI
    ]
  hasFocus <- mkHasFocus e
  files <- holdDyn mempty <=< wrapDomEvent domInputElement (`on` Events.change) $ do
    mfiles <- Input.getFiles domInputElement
    let getMyFiles FileList
xs = ([Maybe File] -> [File]) -> m [Maybe File] -> m [File]
forall a b. (a -> b) -> m a -> m b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
    maybe (return []) getMyFiles mfiles
  checked <- holdUniqDyn c
  return $ InputElement
    { _inputElement_value = v
    , _inputElement_checked = checked
    , _inputElement_checkedChange =  checkedChangedByUI
    , _inputElement_input = valueChangedByUI
    , _inputElement_hasFocus = hasFocus
    , _inputElement_element = e
    , _inputElement_raw = domInputElement
    , _inputElement_files = 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 :: 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 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 a b.
HydrationDomBuilderT HydrationDomSpace t m a
-> (a -> HydrationDomBuilderT HydrationDomSpace t m b)
-> HydrationDomBuilderT HydrationDomSpace t m b
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 (_element_events $ _inputElement_element result) ()
    , _inputElement_raw = ()
    }
  HydrationMode
HydrationMode_Hydrating -> do
  ((e, _), 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 (er1 :: EventTag -> *) k1 (t :: k1) k2 (s1 :: k2)
       (er2 :: EventTag -> *) k3 (s2 :: k3) (f :: * -> *).
Functor f =>
(ElementConfig er1 t s1 -> f (ElementConfig er2 t s2))
-> InputElementConfig er1 t s1 -> f (InputElementConfig 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 a. a -> HydrationDomBuilderT HydrationDomSpace t m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  (valueChangedByUI, triggerChangeByUI) <- newTriggerEvent
  (valueChangedBySetValue, triggerChangeBySetValue) <- newTriggerEvent
  (focusChange, triggerFocusChange) <- newTriggerEvent
  (checkedChangedByUI, triggerCheckedChangedByUI) <- newTriggerEvent
  (checkedChangedBySetChecked, triggerCheckedChangedBySetChecked) <- newTriggerEvent
  (fileChange, triggerFileChange) <- newTriggerEvent
  doc <- askDocument
  -- Expected initial value from config
  let v0 = InputElementConfig er t HydrationDomSpace -> Text
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> Text
_inputElementConfig_initialValue InputElementConfig er t HydrationDomSpace
cfg
      c0 = InputElementConfig er t HydrationDomSpace -> Bool
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> Bool
_inputElementConfig_initialChecked InputElementConfig er t HydrationDomSpace
cfg
      valuesAtSwitchover = do
        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 a. a -> m a
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 a. a -> Behavior t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v0) (Text -> Event t Text -> m (Behavior t Text)
forall a. 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 Text
v0) (InputElementConfig er t HydrationDomSpace -> Maybe (Event t Text)
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> Maybe (Event t Text)
_inputElementConfig_setValue InputElementConfig er t HydrationDomSpace
cfg)
        c <- maybe (pure $ pure c0) (hold c0) (_inputElementConfig_setChecked cfg)
        pure (v, c)
  addHydrationStepWithSetup valuesAtSwitchover $ \(Behavior t Text
switchoverValue', Behavior t Bool
switchoverChecked') -> do
    switchoverValue <- Behavior t Text -> HydrationRunnerT t m Text
forall a. Behavior t a -> HydrationRunnerT t m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
switchoverValue'
    switchoverChecked <- sample switchoverChecked'
    domElement <- liftIO $ readIORef domElementRef
    let 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 = 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.
    when (v0 /= switchoverValue) $ liftIO $ triggerChangeBySetValue 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.
    liftJSM getValue >>= \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 a. IO a -> HydrationRunnerT t m a
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
    requestDomAction_ $ (liftJSM getValue >>= liftIO . triggerChangeByUI) <$ Reflex.select (_element_events e) (WrapArg Input)
    for_ (_inputElementConfig_setValue cfg) $ \Event t Text
eSetValue ->
      Event t (JSM ()) -> HydrationRunnerT t m ()
forall a. Event t (JSM a) -> 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'
        v <- JSM Text
getValue -- We get the value after setting it in case the browser has mucked with it somehow
        liftIO $ triggerChangeBySetValue v
    let 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 a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> forall a. WrapArg er EventName a -> Event t a
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 {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
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 a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> forall a. WrapArg er EventName a -> Event t a
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 {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
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)
          ]
    liftIO . triggerFocusChange =<< Node.isSameNode (toNode domElement) . fmap toNode =<< Document.getActiveElement doc
    requestDomAction_ $ liftIO . triggerFocusChange <$> 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.
    when (c0 /= switchoverChecked) $ liftIO $ triggerCheckedChangedBySetChecked 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.
    liftJSM (Input.getChecked domInputElement) >>= \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 a. IO a -> HydrationRunnerT t m a
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
    _ <- liftJSM $ domInputElement `on` Events.click $ do
      liftIO . triggerCheckedChangedByUI =<< Input.getChecked domInputElement
    for_ (_inputElementConfig_setChecked cfg) $ \Event t Bool
eNewchecked ->
      Event t (JSM ()) -> HydrationRunnerT t m (Event t ())
forall a. Event t (JSM a) -> HydrationRunnerT t m (Event t a)
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
        oldChecked <- HTMLInputElement -> JSM Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement
        Input.setChecked domInputElement newChecked
        when (newChecked /= oldChecked) $ liftIO $ triggerCheckedChangedBySetChecked newChecked
    _ <- liftJSM $ domInputElement `on` Events.change $ do
      mfiles <- Input.getFiles domInputElement
      let getMyFiles FileList
xs = ([Maybe File] -> [File]) -> m [Maybe File] -> m [File]
forall a b. (a -> b) -> m a -> m b
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
      liftIO . triggerFileChange =<< maybe (return []) getMyFiles mfiles
    return ()
  checked' <- holdDyn c0 $ leftmost
    [ checkedChangedBySetChecked
    , checkedChangedByUI
    ]
  checked <- holdUniqDyn checked'
  let initialFocus = Bool
False -- Assume it isn't focused, but we update the actual focus state at switchover
  hasFocus <- holdUniqDyn =<< holdDyn initialFocus focusChange
  v <- holdDyn v0 $ leftmost
    [ valueChangedBySetValue
    , valueChangedByUI
    ]
  files <- holdDyn mempty fileChange
  return $ InputElement
    { _inputElement_value = v
    , _inputElement_checked = checked
    , _inputElement_checkedChange = checkedChangedByUI
    , _inputElement_input = valueChangedByUI
    , _inputElement_hasFocus = hasFocus
    , _inputElement_element = e
    , _inputElement_raw = ()
    , _inputElement_files = 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 :: 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 s
cfg = do
  (e@(Element eventSelector 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 (er1 :: EventTag -> *) k1 (t :: k1) k2 (m1 :: k2)
       (er2 :: EventTag -> *) k3 (m2 :: k3) (f :: * -> *).
Functor f =>
(ElementConfig er1 t m1 -> f (ElementConfig er2 t m2))
-> TextAreaElementConfig er1 t m1
-> f (TextAreaElementConfig 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 a. a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  let 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
  TextArea.setValue domTextAreaElement $ cfg ^. textAreaElementConfig_initialValue
  v0 <- TextArea.getValue domTextAreaElement
  let getMyValue = HTMLTextAreaElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLTextAreaElement -> m result
TextArea.getValue HTMLTextAreaElement
domTextAreaElement
  valueChangedByUI <- requestDomAction $ liftJSM getMyValue <$ Reflex.select eventSelector (WrapArg Input)
  valueChangedBySetValue <- case _textAreaElementConfig_setValue cfg of
    Maybe (Event t Text)
Nothing -> Event t Text -> HydrationDomBuilderT s t m (Event t Text)
forall a. a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Event t Text
forall a. Event t a
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 a. Event t (JSM a) -> HydrationDomBuilderT s t m (Event t a)
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
  v <- holdDyn v0 $ leftmost
    [ valueChangedBySetValue
    , valueChangedByUI
    ]
  hasFocus <- mkHasFocus e
  return $ TextAreaElement
    { _textAreaElement_value = v
    , _textAreaElement_input = valueChangedByUI
    , _textAreaElement_hasFocus = hasFocus
    , _textAreaElement_element = e
    , _textAreaElement_raw = 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 :: 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 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 a b.
HydrationDomBuilderT HydrationDomSpace t m a
-> (a -> HydrationDomBuilderT HydrationDomSpace t m b)
-> HydrationDomBuilderT HydrationDomSpace t m b
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 (_element_events $ _textAreaElement_element result) ()
    , _textAreaElement_raw = ()
    }
  HydrationMode
HydrationMode_Hydrating -> do
  ((e, _), 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 (er1 :: EventTag -> *) k1 (t :: k1) k2 (m1 :: k2)
       (er2 :: EventTag -> *) k3 (m2 :: k3) (f :: * -> *).
Functor f =>
(ElementConfig er1 t m1 -> f (ElementConfig er2 t m2))
-> TextAreaElementConfig er1 t m1
-> f (TextAreaElementConfig 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 a. a -> HydrationDomBuilderT HydrationDomSpace t m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  (valueChangedByUI, triggerChangeByUI) <- newTriggerEvent
  (valueChangedBySetValue, triggerChangeBySetValue) <- newTriggerEvent
  (focusChange, triggerFocusChange) <- newTriggerEvent
  doc <- askDocument
  -- Expected initial value from config
  let v0 = TextAreaElementConfig er t HydrationDomSpace -> Text
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (m :: k2).
TextAreaElementConfig er t m -> Text
_textAreaElementConfig_initialValue TextAreaElementConfig er t HydrationDomSpace
cfg
      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 a. a -> m a
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 a. a -> Behavior t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v0) (Text -> Event t Text -> m (Behavior t Text)
forall a. 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 Text
v0) (TextAreaElementConfig er t HydrationDomSpace
-> Maybe (Event t Text)
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (m :: k2).
TextAreaElementConfig er t m -> Maybe (Event t Text)
_textAreaElementConfig_setValue TextAreaElementConfig er t HydrationDomSpace
cfg)
  addHydrationStepWithSetup valueAtSwitchover $ \Behavior t Text
switchoverValue' -> do
    switchoverValue <- Behavior t Text -> HydrationRunnerT t m Text
forall a. Behavior t a -> HydrationRunnerT t m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
switchoverValue'
    domElement <- liftIO $ readIORef domElementRef
    let 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 = 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.
    when (v0 /= switchoverValue) $ liftIO $ triggerChangeBySetValue 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.
    liftJSM getValue >>= \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 a. IO a -> HydrationRunnerT t m a
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
    requestDomAction_ $ (liftJSM getValue >>= liftIO . triggerChangeByUI) <$ Reflex.select (_element_events e) (WrapArg Input)
    for_ (_textAreaElementConfig_setValue cfg) $ \Event t Text
eSetValue ->
      Event t (JSM ()) -> HydrationRunnerT t m ()
forall a. Event t (JSM a) -> 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'
        v <- JSM Text
getValue -- We get the value after setting it in case the browser has mucked with it somehow
        liftIO $ triggerChangeBySetValue v
    let 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 a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> forall a. WrapArg er EventName a -> Event t a
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 {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
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 a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> forall a. WrapArg er EventName a -> Event t a
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 {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
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)
          ]
    liftIO . triggerFocusChange =<< Node.isSameNode (toNode domElement) . fmap toNode =<< Document.getActiveElement doc
    requestDomAction_ $ liftIO . triggerFocusChange <$> focusChange'
  let initialFocus = Bool
False -- Assume it isn't focused, but we update the actual focus state at switchover
  hasFocus <- holdUniqDyn =<< holdDyn initialFocus focusChange
  v <- holdDyn v0 $ leftmost
    [ valueChangedBySetValue
    , valueChangedByUI
    ]
  return $ TextAreaElement
    { _textAreaElement_value = v
    , _textAreaElement_input = valueChangedByUI
    , _textAreaElement_hasFocus = hasFocus
    , _textAreaElement_element = e
    , _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 :: 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 s
cfg HydrationDomBuilderT s t m a
child = do
  (e@(Element eventSelector domElement), 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 (er1 :: EventTag -> *) k1 (t :: k1) k2 (m1 :: k2)
       (er2 :: EventTag -> *) k3 (m2 :: k3) (f :: * -> *).
Functor f =>
(ElementConfig er1 t m1 -> f (ElementConfig er2 t m2))
-> SelectElementConfig er1 t m1 -> f (SelectElementConfig er2 t m2)
selectElementConfig_elementConfig) HydrationDomBuilderT s t m a
child
  let 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
  Select.setValue domSelectElement $ cfg ^. selectElementConfig_initialValue
  v0 <- Select.getValue domSelectElement
  let getMyValue = HTMLSelectElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLSelectElement -> m result
Select.getValue HTMLSelectElement
domSelectElement
  valueChangedByUI <- requestDomAction $ liftJSM getMyValue <$ Reflex.select eventSelector (WrapArg Change)
  valueChangedBySetValue <- case _selectElementConfig_setValue cfg of
    Maybe (Event t Text)
Nothing -> Event t Text -> HydrationDomBuilderT s t m (Event t Text)
forall a. a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Event t Text
forall a. Event t a
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 a. Event t (JSM a) -> HydrationDomBuilderT s t m (Event t a)
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
  v <- holdDyn v0 $ leftmost
    [ valueChangedBySetValue
    , valueChangedByUI
    ]
  hasFocus <- mkHasFocus e
  let wrapped = 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
        }
  return (wrapped, 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 :: 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 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 a b.
HydrationDomBuilderT HydrationDomSpace t m a
-> (a -> HydrationDomBuilderT HydrationDomSpace t m b)
-> HydrationDomBuilderT HydrationDomSpace t m b
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 (_element_events $ _selectElement_element e) ()
    , _selectElement_raw = ()
    }, a
result)
  HydrationMode
HydrationMode_Hydrating -> do
  ((e, result), 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 (er1 :: EventTag -> *) k1 (t :: k1) k2 (m1 :: k2)
       (er2 :: EventTag -> *) k3 (m2 :: k3) (f :: * -> *).
Functor f =>
(ElementConfig er1 t m1 -> f (ElementConfig er2 t m2))
-> SelectElementConfig er1 t m1 -> f (SelectElementConfig er2 t m2)
selectElementConfig_elementConfig) HydrationDomBuilderT HydrationDomSpace t m a
child
  (valueChangedByUI, triggerChangeByUI) <- newTriggerEvent
  (valueChangedBySetValue, triggerChangeBySetValue) <- newTriggerEvent
  (focusChange, triggerFocusChange) <- newTriggerEvent
  doc <- askDocument
  -- Expected initial value from config
  let v0 = SelectElementConfig er t HydrationDomSpace -> Text
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (m :: k2).
SelectElementConfig er t m -> Text
_selectElementConfig_initialValue SelectElementConfig er t HydrationDomSpace
cfg
  addHydrationStep $ do
    domElement <- liftIO $ readIORef domElementRef
    let 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 = 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
    liftJSM getValue >>= \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 a. IO a -> HydrationRunnerT t m a
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
    requestDomAction_ $ (liftJSM getValue >>= liftIO . triggerChangeByUI) <$ Reflex.select (_element_events e) (WrapArg Change)
    for_ (_selectElementConfig_setValue cfg) $ \Event t Text
eSetValue ->
      Event t (JSM ()) -> HydrationRunnerT t m ()
forall a. Event t (JSM a) -> 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'
        v <- JSM Text
getValue -- We get the value after setting it in case the browser has mucked with it somehow
        liftIO $ triggerChangeBySetValue v
    let 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 a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> forall a. WrapArg er EventName a -> Event t a
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 {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
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 a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> forall a. WrapArg er EventName a -> Event t a
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 {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
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)
          ]
    liftIO . triggerFocusChange =<< Node.isSameNode (toNode domElement) . fmap toNode =<< Document.getActiveElement doc
    requestDomAction_ $ liftIO . triggerFocusChange <$> focusChange'
  let initialFocus = Bool
False -- Assume it isn't focused, but we update the actual focus state at switchover
  hasFocus <- holdUniqDyn =<< holdDyn initialFocus focusChange
  v <- holdDyn v0 $ leftmost
    [ valueChangedBySetValue
    , valueChangedByUI
    ]
  return $ (,result) $ SelectElement
    { _selectElement_value = v
    , _selectElement_change = valueChangedByUI
    , _selectElement_hasFocus = hasFocus
    , _selectElement_element = e
    , _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 :: 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 !Text
t Maybe (Event t Text)
mSetContents) = do
  p <- HydrationDomBuilderT s t m Node
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
  doc <- askDocument
  n <- createTextNode doc t
  appendChild_ p n
  mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
  pure 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 :: 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 tc :: TextNodeConfig t
tc@(TextNodeConfig !Text
t Maybe (Event t Text)
mSetContents) = do
  doc <- HydrationDomBuilderT HydrationDomSpace t m Document
HydrationDomBuilderT
  HydrationDomSpace
  t
  m
  (RawDocument
     (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  getHydrationMode >>= \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 a. a -> m a
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 a. a -> Behavior t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t) (Text -> Event t Text -> m (Behavior t Text)
forall a. 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 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
      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 a. Behavior t a -> HydrationRunnerT t m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
currentText
      mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
  pure $ 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 :: forall (m :: * -> *) t.
MonadJSM m =>
Document -> Text -> HydrationRunnerT t m Text
hydrateTextNode Document
doc t :: Text
t@Text
"" = do
  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
  insertAfterPreviousNode tn
  pure tn
hydrateTextNode Document
doc Text
t = do
  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 a b.
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
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
  setPreviousNode $ Just $ toNode n
  return 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 a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe Node
Nothing -> do
        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 = True }
        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
        insertAfterPreviousNode n
        pure 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 a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe 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
          originalText <- Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self result.
(MonadDOM m, IsNode self, FromJSString result) =>
self -> m result
Node.getTextContentUnchecked Text
originalNode
          case T.stripPrefix t originalText of
            Just Text
"" -> Text -> HydrationRunnerT t m Text
forall a. a -> HydrationRunnerT t m a
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 a. a -> HydrationRunnerT t m a
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 = True }
              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
              insertAfterPreviousNode n
              pure 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 :: 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 (CommentNodeConfig !Text
t Maybe (Event t Text)
mSetContents) = do
  p <- HydrationDomBuilderT s t m Node
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
  doc <- askDocument
  n <- createComment doc t
  appendChild_ p n
  mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
  pure 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 :: 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 tc :: CommentNodeConfig t
tc@(CommentNodeConfig Text
t0 Maybe (Event t Text)
mSetContents) = do
  doc <- HydrationDomBuilderT HydrationDomSpace t m Document
HydrationDomBuilderT
  HydrationDomSpace
  t
  m
  (RawDocument
     (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  getHydrationMode >>= \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 a. a -> m a
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 a. a -> Behavior t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t0) (Text -> Event t Text -> m (Behavior t Text)
forall a. 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 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
      t <- Behavior t Text -> HydrationRunnerT t m Text
forall a. Behavior t a -> HydrationRunnerT t m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
bt
      void $ hydrateComment doc t mSetContents
  pure $ CommentNode ()

{-# INLINE hydrateComment #-}
hydrateComment :: (MonadJSM m, Reflex t, MonadFix m) => Document -> Text -> Maybe (Event t Text) -> HydrationRunnerT t m DOM.Comment
hydrateComment :: 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 = do
  parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
  let 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 a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Node
Nothing -> do
          c <- Document -> Text -> HydrationRunnerT t m Comment
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Comment
createComment Document
doc Text
t
          insertAfterPreviousNode c
          pure c
        Just Node
node -> (JSVal -> Comment) -> Node -> HydrationRunnerT t m (Maybe Comment)
forall obj obj' (m :: * -> *).
(Coercible obj JSVal, IsGObject obj', MonadJSM m) =>
(JSVal -> obj') -> obj -> m (Maybe obj')
DOM.castTo JSVal -> Comment
DOM.Comment Node
node HydrationRunnerT t m (Maybe Comment)
-> (Maybe Comment -> HydrationRunnerT t m Comment)
-> HydrationRunnerT t m Comment
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe Comment
Nothing -> Maybe Node -> HydrationRunnerT t m Comment
go (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
          Just Comment
c -> do
            t' <- Comment -> HydrationRunnerT t m Text
forall (m :: * -> *) self result.
(MonadDOM m, IsNode self, FromJSString result) =>
self -> m result
Node.getTextContentUnchecked Comment
c
            if t == t'
              then pure c
              else do
                c' <- createComment doc t
                insertAfterPreviousNode c'
                pure c'
  n <- go =<< getPreviousNode
  setPreviousNode $ Just $ toNode n
  mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
  pure 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 :: 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
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 a b.
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
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
    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
    append $ toNode t
    textNodeRef <- liftIO $ newIORef t
    keyRef <- liftIO $ newIORef Nothing
    pure (pure (), textNodeRef, keyRef)
  HydrationMode
HydrationMode_Hydrating -> do
    doc <- HydrationDomBuilderT s t m Document
HydrationDomBuilderT
  s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
    textNodeRef <- liftIO $ newIORef $ error "textNodeRef not yet initialized"
    keyRef <- liftIO $ newIORef $ error "keyRef not yet initialized"
    let
      go Maybe Text
Nothing Maybe Node
_ = do
        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)
        insertAfterPreviousNode tn
        HydrationRunnerT $ modify' $ \HydrationState
s -> HydrationState
s { _hydrationState_failed = True }
        pure (tn, Nothing)
      go (Just Text
key0) Maybe Node
mLastNode = do
        parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
        maybe (Node.getFirstChild parent) Node.getNextSibling mLastNode >>= \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 a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just Comment
comment -> do
              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 T.stripPrefix (prefix <> key0) 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
                  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.replaceChild_ parent tn comment
                  pure (tn, Just 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 = do
        key0 <- IO (Maybe Text) -> HydrationRunnerT t m (Maybe Text)
forall a. IO a -> HydrationRunnerT t m a
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
        (tn, key) <- go key0 =<< getPreviousNode
        setPreviousNode $ Just $ toNode tn
        liftIO $ do
          writeIORef textNodeRef tn
          writeIORef keyRef key
    pure (switchComment, textNodeRef, 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 :: 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 = 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 a. IO a -> HydrationDomBuilderT s t m a
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 :: 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)
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 a b.
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
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 :: forall a. Event t a -> HydrationDomBuilderT s t m ()
notReadyUntil Event t a
e = do
    eOnce <- Event t a -> HydrationDomBuilderT s t m (Event t a)
forall a. 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
    unreadyChildren <- askUnreadyChildren
    commitAction <- askCommitAction
    liftIO $ modifyIORef' unreadyChildren succ
    let ready = do
          old <- IO Word -> JSM Word
forall a. IO a -> JSM a
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 -> Word
forall a. Enum a => a -> a
pred Word
old
          liftIO $ writeIORef unreadyChildren $! new
          when (new == 0) commitAction
    requestDomAction_ $ ready <$ eOnce
  notReady :: HydrationDomBuilderT s t m ()
notReady = do
    unreadyChildren <- HydrationDomBuilderT s t m (IORef Word)
forall {k} (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT s t m (IORef Word)
askUnreadyChildren
    liftIO $ modifyIORef' unreadyChildren 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 :: forall (proxy :: * -> *) (en :: EventTag) (er :: EventTag -> *).
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
es
    { _ghcjsEventSpec_filters =
        let 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
                mEventResult <- GhcjsEventHandler er
-> forall (en :: EventTag).
   (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)
                return (f mEventResult, return mEventResult)
              Just (GhcjsEventFilter GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter) -> \GhcjsDomEvent en
evt -> do
                (oldFlags, oldContinuation) <- GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter GhcjsDomEvent en
evt
                mEventResult <- oldContinuation
                let newFlags = EventFlags
oldFlags EventFlags -> EventFlags -> EventFlags
forall a. Semigroup a => a -> a -> a
<> Maybe (er en) -> EventFlags
f Maybe (er en)
mEventResult
                return (newFlags, return mEventResult)
        in DMap.alter f' en $ _ghcjsEventSpec_filters es
    }

instance SupportsHydrationDomBuilder t m => DomBuilder t (HydrationDomBuilderT HydrationDomSpace t m) where
  type DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m) = HydrationDomSpace
  {-# INLINABLE element #-}
  element :: forall (er :: EventTag -> *) a.
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)
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace t m (Element er HydrationDomSpace 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)
TextNodeConfig t
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextNode HydrationDomSpace 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)
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
  {-# INLINABLE inputElement #-}
  inputElement :: forall (er :: EventTag -> *).
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)
InputElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
     HydrationDomSpace t m (InputElement er HydrationDomSpace 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 :: forall (er :: EventTag -> *).
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)
TextAreaElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
     HydrationDomSpace t m (TextAreaElement er HydrationDomSpace 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 :: forall (er :: EventTag -> *) a.
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)
SelectElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
     HydrationDomSpace t m (SelectElement er HydrationDomSpace 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 a. a -> HydrationDomBuilderT HydrationDomSpace t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  wrapRawElement :: forall (er :: EventTag -> *).
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 (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (Element
        er
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
        t)
forall a. a -> HydrationDomBuilderT HydrationDomSpace t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Element
   er (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t
 -> HydrationDomBuilderT
      HydrationDomSpace
      t
      m
      (Element
         er
         (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
         t))
-> Element
     er (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t
-> HydrationDomBuilderT
     HydrationDomSpace
     t
     m
     (Element
        er
        (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
        t)
forall a b. (a -> b) -> a -> b
$ EventSelector t (WrapArg er EventName)
-> RawElement
     (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> Element
     er (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t
forall {k} {k1} (er :: EventTag -> *) (d :: k) (t :: k1).
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 a. 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 :: forall (er :: EventTag -> *) a.
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)
Text
-> ElementConfig er t GhcjsDomSpace
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
     GhcjsDomSpace 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
  {-# 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 a b.
(a -> b)
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT GhcjsDomSpace t m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TextNode GhcjsDomSpace t
RawTextNode GhcjsDomSpace -> TextNode GhcjsDomSpace t
forall {k} {k1} (d :: k) (t :: k1). 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 a b.
(a -> b)
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT GhcjsDomSpace t m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Comment -> CommentNode GhcjsDomSpace t
RawCommentNode GhcjsDomSpace -> CommentNode GhcjsDomSpace t
forall {k} {k1} (d :: k) (t :: k1).
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 :: forall (er :: EventTag -> *).
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)
InputElementConfig er t GhcjsDomSpace
-> HydrationDomBuilderT
     GhcjsDomSpace 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
  {-# INLINABLE textAreaElement #-}
  textAreaElement :: forall (er :: EventTag -> *).
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)
TextAreaElementConfig er t GhcjsDomSpace
-> HydrationDomBuilderT
     GhcjsDomSpace 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
  {-# INLINABLE selectElement #-}
  selectElement :: forall (er :: EventTag -> *) a.
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)
SelectElementConfig er t GhcjsDomSpace
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
     GhcjsDomSpace 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
  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 :: forall (er :: EventTag -> *).
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
    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
    ctx <- askJSM
    eventTriggerRefs <- wrap events e rawCfg
    es <- newFanEventWithTrigger $ triggerBody ctx rawCfg events eventTriggerRefs e
    pure $ Element es 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 :: forall (m :: * -> *). MonadJSM m => ImmediateDomFragment -> m ()
extractFragment ImmediateDomFragment
fragment = do
  state <- IO FragmentState -> m FragmentState
forall a. IO a -> m a
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 state of
    FragmentState
FragmentState_Unmounted -> () -> m ()
forall a. a -> m a
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 a. IO a -> m a
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 :: forall a.
HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
     GhcjsDomSpace
     t
     m
     (DomFragment (HydrationDomBuilderT GhcjsDomSpace t m), a)
buildDomFragment HydrationDomBuilderT GhcjsDomSpace t m a
w = do
    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
HydrationDomBuilderT
  GhcjsDomSpace
  t
  m
  (RawDocument
     (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
    result <- flip localEnv w $ \HydrationDomBuilderEnv t m
env -> HydrationDomBuilderEnv t m
env
      { _hydrationDomBuilderEnv_parent = Left $ toNode df
      }
    state <- liftIO $ newIORef FragmentState_Unmounted
    return (ImmediateDomFragment df state, 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
    parent <- HydrationDomBuilderT GhcjsDomSpace t m Node
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
    extractFragment fragment
    before <- textNodeImmediate $ TextNodeConfig ("" :: Text) Nothing
    appendChild_ parent $ _immediateDomFragment_document fragment
    after <- textNodeImmediate $ TextNodeConfig ("" :: Text) Nothing
    xs <- foldDyn (\ImmediateDomFragment
new (ImmediateDomFragment
previous, Maybe ImmediateDomFragment
_) -> (ImmediateDomFragment
new, ImmediateDomFragment -> Maybe ImmediateDomFragment
forall a. a -> Maybe a
Just ImmediateDomFragment
previous)) (fragment, Nothing) setFragment
    requestDomAction_ $ ffor (updated xs) $ \(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 a. IO a -> JSM a
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)
    liftIO $ writeIORef (_immediateDomFragment_state fragment) $ FragmentState_Mounted (before, after)

instance (Reflex t, Monad m, Adjustable t m, MonadHold t m, MonadFix m) => Adjustable t (DomRenderHookT t m) where
  runWithReplace :: forall a b.
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 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 :: forall v v'.
(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 v v'.
(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 (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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'))
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 (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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'))
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 :: forall a b.
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
    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 = HydrationDomBuilderEnv t m -> IORef HydrationMode
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode HydrationDomBuilderEnv t m
initialEnv
    (hydrateStart, before, beforeKey) <- skipToReplaceStart
    let parentUnreadyChildren = HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren HydrationDomBuilderEnv t m
initialEnv
    haveEverBeenReady <- liftIO $ newIORef False
    currentCohort <- liftIO $ newIORef (-1 :: Int) -- Equal to the cohort currently in the DOM
    let myCommitAction = do
          IO Bool -> JSM Bool
forall a. IO a -> JSM a
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 a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
True -> () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Bool
False -> do
              IO () -> JSM ()
forall a. IO a -> JSM a
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
              old <- IO Word -> JSM Word
forall a. IO a -> JSM a
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 -> Word
forall a. Enum a => a -> a
pred Word
old
              liftIO $ writeIORef parentUnreadyChildren $! new
              when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
    -- We draw 'after' in this roundabout way to avoid using MonadFix
    doc <- askDocument
    parent <- getParent
    (hydrateEnd, after) <- skipToReplaceEnd beforeKey
    let drawInitialChild = do
          h <- IO HydrationMode -> DomRenderHookT t m HydrationMode
forall a. IO a -> DomRenderHookT t m a
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
          p' <- case h of
            HydrationMode
HydrationMode_Hydrating -> Node -> DomRenderHookT t m Node
forall a. a -> DomRenderHookT t m a
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
          unreadyChildren <- liftIO $ newIORef 0
          let a0' = case HydrationMode
h of
                HydrationMode
HydrationMode_Hydrating -> HydrationDomBuilderT s t m a
a0
                HydrationMode
HydrationMode_Immediate -> do
                  a <- HydrationDomBuilderT s t m a
a0
                  insertBefore p' =<< liftIO (readIORef after)
                  pure a
          delayed <- case h of
            HydrationMode
HydrationMode_Hydrating -> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a. IO a -> DomRenderHookT t m a
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 a. a -> HydrationRunnerT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            HydrationMode
HydrationMode_Immediate -> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a. a -> DomRenderHookT t m a
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
          result <- runReaderT (unHydrationDomBuilderT a0') initialEnv
            { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
            , _hydrationDomBuilderEnv_commitAction = myCommitAction
            , _hydrationDomBuilderEnv_parent = Left p'
            , _hydrationDomBuilderEnv_delayed = delayed
            }
          dom <- case h of
            HydrationMode
HydrationMode_Hydrating -> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a. IO a -> DomRenderHookT t m a
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 a. a -> DomRenderHookT t m a
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 a. a -> HydrationRunnerT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          liftIO $ readIORef unreadyChildren >>= \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
          return (dom, result)
    a'' <- numberOccurrences a'
    ((hydrate0, result0), child') <- HydrationDomBuilderT $ lift $ runWithReplace drawInitialChild $ ffor a'' $ \(Int
cohortId, HydrationDomBuilderT s t m b
child) -> do
      h <- IO HydrationMode -> DomRenderHookT t m HydrationMode
forall a. IO a -> DomRenderHookT t m a
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
      p' <- case h of
        HydrationMode
HydrationMode_Hydrating -> Node -> DomRenderHookT t m Node
forall a. a -> DomRenderHookT t m a
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
      unreadyChildren <- liftIO $ newIORef 0
      let commitAction = do
            c <- IO Int -> JSM Int
forall a. IO a -> JSM a
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
            when (c <= cohortId) $ do -- If a newer cohort has already been committed, just ignore this
              !before' <- liftIO $ readIORef before
              !after' <- liftIO $ readIORef after
              deleteBetweenExclusive before' after'
              insertBefore p' after'
              liftIO $ writeIORef currentCohort cohortId
              myCommitAction
      delayed <- case h of
        HydrationMode
HydrationMode_Hydrating -> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a. IO a -> DomRenderHookT t m a
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 a. a -> HydrationRunnerT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        HydrationMode
HydrationMode_Immediate -> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a. a -> DomRenderHookT t m a
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
      result <- runReaderT (unHydrationDomBuilderT child) $ initialEnv
            { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
            , _hydrationDomBuilderEnv_commitAction = case h of
              HydrationMode
HydrationMode_Hydrating -> JSM ()
myCommitAction
              HydrationMode
HydrationMode_Immediate -> JSM ()
commitAction
            , _hydrationDomBuilderEnv_parent = Left p'
            , _hydrationDomBuilderEnv_delayed = delayed
            }
      dom <- case h of
        HydrationMode
HydrationMode_Hydrating -> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a. IO a -> DomRenderHookT t m a
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 a. a -> DomRenderHookT t m a
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 a. a -> HydrationRunnerT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      uc <- liftIO $ readIORef unreadyChildren
      let 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 = 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
      return (actions, result)
    let (hydrate', commitAction) = fanEither $ fmap fst child'
    addHydrationStepWithSetup (hold hydrate0 hydrate') $ \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 a. Behavior t a -> HydrationRunnerT t m a
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
    requestDomAction_ $ fmapMaybe id commitAction
    return (result0, snd <$> child')

  {-# INLINABLE traverseIntMapWithKeyWithAdjust #-}
  traverseIntMapWithKeyWithAdjust :: forall v v'.
(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 (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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 (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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 :: forall a.
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 a. a -> IO 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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO 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 a. a -> IO 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 a. a -> IO 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 a. a -> IO 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 :: forall a.
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 a. a -> IO 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 ()
          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 a b. (a -> b) -> IO a -> IO b
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 a.
 k a
 -> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
 -> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a))
-> 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 k v
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') v
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) v)
forall a.
k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
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.traverseWithKey deleteOrMove $ PatchDMapWithMove.getDeletionsAndMoves p old
          return $ applyAlways p' 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 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 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'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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. vv a -> vv' a)
-> PatchDMapWithMove k vv -> PatchDMapWithMove k vv'
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_
      phsBefore <- IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall a. IO a -> JSM a
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
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 a. a -> JSM 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)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe 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
      collected <- DMap.traverseWithKey collectIfMoved p
      let !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 = (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} {k2} (f :: k1 -> *) (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 = 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 v k. 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
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 a. a -> JSM a
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 a. a -> JSM a
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 a. a -> JSM 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
                mapM_ (`insertBefore` nextPlaceholder) mdf
            Constant () a -> JSM (Constant () a)
forall a. a -> JSM 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 ()
      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) $ DMap.toDescList p -- We need to go in reverse order here, to make sure the placeholders are in the right spot at the right time
      liftIO $ writeIORef placeholders $! phsAfter

{-# INLINABLE traverseDMapWithKeyWithAdjust' #-}
traverseDMapWithKeyWithAdjust'
  :: forall s t m (k :: Type -> Type) 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 {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' = 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 :: forall a.
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 a. a -> IO 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 a. a -> IO 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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO 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 a. a -> IO 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 a. a -> IO a
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 ()
        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 a b. (a -> b) -> IO a -> IO b
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 a.
 k a
 -> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') a
 -> IO
      (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a))
-> 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 k v
-> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') v
-> IO
     (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v)
forall a.
k a
-> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') a
-> IO
     (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
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.traverseWithKey delete $ PatchDMap.getDeletions p old
        return $ applyAlways p' 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 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 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'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(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. vv a -> vv' a) -> PatchDMap k vv -> PatchDMap k vv'
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
    phs <- IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall a. IO a -> JSM a
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
    forM_ (DMap.toList patch) $ \(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 a. a -> JSM a
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 = (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} {k2} (f :: k1 -> *) (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 = 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
    liftIO $ writeIORef placeholders $! fromMaybe phs $ apply filtered 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' :: 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' = 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 a. a -> IO a
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 a. a -> IO a
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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        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.traverseWithKey delete $ FastMutableIntMap.getDeletions p old
        return $ applyAlways p' 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 v v'.
(Int -> v -> DomRenderHookT t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> DomRenderHookT 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 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
    phs <- IO (IntMap Text) -> JSM (IntMap Text)
forall a. IO a -> JSM a
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
    forM_ (IntMap.toList p) $ \(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 a. a -> JSM a
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 = 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
    liftIO $ writeIORef placeholders $! fromMaybe phs $ apply filtered 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
$cshowsPrec :: forall a. Show a => Int -> ChildReadyState a -> ShowS
showsPrec :: Int -> ChildReadyState a -> ShowS
$cshow :: forall a. Show a => ChildReadyState a -> String
show :: ChildReadyState a -> String
$cshowList :: forall a. Show a => [ChildReadyState a] -> ShowS
showList :: [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
$creadsPrec :: forall a. Read a => Int -> ReadS (ChildReadyState a)
readsPrec :: Int -> ReadS (ChildReadyState a)
$creadList :: forall a. Read a => ReadS [ChildReadyState a]
readList :: ReadS [ChildReadyState a]
$creadPrec :: forall a. Read a => ReadPrec (ChildReadyState a)
readPrec :: ReadPrec (ChildReadyState a)
$creadListPrec :: forall a. Read a => ReadPrec [ChildReadyState a]
readListPrec :: ReadPrec [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
$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
/= :: 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
$ccompare :: forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> Ordering
compare :: ChildReadyState a -> ChildReadyState a -> Ordering
$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
>= :: ChildReadyState a -> ChildReadyState a -> Bool
$cmax :: forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
max :: ChildReadyState a -> ChildReadyState a -> ChildReadyState a
$cmin :: forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
min :: ChildReadyState a -> ChildReadyState a -> ChildReadyState a
Ord)

insertAfterPreviousNode :: (Monad m, MonadJSM m) => DOM.IsNode node => node -> HydrationRunnerT t m ()
insertAfterPreviousNode :: forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode node
node = do
  parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
  nextNode <- maybe (Node.getFirstChild parent) Node.getNextSibling =<< getPreviousNode
  Node.insertBefore_ parent node nextNode
  setPreviousNode $ Just $ toNode 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 {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 (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
  doc <- HydrationDomBuilderT s t m Document
HydrationDomBuilderT
  s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  initialEnv <- HydrationDomBuilderT ask
  let parentUnreadyChildren = HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren HydrationDomBuilderEnv t m
initialEnv
  pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState (Some k)))), p k (Compose (TraverseChild t m (Some k)) v')) <- liftIO $ newIORef mempty
  haveEverBeenReady <- liftIO $ newIORef False
  placeholders <- liftIO $ newIORef Map.empty
  lastPlaceholder <- createTextNode doc ("" :: Text)
  let 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 a. IO a -> JSM a
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 = do
        IO Bool -> JSM Bool
forall a. IO a -> JSM a
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 a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True -> () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Bool
False -> do
            IO () -> JSM ()
forall a. IO a -> JSM a
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
            old <- IO Word -> JSM Word
forall a. IO a -> JSM a
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 -> Word
forall a. Enum a => a -> a
pred Word
old
            liftIO $ writeIORef parentUnreadyChildren $! new
            when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
      markChildReady :: IORef (ChildReadyState (Some k)) -> JSM ()
      markChildReady IORef (ChildReadyState (Some k))
childReadyState = do
        IO (ChildReadyState (Some k)) -> JSM (ChildReadyState (Some k))
forall a. IO a -> JSM a
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 a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          ChildReadyState (Some k)
ChildReadyState_Ready -> () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          ChildReadyState_Unready Maybe (Some k)
countedAt -> do
            IO () -> JSM ()
forall a. IO a -> JSM a
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 a. a -> JSM a
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
                (oldUnready, 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 a. IO a -> JSM a
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
                when (not $ DMap.null oldUnready) $ do -- This shouldn't actually ever be null
                  let 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
                  liftIO $ writeIORef pendingChange (newUnready, p)
                  when (DMap.null newUnready) $ do
                    applyDomUpdate p
  (children0 :: DMap k (Compose (TraverseChild t m (Some k)) v'), children' :: Event t (p k (Compose (TraverseChild t m (Some k)) v')))
    <- HydrationDomBuilderT $ lift $ 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) dm0 dm'
  let 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 a. a -> IO 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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO 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 a. a -> IO 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)
  initialUnready <- liftIO $ 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.traverseWithKey processChild children0
  liftIO $ if DMap.null initialUnready
    then writeIORef haveEverBeenReady True
    else do
      modifyIORef' parentUnreadyChildren succ
      writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time
  getHydrationMode >>= \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 p.
Patch p =>
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 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
      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 a. Behavior t a -> HydrationRunnerT t m a
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 p. Patch p => Incremental t p -> Behavior t (PatchTarget p)
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
      phs <- sequenceA $ weakenDMapWith (either _traverseChildHydration_delayed (pure . _traverseChildImmediate_placeholder) . _traverseChild_mode . getCompose) dm
      liftIO $ writeIORef placeholders $! phs
      insertAfterPreviousNode 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 a. a -> HydrationDomBuilderT s t m a
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
      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)
forall (f :: * -> *) a.
Applicative f =>
Map (Some k) (f a) -> f (Map (Some k) 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} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) DMap k (Compose (TraverseChild t m (Some k)) v')
children0
      liftIO $ writeIORef placeholders $! phs
      append $ toNode lastPlaceholder
  requestDomAction_ $ ffor children' $ \p k (Compose (TraverseChild t m (Some k)) v')
p -> do
    (oldUnready, 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 a. IO a -> JSM a
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
    newUnready <- liftIO $ updateChildUnreadiness p oldUnready
    let !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
    liftIO $ writeIORef pendingChange (newUnready, newP)
    when (DMap.null newUnready) $ do
      applyDomUpdate newP
  let 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} {k2} (f :: k1 -> *) (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 (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} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
  return (result0, 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 :: 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 (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
  doc <- HydrationDomBuilderT s t m Document
HydrationDomBuilderT
  s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  initialEnv <- HydrationDomBuilderT ask
  let parentUnreadyChildren = HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren HydrationDomBuilderEnv t m
initialEnv
  pendingChange :: IORef (IntMap (IORef (ChildReadyState Int)), p (TraverseChild t m Int v')) <- liftIO $ newIORef mempty
  haveEverBeenReady <- liftIO $ newIORef False
  placeholders <- liftIO $ newIORef IntMap.empty
  lastPlaceholder <- createTextNode doc ("" :: Text)
  let 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 a. IO a -> JSM a
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 = do
        IO Bool -> JSM Bool
forall a. IO a -> JSM a
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 a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True -> () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Bool
False -> do
            IO () -> JSM ()
forall a. IO a -> JSM a
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
            old <- IO Word -> JSM Word
forall a. IO a -> JSM a
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 -> Word
forall a. Enum a => a -> a
pred Word
old
            liftIO $ writeIORef parentUnreadyChildren $! new
            when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
      markChildReady :: IORef (ChildReadyState Int) -> JSM ()
      markChildReady IORef (ChildReadyState Int)
childReadyState = do
        IO (ChildReadyState Int) -> JSM (ChildReadyState Int)
forall a. IO a -> JSM a
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 a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          ChildReadyState Int
ChildReadyState_Ready -> () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          ChildReadyState_Unready Maybe Int
countedAt -> do
            IO () -> JSM ()
forall a. IO a -> JSM a
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 a. a -> JSM a
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
                (oldUnready, p) <- IO
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
-> JSM
     (IntMap (IORef (ChildReadyState Int)),
      p (TraverseChild t m Int v'))
forall a. IO a -> JSM a
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
                when (not $ IntMap.null oldUnready) $ do -- This shouldn't actually ever be null
                  let 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
                  liftIO $ writeIORef pendingChange (newUnready, p)
                  when (IntMap.null newUnready) $ do
                    applyDomUpdate p
  (children0 :: IntMap (TraverseChild t m Int v'), children' :: Event t (p (TraverseChild t m Int v')))
    <- HydrationDomBuilderT $ lift $ 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) dm0 dm'
  let 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 a. a -> IO a
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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
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 a. a -> IO a
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)
  initialUnready <- liftIO $ IntMap.mapMaybe id <$> IntMap.traverseWithKey processChild children0
  liftIO $ if IntMap.null initialUnready
    then writeIORef haveEverBeenReady True
    else do
      modifyIORef' parentUnreadyChildren succ
      writeIORef pendingChange (initialUnready, mempty) -- The patch is always empty because it got applied implicitly when we ran the children the first time
  getHydrationMode >>= \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 p.
Patch p =>
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 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
      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 a. Behavior t a -> HydrationRunnerT t m a
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 p. Patch p => Incremental t p -> Behavior t (PatchTarget p)
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
      phs <- traverse (either _traverseChildHydration_delayed (pure . _traverseChildImmediate_placeholder) . _traverseChild_mode) dm
      liftIO $ writeIORef placeholders $! phs
      insertAfterPreviousNode 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 a. a -> HydrationDomBuilderT s t m a
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
      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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntMap a -> f (IntMap 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
      liftIO $ writeIORef placeholders $! phs
      append $ toNode lastPlaceholder
  requestDomAction_ $ ffor children' $ \p (TraverseChild t m Int v')
p -> do
    (oldUnready, oldP) <- IO
  (IntMap (IORef (ChildReadyState Int)),
   p (TraverseChild t m Int v'))
-> JSM
     (IntMap (IORef (ChildReadyState Int)),
      p (TraverseChild t m Int v'))
forall a. IO a -> JSM a
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
    newUnready <- liftIO $ updateChildUnreadiness p oldUnready
    let !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
    liftIO $ writeIORef pendingChange (newUnready, newP)
    when (IntMap.null newUnready) $ do
      applyDomUpdate newP
  let 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 (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 a b. (a -> b) -> p a -> p b
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
  return (result0, 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
  { forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment :: {-# UNPACK #-} !DOM.DocumentFragment
  -- ^ Child is appended to this fragment
  , forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder :: {-# UNPACK #-} !DOM.Text
  -- ^ Placeholder reference
  , forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState :: {-# UNPACK #-} !(IORef (ChildReadyState k))
  }

newtype TraverseChildHydration t m = TraverseChildHydration
  { forall t (m :: * -> *).
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
  { forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode :: !(Either (TraverseChildHydration t m) (TraverseChildImmediate k))
  , forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result :: !a
  } deriving (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
$cfmap :: forall t (m :: * -> *) k a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
fmap :: forall a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
$c<$ :: forall t (m :: * -> *) k a b.
a -> TraverseChild t m k b -> TraverseChild t m k a
<$ :: forall a b. a -> TraverseChild t m k b -> TraverseChild t m k a
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 :: 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 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
  unreadyChildren <- IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall a. IO a -> DomRenderHookT t m a
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
  liftIO (readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv) >>= \case
    HydrationMode
HydrationMode_Hydrating -> do
      childDelayedRef <- IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a. IO a -> DomRenderHookT t m a
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 a. a -> HydrationRunnerT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      result <- runReaderT (unHydrationDomBuilderT child) initialEnv
        { _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
        , _hydrationDomBuilderEnv_delayed = childDelayedRef
        }
      childDelayed <- liftIO $ readIORef childDelayedRef
      return $ Compose $ TraverseChild
        { _traverseChild_result = result
        , _traverseChild_mode = Left TraverseChildHydration
          { _traverseChildHydration_delayed = do
            placeholder <- createTextNode doc ("" :: Text)
            insertAfterPreviousNode placeholder
            childDelayed
            pure placeholder
          }
        }
    HydrationMode
HydrationMode_Immediate -> do
      childReadyState <- IO (IORef (ChildReadyState k))
-> DomRenderHookT t m (IORef (ChildReadyState k))
forall a. IO a -> DomRenderHookT t m a
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
      df <- createDocumentFragment doc
      placeholder <- createTextNode doc ("" :: Text)
      Node.appendChild_ df placeholder
      result <- runReaderT (unHydrationDomBuilderT child) initialEnv
        { _hydrationDomBuilderEnv_parent = Left $ toNode df
        , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
        , _hydrationDomBuilderEnv_commitAction = markReady childReadyState
        }
      u <- liftIO $ readIORef unreadyChildren
      when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready
      return $ Compose $ TraverseChild
        { _traverseChild_result = result
        , _traverseChild_mode = Right TraverseChildImmediate
          { _traverseChildImmediate_fragment = df
          , _traverseChildImmediate_placeholder = placeholder
          , _traverseChildImmediate_childReadyState = 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 :: 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
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 a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
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} {k2} (f :: k1 -> *) (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 :: 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 d t
e = do
  doc <- m (RawDocument (DomBuilderSpace m))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
  initialFocus <- Node.isSameNode (toNode $ _element_raw e) . fmap toNode =<< Document.getActiveElement doc
  holdDyn initialFocus $ leftmost
    [ False <$ Reflex.select (_element_events e) (WrapArg Blur)
    , True <$ Reflex.select (_element_events e) (WrapArg Focus)
    ]

insertBefore :: (MonadJSM m, IsNode new, IsNode existing) => new -> existing -> m ()
insertBefore :: forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
insertBefore new
new existing
existing = do
  p <- existing -> m Node
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Node
getParentNodeUnchecked existing
existing
  Node.insertBefore_ p new (Just 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 (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
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 :: forall a.
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 (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m 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 a. 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 (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
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 :: forall a.
(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 (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m 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 a. (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 (k :: * -> *).
GCompare k =>
(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 (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
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)
forall (k :: * -> *).
GCompare k =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger k a -> EventTrigger t a -> IO (IO ())
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 :: forall a. 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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) m a
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 a. 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 :: forall a.
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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) m a
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 a. 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 :: forall a.
((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 (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) m 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 a.
((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 :: forall a. 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 (m :: * -> *) a.
Monad m =>
m a -> RequesterT t JSM Identity m a
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 a. 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 :: forall a. 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 (m :: * -> *) a.
Monad m =>
m a -> RequesterT t JSM Identity m a
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 a. 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 :: forall a.
((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 (m :: * -> *) a.
Monad m =>
m a -> RequesterT t JSM Identity m 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 a.
((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 MonadRef m => MonadRef (HydrationDomBuilderT s t m) where
  type Ref (HydrationDomBuilderT s t m) = Ref m
  {-# INLINABLE newRef #-}
  newRef :: forall a.
a
-> HydrationDomBuilderT s t m (Ref (HydrationDomBuilderT s t m) a)
newRef = m (Ref m a) -> HydrationDomBuilderT s t m (Ref m a)
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t 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 a. a -> m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
  {-# INLINABLE readRef #-}
  readRef :: forall a.
Ref (HydrationDomBuilderT s t m) a -> HydrationDomBuilderT s t m a
readRef = m a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a.
Monad m =>
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 a. Ref m a -> m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
  {-# INLINABLE writeRef #-}
  writeRef :: forall a.
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 (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
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 a. 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 :: forall a b.
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 (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
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 a b. 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

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

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

{-# INLINABLE withIsEvent #-}
withIsEvent :: EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent :: forall (en :: EventTag) r.
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 :: forall (en :: EventTag). 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
FromJSVal ElementEventTarget
ToJSVal 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
$ctypeGType :: ElementEventTarget -> JSM GType
typeGType :: ElementEventTarget -> JSM GType
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
$ctoJSVal :: ElementEventTarget -> JSM JSVal
toJSVal :: ElementEventTarget -> JSM JSVal
$ctoJSValListOf :: [ElementEventTarget] -> JSM JSVal
toJSValListOf :: [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, IsEventTarget ElementEventTarget
IsGObject ElementEventTarget
(IsEventTarget ElementEventTarget, IsGObject ElementEventTarget) =>
IsNode ElementEventTarget
forall o. (IsEventTarget o, IsGObject o) => IsNode o
IsNode, IsSlotable ElementEventTarget
IsParentNode ElementEventTarget
IsNonDocumentTypeChildNode ElementEventTarget
IsNode ElementEventTarget
IsEventTarget ElementEventTarget
IsDocumentAndElementEventHandlers ElementEventTarget
IsChildNode ElementEventTarget
IsAnimatable ElementEventTarget
IsGObject 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
IsElement)
instance DOM.FromJSVal ElementEventTarget where
  fromJSVal :: JSVal -> JSM (Maybe ElementEventTarget)
fromJSVal = (Maybe Element -> Maybe ElementEventTarget)
-> JSM (Maybe Element) -> JSM (Maybe ElementEventTarget)
forall a b. (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Element -> ElementEventTarget)
-> Maybe Element -> Maybe ElementEventTarget
forall a b. (a -> b) -> Maybe a -> Maybe b
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 :: forall e (en :: EventTag).
IsElement e =>
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 :: forall (en :: EventTag).
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 Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO
  EventName en
Cut -> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO
  EventName en
Beforecopy -> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO
  EventName en
Copy -> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO
  EventName en
Beforepaste -> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return () --TODO
  EventName en
Paste -> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
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 Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
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 :: 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 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 a b. (a -> b) -> ReaderT event JSM a -> ReaderT event JSM b
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 :: 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 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
  mv <- EventM e event (Maybe a)
getValue
  forM_ mv $ \a
v -> IO () -> EventM e event ()
forall a. IO a -> ReaderT event JSM a
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
    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
    writeChan eventChan [EventTriggerRef etr :=> TriggerInvocation v (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 :: 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)
getValue = do
  ctx <- m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
  newEventWithLazyTriggerWithOnComplete $ \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
    mv <- EventM e event (Maybe a)
getValue
    forM_ mv $ \a
v -> IO () -> EventM e event ()
forall a. IO a -> ReaderT event JSM a
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 a. a -> IO a
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 :: 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 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
  ctx <- HydrationDomBuilderT GhcjsDomSpace t m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
  eventChan <- askEvents
  e <- lift $ newFanEventWithTrigger $ \(WrapArg EventName a1
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 (ZonkAny 36) (EventType a1) () -> JSM (JSM ()))
-> EventM (ZonkAny 36) (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 (ZonkAny 36) (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 (ZonkAny 36) (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)
  return $! e

{-# INLINABLE getKeyEvent #-}
getKeyEvent :: EventM e KeyboardEvent Word
getKeyEvent :: forall e. EventM (ZonkAny 19) KeyboardEvent Word
getKeyEvent = do
  e <- EventM (ZonkAny 4) KeyboardEvent KeyboardEvent
forall t e. EventM t e e
event
  which <- KeyboardEvent.getWhich e
  if which /= 0 then return which else do
    charCode <- getCharCode e
    if charCode /= 0 then return charCode else
      getKeyCode e

{-# INLINABLE getMouseEventCoords #-}
getMouseEventCoords :: EventM e MouseEvent (Int, Int)
getMouseEventCoords :: forall e. EventM (ZonkAny 18) MouseEvent (Int, Int)
getMouseEventCoords = do
  e <- EventM (ZonkAny 3) MouseEvent MouseEvent
forall t e. EventM t e e
event
  bisequence (getClientX e, getClientY e)

{-# INLINABLE getPasteData #-}
getPasteData :: EventM e ClipboardEvent (Maybe Text)
getPasteData :: forall e. EventM (ZonkAny 25) ClipboardEvent (Maybe Text)
getPasteData = do
  e <- EventM (ZonkAny 2) ClipboardEvent ClipboardEvent
forall t e. EventM t e e
event
  mdt <- ClipboardEvent.getClipboardData e
  case mdt of
    Maybe DataTransfer
Nothing -> Maybe Text -> EventM (ZonkAny 25) ClipboardEvent (Maybe Text)
forall a. a -> ReaderT ClipboardEvent JSM a
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 (ZonkAny 25) 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 :: forall e. EventM (ZonkAny 26) TouchEvent TouchEventResult
getTouchEvent = do
  let touchResults :: TouchList -> m [TouchResult]
touchResults TouchList
ts = do
          n <- TouchList -> m Word
forall (m :: * -> *). MonadDOM m => TouchList -> m Word
TouchList.getLength TouchList
ts
          forM (takeWhile (< n) [0..]) $ \Word
ix -> do
            t <- TouchList -> Word -> m Touch
forall (m :: * -> *). MonadDOM m => TouchList -> Word -> m Touch
TouchList.item TouchList
ts Word
ix
            identifier <- Touch.getIdentifier t
            screenX <- Touch.getScreenX t
            screenY <- Touch.getScreenY t
            clientX <- Touch.getClientX t
            clientY <- Touch.getClientY t
            pageX <- Touch.getPageX t
            pageY <- Touch.getPageY t
            return TouchResult
              { _touchResult_identifier = identifier
              , _touchResult_screenX = screenX
              , _touchResult_screenY = screenY
              , _touchResult_clientX = clientX
              , _touchResult_clientY = clientY
              , _touchResult_pageX = pageX
              , _touchResult_pageY = pageY
              }
  e <- EventM (ZonkAny 1) TouchEvent TouchEvent
forall t e. EventM t e e
event
  altKey <- TouchEvent.getAltKey e
  ctrlKey <- TouchEvent.getCtrlKey e
  shiftKey <- TouchEvent.getShiftKey e
  metaKey <- TouchEvent.getMetaKey e
  changedTouches <- touchResults =<< TouchEvent.getChangedTouches e
  targetTouches <- touchResults =<< TouchEvent.getTargetTouches e
  touches <- touchResults =<< TouchEvent.getTouches e
  return $ TouchEventResult
    { _touchEventResult_altKey = altKey
    , _touchEventResult_changedTouches = changedTouches
    , _touchEventResult_ctrlKey = ctrlKey
    , _touchEventResult_metaKey = metaKey
    , _touchEventResult_shiftKey = shiftKey
    , _touchEventResult_targetTouches = targetTouches
    , _touchEventResult_touches = touches
    }

{-# INLINABLE getWheelEvent #-}
getWheelEvent :: EventM e WheelEvent WheelEventResult
getWheelEvent :: forall e. EventM (ZonkAny 30) WheelEvent WheelEventResult
getWheelEvent = do
  e <- EventM (ZonkAny 0) WheelEvent WheelEvent
forall t e. EventM t e e
event
  dx :: Double <- WheelEvent.getDeltaX e
  dy :: Double <- WheelEvent.getDeltaY e
  dz :: Double <- WheelEvent.getDeltaZ e
  deltaMode :: Word <- WheelEvent.getDeltaMode e
  return $ WheelEventResult
    { _wheelEventResult_deltaX = dx
    , _wheelEventResult_deltaY = dy
    , _wheelEventResult_deltaZ = dz
    , _wheelEventResult_deltaMode = case 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 :: forall a. Behavior t a -> HydrationDomBuilderT s t m a
sample = m a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a.
Monad m =>
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 a. 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 :: forall a.
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 (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m 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 a. 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 :: forall a.
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 (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m 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 a. 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 :: forall p.
Patch p =>
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 (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
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 p.
Patch p =>
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 :: forall a.
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 (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m 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 a. 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 :: forall a. Event t a -> HydrationDomBuilderT s t m (Event t a)
headE = m (Event t a) -> HydrationDomBuilderT s t m (Event t a)
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m 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 a. 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
  { forall {k} (t :: k).
Window t -> EventSelector t (WrapArg EventResult EventName)
_window_events :: EventSelector t (WrapArg EventResult EventName)
  , forall {k} (t :: k). Window t -> Window
_window_raw :: DOM.Window
  }

wrapWindow :: (MonadJSM m, MonadReflexCreateTrigger t m) => DOM.Window -> WindowConfig t -> HydrationDomBuilderT GhcjsDomSpace t m (Window t)
wrapWindow :: forall (m :: * -> *) t.
(MonadJSM m, MonadReflexCreateTrigger t m) =>
Window
-> WindowConfig t
-> HydrationDomBuilderT GhcjsDomSpace t m (Window t)
wrapWindow Window
wv WindowConfig t
_ = do
  events <- Window
-> (forall (en :: EventTag).
    IsEvent (EventType en) =>
    EventName en
    -> EventM Window (EventType en) (Maybe (EventResult en)))
-> (forall (en :: EventTag).
    EventName en
    -> Window -> EventM Window (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
-> ReaderT (EventType en) JSM (Maybe (EventResult en))
forall (en :: EventTag).
Window
-> EventName en
-> EventM Window (EventType en) (Maybe (EventResult en))
defaultDomWindowEventHandler Window
wv) EventName en
-> Window -> EventM Window (EventType en) () -> JSM (JSM ())
forall (en :: EventTag).
EventName en
-> Window -> EventM Window (EventType en) () -> JSM (JSM ())
windowOnEventName
  return $ Window
    { _window_events = events
    , _window_raw = wv
    }

#ifdef USE_TEMPLATE_HASKELL
makeLenses ''GhcjsEventSpec
#endif