{-# 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
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
, hydratableAttribute
, skipHydrationAttribute
, traverseDMapWithKeyWithAdjust'
, hoistTraverseWithKeyWithAdjust
, traverseIntMapWithKeyWithAdjust'
, hoistTraverseIntMapWithKeyWithAdjust
) where
import Control.Concurrent
import Control.Exception (bracketOnError)
import Control.Lens (Identity(..), imapM_, iforM_, (^.), makeLenses)
import Control.Monad.Exception
import Control.Monad.Primitive
import Control.Monad.Reader
import Control.Monad.Ref
import Control.Monad.State.Strict (StateT, mapStateT, get, modify', gets, runStateT)
import Data.Bitraversable
import Data.Default
import Data.Dependent.Map (DMap)
import Data.Dependent.Sum
import Data.FastMutableIntMap (PatchIntMap (..))
import Data.Foldable (for_, traverse_)
import Data.Functor.Compose
import Data.Functor.Constant
import Data.Functor.Misc
import Data.Functor.Product
import Data.GADT.Compare (GCompare)
import Data.IORef
import Data.IntMap.Strict (IntMap)
import Data.Maybe
import Data.Monoid ((<>))
import Data.Some (Some(..))
import Data.GADT.Compare (GCompare)
import Data.String (IsString)
import Data.Text (Text)
import Foreign.JavaScript.Internal.Utils
import Foreign.JavaScript.TH
import GHCJS.DOM.ClipboardEvent as ClipboardEvent
import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)
import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS, hasAttribute)
import GHCJS.DOM.EventM (EventM, event, on)
import GHCJS.DOM.KeyboardEvent as KeyboardEvent
import GHCJS.DOM.MouseEvent
import GHCJS.DOM.Node (appendChild_, getOwnerDocumentUnchecked, getParentNodeUnchecked, setNodeValue, toNode)
import GHCJS.DOM.Types (liftJSM, askJSM, runJSM, JSM, MonadJSM, FocusEvent, IsElement, IsEvent, IsNode, KeyboardEvent, Node, TouchEvent, WheelEvent, uncheckedCastTo, ClipboardEvent)
import GHCJS.DOM.UIEvent
import Language.Javascript.JSaddle (call, eval)
import Reflex.Adjustable.Class
import Reflex.Class as Reflex
import Reflex.Dom.Builder.Class
import Reflex.Dynamic
import Reflex.Host.Class
import Reflex.Patch.DMapWithMove (PatchDMapWithMove(..))
import Reflex.Patch.MapWithMove (PatchMapWithMove(..))
import Reflex.PerformEvent.Base (PerformEventT)
import Reflex.PerformEvent.Class
import Reflex.PostBuild.Base (PostBuildT)
import Reflex.PostBuild.Class
#ifdef PROFILE_REFLEX
import Reflex.Profiled
#endif
import Reflex.Requester.Base
import Reflex.Requester.Class
import Reflex.Spider (Spider, SpiderHost, Global)
import Reflex.TriggerEvent.Base hiding (askEvents)
import Reflex.TriggerEvent.Class
import qualified Data.Dependent.Map as DMap
import qualified Data.FastMutableIntMap as FastMutableIntMap
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified GHCJS.DOM as DOM
import qualified GHCJS.DOM.DataTransfer as DataTransfer
import qualified GHCJS.DOM.DocumentAndElementEventHandlers as Events
import qualified GHCJS.DOM.DocumentOrShadowRoot as Document
import qualified GHCJS.DOM.Element as Element
import qualified GHCJS.DOM.Event as Event
import qualified GHCJS.DOM.EventM as DOM
import qualified GHCJS.DOM.FileList as FileList
import qualified GHCJS.DOM.GlobalEventHandlers as Events
import qualified GHCJS.DOM.HTMLInputElement as Input
import qualified GHCJS.DOM.HTMLSelectElement as Select
import qualified GHCJS.DOM.HTMLTextAreaElement as TextArea
import qualified GHCJS.DOM.Node as Node
import qualified GHCJS.DOM.Text as DOM
import qualified GHCJS.DOM.Touch as Touch
import qualified GHCJS.DOM.TouchEvent as TouchEvent
import qualified GHCJS.DOM.TouchList as TouchList
import qualified GHCJS.DOM.Types as DOM
import qualified GHCJS.DOM.Window as Window
import qualified GHCJS.DOM.WheelEvent as WheelEvent
import qualified Reflex.Patch.DMap as PatchDMap
import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)
#ifndef USE_TEMPLATE_HASKELL
import Data.Functor.Contravariant (phantom)
import Control.Lens (Lens', Getter)
#endif
#ifndef ghcjs_HOST_OS
import GHCJS.DOM.Types (MonadJSM (..))
instance MonadJSM m => MonadJSM (HydrationRunnerT t m) where
{-# INLINABLE liftJSM' #-}
liftJSM' :: JSM a -> HydrationRunnerT t m a
liftJSM' = m a -> HydrationRunnerT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationRunnerT t m a)
-> (JSM a -> m a) -> JSM a -> HydrationRunnerT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
instance MonadJSM m => MonadJSM (HydrationDomBuilderT s t m) where
{-# INLINABLE liftJSM' #-}
liftJSM' :: JSM a -> HydrationDomBuilderT s t m a
liftJSM' = m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> (JSM a -> m a) -> JSM a -> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
instance MonadJSM m => MonadJSM (DomRenderHookT t m) where
{-# INLINABLE liftJSM' #-}
liftJSM' :: JSM a -> DomRenderHookT t m a
liftJSM' = m a -> DomRenderHookT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> DomRenderHookT t m a)
-> (JSM a -> m a) -> JSM a -> DomRenderHookT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
#endif
data HydrationDomBuilderEnv t m = HydrationDomBuilderEnv
{ HydrationDomBuilderEnv t m -> Document
_hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document
, HydrationDomBuilderEnv t m -> Either Node (IORef Node)
_hydrationDomBuilderEnv_parent :: !(Either Node (IORef Node))
, HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren :: {-# UNPACK #-} !(IORef Word)
, HydrationDomBuilderEnv t m -> JSM ()
_hydrationDomBuilderEnv_commitAction :: !(JSM ())
, HydrationDomBuilderEnv t m -> IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode :: {-# UNPACK #-} !(IORef HydrationMode)
, HydrationDomBuilderEnv t m -> Event t ()
_hydrationDomBuilderEnv_switchover :: !(Event t ())
, HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed :: {-# UNPACK #-} !(IORef (HydrationRunnerT t m ()))
}
newtype HydrationDomBuilderT s t m a = HydrationDomBuilderT { HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT :: ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a }
deriving (a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
(forall a b.
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b)
-> (forall a b.
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a)
-> Functor (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
forall a b.
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall a b.
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
$c<$ :: forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
fmap :: (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
$cfmap :: forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
Functor, Functor (HydrationDomBuilderT s t m)
a -> HydrationDomBuilderT s t m a
Functor (HydrationDomBuilderT s t m)
-> (forall a. a -> HydrationDomBuilderT s t m a)
-> (forall a b.
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b)
-> (forall a b c.
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c)
-> (forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b)
-> (forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a)
-> Applicative (HydrationDomBuilderT s t m)
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
forall a. a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
Monad m =>
Functor (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
forall k (s :: k) t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall a b.
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
forall a b c.
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
$c<* :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
*> :: HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
$c*> :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
liftA2 :: (a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
$cliftA2 :: forall k (s :: k) t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
<*> :: HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
$c<*> :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
pure :: a -> HydrationDomBuilderT s t m a
$cpure :: forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
$cp1Applicative :: forall k (s :: k) t (m :: * -> *).
Monad m =>
Functor (HydrationDomBuilderT s t m)
Applicative, Applicative (HydrationDomBuilderT s t m)
a -> HydrationDomBuilderT s t m a
Applicative (HydrationDomBuilderT s t m)
-> (forall a b.
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b)
-> (forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b)
-> (forall a. a -> HydrationDomBuilderT s t m a)
-> Monad (HydrationDomBuilderT s t m)
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall a. a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
Monad m =>
Applicative (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall a b.
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> HydrationDomBuilderT s t m a
$creturn :: forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
>> :: HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
$c>> :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
>>= :: HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
$c>>= :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
$cp1Monad :: forall k (s :: k) t (m :: * -> *).
Monad m =>
Applicative (HydrationDomBuilderT s t m)
Monad, Monad (HydrationDomBuilderT s t m)
Monad (HydrationDomBuilderT s t m)
-> (forall a.
(a -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a)
-> MonadFix (HydrationDomBuilderT s t m)
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
forall a.
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
MonadFix m =>
Monad (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
$cmfix :: forall k (s :: k) t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
$cp1MonadFix :: forall k (s :: k) t (m :: * -> *).
MonadFix m =>
Monad (HydrationDomBuilderT s t m)
MonadFix, Monad (HydrationDomBuilderT s t m)
Monad (HydrationDomBuilderT s t m)
-> (forall a. IO a -> HydrationDomBuilderT s t m a)
-> MonadIO (HydrationDomBuilderT s t m)
IO a -> HydrationDomBuilderT s t m a
forall a. IO a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
MonadIO m =>
Monad (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationDomBuilderT s t m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> HydrationDomBuilderT s t m a
$cliftIO :: forall k (s :: k) t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationDomBuilderT s t m a
$cp1MonadIO :: forall k (s :: k) t (m :: * -> *).
MonadIO m =>
Monad (HydrationDomBuilderT s t m)
MonadIO, Monad (HydrationDomBuilderT s t m)
e -> HydrationDomBuilderT s t m a
Monad (HydrationDomBuilderT s t m)
-> (forall e a. Exception e => e -> HydrationDomBuilderT s t m a)
-> (forall e a.
Exception e =>
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a)
-> (forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a)
-> MonadException (HydrationDomBuilderT s t m)
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
MonadException m =>
Monad (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) e a.
(MonadException m, Exception e) =>
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
MonadException m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall e a. Exception e => e -> HydrationDomBuilderT s t m a
forall e a.
Exception e =>
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall (m :: * -> *).
Monad m
-> (forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
finally :: HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
$cfinally :: forall k (s :: k) t (m :: * -> *) a b.
MonadException m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
catch :: HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
$ccatch :: forall k (s :: k) t (m :: * -> *) e a.
(MonadException m, Exception e) =>
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
throw :: e -> HydrationDomBuilderT s t m a
$cthrow :: forall k (s :: k) t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationDomBuilderT s t m a
$cp1MonadException :: forall k (s :: k) t (m :: * -> *).
MonadException m =>
Monad (HydrationDomBuilderT s t m)
MonadException
#if MIN_VERSION_base(4,9,1)
, MonadIO (HydrationDomBuilderT s t m)
MonadException (HydrationDomBuilderT s t m)
MonadIO (HydrationDomBuilderT s t m)
-> MonadException (HydrationDomBuilderT s t m)
-> (forall b.
((forall a.
HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b)
-> MonadAsyncException (HydrationDomBuilderT s t m)
((forall a.
HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall b.
((forall a.
HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall k (s :: k) t (m :: * -> *).
MonadAsyncException m =>
MonadIO (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *).
MonadAsyncException m =>
MonadException (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) b.
MonadAsyncException m =>
((forall a.
HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall (m :: * -> *).
MonadIO m
-> MonadException m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
mask :: ((forall a.
HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
$cmask :: forall k (s :: k) t (m :: * -> *) b.
MonadAsyncException m =>
((forall a.
HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
$cp2MonadAsyncException :: forall k (s :: k) t (m :: * -> *).
MonadAsyncException m =>
MonadException (HydrationDomBuilderT s t m)
$cp1MonadAsyncException :: forall k (s :: k) t (m :: * -> *).
MonadAsyncException m =>
MonadIO (HydrationDomBuilderT s t m)
MonadAsyncException
#endif
)
instance PrimMonad m => PrimMonad (HydrationDomBuilderT s t m) where
type PrimState (HydrationDomBuilderT s t m) = PrimState m
primitive :: (State# (PrimState (HydrationDomBuilderT s t m))
-> (# State# (PrimState (HydrationDomBuilderT s t m)), a #))
-> HydrationDomBuilderT s t m a
primitive = m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
instance MonadTrans (HydrationDomBuilderT s t) where
lift :: m a -> HydrationDomBuilderT s t m a
lift = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a)
-> (m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> m a
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> (m a -> DomRenderHookT t m a)
-> m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> DomRenderHookT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationDomBuilderT s t m) where
withRenderHook :: (forall x. JSM x -> JSM x)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
withRenderHook forall x. JSM x -> JSM x
hook = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a)
-> (HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DomRenderHookT t m a -> DomRenderHookT t m a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((forall x. JSM x -> JSM x)
-> DomRenderHookT t m a -> DomRenderHookT t m a
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
(forall x. JSM x -> JSM x) -> m a -> m a
withRenderHook forall x. JSM x -> JSM x
hook) (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> (HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT
requestDomAction :: Event t (JSM a) -> HydrationDomBuilderT s t m (Event t a)
requestDomAction = ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
-> HydrationDomBuilderT s t m (Event t a)
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
-> HydrationDomBuilderT s t m (Event t a))
-> (Event t (JSM a)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a))
-> Event t (JSM a)
-> HydrationDomBuilderT s t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a))
-> (Event t (JSM a) -> DomRenderHookT t m (Event t a))
-> Event t (JSM a)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> DomRenderHookT t m (Event t a)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction
requestDomAction_ :: Event t (JSM a) -> HydrationDomBuilderT s t m ()
requestDomAction_ = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ()
-> HydrationDomBuilderT s t m ()
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ()
-> HydrationDomBuilderT s t m ())
-> (Event t (JSM a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ())
-> Event t (JSM a)
-> HydrationDomBuilderT s t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m ()
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m ()
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ())
-> (Event t (JSM a) -> DomRenderHookT t m ())
-> Event t (JSM a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> DomRenderHookT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_
newtype HydrationRunnerT t m a = HydrationRunnerT { HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
unHydrationRunnerT :: StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a }
deriving (a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
(forall a b.
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b)
-> (forall a b.
a -> HydrationRunnerT t m b -> HydrationRunnerT t m a)
-> Functor (HydrationRunnerT t m)
forall a b. a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall a b.
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
forall t (m :: * -> *) a b.
Functor m =>
a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
fmap :: (a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
Functor, Functor (HydrationRunnerT t m)
a -> HydrationRunnerT t m a
Functor (HydrationRunnerT t m)
-> (forall a. a -> HydrationRunnerT t m a)
-> (forall a b.
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b)
-> (forall a b c.
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c)
-> (forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b)
-> (forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a)
-> Applicative (HydrationRunnerT t m)
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
forall a. a -> HydrationRunnerT t m a
forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall a b.
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
forall a b c.
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
forall t (m :: * -> *). Monad m => Functor (HydrationRunnerT t m)
forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
*> :: HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
liftA2 :: (a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
<*> :: HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
pure :: a -> HydrationRunnerT t m a
$cpure :: forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
$cp1Applicative :: forall t (m :: * -> *). Monad m => Functor (HydrationRunnerT t m)
Applicative, Applicative (HydrationRunnerT t m)
a -> HydrationRunnerT t m a
Applicative (HydrationRunnerT t m)
-> (forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b)
-> (forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b)
-> (forall a. a -> HydrationRunnerT t m a)
-> Monad (HydrationRunnerT t m)
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall a. a -> HydrationRunnerT t m a
forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall t (m :: * -> *).
Monad m =>
Applicative (HydrationRunnerT t m)
forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> HydrationRunnerT t m a
$creturn :: forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
>> :: HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
>>= :: HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
$cp1Monad :: forall t (m :: * -> *).
Monad m =>
Applicative (HydrationRunnerT t m)
Monad, Monad (HydrationRunnerT t m)
Monad (HydrationRunnerT t m)
-> (forall a.
(a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a)
-> MonadFix (HydrationRunnerT t m)
(a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall a. (a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall t (m :: * -> *). MonadFix m => Monad (HydrationRunnerT t m)
forall t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
$cp1MonadFix :: forall t (m :: * -> *). MonadFix m => Monad (HydrationRunnerT t m)
MonadFix, Monad (HydrationRunnerT t m)
Monad (HydrationRunnerT t m)
-> (forall a. IO a -> HydrationRunnerT t m a)
-> MonadIO (HydrationRunnerT t m)
IO a -> HydrationRunnerT t m a
forall a. IO a -> HydrationRunnerT t m a
forall t (m :: * -> *). MonadIO m => Monad (HydrationRunnerT t m)
forall t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationRunnerT t m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> HydrationRunnerT t m a
$cliftIO :: forall t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationRunnerT t m a
$cp1MonadIO :: forall t (m :: * -> *). MonadIO m => Monad (HydrationRunnerT t m)
MonadIO, Monad (HydrationRunnerT t m)
e -> HydrationRunnerT t m a
Monad (HydrationRunnerT t m)
-> (forall e a. Exception e => e -> HydrationRunnerT t m a)
-> (forall e a.
Exception e =>
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a)
-> (forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a)
-> MonadException (HydrationRunnerT t m)
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall e a. Exception e => e -> HydrationRunnerT t m a
forall e a.
Exception e =>
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall t (m :: * -> *).
MonadException m =>
Monad (HydrationRunnerT t m)
forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationRunnerT t m a
forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
MonadException m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall (m :: * -> *).
Monad m
-> (forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
finally :: HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
$cfinally :: forall t (m :: * -> *) a b.
MonadException m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
catch :: HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
$ccatch :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
throw :: e -> HydrationRunnerT t m a
$cthrow :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationRunnerT t m a
$cp1MonadException :: forall t (m :: * -> *).
MonadException m =>
Monad (HydrationRunnerT t m)
MonadException
#if MIN_VERSION_base(4,9,1)
, MonadIO (HydrationRunnerT t m)
MonadException (HydrationRunnerT t m)
MonadIO (HydrationRunnerT t m)
-> MonadException (HydrationRunnerT t m)
-> (forall b.
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
-> HydrationRunnerT t m b)
-> HydrationRunnerT t m b)
-> MonadAsyncException (HydrationRunnerT t m)
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
-> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
forall b.
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
-> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
forall t (m :: * -> *).
MonadAsyncException m =>
MonadIO (HydrationRunnerT t m)
forall t (m :: * -> *).
MonadAsyncException m =>
MonadException (HydrationRunnerT t m)
forall t (m :: * -> *) b.
MonadAsyncException m =>
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
-> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
forall (m :: * -> *).
MonadIO m
-> MonadException m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
mask :: ((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
-> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
$cmask :: forall t (m :: * -> *) b.
MonadAsyncException m =>
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
-> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
$cp2MonadAsyncException :: forall t (m :: * -> *).
MonadAsyncException m =>
MonadException (HydrationRunnerT t m)
$cp1MonadAsyncException :: forall t (m :: * -> *).
MonadAsyncException m =>
MonadIO (HydrationRunnerT t m)
MonadAsyncException
#endif
)
data HydrationState = HydrationState
{ HydrationState -> Maybe Node
_hydrationState_previousNode :: !(Maybe Node)
, HydrationState -> Bool
_hydrationState_failed :: !Bool
}
{-# INLINABLE localRunner #-}
localRunner :: (MonadJSM m, Monad m) => HydrationRunnerT t m a -> Maybe Node -> Node -> HydrationRunnerT t m a
localRunner :: HydrationRunnerT t m a
-> Maybe Node -> Node -> HydrationRunnerT t m a
localRunner (HydrationRunnerT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
m) Maybe Node
s Node
parent = do
HydrationState
s0 <- StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) HydrationState
-> HydrationRunnerT t m HydrationState
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) HydrationState
forall s (m :: * -> *). MonadState s m => m s
get
(a
a, HydrationState
s') <- StateT
HydrationState
(ReaderT Node (DomRenderHookT t m))
(a, HydrationState)
-> HydrationRunnerT t m (a, HydrationState)
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT
HydrationState
(ReaderT Node (DomRenderHookT t m))
(a, HydrationState)
-> HydrationRunnerT t m (a, HydrationState))
-> StateT
HydrationState
(ReaderT Node (DomRenderHookT t m))
(a, HydrationState)
-> HydrationRunnerT t m (a, HydrationState)
forall a b. (a -> b) -> a -> b
$ ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> StateT
HydrationState
(ReaderT Node (DomRenderHookT t m))
(a, HydrationState)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> StateT
HydrationState
(ReaderT Node (DomRenderHookT t m))
(a, HydrationState))
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> StateT
HydrationState
(ReaderT Node (DomRenderHookT t m))
(a, HydrationState)
forall a b. (a -> b) -> a -> b
$ (Node -> Node)
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\Node
_ -> Node
parent) (ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState))
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
forall a b. (a -> b) -> a -> b
$ StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationState
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
m (HydrationState
s0 { _hydrationState_previousNode :: Maybe Node
_hydrationState_previousNode = Maybe Node
s })
(Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Node -> HydrationRunnerT t m ()
forall (m :: * -> *) n. (MonadJSM m, IsNode n) => n -> m ()
removeSubsequentNodes (Maybe Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ HydrationState -> Maybe Node
_hydrationState_previousNode HydrationState
s'
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
hs -> HydrationState
hs { _hydrationState_failed :: Bool
_hydrationState_failed = HydrationState -> Bool
_hydrationState_failed HydrationState
s' }
a -> HydrationRunnerT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINABLE runHydrationRunnerT #-}
runHydrationRunnerT
:: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))
=> HydrationRunnerT t m a -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runHydrationRunnerT :: HydrationRunnerT t m a
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationRunnerT HydrationRunnerT t m a
m = HydrationRunnerT t m a
-> IO ()
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
forall (m :: * -> *) t a.
(MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m,
MonadReflexCreateTrigger t m, MonadJSM m,
MonadJSM (Performable m)) =>
HydrationRunnerT t m a
-> IO ()
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationRunnerTWithFailure HydrationRunnerT t m a
m (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# INLINABLE runHydrationRunnerTWithFailure #-}
runHydrationRunnerTWithFailure
:: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))
=> HydrationRunnerT t m a -> IO () -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runHydrationRunnerTWithFailure :: HydrationRunnerT t m a
-> IO ()
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationRunnerTWithFailure (HydrationRunnerT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
m) IO ()
onFailure Maybe Node
s Node
parent Chan [DSum (EventTriggerRef t) TriggerInvocation]
events = (DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DomRenderHookT t m a
-> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
forall (m :: * -> *) t a.
(MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m,
MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef) =>
DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runDomRenderHookT Chan [DSum (EventTriggerRef t) TriggerInvocation]
events (DomRenderHookT t m a -> m a) -> DomRenderHookT t m a -> m a
forall a b. (a -> b) -> a -> b
$ (ReaderT Node (DomRenderHookT t m) a
-> Node -> DomRenderHookT t m a)
-> Node
-> ReaderT Node (DomRenderHookT t m) a
-> DomRenderHookT t m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Node (DomRenderHookT t m) a -> Node -> DomRenderHookT t m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Node
parent (ReaderT Node (DomRenderHookT t m) a -> DomRenderHookT t m a)
-> ReaderT Node (DomRenderHookT t m) a -> DomRenderHookT t m a
forall a b. (a -> b) -> a -> b
$ do
(a
a, HydrationState
s') <- StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationState
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
m (Maybe Node -> Bool -> HydrationState
HydrationState Maybe Node
s Bool
False)
(Node -> ReaderT Node (DomRenderHookT t m) ())
-> Maybe Node -> ReaderT Node (DomRenderHookT t m) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Node -> ReaderT Node (DomRenderHookT t m) ()
forall (m :: * -> *) n. (MonadJSM m, IsNode n) => n -> m ()
removeSubsequentNodes (Maybe Node -> ReaderT Node (DomRenderHookT t m) ())
-> Maybe Node -> ReaderT Node (DomRenderHookT t m) ()
forall a b. (a -> b) -> a -> b
$ HydrationState -> Maybe Node
_hydrationState_previousNode HydrationState
s'
Bool
-> ReaderT Node (DomRenderHookT t m) ()
-> ReaderT Node (DomRenderHookT t m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HydrationState -> Bool
_hydrationState_failed HydrationState
s') (ReaderT Node (DomRenderHookT t m) ()
-> ReaderT Node (DomRenderHookT t m) ())
-> ReaderT Node (DomRenderHookT t m) ()
-> ReaderT Node (DomRenderHookT t m) ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT Node (DomRenderHookT t m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Node (DomRenderHookT t m) ())
-> IO () -> ReaderT Node (DomRenderHookT t m) ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"reflex-dom warning: hydration failed: the DOM was not as expected at switchover time. This may be due to invalid HTML which the browser has altered upon parsing, some external JS altering the DOM, or the page being served from an outdated cache."
Bool
-> ReaderT Node (DomRenderHookT t m) ()
-> ReaderT Node (DomRenderHookT t m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HydrationState -> Bool
_hydrationState_failed HydrationState
s') (ReaderT Node (DomRenderHookT t m) ()
-> ReaderT Node (DomRenderHookT t m) ())
-> ReaderT Node (DomRenderHookT t m) ()
-> ReaderT Node (DomRenderHookT t m) ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT Node (DomRenderHookT t m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
onFailure
a -> ReaderT Node (DomRenderHookT t m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRunnerT t m) where
{-# INLINABLE newEventWithTrigger #-}
newEventWithTrigger :: (EventTrigger t a -> IO (IO ()))
-> HydrationRunnerT t m (Event t a)
newEventWithTrigger = m (Event t a) -> HydrationRunnerT t m (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> HydrationRunnerT t m (Event t a))
-> ((EventTrigger t a -> IO (IO ())) -> m (Event t a))
-> (EventTrigger t a -> IO (IO ()))
-> HydrationRunnerT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventTrigger t a -> IO (IO ())) -> m (Event t a)
forall t (m :: * -> *) a.
MonadReflexCreateTrigger t m =>
(EventTrigger t a -> IO (IO ())) -> m (Event t a)
newEventWithTrigger
{-# INLINABLE newFanEventWithTrigger #-}
newFanEventWithTrigger :: (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> HydrationRunnerT t m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f = m (EventSelector t k) -> HydrationRunnerT t m (EventSelector t k)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (EventSelector t k) -> HydrationRunnerT t m (EventSelector t k))
-> m (EventSelector t k)
-> HydrationRunnerT t m (EventSelector t k)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f
instance MonadTrans (HydrationRunnerT t) where
{-# INLINABLE lift #-}
lift :: m a -> HydrationRunnerT t m a
lift = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a)
-> (m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> m a
-> HydrationRunnerT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Node (DomRenderHookT t m) a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Node (DomRenderHookT t m) a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> (m a -> ReaderT Node (DomRenderHookT t m) a)
-> m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m a -> ReaderT Node (DomRenderHookT t m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m a -> ReaderT Node (DomRenderHookT t m) a)
-> (m a -> DomRenderHookT t m a)
-> m a
-> ReaderT Node (DomRenderHookT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> DomRenderHookT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MonadSample t m => MonadSample t (HydrationRunnerT t m) where
{-# INLINABLE sample #-}
sample :: Behavior t a -> HydrationRunnerT t m a
sample = m a -> HydrationRunnerT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationRunnerT t m a)
-> (Behavior t a -> m a) -> Behavior t a -> HydrationRunnerT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior t a -> m a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample
instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationRunnerT t m) where
withRenderHook :: (forall x. JSM x -> JSM x)
-> HydrationRunnerT t m a -> HydrationRunnerT t m a
withRenderHook forall x. JSM x -> JSM x
hook = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a)
-> (HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState))
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((DomRenderHookT t m (a, HydrationState)
-> DomRenderHookT t m (a, HydrationState))
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((forall x. JSM x -> JSM x)
-> DomRenderHookT t m (a, HydrationState)
-> DomRenderHookT t m (a, HydrationState)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
(forall x. JSM x -> JSM x) -> m a -> m a
withRenderHook forall x. JSM x -> JSM x
hook)) (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> (HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall t (m :: * -> *) a.
HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
unHydrationRunnerT
requestDomAction :: Event t (JSM a) -> HydrationRunnerT t m (Event t a)
requestDomAction = StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a)
-> HydrationRunnerT t m (Event t a)
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a)
-> HydrationRunnerT t m (Event t a))
-> (Event t (JSM a)
-> StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a))
-> Event t (JSM a)
-> HydrationRunnerT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Node (DomRenderHookT t m) (Event t a)
-> StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Node (DomRenderHookT t m) (Event t a)
-> StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a))
-> (Event t (JSM a)
-> ReaderT Node (DomRenderHookT t m) (Event t a))
-> Event t (JSM a)
-> StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a)
-> ReaderT Node (DomRenderHookT t m) (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a)
-> ReaderT Node (DomRenderHookT t m) (Event t a))
-> (Event t (JSM a) -> DomRenderHookT t m (Event t a))
-> Event t (JSM a)
-> ReaderT Node (DomRenderHookT t m) (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> DomRenderHookT t m (Event t a)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction
requestDomAction_ :: Event t (JSM a) -> HydrationRunnerT t m ()
requestDomAction_ = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ())
-> (Event t (JSM a)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> Event t (JSM a)
-> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Node (DomRenderHookT t m) ()
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Node (DomRenderHookT t m) ()
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (Event t (JSM a) -> ReaderT Node (DomRenderHookT t m) ())
-> Event t (JSM a)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m () -> ReaderT Node (DomRenderHookT t m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m () -> ReaderT Node (DomRenderHookT t m) ())
-> (Event t (JSM a) -> DomRenderHookT t m ())
-> Event t (JSM a)
-> ReaderT Node (DomRenderHookT t m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> DomRenderHookT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_
{-# INLINABLE addHydrationStepWithSetup #-}
addHydrationStepWithSetup :: MonadIO m => m a -> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup :: m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup m a
setup a -> HydrationRunnerT t m ()
f = HydrationDomBuilderT s t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT s t m HydrationMode
-> (HydrationMode -> HydrationDomBuilderT s t m ())
-> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> () -> HydrationDomBuilderT s t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
HydrationMode
HydrationMode_Hydrating -> do
a
s <- m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
setup
HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) t (s :: k).
MonadIO m =>
HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
addHydrationStep (a -> HydrationRunnerT t m ()
f a
s)
{-# INLINABLE addHydrationStep #-}
addHydrationStep :: MonadIO m => HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
addHydrationStep :: HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
addHydrationStep HydrationRunnerT t m ()
m = do
IORef (HydrationRunnerT t m ())
delayedRef <- ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IORef (HydrationRunnerT t m ()))
-> HydrationDomBuilderT s t m (IORef (HydrationRunnerT t m ()))
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IORef (HydrationRunnerT t m ()))
-> HydrationDomBuilderT s t m (IORef (HydrationRunnerT t m ())))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IORef (HydrationRunnerT t m ()))
-> HydrationDomBuilderT s t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ (HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ()))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IORef (HydrationRunnerT t m ()))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed
IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ IORef (HydrationRunnerT t m ())
-> (HydrationRunnerT t m () -> HydrationRunnerT t m ()) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (HydrationRunnerT t m ())
delayedRef (HydrationRunnerT t m ()
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HydrationRunnerT t m ()
m)
newtype DomRenderHookT t m a = DomRenderHookT { DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT :: RequesterT t JSM Identity (TriggerEventT t m) a }
deriving (a -> DomRenderHookT t m b -> DomRenderHookT t m a
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
(forall a b.
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b)
-> (forall a b. a -> DomRenderHookT t m b -> DomRenderHookT t m a)
-> Functor (DomRenderHookT t m)
forall a b. a -> DomRenderHookT t m b -> DomRenderHookT t m a
forall a b.
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
forall t (m :: * -> *) a b.
Functor m =>
a -> DomRenderHookT t m b -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DomRenderHookT t m b -> DomRenderHookT t m a
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> DomRenderHookT t m b -> DomRenderHookT t m a
fmap :: (a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
Functor, Functor (DomRenderHookT t m)
a -> DomRenderHookT t m a
Functor (DomRenderHookT t m)
-> (forall a. a -> DomRenderHookT t m a)
-> (forall a b.
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b)
-> (forall a b c.
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c)
-> (forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b)
-> (forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a)
-> Applicative (DomRenderHookT t m)
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
forall a. a -> DomRenderHookT t m a
forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall a b.
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
forall a b c.
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
forall t (m :: * -> *). Monad m => Functor (DomRenderHookT t m)
forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
*> :: DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
liftA2 :: (a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
<*> :: DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
pure :: a -> DomRenderHookT t m a
$cpure :: forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
$cp1Applicative :: forall t (m :: * -> *). Monad m => Functor (DomRenderHookT t m)
Applicative, Applicative (DomRenderHookT t m)
a -> DomRenderHookT t m a
Applicative (DomRenderHookT t m)
-> (forall a b.
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b)
-> (forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b)
-> (forall a. a -> DomRenderHookT t m a)
-> Monad (DomRenderHookT t m)
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall a. a -> DomRenderHookT t m a
forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall a b.
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b
forall t (m :: * -> *). Monad m => Applicative (DomRenderHookT t m)
forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> DomRenderHookT t m a
$creturn :: forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
>> :: DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
>>= :: DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b
$cp1Monad :: forall t (m :: * -> *). Monad m => Applicative (DomRenderHookT t m)
Monad, Monad (DomRenderHookT t m)
Monad (DomRenderHookT t m)
-> (forall a. (a -> DomRenderHookT t m a) -> DomRenderHookT t m a)
-> MonadFix (DomRenderHookT t m)
(a -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall a. (a -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall t (m :: * -> *). MonadFix m => Monad (DomRenderHookT t m)
forall t (m :: * -> *) a.
MonadFix m =>
(a -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> DomRenderHookT t m a) -> DomRenderHookT t m a
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> DomRenderHookT t m a) -> DomRenderHookT t m a
$cp1MonadFix :: forall t (m :: * -> *). MonadFix m => Monad (DomRenderHookT t m)
MonadFix, Monad (DomRenderHookT t m)
Monad (DomRenderHookT t m)
-> (forall a. IO a -> DomRenderHookT t m a)
-> MonadIO (DomRenderHookT t m)
IO a -> DomRenderHookT t m a
forall a. IO a -> DomRenderHookT t m a
forall t (m :: * -> *). MonadIO m => Monad (DomRenderHookT t m)
forall t (m :: * -> *) a. MonadIO m => IO a -> DomRenderHookT t m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> DomRenderHookT t m a
$cliftIO :: forall t (m :: * -> *) a. MonadIO m => IO a -> DomRenderHookT t m a
$cp1MonadIO :: forall t (m :: * -> *). MonadIO m => Monad (DomRenderHookT t m)
MonadIO, Monad (DomRenderHookT t m)
e -> DomRenderHookT t m a
Monad (DomRenderHookT t m)
-> (forall e a. Exception e => e -> DomRenderHookT t m a)
-> (forall e a.
Exception e =>
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a)
-> (forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a)
-> MonadException (DomRenderHookT t m)
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall e a. Exception e => e -> DomRenderHookT t m a
forall e a.
Exception e =>
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall t (m :: * -> *).
MonadException m =>
Monad (DomRenderHookT t m)
forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> DomRenderHookT t m a
forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
MonadException m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall (m :: * -> *).
Monad m
-> (forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
finally :: DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
$cfinally :: forall t (m :: * -> *) a b.
MonadException m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
catch :: DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
$ccatch :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
throw :: e -> DomRenderHookT t m a
$cthrow :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> DomRenderHookT t m a
$cp1MonadException :: forall t (m :: * -> *).
MonadException m =>
Monad (DomRenderHookT t m)
MonadException
#if MIN_VERSION_base(4,9,1)
, MonadIO (DomRenderHookT t m)
MonadException (DomRenderHookT t m)
MonadIO (DomRenderHookT t m)
-> MonadException (DomRenderHookT t m)
-> (forall b.
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
-> DomRenderHookT t m b)
-> DomRenderHookT t m b)
-> MonadAsyncException (DomRenderHookT t m)
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
-> DomRenderHookT t m b)
-> DomRenderHookT t m b
forall b.
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
-> DomRenderHookT t m b)
-> DomRenderHookT t m b
forall t (m :: * -> *).
MonadAsyncException m =>
MonadIO (DomRenderHookT t m)
forall t (m :: * -> *).
MonadAsyncException m =>
MonadException (DomRenderHookT t m)
forall t (m :: * -> *) b.
MonadAsyncException m =>
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
-> DomRenderHookT t m b)
-> DomRenderHookT t m b
forall (m :: * -> *).
MonadIO m
-> MonadException m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
mask :: ((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
-> DomRenderHookT t m b)
-> DomRenderHookT t m b
$cmask :: forall t (m :: * -> *) b.
MonadAsyncException m =>
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
-> DomRenderHookT t m b)
-> DomRenderHookT t m b
$cp2MonadAsyncException :: forall t (m :: * -> *).
MonadAsyncException m =>
MonadException (DomRenderHookT t m)
$cp1MonadAsyncException :: forall t (m :: * -> *).
MonadAsyncException m =>
MonadIO (DomRenderHookT t m)
MonadAsyncException
#endif
)
{-# INLINABLE runDomRenderHookT #-}
runDomRenderHookT
:: (MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef)
=> DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runDomRenderHookT :: DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runDomRenderHookT (DomRenderHookT RequesterT t JSM Identity (TriggerEventT t m) a
a) Chan [DSum (EventTriggerRef t) TriggerInvocation]
events = do
(TriggerEventT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> TriggerEventT t m a
-> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip TriggerEventT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
forall t (m :: * -> *) a.
TriggerEventT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runTriggerEventT Chan [DSum (EventTriggerRef t) TriggerInvocation]
events (TriggerEventT t m a -> m a) -> TriggerEventT t m a -> m a
forall a b. (a -> b) -> a -> b
$ do
rec (a
result, Event t (RequesterData JSM)
req) <- RequesterT t JSM Identity (TriggerEventT t m) a
-> Event t (RequesterData Identity)
-> TriggerEventT t m (a, Event t (RequesterData JSM))
forall t (m :: * -> *) (request :: * -> *) (response :: * -> *) a.
(Reflex t, Monad m) =>
RequesterT t request response m a
-> Event t (RequesterData response)
-> m (a, Event t (RequesterData request))
runRequesterT RequesterT t JSM Identity (TriggerEventT t m) a
a Event t (RequesterData Identity)
rsp
Event t (RequesterData Identity)
rsp <- Event
t
((RequesterData Identity -> IO ())
-> Performable (TriggerEventT t m) ())
-> TriggerEventT t m (Event t (RequesterData Identity))
forall t (m :: * -> *) a.
(TriggerEvent t m, PerformEvent t m) =>
Event t ((a -> IO ()) -> Performable m ()) -> m (Event t a)
performEventAsync (Event
t
((RequesterData Identity -> IO ())
-> Performable (TriggerEventT t m) ())
-> TriggerEventT t m (Event t (RequesterData Identity)))
-> Event
t
((RequesterData Identity -> IO ())
-> Performable (TriggerEventT t m) ())
-> TriggerEventT t m (Event t (RequesterData Identity))
forall a b. (a -> b) -> a -> b
$ Event t (RequesterData JSM)
-> (RequesterData JSM
-> (RequesterData Identity -> IO ()) -> Performable m ())
-> Event t ((RequesterData Identity -> IO ()) -> Performable m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (RequesterData JSM)
req ((RequesterData JSM
-> (RequesterData Identity -> IO ()) -> Performable m ())
-> Event t ((RequesterData Identity -> IO ()) -> Performable m ()))
-> (RequesterData JSM
-> (RequesterData Identity -> IO ()) -> Performable m ())
-> Event t ((RequesterData Identity -> IO ()) -> Performable m ())
forall a b. (a -> b) -> a -> b
$ \RequesterData JSM
rm RequesterData Identity -> IO ()
f -> JSM () -> Performable m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> Performable m ()) -> JSM () -> Performable m ()
forall a b. (a -> b) -> a -> b
$ (RequesterData Identity -> IO ())
-> JSM (RequesterData Identity) -> JSM ()
forall t a. (t -> IO a) -> JSM t -> JSM ()
runInAnimationFrame RequesterData Identity -> IO ()
f (JSM (RequesterData Identity) -> JSM ())
-> JSM (RequesterData Identity) -> JSM ()
forall a b. (a -> b) -> a -> b
$
(forall a. JSM a -> JSM (Identity a))
-> RequesterData JSM -> JSM (RequesterData Identity)
forall (m :: * -> *) (request :: * -> *) (response :: * -> *).
Applicative m =>
(forall a. request a -> m (response a))
-> RequesterData request -> m (RequesterData response)
traverseRequesterData ((a -> Identity a) -> JSM a -> JSM (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity) RequesterData JSM
rm
a -> TriggerEventT t m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
where
runInAnimationFrame :: (t -> IO a) -> JSM t -> JSM ()
runInAnimationFrame t -> IO a
f JSM t
x = JSM AnimationFrameHandle -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM AnimationFrameHandle -> JSM ())
-> ((Double -> JSM ()) -> JSM AnimationFrameHandle)
-> (Double -> JSM ())
-> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> JSM ()) -> JSM AnimationFrameHandle
DOM.inAnimationFrame' ((Double -> JSM ()) -> JSM ()) -> (Double -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \Double
_ -> do
t
v <- JSM t -> JSM t
forall x. JSM x -> JSM x
synchronously JSM t
x
JSM a -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM a -> JSM ()) -> (IO a -> JSM a) -> IO a -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> JSM ()) -> IO a -> JSM ()
forall a b. (a -> b) -> a -> b
$ t -> IO a
f t
v
instance MonadTrans (DomRenderHookT t) where
{-# INLINABLE lift #-}
lift :: m a -> DomRenderHookT t m a
lift = RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a)
-> (m a -> RequesterT t JSM Identity (TriggerEventT t m) a)
-> m a
-> DomRenderHookT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a)
-> (m a -> TriggerEventT t m a)
-> m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> TriggerEventT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance (Reflex t, MonadFix m) => DomRenderHook t (DomRenderHookT t m) where
withRenderHook :: (forall x. JSM x -> JSM x)
-> DomRenderHookT t m a -> DomRenderHookT t m a
withRenderHook forall x. JSM x -> JSM x
hook (DomRenderHookT RequesterT t JSM Identity (TriggerEventT t m) a
a) = do
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a)
-> RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
forall a b. (a -> b) -> a -> b
$ (Event
t
(Response
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity))
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Event
t
(Request
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity)),
a))
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall t (m :: * -> *) a r.
(Requester t m, MonadFix m) =>
(Event t (Response m a) -> m (Event t (Request m a), r)) -> m r
withRequesting ((Event
t
(Response
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity))
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Event
t
(Request
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity)),
a))
-> RequesterT t JSM Identity (TriggerEventT t m) a)
-> (Event
t
(Response
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity))
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Event
t
(Request
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity)),
a))
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall a b. (a -> b) -> a -> b
$ \Event
t
(Response
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity))
rsp -> do
(a
x, Event t (RequesterData JSM)
req) <- TriggerEventT t m (a, Event t (RequesterData JSM))
-> RequesterT
t JSM Identity (TriggerEventT t m) (a, Event t (RequesterData JSM))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m (a, Event t (RequesterData JSM))
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(a, Event t (RequesterData JSM)))
-> TriggerEventT t m (a, Event t (RequesterData JSM))
-> RequesterT
t JSM Identity (TriggerEventT t m) (a, Event t (RequesterData JSM))
forall a b. (a -> b) -> a -> b
$ RequesterT t JSM Identity (TriggerEventT t m) a
-> Event t (RequesterData Identity)
-> TriggerEventT t m (a, Event t (RequesterData JSM))
forall t (m :: * -> *) (request :: * -> *) (response :: * -> *) a.
(Reflex t, Monad m) =>
RequesterT t request response m a
-> Event t (RequesterData response)
-> m (a, Event t (RequesterData request))
runRequesterT RequesterT t JSM Identity (TriggerEventT t m) a
a (Event t (RequesterData Identity)
-> TriggerEventT t m (a, Event t (RequesterData JSM)))
-> Event t (RequesterData Identity)
-> TriggerEventT t m (a, Event t (RequesterData JSM))
forall a b. (a -> b) -> a -> b
$ Identity (RequesterData Identity) -> RequesterData Identity
forall a. Identity a -> a
runIdentity (Identity (RequesterData Identity) -> RequesterData Identity)
-> Event t (Identity (RequesterData Identity))
-> Event t (RequesterData Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (Identity (RequesterData Identity))
Event
t
(Response
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity))
rsp
(Event t (JSM (RequesterData Identity)), a)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Event t (JSM (RequesterData Identity)), a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t (RequesterData JSM)
-> (RequesterData JSM -> JSM (RequesterData Identity))
-> Event t (JSM (RequesterData Identity))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (RequesterData JSM)
req ((RequesterData JSM -> JSM (RequesterData Identity))
-> Event t (JSM (RequesterData Identity)))
-> (RequesterData JSM -> JSM (RequesterData Identity))
-> Event t (JSM (RequesterData Identity))
forall a b. (a -> b) -> a -> b
$ \RequesterData JSM
rm -> JSM (RequesterData Identity) -> JSM (RequesterData Identity)
forall x. JSM x -> JSM x
hook (JSM (RequesterData Identity) -> JSM (RequesterData Identity))
-> JSM (RequesterData Identity) -> JSM (RequesterData Identity)
forall a b. (a -> b) -> a -> b
$ (forall a. JSM a -> JSM (Identity a))
-> RequesterData JSM -> JSM (RequesterData Identity)
forall (m :: * -> *) (request :: * -> *) (response :: * -> *).
Applicative m =>
(forall a. request a -> m (response a))
-> RequesterData request -> m (RequesterData response)
traverseRequesterData ((a -> Identity a) -> JSM a -> JSM (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity) RequesterData JSM
rm, a
x)
requestDomAction :: Event t (JSM a) -> DomRenderHookT t m (Event t a)
requestDomAction = RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
-> DomRenderHookT t m (Event t a)
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
-> DomRenderHookT t m (Event t a))
-> (Event t (JSM a)
-> RequesterT t JSM Identity (TriggerEventT t m) (Event t a))
-> Event t (JSM a)
-> DomRenderHookT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a)
-> RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
forall t (m :: * -> *) a.
(Requester t m, Response m ~ Identity) =>
Event t (Request m a) -> m (Event t a)
requestingIdentity
requestDomAction_ :: Event t (JSM a) -> DomRenderHookT t m ()
requestDomAction_ = RequesterT t JSM Identity (TriggerEventT t m) ()
-> DomRenderHookT t m ()
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) ()
-> DomRenderHookT t m ())
-> (Event t (JSM a)
-> RequesterT t JSM Identity (TriggerEventT t m) ())
-> Event t (JSM a)
-> DomRenderHookT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> RequesterT t JSM Identity (TriggerEventT t m) ()
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m ()
requesting_
{-# INLINABLE runHydrationDomBuilderT #-}
runHydrationDomBuilderT
:: ( MonadFix m
, PerformEvent t m
, MonadReflexCreateTrigger t m
, MonadJSM m
, MonadJSM (Performable m)
, MonadRef m
, Ref m ~ IORef
)
=> HydrationDomBuilderT s t m a
-> HydrationDomBuilderEnv t m
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationDomBuilderT :: HydrationDomBuilderT s t m a
-> HydrationDomBuilderEnv t m
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationDomBuilderT (HydrationDomBuilderT ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
a) HydrationDomBuilderEnv t m
env = DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
forall (m :: * -> *) t a.
(MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m,
MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef) =>
DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runDomRenderHookT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
a HydrationDomBuilderEnv t m
env)
instance (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, Monad m) => HasDocument (HydrationDomBuilderT s t m) where
{-# INLINABLE askDocument #-}
askDocument :: HydrationDomBuilderT
s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
askDocument = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) Document
-> HydrationDomBuilderT s t m Document
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) Document
-> HydrationDomBuilderT s t m Document)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) Document
-> HydrationDomBuilderT s t m Document
forall a b. (a -> b) -> a -> b
$ (HydrationDomBuilderEnv t m -> Document)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) Document
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> Document
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> Document
_hydrationDomBuilderEnv_document
{-# INLINABLE askParent #-}
askParent :: Monad m => HydrationRunnerT t m DOM.Node
askParent :: HydrationRunnerT t m Node
askParent = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) Node
-> HydrationRunnerT t m Node
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) Node
forall r (m :: * -> *). MonadReader r m => m r
ask
{-# INLINABLE getParent #-}
getParent :: MonadIO m => HydrationDomBuilderT s t m DOM.Node
getParent :: HydrationDomBuilderT s t m Node
getParent = (Node -> HydrationDomBuilderT s t m Node)
-> (IORef Node -> HydrationDomBuilderT s t m Node)
-> Either Node (IORef Node)
-> HydrationDomBuilderT s t m Node
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Node -> HydrationDomBuilderT s t m Node
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO Node -> HydrationDomBuilderT s t m Node
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Node -> HydrationDomBuilderT s t m Node)
-> (IORef Node -> IO Node)
-> IORef Node
-> HydrationDomBuilderT s t m Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Node -> IO Node
forall a. IORef a -> IO a
readIORef) (Either Node (IORef Node) -> HydrationDomBuilderT s t m Node)
-> HydrationDomBuilderT s t m (Either Node (IORef Node))
-> HydrationDomBuilderT s t m Node
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Either Node (IORef Node))
-> HydrationDomBuilderT s t m (Either Node (IORef Node))
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT ((HydrationDomBuilderEnv t m -> Either Node (IORef Node))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Either Node (IORef Node))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> Either Node (IORef Node)
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> Either Node (IORef Node)
_hydrationDomBuilderEnv_parent)
{-# INLINABLE askEvents #-}
askEvents :: Monad m => HydrationDomBuilderT s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents :: HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents = ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> (TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> (TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> DomRenderHookT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> DomRenderHookT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> DomRenderHookT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> (TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> DomRenderHookT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall a b. (a -> b) -> a -> b
$ TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall (m :: * -> *) t.
Monad m =>
TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
TriggerEventT.askEvents
{-# INLINABLE localEnv #-}
localEnv :: Monad m => (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m) -> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
localEnv :: (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
localEnv HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m
f = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a)
-> (HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m
f (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m
forall a b. (a -> b) -> a -> b
$!) (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> (HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT
{-# INLINABLE append #-}
append :: MonadJSM m => DOM.Node -> HydrationDomBuilderT s t m ()
append :: Node -> HydrationDomBuilderT s t m ()
append Node
n = do
Node
p <- HydrationDomBuilderT s t m Node
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
JSM () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> HydrationDomBuilderT s t m ())
-> JSM () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Node -> Node -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
appendChild_ Node
p Node
n
() -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# SPECIALIZE append
:: DOM.Node
-> HydrationDomBuilderT s Spider HydrationM ()
#-}
data HydrationMode
= HydrationMode_Hydrating
| HydrationMode_Immediate
deriving (HydrationMode -> HydrationMode -> Bool
(HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> Bool) -> Eq HydrationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HydrationMode -> HydrationMode -> Bool
$c/= :: HydrationMode -> HydrationMode -> Bool
== :: HydrationMode -> HydrationMode -> Bool
$c== :: HydrationMode -> HydrationMode -> Bool
Eq, Eq HydrationMode
Eq HydrationMode
-> (HydrationMode -> HydrationMode -> Ordering)
-> (HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> HydrationMode)
-> (HydrationMode -> HydrationMode -> HydrationMode)
-> Ord HydrationMode
HydrationMode -> HydrationMode -> Bool
HydrationMode -> HydrationMode -> Ordering
HydrationMode -> HydrationMode -> HydrationMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HydrationMode -> HydrationMode -> HydrationMode
$cmin :: HydrationMode -> HydrationMode -> HydrationMode
max :: HydrationMode -> HydrationMode -> HydrationMode
$cmax :: HydrationMode -> HydrationMode -> HydrationMode
>= :: HydrationMode -> HydrationMode -> Bool
$c>= :: HydrationMode -> HydrationMode -> Bool
> :: HydrationMode -> HydrationMode -> Bool
$c> :: HydrationMode -> HydrationMode -> Bool
<= :: HydrationMode -> HydrationMode -> Bool
$c<= :: HydrationMode -> HydrationMode -> Bool
< :: HydrationMode -> HydrationMode -> Bool
$c< :: HydrationMode -> HydrationMode -> Bool
compare :: HydrationMode -> HydrationMode -> Ordering
$ccompare :: HydrationMode -> HydrationMode -> Ordering
$cp1Ord :: Eq HydrationMode
Ord, Int -> HydrationMode -> ShowS
[HydrationMode] -> ShowS
HydrationMode -> String
(Int -> HydrationMode -> ShowS)
-> (HydrationMode -> String)
-> ([HydrationMode] -> ShowS)
-> Show HydrationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HydrationMode] -> ShowS
$cshowList :: [HydrationMode] -> ShowS
show :: HydrationMode -> String
$cshow :: HydrationMode -> String
showsPrec :: Int -> HydrationMode -> ShowS
$cshowsPrec :: Int -> HydrationMode -> ShowS
Show)
{-# INLINABLE getPreviousNode #-}
getPreviousNode :: Monad m => HydrationRunnerT t m (Maybe DOM.Node)
getPreviousNode :: HydrationRunnerT t m (Maybe Node)
getPreviousNode = StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Maybe Node)
-> HydrationRunnerT t m (Maybe Node)
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Maybe Node)
-> HydrationRunnerT t m (Maybe Node))
-> StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Maybe Node)
-> HydrationRunnerT t m (Maybe Node)
forall a b. (a -> b) -> a -> b
$ (HydrationState -> Maybe Node)
-> StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Maybe Node)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HydrationState -> Maybe Node
_hydrationState_previousNode
{-# INLINABLE setPreviousNode #-}
setPreviousNode :: Monad m => Maybe DOM.Node -> HydrationRunnerT t m ()
setPreviousNode :: Maybe Node -> HydrationRunnerT t m ()
setPreviousNode Maybe Node
n = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\HydrationState
hs -> HydrationState
hs { _hydrationState_previousNode :: Maybe Node
_hydrationState_previousNode = Maybe Node
n })
{-# INLINABLE askUnreadyChildren #-}
askUnreadyChildren :: Monad m => HydrationDomBuilderT s t m (IORef Word)
askUnreadyChildren :: HydrationDomBuilderT s t m (IORef Word)
askUnreadyChildren = ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (IORef Word)
-> HydrationDomBuilderT s t m (IORef Word)
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (IORef Word)
-> HydrationDomBuilderT s t m (IORef Word))
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (IORef Word)
-> HydrationDomBuilderT s t m (IORef Word)
forall a b. (a -> b) -> a -> b
$ (HydrationDomBuilderEnv t m -> IORef Word)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (IORef Word)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren
{-# INLINABLE askCommitAction #-}
askCommitAction :: Monad m => HydrationDomBuilderT s t m (JSM ())
askCommitAction :: HydrationDomBuilderT s t m (JSM ())
askCommitAction = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (JSM ())
-> HydrationDomBuilderT s t m (JSM ())
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (JSM ())
-> HydrationDomBuilderT s t m (JSM ()))
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (JSM ())
-> HydrationDomBuilderT s t m (JSM ())
forall a b. (a -> b) -> a -> b
$ (HydrationDomBuilderEnv t m -> JSM ())
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (JSM ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> JSM ()
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> JSM ()
_hydrationDomBuilderEnv_commitAction
{-# INLINABLE getHydrationMode #-}
getHydrationMode :: MonadIO m => HydrationDomBuilderT s t m HydrationMode
getHydrationMode :: HydrationDomBuilderT s t m HydrationMode
getHydrationMode = IO HydrationMode -> HydrationDomBuilderT s t m HydrationMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HydrationMode -> HydrationDomBuilderT s t m HydrationMode)
-> (IORef HydrationMode -> IO HydrationMode)
-> IORef HydrationMode
-> HydrationDomBuilderT s t m HydrationMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef HydrationMode -> IO HydrationMode
forall a. IORef a -> IO a
readIORef (IORef HydrationMode -> HydrationDomBuilderT s t m HydrationMode)
-> HydrationDomBuilderT s t m (IORef HydrationMode)
-> HydrationDomBuilderT s t m HydrationMode
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IORef HydrationMode)
-> HydrationDomBuilderT s t m (IORef HydrationMode)
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT ((HydrationDomBuilderEnv t m -> IORef HydrationMode)
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IORef HydrationMode)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> IORef HydrationMode
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode)
removeSubsequentNodes :: (MonadJSM m, IsNode n) => n -> m ()
removeSubsequentNodes :: n -> m ()
removeSubsequentNodes n
n = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
JSVal
f <- Text -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval (Text
"(function(n) { while (n.nextSibling) { (n.parentNode).removeChild(n.nextSibling); }; })" :: Text)
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal -> JSVal -> [n] -> JSM JSVal
forall f this args.
(MakeObject f, MakeObject this, MakeArgs args) =>
f -> this -> args -> JSM JSVal
call JSVal
f JSVal
f [n
n]
deleteBetweenExclusive :: (MonadJSM m, IsNode start, IsNode end) => start -> end -> m ()
deleteBetweenExclusive :: start -> end -> m ()
deleteBetweenExclusive start
s end
e = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
DocumentFragment
df <- Document -> JSM DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment (Document -> JSM DocumentFragment)
-> JSM Document -> JSM DocumentFragment
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< start -> JSM Document
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Document
getOwnerDocumentUnchecked start
s
DocumentFragment -> start -> end -> JSM ()
forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
DocumentFragment -> start -> end -> m ()
extractBetweenExclusive DocumentFragment
df start
s end
e
extractBetweenExclusive :: (MonadJSM m, IsNode start, IsNode end) => DOM.DocumentFragment -> start -> end -> m ()
DocumentFragment
df start
s end
e = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
JSVal
f <- Text -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval (Text
"(function(df,s,e) { var x; for(;;) { x = s['nextSibling']; if(e===x) { break; }; df['appendChild'](x); } })" :: Text)
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal -> JSVal -> (DocumentFragment, start, end) -> JSM JSVal
forall f this args.
(MakeObject f, MakeObject this, MakeArgs args) =>
f -> this -> args -> JSM JSVal
call JSVal
f JSVal
f (DocumentFragment
df, start
s, end
e)
{-# INLINABLE deleteUpTo #-}
deleteUpTo :: (MonadJSM m, IsNode start, IsNode end) => start -> end -> m ()
deleteUpTo :: start -> end -> m ()
deleteUpTo start
s end
e = do
DocumentFragment
df <- Document -> m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment (Document -> m DocumentFragment)
-> m Document -> m DocumentFragment
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< start -> m Document
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Document
getOwnerDocumentUnchecked start
s
DocumentFragment -> start -> end -> m ()
forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
DocumentFragment -> start -> end -> m ()
extractUpTo DocumentFragment
df start
s end
e
extractUpTo :: (MonadJSM m, IsNode start, IsNode end) => DOM.DocumentFragment -> start -> end -> m ()
#ifdef ghcjs_HOST_OS
foreign import javascript unsafe
"(function() { var x = $2; while(x !== $3) { var y = x['nextSibling']; $1['appendChild'](x); x = y; } })()"
extractUpTo_ :: DOM.DocumentFragment -> DOM.Node -> DOM.Node -> IO ()
extractUpTo df s e = liftJSM $ extractUpTo_ df (toNode s) (toNode e)
#else
DocumentFragment
df start
s end
e = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
JSVal
f <- Text -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval (Text
"(function(df,s,e){ var x = s; var y; for(;;) { y = x['nextSibling']; df['appendChild'](x); if(e===y) { break; } x = y; } })" :: Text)
JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$ JSVal -> JSVal -> (DocumentFragment, start, end) -> JSM JSVal
forall f this args.
(MakeObject f, MakeObject this, MakeArgs args) =>
f -> this -> args -> JSM JSVal
call JSVal
f JSVal
f (DocumentFragment
df, start
s, end
e)
#endif
type SupportsHydrationDomBuilder t m = (Reflex t, MonadJSM m, MonadHold t m, MonadFix m, MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref JSM, Adjustable t m, PrimMonad m, PerformEvent t m, MonadJSM (Performable m))
{-# INLINABLE collectUpTo #-}
collectUpTo :: (MonadJSM m, IsNode start, IsNode end) => start -> end -> m DOM.DocumentFragment
collectUpTo :: start -> end -> m DocumentFragment
collectUpTo start
s end
e = do
Node
currentParent <- end -> m Node
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Node
getParentNodeUnchecked end
e
Node -> start -> end -> m DocumentFragment
forall (m :: * -> *) parent start end.
(MonadJSM m, IsNode parent, IsNode start, IsNode end) =>
parent -> start -> end -> m DocumentFragment
collectUpToGivenParent Node
currentParent start
s end
e
{-# INLINABLE collectUpToGivenParent #-}
collectUpToGivenParent :: (MonadJSM m, IsNode parent, IsNode start, IsNode end) => parent -> start -> end -> m DOM.DocumentFragment
collectUpToGivenParent :: parent -> start -> end -> m DocumentFragment
collectUpToGivenParent parent
currentParent start
s end
e = do
Document
doc <- parent -> m Document
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Document
getOwnerDocumentUnchecked parent
currentParent
DocumentFragment
df <- Document -> m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment Document
doc
DocumentFragment -> start -> end -> m ()
forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
DocumentFragment -> start -> end -> m ()
extractUpTo DocumentFragment
df start
s end
e
DocumentFragment -> m DocumentFragment
forall (m :: * -> *) a. Monad m => a -> m a
return DocumentFragment
df
newtype EventFilterTriggerRef t er (en :: EventTag) = EventFilterTriggerRef (IORef (Maybe (EventTrigger t (er en))))
{-# INLINE wrap #-}
wrap
:: forall s m er t. (Reflex t, MonadJSM m, MonadReflexCreateTrigger t m, DomRenderHook t m, EventSpec s ~ GhcjsEventSpec)
=> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DOM.Element
-> RawElementConfig er t s
-> m (DMap EventName (EventFilterTriggerRef t er))
wrap :: Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t s
-> m (DMap EventName (EventFilterTriggerRef t er))
wrap Chan [DSum (EventTriggerRef t) TriggerInvocation]
events Element
e RawElementConfig er t s
cfg = do
Maybe (Event t (Map AttributeName (Maybe Text)))
-> (Event t (Map AttributeName (Maybe Text)) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (RawElementConfig er t s
-> Maybe (Event t (Map AttributeName (Maybe Text)))
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
RawElementConfig er t s
-> Maybe (Event t (Map AttributeName (Maybe Text)))
_rawElementConfig_modifyAttributes RawElementConfig er t s
cfg) ((Event t (Map AttributeName (Maybe Text)) -> m ()) -> m ())
-> (Event t (Map AttributeName (Maybe Text)) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Event t (Map AttributeName (Maybe Text))
modifyAttrs -> Event t (JSM ()) -> m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> m ()) -> Event t (JSM ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Event t (Map AttributeName (Maybe Text))
-> (Map AttributeName (Maybe Text) -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (Map AttributeName (Maybe Text))
modifyAttrs ((Map AttributeName (Maybe Text) -> JSM ()) -> Event t (JSM ()))
-> (Map AttributeName (Maybe Text) -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ (AttributeName -> Maybe Text -> JSM ())
-> Map AttributeName (Maybe Text) -> JSM ()
forall i (t :: * -> *) (m :: * -> *) a b.
(FoldableWithIndex i t, Monad m) =>
(i -> a -> m b) -> t a -> m ()
imapM_ ((AttributeName -> Maybe Text -> JSM ())
-> Map AttributeName (Maybe Text) -> JSM ())
-> (AttributeName -> Maybe Text -> JSM ())
-> Map AttributeName (Maybe Text)
-> JSM ()
forall a b. (a -> b) -> a -> b
$ \(AttributeName Maybe Text
mAttrNamespace Text
n) Maybe Text
mv -> case Maybe Text
mAttrNamespace of
Maybe Text
Nothing -> JSM () -> (Text -> JSM ()) -> Maybe Text -> JSM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Element -> Text -> JSM ()
forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsElement self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
removeAttribute Element
e Text
n) (Element -> Text -> Text -> JSM ()
forall (m :: * -> *) self qualifiedName value.
(MonadDOM m, IsElement self, ToJSString qualifiedName,
ToJSString value) =>
self -> qualifiedName -> value -> m ()
setAttribute Element
e Text
n) Maybe Text
mv
Just Text
ns -> JSM () -> (Text -> JSM ()) -> Maybe Text -> JSM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Element -> Maybe Text -> Text -> JSM ()
forall (m :: * -> *) self namespaceURI localName.
(MonadDOM m, IsElement self, ToJSString namespaceURI,
ToJSString localName) =>
self -> Maybe namespaceURI -> localName -> m ()
removeAttributeNS Element
e (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ns) Text
n) (Element -> Maybe Text -> Text -> Text -> JSM ()
forall (m :: * -> *) self namespaceURI qualifiedName value.
(MonadDOM m, IsElement self, ToJSString namespaceURI,
ToJSString qualifiedName, ToJSString value) =>
self -> Maybe namespaceURI -> qualifiedName -> value -> m ()
setAttributeNS Element
e (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ns) Text
n) Maybe Text
mv
DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs :: DMap EventName (EventFilterTriggerRef t er) <- JSM (DMap EventName (EventFilterTriggerRef t er))
-> m (DMap EventName (EventFilterTriggerRef t er))
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM (DMap EventName (EventFilterTriggerRef t er))
-> m (DMap EventName (EventFilterTriggerRef t er)))
-> JSM (DMap EventName (EventFilterTriggerRef t er))
-> m (DMap EventName (EventFilterTriggerRef t er))
forall a b. (a -> b) -> a -> b
$ ([DSum EventName (EventFilterTriggerRef t er)]
-> DMap EventName (EventFilterTriggerRef t er))
-> JSM [DSum EventName (EventFilterTriggerRef t er)]
-> JSM (DMap EventName (EventFilterTriggerRef t er))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [DSum EventName (EventFilterTriggerRef t er)]
-> DMap EventName (EventFilterTriggerRef t er)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
[DSum k2 f] -> DMap k2 f
DMap.fromList (JSM [DSum EventName (EventFilterTriggerRef t er)]
-> JSM (DMap EventName (EventFilterTriggerRef t er)))
-> JSM [DSum EventName (EventFilterTriggerRef t er)]
-> JSM (DMap EventName (EventFilterTriggerRef t er))
forall a b. (a -> b) -> a -> b
$ [DSum EventName (GhcjsEventFilter er)]
-> (DSum EventName (GhcjsEventFilter er)
-> JSM (DSum EventName (EventFilterTriggerRef t er)))
-> JSM [DSum EventName (EventFilterTriggerRef t er)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (DMap EventName (GhcjsEventFilter er)
-> [DSum EventName (GhcjsEventFilter er)]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList (DMap EventName (GhcjsEventFilter er)
-> [DSum EventName (GhcjsEventFilter er)])
-> DMap EventName (GhcjsEventFilter er)
-> [DSum EventName (GhcjsEventFilter er)]
forall a b. (a -> b) -> a -> b
$ GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
forall (er :: EventTag -> *).
GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters (GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er))
-> GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
forall a b. (a -> b) -> a -> b
$ RawElementConfig er t s -> EventSpec s er
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
RawElementConfig er t s -> EventSpec s er
_rawElementConfig_eventSpec RawElementConfig er t s
cfg) ((DSum EventName (GhcjsEventFilter er)
-> JSM (DSum EventName (EventFilterTriggerRef t er)))
-> JSM [DSum EventName (EventFilterTriggerRef t er)])
-> (DSum EventName (GhcjsEventFilter er)
-> JSM (DSum EventName (EventFilterTriggerRef t er)))
-> JSM [DSum EventName (EventFilterTriggerRef t er)]
forall a b. (a -> b) -> a -> b
$ \(EventName a
en :=> GhcjsEventFilter GhcjsDomEvent a -> JSM (EventFlags, JSM (Maybe (er a)))
f) -> do
IORef (Maybe (EventTrigger t (er a)))
triggerRef <- IO (IORef (Maybe (EventTrigger t (er a))))
-> JSM (IORef (Maybe (EventTrigger t (er a))))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe (EventTrigger t (er a))))
-> JSM (IORef (Maybe (EventTrigger t (er a)))))
-> IO (IORef (Maybe (EventTrigger t (er a))))
-> JSM (IORef (Maybe (EventTrigger t (er a))))
forall a b. (a -> b) -> a -> b
$ Maybe (EventTrigger t (er a))
-> IO (IORef (Maybe (EventTrigger t (er a))))
forall a. a -> IO (IORef a)
newIORef Maybe (EventTrigger t (er a))
forall a. Maybe a
Nothing
JSM ()
_ <- EventName a
-> Element -> EventM Element (EventType a) () -> JSM (JSM ())
forall e (en :: EventTag).
IsElement e =>
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
elementOnEventName EventName a
en Element
e (EventM Element (EventType a) () -> JSM (JSM ()))
-> EventM Element (EventType a) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
EventType a
evt <- EventM Any (EventType a) (EventType a)
forall t e. EventM t e e
DOM.event
(EventFlags
flags, JSM (Maybe (er a))
k) <- JSM (EventFlags, JSM (Maybe (er a)))
-> ReaderT (EventType a) JSM (EventFlags, JSM (Maybe (er a)))
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM (EventFlags, JSM (Maybe (er a)))
-> ReaderT (EventType a) JSM (EventFlags, JSM (Maybe (er a))))
-> JSM (EventFlags, JSM (Maybe (er a)))
-> ReaderT (EventType a) JSM (EventFlags, JSM (Maybe (er a)))
forall a b. (a -> b) -> a -> b
$ GhcjsDomEvent a -> JSM (EventFlags, JSM (Maybe (er a)))
f (GhcjsDomEvent a -> JSM (EventFlags, JSM (Maybe (er a))))
-> GhcjsDomEvent a -> JSM (EventFlags, JSM (Maybe (er a)))
forall a b. (a -> b) -> a -> b
$ EventType a -> GhcjsDomEvent a
forall (en :: EventTag). EventType en -> GhcjsDomEvent en
GhcjsDomEvent EventType a
evt
Bool
-> EventM Element (EventType a) ()
-> EventM Element (EventType a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventFlags -> Bool
_eventFlags_preventDefault EventFlags
flags) (EventM Element (EventType a) ()
-> EventM Element (EventType a) ())
-> EventM Element (EventType a) ()
-> EventM Element (EventType a) ()
forall a b. (a -> b) -> a -> b
$ EventName a
-> (IsEvent (EventType a) => EventM Element (EventType a) ())
-> EventM Element (EventType a) ()
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName a
en IsEvent (EventType a) => EventM Element (EventType a) ()
forall e t. IsEvent e => EventM t e ()
DOM.preventDefault
case EventFlags -> Propagation
_eventFlags_propagation EventFlags
flags of
Propagation
Propagation_Continue -> () -> EventM Element (EventType a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Propagation
Propagation_Stop -> EventName a
-> (IsEvent (EventType a) => EventM Element (EventType a) ())
-> EventM Element (EventType a) ()
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName a
en IsEvent (EventType a) => EventM Element (EventType a) ()
forall e t. IsEvent e => EventM t e ()
DOM.stopPropagation
Propagation
Propagation_StopImmediate -> EventName a
-> (IsEvent (EventType a) => EventM Element (EventType a) ())
-> EventM Element (EventType a) ()
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName a
en IsEvent (EventType a) => EventM Element (EventType a) ()
forall e t. IsEvent e => EventM t e ()
DOM.stopImmediatePropagation
Maybe (er a)
mv <- JSM (Maybe (er a)) -> ReaderT (EventType a) JSM (Maybe (er a))
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM (Maybe (er a))
k
IO () -> EventM Element (EventType a) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Element (EventType a) ())
-> IO () -> EventM Element (EventType a) ()
forall a b. (a -> b) -> a -> b
$ Maybe (er a) -> (er a -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (er a)
mv ((er a -> IO ()) -> IO ()) -> (er a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \er a
v -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> [DSum (EventTriggerRef t) TriggerInvocation] -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan [DSum (EventTriggerRef t) TriggerInvocation]
events [IORef (Maybe (EventTrigger t (er a))) -> EventTriggerRef t (er a)
forall t a. IORef (Maybe (EventTrigger t a)) -> EventTriggerRef t a
EventTriggerRef IORef (Maybe (EventTrigger t (er a)))
triggerRef EventTriggerRef t (er a)
-> TriggerInvocation (er a)
-> DSum (EventTriggerRef t) TriggerInvocation
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> er a -> IO () -> TriggerInvocation (er a)
forall a. a -> IO () -> TriggerInvocation a
TriggerInvocation er a
v (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())]
DSum EventName (EventFilterTriggerRef t er)
-> JSM (DSum EventName (EventFilterTriggerRef t er))
forall (m :: * -> *) a. Monad m => a -> m a
return (DSum EventName (EventFilterTriggerRef t er)
-> JSM (DSum EventName (EventFilterTriggerRef t er)))
-> DSum EventName (EventFilterTriggerRef t er)
-> JSM (DSum EventName (EventFilterTriggerRef t er))
forall a b. (a -> b) -> a -> b
$ EventName a
en EventName a
-> EventFilterTriggerRef t er a
-> DSum EventName (EventFilterTriggerRef t er)
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> IORef (Maybe (EventTrigger t (er a)))
-> EventFilterTriggerRef t er a
forall t (er :: EventTag -> *) (en :: EventTag).
IORef (Maybe (EventTrigger t (er en)))
-> EventFilterTriggerRef t er en
EventFilterTriggerRef IORef (Maybe (EventTrigger t (er a)))
triggerRef
DMap EventName (EventFilterTriggerRef t er)
-> m (DMap EventName (EventFilterTriggerRef t er))
forall (m :: * -> *) a. Monad m => a -> m a
return DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs
{-# SPECIALIZE wrap
:: Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
-> DOM.Element
-> RawElementConfig er DomTimeline HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (DMap EventName (EventFilterTriggerRef DomTimeline er))
#-}
{-# SPECIALIZE wrap
:: Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
-> DOM.Element
-> RawElementConfig er DomTimeline GhcjsDomSpace
-> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (DMap EventName (EventFilterTriggerRef DomTimeline er))
#-}
{-# INLINE triggerBody #-}
triggerBody
:: forall s er t x. EventSpec s ~ GhcjsEventSpec
=> DOM.JSContextRef
-> RawElementConfig er t s
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> DOM.Element
-> WrapArg er EventName x
-> EventTrigger t x
-> IO (IO ())
triggerBody :: JSContextRef
-> RawElementConfig er t s
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName x
-> EventTrigger t x
-> IO (IO ())
triggerBody JSContextRef
ctx RawElementConfig er t s
cfg Chan [DSum (EventTriggerRef t) TriggerInvocation]
events DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs Element
e (WrapArg EventName a1
en) EventTrigger t x
t = case EventName a1
-> DMap EventName (EventFilterTriggerRef t er)
-> Maybe (EventFilterTriggerRef t er a1)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup EventName a1
en DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs of
Just (EventFilterTriggerRef IORef (Maybe (EventTrigger t (er a1)))
r) -> do
IORef (Maybe (EventTrigger t (er a1)))
-> Maybe (EventTrigger t (er a1)) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (EventTrigger t (er a1)))
r (Maybe (EventTrigger t (er a1)) -> IO ())
-> Maybe (EventTrigger t (er a1)) -> IO ()
forall a b. (a -> b) -> a -> b
$ EventTrigger t (er a1) -> Maybe (EventTrigger t (er a1))
forall a. a -> Maybe a
Just EventTrigger t x
EventTrigger t (er a1)
t
IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ do
IORef (Maybe (EventTrigger t (er a1)))
-> Maybe (EventTrigger t (er a1)) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (EventTrigger t (er a1)))
r Maybe (EventTrigger t (er a1))
forall a. Maybe a
Nothing
Maybe (EventFilterTriggerRef t er a1)
Nothing -> (JSM () -> JSContextRef -> IO ()
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM () -> IO ()) -> IO (JSM ()) -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSM (JSM ()) -> JSContextRef -> IO (JSM ())
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (EventName a1
-> Element -> EventM Element (EventType a1) () -> JSM (JSM ())
forall e (en :: EventTag).
IsElement e =>
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
elementOnEventName EventName a1
en Element
e (EventM Element (EventType a1) () -> JSM (JSM ()))
-> EventM Element (EventType a1) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
EventType a1
evt <- EventM Any (EventType a1) (EventType a1)
forall t e. EventM t e e
DOM.event
Maybe (er a1)
mv <- JSM (Maybe (er a1)) -> ReaderT (EventType a1) JSM (Maybe (er a1))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (JSM (Maybe (er a1)) -> ReaderT (EventType a1) JSM (Maybe (er a1)))
-> JSM (Maybe (er a1))
-> ReaderT (EventType a1) JSM (Maybe (er a1))
forall a b. (a -> b) -> a -> b
$ GhcjsEventHandler er
-> (EventName a1, GhcjsDomEvent a1) -> JSM (Maybe (er a1))
forall (er :: EventTag -> *).
GhcjsEventHandler er
-> forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
unGhcjsEventHandler GhcjsEventHandler er
handler (EventName a1
en, EventType a1 -> GhcjsDomEvent a1
forall (en :: EventTag). EventType en -> GhcjsDomEvent en
GhcjsDomEvent EventType a1
evt)
case Maybe (er a1)
mv of
Maybe (er a1)
Nothing -> () -> EventM Element (EventType a1) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just er a1
v -> IO () -> EventM Element (EventType a1) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Element (EventType a1) ())
-> IO () -> EventM Element (EventType a1) ()
forall a b. (a -> b) -> a -> b
$ do
IORef (Maybe (EventTrigger t (er a1)))
ref <- Maybe (EventTrigger t (er a1))
-> IO (IORef (Maybe (EventTrigger t (er a1))))
forall a. a -> IO (IORef a)
newIORef (Maybe (EventTrigger t (er a1))
-> IO (IORef (Maybe (EventTrigger t (er a1)))))
-> Maybe (EventTrigger t (er a1))
-> IO (IORef (Maybe (EventTrigger t (er a1))))
forall a b. (a -> b) -> a -> b
$ EventTrigger t (er a1) -> Maybe (EventTrigger t (er a1))
forall a. a -> Maybe a
Just EventTrigger t x
EventTrigger t (er a1)
t
Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> [DSum (EventTriggerRef t) TriggerInvocation] -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan [DSum (EventTriggerRef t) TriggerInvocation]
events [IORef (Maybe (EventTrigger t (er a1))) -> EventTriggerRef t (er a1)
forall t a. IORef (Maybe (EventTrigger t a)) -> EventTriggerRef t a
EventTriggerRef IORef (Maybe (EventTrigger t (er a1)))
ref EventTriggerRef t (er a1)
-> TriggerInvocation (er a1)
-> DSum (EventTriggerRef t) TriggerInvocation
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> er a1 -> IO () -> TriggerInvocation (er a1)
forall a. a -> IO () -> TriggerInvocation a
TriggerInvocation er a1
v (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())])
where
handler :: GhcjsEventHandler er
!handler :: GhcjsEventHandler er
handler = GhcjsEventSpec er -> GhcjsEventHandler er
forall (er :: EventTag -> *).
GhcjsEventSpec er -> GhcjsEventHandler er
_ghcjsEventSpec_handler (GhcjsEventSpec er -> GhcjsEventHandler er)
-> GhcjsEventSpec er -> GhcjsEventHandler er
forall a b. (a -> b) -> a -> b
$ RawElementConfig er t s -> EventSpec s er
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
RawElementConfig er t s -> EventSpec s er
_rawElementConfig_eventSpec RawElementConfig er t s
cfg
{-# SPECIALIZE triggerBody
:: DOM.JSContextRef
-> RawElementConfig er DomTimeline HydrationDomSpace
-> Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef DomTimeline er)
-> DOM.Element
-> WrapArg er EventName x
-> EventTrigger DomTimeline x
-> IO (IO ())
#-}
{-# SPECIALIZE triggerBody
:: DOM.JSContextRef
-> RawElementConfig er DomTimeline GhcjsDomSpace
-> Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef DomTimeline er)
-> DOM.Element
-> WrapArg er EventName x
-> EventTrigger DomTimeline x
-> IO (IO ())
#-}
newtype GhcjsDomHandler a b = GhcjsDomHandler { GhcjsDomHandler a b -> a -> JSM b
unGhcjsDomHandler :: a -> JSM b }
newtype GhcjsDomHandler1 a b = GhcjsDomHandler1 { GhcjsDomHandler1 a b -> forall (x :: EventTag). a x -> JSM (b x)
unGhcjsDomHandler1 :: forall (x :: EventTag). a x -> JSM (b x) }
newtype GhcjsDomEvent en = GhcjsDomEvent { GhcjsDomEvent en -> EventType en
unGhcjsDomEvent :: EventType en }
data GhcjsDomSpace
instance DomSpace GhcjsDomSpace where
type EventSpec GhcjsDomSpace = GhcjsEventSpec
type RawDocument GhcjsDomSpace = DOM.Document
type RawTextNode GhcjsDomSpace = DOM.Text
type GhcjsDomSpace = DOM.Comment
type RawElement GhcjsDomSpace = DOM.Element
type RawInputElement GhcjsDomSpace = DOM.HTMLInputElement
type RawTextAreaElement GhcjsDomSpace = DOM.HTMLTextAreaElement
type RawSelectElement GhcjsDomSpace = DOM.HTMLSelectElement
addEventSpecFlags :: proxy GhcjsDomSpace
-> EventName en
-> (Maybe (er en) -> EventFlags)
-> EventSpec GhcjsDomSpace er
-> EventSpec GhcjsDomSpace er
addEventSpecFlags proxy GhcjsDomSpace
_ EventName en
en Maybe (er en) -> EventFlags
f EventSpec GhcjsDomSpace er
es = EventSpec GhcjsDomSpace er
GhcjsEventSpec er
es
{ _ghcjsEventSpec_filters :: DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters =
let f' :: Maybe (GhcjsEventFilter er en) -> Maybe (GhcjsEventFilter er en)
f' = GhcjsEventFilter er en -> Maybe (GhcjsEventFilter er en)
forall a. a -> Maybe a
Just (GhcjsEventFilter er en -> Maybe (GhcjsEventFilter er en))
-> (Maybe (GhcjsEventFilter er en) -> GhcjsEventFilter er en)
-> Maybe (GhcjsEventFilter er en)
-> Maybe (GhcjsEventFilter er en)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
forall (er :: EventTag -> *) (en :: EventTag).
(GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
GhcjsEventFilter ((GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en)
-> (Maybe (GhcjsEventFilter er en)
-> GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> Maybe (GhcjsEventFilter er en)
-> GhcjsEventFilter er en
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Maybe (GhcjsEventFilter er en)
Nothing -> \GhcjsDomEvent en
evt -> do
Maybe (er en)
mEventResult <- GhcjsEventHandler er
-> (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
forall (er :: EventTag -> *).
GhcjsEventHandler er
-> forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
unGhcjsEventHandler (GhcjsEventSpec er -> GhcjsEventHandler er
forall (er :: EventTag -> *).
GhcjsEventSpec er -> GhcjsEventHandler er
_ghcjsEventSpec_handler EventSpec GhcjsDomSpace er
GhcjsEventSpec er
es) (EventName en
en, GhcjsDomEvent en
evt)
(EventFlags, JSM (Maybe (er en)))
-> JSM (EventFlags, JSM (Maybe (er en)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (er en) -> EventFlags
f Maybe (er en)
mEventResult, Maybe (er en) -> JSM (Maybe (er en))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (er en)
mEventResult)
Just (GhcjsEventFilter GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter) -> \GhcjsDomEvent en
evt -> do
(EventFlags
oldFlags, JSM (Maybe (er en))
oldContinuation) <- GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter GhcjsDomEvent en
evt
Maybe (er en)
mEventResult <- JSM (Maybe (er en))
oldContinuation
let newFlags :: EventFlags
newFlags = EventFlags
oldFlags EventFlags -> EventFlags -> EventFlags
forall a. Semigroup a => a -> a -> a
<> Maybe (er en) -> EventFlags
f Maybe (er en)
mEventResult
(EventFlags, JSM (Maybe (er en)))
-> JSM (EventFlags, JSM (Maybe (er en)))
forall (m :: * -> *) a. Monad m => a -> m a
return (EventFlags
newFlags, Maybe (er en) -> JSM (Maybe (er en))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (er en)
mEventResult)
in (Maybe (GhcjsEventFilter er en) -> Maybe (GhcjsEventFilter er en))
-> EventName en
-> DMap EventName (GhcjsEventFilter er)
-> DMap EventName (GhcjsEventFilter er)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
(Maybe (f v) -> Maybe (f v)) -> k2 v -> DMap k2 f -> DMap k2 f
DMap.alter Maybe (GhcjsEventFilter er en) -> Maybe (GhcjsEventFilter er en)
f' EventName en
en (DMap EventName (GhcjsEventFilter er)
-> DMap EventName (GhcjsEventFilter er))
-> DMap EventName (GhcjsEventFilter er)
-> DMap EventName (GhcjsEventFilter er)
forall a b. (a -> b) -> a -> b
$ GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
forall (er :: EventTag -> *).
GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters EventSpec GhcjsDomSpace er
GhcjsEventSpec er
es
}
newtype GhcjsEventFilter er en = GhcjsEventFilter (GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
data Pair1 (f :: k -> *) (g :: k -> *) (a :: k) = Pair1 (f a) (g a)
data Maybe1 f a = Nothing1 | Just1 (f a)
data GhcjsEventSpec er = GhcjsEventSpec
{ GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters :: DMap EventName (GhcjsEventFilter er)
, GhcjsEventSpec er -> GhcjsEventHandler er
_ghcjsEventSpec_handler :: GhcjsEventHandler er
}
newtype GhcjsEventHandler er = GhcjsEventHandler { GhcjsEventHandler er
-> forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
unGhcjsEventHandler :: forall en. (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)) }
#ifndef USE_TEMPLATE_HASKELL
ghcjsEventSpec_filters :: forall er . Lens' (GhcjsEventSpec er) (DMap EventName (GhcjsEventFilter er))
ghcjsEventSpec_filters f (GhcjsEventSpec a b) = (\a' -> GhcjsEventSpec a' b) <$> f a
{-# INLINE ghcjsEventSpec_filters #-}
ghcjsEventSpec_handler :: forall er en . Getter (GhcjsEventSpec er) ((EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
ghcjsEventSpec_handler f (GhcjsEventSpec _ (GhcjsEventHandler b)) = phantom (f b)
{-# INLINE ghcjsEventSpec_handler #-}
#endif
instance er ~ EventResult => Default (GhcjsEventSpec er) where
def :: GhcjsEventSpec er
def = GhcjsEventSpec :: forall (er :: EventTag -> *).
DMap EventName (GhcjsEventFilter er)
-> GhcjsEventHandler er -> GhcjsEventSpec er
GhcjsEventSpec
{ _ghcjsEventSpec_filters :: DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters = DMap EventName (GhcjsEventFilter er)
forall a. Monoid a => a
mempty
, _ghcjsEventSpec_handler :: GhcjsEventHandler er
_ghcjsEventSpec_handler = (forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
-> GhcjsEventHandler er
forall (er :: EventTag -> *).
(forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
-> GhcjsEventHandler er
GhcjsEventHandler ((forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
-> GhcjsEventHandler er)
-> (forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
-> GhcjsEventHandler er
forall a b. (a -> b) -> a -> b
$ \(EventName en
en, GhcjsDomEvent EventType en
evt) -> do
EventTarget
t :: DOM.EventTarget <- EventName en
-> (IsEvent (EventType en) => JSM EventTarget) -> JSM EventTarget
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName en
en ((IsEvent (EventType en) => JSM EventTarget) -> JSM EventTarget)
-> (IsEvent (EventType en) => JSM EventTarget) -> JSM EventTarget
forall a b. (a -> b) -> a -> b
$ EventType en -> JSM EventTarget
forall (m :: * -> *) self.
(MonadDOM m, IsEvent self) =>
self -> m EventTarget
Event.getTargetUnchecked EventType en
evt
let e :: Element
e = (JSVal -> Element) -> EventTarget -> Element
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> Element
DOM.Element EventTarget
t
ReaderT (EventType en) JSM (Maybe (EventResult en))
-> EventType en -> DOM (Maybe (EventResult en))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Element
-> EventName en
-> ReaderT (EventType en) JSM (Maybe (EventResult en))
forall e (en :: EventTag).
IsElement e =>
e
-> EventName en -> EventM e (EventType en) (Maybe (EventResult en))
defaultDomEventHandler Element
e EventName en
en) EventType en
evt
}
{-# INLINE makeElement #-}
makeElement :: MonadJSM m => Document -> Text -> ElementConfig er t s -> m DOM.Element
makeElement :: Document -> Text -> ElementConfig er t s -> m Element
makeElement Document
doc Text
elementTag ElementConfig er t s
cfg = do
Element
e <- (JSVal -> Element) -> Element -> Element
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> Element
DOM.Element (Element -> Element) -> m Element -> m Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ElementConfig er t s
cfg ElementConfig er t s
-> Getting (Maybe Text) (ElementConfig er t s) (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) (ElementConfig er t s) (Maybe Text)
forall a. HasNamespace a => Lens' a (Maybe Text)
namespace of
Maybe Text
Nothing -> Document -> Text -> m Element
forall (m :: * -> *) self localName.
(MonadDOM m, IsDocument self, ToJSString localName) =>
self -> localName -> m Element
createElement Document
doc Text
elementTag
Just Text
ens -> Document -> Maybe Text -> Text -> m Element
forall (m :: * -> *) self namespaceURI qualifiedName.
(MonadDOM m, IsDocument self, ToJSString namespaceURI,
ToJSString qualifiedName) =>
self -> Maybe namespaceURI -> qualifiedName -> m Element
createElementNS Document
doc (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ens) Text
elementTag
Map AttributeName Text -> (AttributeName -> Text -> m ()) -> m ()
forall i (t :: * -> *) (m :: * -> *) a b.
(FoldableWithIndex i t, Monad m) =>
t a -> (i -> a -> m b) -> m ()
iforM_ (ElementConfig er t s
cfg ElementConfig er t s
-> Getting
(Map AttributeName Text)
(ElementConfig er t s)
(Map AttributeName Text)
-> Map AttributeName Text
forall s a. s -> Getting a s a -> a
^. Getting
(Map AttributeName Text)
(ElementConfig er t s)
(Map AttributeName Text)
forall a. InitialAttributes a => Lens' a (Map AttributeName Text)
initialAttributes) ((AttributeName -> Text -> m ()) -> m ())
-> (AttributeName -> Text -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(AttributeName Maybe Text
mAttrNamespace Text
n) Text
v -> case Maybe Text
mAttrNamespace of
Maybe Text
Nothing -> Element -> Text -> Text -> m ()
forall (m :: * -> *) self qualifiedName value.
(MonadDOM m, IsElement self, ToJSString qualifiedName,
ToJSString value) =>
self -> qualifiedName -> value -> m ()
setAttribute Element
e Text
n Text
v
Just Text
ans -> Element -> Maybe Text -> Text -> Text -> m ()
forall (m :: * -> *) self namespaceURI qualifiedName value.
(MonadDOM m, IsElement self, ToJSString namespaceURI,
ToJSString qualifiedName, ToJSString value) =>
self -> Maybe namespaceURI -> qualifiedName -> value -> m ()
setAttributeNS Element
e (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ans) Text
n Text
v
Element -> m Element
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
e
{-# INLINE elementImmediate #-}
elementImmediate
:: ( RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, EventSpec s ~ GhcjsEventSpec
, MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m )
=> Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate :: Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
elementTag ElementConfig er t s
cfg HydrationDomBuilderT s t m a
child = do
Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
JSContextRef
ctx <- HydrationDomBuilderT s t m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
Chan [DSum (EventTriggerRef t) TriggerInvocation]
events <- HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents
Node
parent <- HydrationDomBuilderT s t m Node
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
Element
e <- Document
-> Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m Element
forall k k (m :: * -> *) (er :: EventTag -> *) (t :: k) (s :: k).
MonadJSM m =>
Document -> Text -> ElementConfig er t s -> m Element
makeElement Document
doc Text
elementTag ElementConfig er t s
cfg
Node -> Element -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
appendChild_ Node
parent Element
e
a
result <- (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
forall k (m :: * -> *) t (s :: k) a.
Monad m =>
(HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
localEnv (\HydrationDomBuilderEnv t m
env -> HydrationDomBuilderEnv t m
env { _hydrationDomBuilderEnv_parent :: Either Node (IORef Node)
_hydrationDomBuilderEnv_parent = Node -> Either Node (IORef Node)
forall a b. a -> Either a b
Left (Node -> Either Node (IORef Node))
-> Node -> Either Node (IORef Node)
forall a b. (a -> b) -> a -> b
$ Element -> Node
forall o. IsNode o => o -> Node
toNode Element
e }) HydrationDomBuilderT s t m a
child
let rawCfg :: RawElementConfig er t s
rawCfg = ElementConfig er t s -> RawElementConfig er t s
forall k1 k2 (er :: EventTag -> *) (t :: k1) (m :: k2).
ElementConfig er t m -> RawElementConfig er t m
extractRawElementConfig ElementConfig er t s
cfg
DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs <- Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t s
-> HydrationDomBuilderT
s t m (DMap EventName (EventFilterTriggerRef t er))
forall k (s :: k) (m :: * -> *) (er :: EventTag -> *) t.
(Reflex t, MonadJSM m, MonadReflexCreateTrigger t m,
DomRenderHook t m, EventSpec s ~ GhcjsEventSpec) =>
Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t s
-> m (DMap EventName (EventFilterTriggerRef t er))
wrap Chan [DSum (EventTriggerRef t) TriggerInvocation]
events Element
e RawElementConfig er t s
rawCfg
EventSelector t (WrapArg er EventName)
es <- (forall a.
WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
s t m (EventSelector t (WrapArg er EventName))
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger ((forall a.
WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
s t m (EventSelector t (WrapArg er EventName)))
-> (forall a.
WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
s t m (EventSelector t (WrapArg er EventName))
forall a b. (a -> b) -> a -> b
$ JSContextRef
-> RawElementConfig er t s
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName a
-> EventTrigger t a
-> IO (IO ())
forall k (s :: k) (er :: EventTag -> *) t x.
(EventSpec s ~ GhcjsEventSpec) =>
JSContextRef
-> RawElementConfig er t s
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName x
-> EventTrigger t x
-> IO (IO ())
triggerBody JSContextRef
ctx RawElementConfig er t s
rawCfg Chan [DSum (EventTriggerRef t) TriggerInvocation]
events DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs Element
e
(Element er GhcjsDomSpace t, a)
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventSelector t (WrapArg er EventName)
-> RawElement GhcjsDomSpace -> Element er GhcjsDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element EventSelector t (WrapArg er EventName)
es Element
RawElement GhcjsDomSpace
e, a
result)
{-# SPECIALIZE elementImmediate
:: Text
-> ElementConfig er DomTimeline HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM a
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (Element er GhcjsDomSpace DomTimeline, a)
#-}
{-# SPECIALIZE elementImmediate
:: Text
-> ElementConfig er DomTimeline GhcjsDomSpace
-> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM a
-> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (Element er GhcjsDomSpace DomTimeline, a)
#-}
type DomTimeline =
#ifdef PROFILE_REFLEX
ProfiledTimeline
#endif
Spider
type DomHost =
#ifdef PROFILE_REFLEX
ProfiledM
#endif
(SpiderHost Global)
type DomCoreWidget x = PostBuildT DomTimeline (WithJSContextSingleton x (PerformEventT DomTimeline DomHost))
type HydrationM = DomCoreWidget ()
{-# INLINE elementInternal #-}
elementInternal
:: (MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m)
=> Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT HydrationDomSpace t m (Element er HydrationDomSpace t, a)
elementInternal :: Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t, a)
elementInternal Text
elementTag ElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child = HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t, a))
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> do
(Element EventSelector t (WrapArg er EventName)
es RawElement GhcjsDomSpace
_, a
result) <- Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er GhcjsDomSpace t, a)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
elementTag ElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child
(Element er HydrationDomSpace t, a)
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventSelector t (WrapArg er EventName)
-> RawElement HydrationDomSpace -> Element er HydrationDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element EventSelector t (WrapArg er EventName)
es (), a
result)
HydrationMode
HydrationMode_Hydrating -> ((Element er HydrationDomSpace t, a), IORef Element)
-> (Element er HydrationDomSpace t, a)
forall a b. (a, b) -> a
fst (((Element er HydrationDomSpace t, a), IORef Element)
-> (Element er HydrationDomSpace t, a))
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
forall (er :: EventTag -> *) t (m :: * -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
elementTag ElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child
{-# SPECIALIZE elementInternal
:: Text
-> ElementConfig er DomTimeline HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM a
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (Element er HydrationDomSpace DomTimeline, a)
#-}
skipHydrationAttribute :: IsString s => s
skipHydrationAttribute :: s
skipHydrationAttribute = s
"data-hydration-skip"
hydratableAttribute :: IsString s => s
hydratableAttribute :: s
hydratableAttribute = s
"data-ssr"
{-# INLINE hydrateElement #-}
hydrateElement
:: forall er t m a. (MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m)
=> Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT HydrationDomSpace t m ((Element er HydrationDomSpace t, a), IORef DOM.Element)
hydrateElement :: Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
elementTag ElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child = do
JSContextRef
ctx <- HydrationDomBuilderT HydrationDomSpace t m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
Chan [DSum (EventTriggerRef t) TriggerInvocation]
events <- HydrationDomBuilderT
HydrationDomSpace
t
m
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents
IORef Node
parentRef <- IO (IORef Node)
-> HydrationDomBuilderT HydrationDomSpace t m (IORef Node)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Node)
-> HydrationDomBuilderT HydrationDomSpace t m (IORef Node))
-> IO (IORef Node)
-> HydrationDomBuilderT HydrationDomSpace t m (IORef Node)
forall a b. (a -> b) -> a -> b
$ Node -> IO (IORef Node)
forall a. a -> IO (IORef a)
newIORef (Node -> IO (IORef Node)) -> Node -> IO (IORef Node)
forall a b. (a -> b) -> a -> b
$ String -> Node
forall a. HasCallStack => String -> a
error String
"Parent not yet initialized"
IORef Element
e' <- IO (IORef Element)
-> HydrationDomBuilderT HydrationDomSpace t m (IORef Element)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Element)
-> HydrationDomBuilderT HydrationDomSpace t m (IORef Element))
-> IO (IORef Element)
-> HydrationDomBuilderT HydrationDomSpace t m (IORef Element)
forall a b. (a -> b) -> a -> b
$ Element -> IO (IORef Element)
forall a. a -> IO (IORef a)
newIORef (Element -> IO (IORef Element)) -> Element -> IO (IORef Element)
forall a b. (a -> b) -> a -> b
$ String -> Element
forall a. HasCallStack => String -> a
error String
"hydrateElement: Element not yet initialized"
HydrationDomBuilderEnv t m
env <- ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT
HydrationDomSpace t m (HydrationDomBuilderEnv t m)
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(HydrationDomBuilderEnv t m)
forall r (m :: * -> *). MonadReader r m => m r
ask
IORef (HydrationRunnerT t m ())
childDelayedRef <- IO (IORef (HydrationRunnerT t m ()))
-> HydrationDomBuilderT
HydrationDomSpace t m (IORef (HydrationRunnerT t m ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HydrationRunnerT t m ()))
-> HydrationDomBuilderT
HydrationDomSpace t m (IORef (HydrationRunnerT t m ())))
-> IO (IORef (HydrationRunnerT t m ()))
-> HydrationDomBuilderT
HydrationDomSpace t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a. a -> IO (IORef a)
newIORef (HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ())))
-> HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
let env' :: HydrationDomBuilderEnv t m
env' = HydrationDomBuilderEnv t m
env
{ _hydrationDomBuilderEnv_parent :: Either Node (IORef Node)
_hydrationDomBuilderEnv_parent = IORef Node -> Either Node (IORef Node)
forall a b. b -> Either a b
Right IORef Node
parentRef
, _hydrationDomBuilderEnv_delayed :: IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed = IORef (HydrationRunnerT t m ())
childDelayedRef
}
a
result <- ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT HydrationDomSpace t m a
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT HydrationDomSpace t m a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT HydrationDomSpace t m a
forall a b. (a -> b) -> a -> b
$ DomRenderHookT t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> DomRenderHookT t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall a b. (a -> b) -> a -> b
$ ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (HydrationDomBuilderT HydrationDomSpace t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT HydrationDomBuilderT HydrationDomSpace t m a
child) HydrationDomBuilderEnv t m
env'
MVar (Element, DMap EventName (EventFilterTriggerRef t er))
wrapResult <- IO (MVar (Element, DMap EventName (EventFilterTriggerRef t er)))
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(MVar (Element, DMap EventName (EventFilterTriggerRef t er)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar (Element, DMap EventName (EventFilterTriggerRef t er)))
forall a. IO (MVar a)
newEmptyMVar
let
shouldSkip :: DOM.Element -> HydrationRunnerT t m Bool
shouldSkip :: Element -> HydrationRunnerT t m Bool
shouldSkip Element
e = do
Bool
skip <- Element -> JSString -> HydrationRunnerT t m Bool
forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsElement self, ToJSString qualifiedName) =>
self -> qualifiedName -> m Bool
hasAttribute Element
e (JSString
forall s. IsString s => s
skipHydrationAttribute :: DOM.JSString)
Bool
hydratable <- Element -> JSString -> HydrationRunnerT t m Bool
forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsElement self, ToJSString qualifiedName) =>
self -> qualifiedName -> m Bool
hasAttribute Element
e (JSString
forall s. IsString s => s
hydratableAttribute :: DOM.JSString)
Bool -> HydrationRunnerT t m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> HydrationRunnerT t m Bool)
-> Bool -> HydrationRunnerT t m Bool
forall a b. (a -> b) -> a -> b
$ Bool
skip Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
hydratable
HydrationRunnerT t m ()
childDom <- IO (HydrationRunnerT t m ())
-> HydrationDomBuilderT
HydrationDomSpace t m (HydrationRunnerT t m ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HydrationRunnerT t m ())
-> HydrationDomBuilderT
HydrationDomSpace t m (HydrationRunnerT t m ()))
-> IO (HydrationRunnerT t m ())
-> HydrationDomBuilderT
HydrationDomSpace t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ IORef (HydrationRunnerT t m ()) -> IO (HydrationRunnerT t m ())
forall a. IORef a -> IO a
readIORef IORef (HydrationRunnerT t m ())
childDelayedRef
let rawCfg :: RawElementConfig er t HydrationDomSpace
rawCfg = ElementConfig er t HydrationDomSpace
-> RawElementConfig er t HydrationDomSpace
forall k1 k2 (er :: EventTag -> *) (t :: k1) (m :: k2).
ElementConfig er t m -> RawElementConfig er t m
extractRawElementConfig ElementConfig er t HydrationDomSpace
cfg
Document
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
HydrationRunnerT t m ()
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall k (m :: * -> *) t (s :: k).
MonadIO m =>
HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
addHydrationStep (HydrationRunnerT t m ()
-> HydrationDomBuilderT HydrationDomSpace t m ())
-> HydrationRunnerT t m ()
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ do
Node
parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
Maybe Node
lastHydrationNode <- HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) t.
Monad m =>
HydrationRunnerT t m (Maybe Node)
getPreviousNode
let go :: Maybe Node -> HydrationRunnerT t m Element
go Maybe Node
mLastNode = HydrationRunnerT t m (Maybe Node)
-> (Node -> HydrationRunnerT t m (Maybe Node))
-> Maybe Node
-> HydrationRunnerT t m (Maybe Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getFirstChild Node
parent) Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling Maybe Node
mLastNode HydrationRunnerT t m (Maybe Node)
-> (Maybe Node -> HydrationRunnerT t m Element)
-> HydrationRunnerT t m Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Node
Nothing -> do
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
s -> HydrationState
s { _hydrationState_failed :: Bool
_hydrationState_failed = Bool
True }
Element
e <- Document
-> Text
-> ElementConfig er t HydrationDomSpace
-> HydrationRunnerT t m Element
forall k k (m :: * -> *) (er :: EventTag -> *) (t :: k) (s :: k).
MonadJSM m =>
Document -> Text -> ElementConfig er t s -> m Element
makeElement Document
doc Text
elementTag ElementConfig er t HydrationDomSpace
cfg
Element -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Element
e
Element -> HydrationRunnerT t m Element
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
e
Just Node
node -> (JSVal -> Element) -> Node -> HydrationRunnerT t m (Maybe Element)
forall obj obj' (m :: * -> *).
(Coercible obj JSVal, IsGObject obj', MonadJSM m) =>
(JSVal -> obj') -> obj -> m (Maybe obj')
DOM.castTo JSVal -> Element
DOM.Element Node
node HydrationRunnerT t m (Maybe Element)
-> (Maybe Element -> HydrationRunnerT t m Element)
-> HydrationRunnerT t m Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Element
Nothing -> Maybe Node -> HydrationRunnerT t m Element
go (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
Just Element
e -> Element -> HydrationRunnerT t m Bool
shouldSkip Element
e HydrationRunnerT t m Bool
-> (Bool -> HydrationRunnerT t m Element)
-> HydrationRunnerT t m Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> Maybe Node -> HydrationRunnerT t m Element
go (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
Bool
False -> do
Text
t <- Element -> HydrationRunnerT t m Text
forall (m :: * -> *) self result.
(MonadDOM m, IsElement self, FromJSString result) =>
self -> m result
Element.getTagName Element
e
if Text -> Text
T.toCaseFold Text
elementTag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toCaseFold Text
t
then Element -> HydrationRunnerT t m Element
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
e
else do
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
s -> HydrationState
s { _hydrationState_failed :: Bool
_hydrationState_failed = Bool
True }
Element
n <- Document
-> Text
-> ElementConfig er t HydrationDomSpace
-> HydrationRunnerT t m Element
forall k k (m :: * -> *) (er :: EventTag -> *) (t :: k) (s :: k).
MonadJSM m =>
Document -> Text -> ElementConfig er t s -> m Element
makeElement Document
doc Text
elementTag ElementConfig er t HydrationDomSpace
cfg
Element -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Element
n
Element -> HydrationRunnerT t m Element
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
n
Element
e <- Maybe Node -> HydrationRunnerT t m Element
go Maybe Node
lastHydrationNode
Maybe Node -> HydrationRunnerT t m ()
forall (m :: * -> *) t.
Monad m =>
Maybe Node -> HydrationRunnerT t m ()
setPreviousNode (Maybe Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Element -> Node
forall o. IsNode o => o -> Node
toNode Element
e
IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IORef Node -> Node -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Node
parentRef (Node -> IO ()) -> Node -> IO ()
forall a b. (a -> b) -> a -> b
$ Element -> Node
forall o. IsNode o => o -> Node
toNode Element
e
IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IORef Element -> Element -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Element
e' Element
e
DMap EventName (EventFilterTriggerRef t er)
refs <- Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t HydrationDomSpace
-> HydrationRunnerT
t m (DMap EventName (EventFilterTriggerRef t er))
forall k (s :: k) (m :: * -> *) (er :: EventTag -> *) t.
(Reflex t, MonadJSM m, MonadReflexCreateTrigger t m,
DomRenderHook t m, EventSpec s ~ GhcjsEventSpec) =>
Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t s
-> m (DMap EventName (EventFilterTriggerRef t er))
wrap Chan [DSum (EventTriggerRef t) TriggerInvocation]
events Element
e RawElementConfig er t HydrationDomSpace
rawCfg
IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ MVar (Element, DMap EventName (EventFilterTriggerRef t er))
-> (Element, DMap EventName (EventFilterTriggerRef t er)) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Element, DMap EventName (EventFilterTriggerRef t er))
wrapResult (Element
e, DMap EventName (EventFilterTriggerRef t er)
refs)
HydrationRunnerT t m ()
-> Maybe Node -> Node -> HydrationRunnerT t m ()
forall (m :: * -> *) t a.
(MonadJSM m, Monad m) =>
HydrationRunnerT t m a
-> Maybe Node -> Node -> HydrationRunnerT t m a
localRunner HydrationRunnerT t m ()
childDom Maybe Node
forall a. Maybe a
Nothing (Node -> HydrationRunnerT t m ())
-> Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Element -> Node
forall o. IsNode o => o -> Node
toNode Element
e
EventSelector t (WrapArg er EventName)
es <- (forall a.
WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
HydrationDomSpace t m (EventSelector t (WrapArg er EventName))
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger ((forall a.
WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
HydrationDomSpace t m (EventSelector t (WrapArg er EventName)))
-> (forall a.
WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
HydrationDomSpace t m (EventSelector t (WrapArg er EventName))
forall a b. (a -> b) -> a -> b
$ \(WrapArg en) EventTrigger t a
t -> do
MVar (IO ())
cleanup <- IO (MVar (IO ()))
forall a. IO (MVar a)
newEmptyMVar
ThreadId
threadId <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
(Element
e, DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs) <- MVar (Element, DMap EventName (EventFilterTriggerRef t er))
-> IO (Element, DMap EventName (EventFilterTriggerRef t er))
forall a. MVar a -> IO a
readMVar MVar (Element, DMap EventName (EventFilterTriggerRef t er))
wrapResult
IO (IO ()) -> (IO () -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
(JSContextRef
-> RawElementConfig er t HydrationDomSpace
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName (er a1)
-> EventTrigger t (er a1)
-> IO (IO ())
forall k (s :: k) (er :: EventTag -> *) t x.
(EventSpec s ~ GhcjsEventSpec) =>
JSContextRef
-> RawElementConfig er t s
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName x
-> EventTrigger t x
-> IO (IO ())
triggerBody JSContextRef
ctx RawElementConfig er t HydrationDomSpace
rawCfg Chan [DSum (EventTriggerRef t) TriggerInvocation]
events DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs Element
e (EventName a1 -> WrapArg er EventName (er a1)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName a1
en) EventTrigger t a
EventTrigger t (er a1)
t)
IO () -> IO ()
forall a. a -> a
id
(MVar (IO ()) -> IO () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (IO ())
cleanup)
IO () -> IO (IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO () -> IO (IO ())) -> IO () -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ do
MVar (IO ()) -> IO (Maybe (IO ()))
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar (IO ())
cleanup IO (Maybe (IO ())) -> (Maybe (IO ()) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (IO ())
Nothing -> ThreadId -> IO ()
killThread ThreadId
threadId
Just IO ()
c -> IO ()
c
((Element er HydrationDomSpace t, a), IORef Element)
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
forall (m :: * -> *) a. Monad m => a -> m a
return ((EventSelector t (WrapArg er EventName)
-> RawElement HydrationDomSpace -> Element er HydrationDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element EventSelector t (WrapArg er EventName)
es (), a
result), IORef Element
e')
{-# SPECIALIZE hydrateElement
:: Text
-> ElementConfig er DomTimeline HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM a
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM ((Element er HydrationDomSpace DomTimeline, a), IORef DOM.Element)
#-}
{-# INLINE inputElementImmediate #-}
inputElementImmediate
:: ( RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, EventSpec s ~ GhcjsEventSpec
, MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
, MonadRef m, Ref m ~ IORef )
=> InputElementConfig er t s -> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
inputElementImmediate :: InputElementConfig er t s
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
inputElementImmediate InputElementConfig er t s
cfg = do
(e :: Element er GhcjsDomSpace t
e@(Element EventSelector t (WrapArg er EventName)
eventSelector RawElement GhcjsDomSpace
domElement), ()) <- Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ())
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
"input" (InputElementConfig er t s -> ElementConfig er t s
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> ElementConfig er t s
_inputElementConfig_elementConfig InputElementConfig er t s
cfg) (HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ()))
-> HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ())
forall a b. (a -> b) -> a -> b
$ () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
let domInputElement :: HTMLInputElement
domInputElement = (JSVal -> HTMLInputElement) -> Element -> HTMLInputElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLInputElement
DOM.HTMLInputElement Element
RawElement GhcjsDomSpace
domElement
HTMLInputElement -> Text -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLInputElement -> val -> m ()
Input.setValue HTMLInputElement
domInputElement (Text -> HydrationDomBuilderT s t m ())
-> Text -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ InputElementConfig er t s
cfg InputElementConfig er t s
-> Getting Text (InputElementConfig er t s) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (InputElementConfig er t s) Text
forall k1 k2 (er :: EventTag -> *) (t :: k1) (s :: k2).
Lens' (InputElementConfig er t s) Text
inputElementConfig_initialValue
Text
v0 <- HTMLInputElement -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLInputElement -> m result
Input.getValue HTMLInputElement
domInputElement
let getMyValue :: JSM Text
getMyValue = HTMLInputElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLInputElement -> m result
Input.getValue HTMLInputElement
domInputElement
Event t Text
valueChangedByUI <- Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ JSM Text -> JSM Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getMyValue JSM Text -> Event t (er 'InputTag) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'InputTag) -> Event t (er 'InputTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select EventSelector t (WrapArg er EventName)
eventSelector (EventName 'InputTag -> WrapArg er EventName (er 'InputTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'InputTag
Input)
Event t Text
valueChangedBySetValue <- case InputElementConfig er t s -> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Maybe (Event t Text)
_inputElementConfig_setValue InputElementConfig er t s
cfg of
Maybe (Event t Text)
Nothing -> Event t Text -> HydrationDomBuilderT s t m (Event t Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Event t Text
forall k (t :: k) a. Reflex t => Event t a
never
Just Event t Text
eSetValue -> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM Text) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM Text) -> Event t (JSM Text))
-> (Text -> JSM Text) -> Event t (JSM Text)
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
HTMLInputElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLInputElement -> val -> m ()
Input.setValue HTMLInputElement
domInputElement Text
v'
JSM Text
getMyValue
Dynamic t Text
v <- Text -> Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
v0 (Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text))
-> Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ [Event t Text] -> Event t Text
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Event t Text
valueChangedBySetValue
, Event t Text
valueChangedByUI
]
HTMLInputElement -> Bool -> HydrationDomBuilderT s t m ()
forall (m :: * -> *).
MonadDOM m =>
HTMLInputElement -> Bool -> m ()
Input.setChecked HTMLInputElement
domInputElement (Bool -> HydrationDomBuilderT s t m ())
-> Bool -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ InputElementConfig er t s -> Bool
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Bool
_inputElementConfig_initialChecked InputElementConfig er t s
cfg
Event t Bool
checkedChangedByUI <- HTMLInputElement
-> (HTMLInputElement
-> EventM HTMLInputElement MouseEvent () -> JSM (JSM ()))
-> EventM HTMLInputElement MouseEvent Bool
-> HydrationDomBuilderT s t m (Event t Bool)
forall t (m :: * -> *) e event a.
(TriggerEvent t m, MonadJSM m) =>
e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event a
-> m (Event t a)
wrapDomEvent HTMLInputElement
domInputElement (HTMLInputElement
-> EventName HTMLInputElement MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName HTMLInputElement MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.click) (EventM HTMLInputElement MouseEvent Bool
-> HydrationDomBuilderT s t m (Event t Bool))
-> EventM HTMLInputElement MouseEvent Bool
-> HydrationDomBuilderT s t m (Event t Bool)
forall a b. (a -> b) -> a -> b
$ do
HTMLInputElement -> EventM HTMLInputElement MouseEvent Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement
Event t (Maybe Bool)
checkedChangedBySetChecked <- case InputElementConfig er t s -> Maybe (Event t Bool)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Maybe (Event t Bool)
_inputElementConfig_setChecked InputElementConfig er t s
cfg of
Maybe (Event t Bool)
Nothing -> Event t (Maybe Bool)
-> HydrationDomBuilderT s t m (Event t (Maybe Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return Event t (Maybe Bool)
forall k (t :: k) a. Reflex t => Event t a
never
Just Event t Bool
eNewchecked -> Event t (JSM (Maybe Bool))
-> HydrationDomBuilderT s t m (Event t (Maybe Bool))
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM (Maybe Bool))
-> HydrationDomBuilderT s t m (Event t (Maybe Bool)))
-> Event t (JSM (Maybe Bool))
-> HydrationDomBuilderT s t m (Event t (Maybe Bool))
forall a b. (a -> b) -> a -> b
$ Event t Bool
-> (Bool -> JSM (Maybe Bool)) -> Event t (JSM (Maybe Bool))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Bool
eNewchecked ((Bool -> JSM (Maybe Bool)) -> Event t (JSM (Maybe Bool)))
-> (Bool -> JSM (Maybe Bool)) -> Event t (JSM (Maybe Bool))
forall a b. (a -> b) -> a -> b
$ \Bool
newChecked -> do
Bool
oldChecked <- HTMLInputElement -> JSM Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement
HTMLInputElement -> Bool -> JSM ()
forall (m :: * -> *).
MonadDOM m =>
HTMLInputElement -> Bool -> m ()
Input.setChecked HTMLInputElement
domInputElement Bool
newChecked
Maybe Bool -> JSM (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bool -> JSM (Maybe Bool)) -> Maybe Bool -> JSM (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ if Bool
newChecked Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
oldChecked
then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
newChecked
else Maybe Bool
forall a. Maybe a
Nothing
Dynamic t Bool
c <- Bool -> Event t Bool -> HydrationDomBuilderT s t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (InputElementConfig er t s -> Bool
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Bool
_inputElementConfig_initialChecked InputElementConfig er t s
cfg) (Event t Bool -> HydrationDomBuilderT s t m (Dynamic t Bool))
-> Event t Bool -> HydrationDomBuilderT s t m (Dynamic t Bool)
forall a b. (a -> b) -> a -> b
$ [Event t Bool] -> Event t Bool
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ (Maybe Bool -> Maybe Bool) -> Event t (Maybe Bool) -> Event t Bool
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe Maybe Bool -> Maybe Bool
forall a. a -> a
id Event t (Maybe Bool)
checkedChangedBySetChecked
, Event t Bool
checkedChangedByUI
]
Dynamic t Bool
hasFocus <- Element er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (Dynamic t Bool)
forall k k (m :: * -> *) (d :: k) (t :: k) (er :: EventTag -> *).
(HasDocument m, MonadJSM m, IsNode (RawElement d), MonadHold t m,
Reflex t,
IsDocumentOrShadowRoot (RawDocument (DomBuilderSpace m))) =>
Element er d t -> m (Dynamic t Bool)
mkHasFocus Element er GhcjsDomSpace t
e
Dynamic t [File]
files <- [File]
-> Event t [File] -> HydrationDomBuilderT s t m (Dynamic t [File])
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn [File]
forall a. Monoid a => a
mempty (Event t [File] -> HydrationDomBuilderT s t m (Dynamic t [File]))
-> (EventM HTMLInputElement Event [File]
-> HydrationDomBuilderT s t m (Event t [File]))
-> EventM HTMLInputElement Event [File]
-> HydrationDomBuilderT s t m (Dynamic t [File])
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< HTMLInputElement
-> (HTMLInputElement
-> EventM HTMLInputElement Event () -> JSM (JSM ()))
-> EventM HTMLInputElement Event [File]
-> HydrationDomBuilderT s t m (Event t [File])
forall t (m :: * -> *) e event a.
(TriggerEvent t m, MonadJSM m) =>
e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event a
-> m (Event t a)
wrapDomEvent HTMLInputElement
domInputElement (HTMLInputElement
-> EventName HTMLInputElement Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName HTMLInputElement Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.change) (EventM HTMLInputElement Event [File]
-> HydrationDomBuilderT s t m (Dynamic t [File]))
-> EventM HTMLInputElement Event [File]
-> HydrationDomBuilderT s t m (Dynamic t [File])
forall a b. (a -> b) -> a -> b
$ do
Maybe FileList
mfiles <- HTMLInputElement -> ReaderT Event JSM (Maybe FileList)
forall (m :: * -> *).
MonadDOM m =>
HTMLInputElement -> m (Maybe FileList)
Input.getFiles HTMLInputElement
domInputElement
let getMyFiles :: FileList -> m [File]
getMyFiles FileList
xs = ([Maybe File] -> [File]) -> m [Maybe File] -> m [File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe File] -> [File]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe File] -> m [File])
-> (Word -> m [Maybe File]) -> Word -> m [File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> m (Maybe File)) -> [Word] -> m [Maybe File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FileList -> Word -> m (Maybe File)
forall (m :: * -> *).
MonadDOM m =>
FileList -> Word -> m (Maybe File)
FileList.item FileList
xs) ([Word] -> m [Maybe File])
-> (Word -> [Word]) -> Word -> m [Maybe File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Word] -> [Word]) -> [Word] -> Int -> [Word]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [Word] -> [Word]
forall a. Int -> [a] -> [a]
take [Word
0..] (Int -> [Word]) -> (Word -> Int) -> Word -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> m [File]) -> m Word -> m [File]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FileList -> m Word
forall (m :: * -> *). MonadDOM m => FileList -> m Word
FileList.getLength FileList
xs
EventM HTMLInputElement Event [File]
-> (FileList -> EventM HTMLInputElement Event [File])
-> Maybe FileList
-> EventM HTMLInputElement Event [File]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([File] -> EventM HTMLInputElement Event [File]
forall (m :: * -> *) a. Monad m => a -> m a
return []) FileList -> EventM HTMLInputElement Event [File]
forall (m :: * -> *). MonadJSM m => FileList -> m [File]
getMyFiles Maybe FileList
mfiles
Dynamic t Bool
checked <- Dynamic t Bool -> HydrationDomBuilderT s t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn Dynamic t Bool
c
InputElement er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
forall (m :: * -> *) a. Monad m => a -> m a
return (InputElement er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t))
-> InputElement er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
forall a b. (a -> b) -> a -> b
$ InputElement :: forall k k (er :: EventTag -> *) (d :: k) (t :: k).
Dynamic t Text
-> Dynamic t Bool
-> Event t Bool
-> Event t Text
-> Dynamic t Bool
-> Element er d t
-> RawInputElement d
-> Dynamic t [File]
-> InputElement er d t
InputElement
{ _inputElement_value :: Dynamic t Text
_inputElement_value = Dynamic t Text
v
, _inputElement_checked :: Dynamic t Bool
_inputElement_checked = Dynamic t Bool
checked
, _inputElement_checkedChange :: Event t Bool
_inputElement_checkedChange = Event t Bool
checkedChangedByUI
, _inputElement_input :: Event t Text
_inputElement_input = Event t Text
valueChangedByUI
, _inputElement_hasFocus :: Dynamic t Bool
_inputElement_hasFocus = Dynamic t Bool
hasFocus
, _inputElement_element :: Element er GhcjsDomSpace t
_inputElement_element = Element er GhcjsDomSpace t
e
, _inputElement_raw :: RawInputElement GhcjsDomSpace
_inputElement_raw = HTMLInputElement
RawInputElement GhcjsDomSpace
domInputElement
, _inputElement_files :: Dynamic t [File]
_inputElement_files = Dynamic t [File]
files
}
{-# INLINE inputElementInternal #-}
inputElementInternal
:: ( MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
, MonadRef m, Ref m ~ IORef )
=> InputElementConfig er t HydrationDomSpace -> HydrationDomBuilderT HydrationDomSpace t m (InputElement er HydrationDomSpace t)
inputElementInternal :: InputElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t)
inputElementInternal InputElementConfig er t HydrationDomSpace
cfg = HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t))
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er GhcjsDomSpace t)
-> (InputElement er GhcjsDomSpace t
-> InputElement er HydrationDomSpace t)
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (InputElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er GhcjsDomSpace t)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
MonadRef m, Ref m ~ IORef) =>
InputElementConfig er t s
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
inputElementImmediate InputElementConfig er t HydrationDomSpace
cfg) ((InputElement er GhcjsDomSpace t
-> InputElement er HydrationDomSpace t)
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t))
-> (InputElement er GhcjsDomSpace t
-> InputElement er HydrationDomSpace t)
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ \InputElement er GhcjsDomSpace t
result -> InputElement er GhcjsDomSpace t
result
{ _inputElement_element :: Element er HydrationDomSpace t
_inputElement_element = EventSelector t (WrapArg er EventName)
-> RawElement HydrationDomSpace -> Element er HydrationDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element (Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events (Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName))
-> Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName)
forall a b. (a -> b) -> a -> b
$ InputElement er GhcjsDomSpace t -> Element er GhcjsDomSpace t
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
InputElement er d t -> Element er d t
_inputElement_element InputElement er GhcjsDomSpace t
result) ()
, _inputElement_raw :: RawInputElement HydrationDomSpace
_inputElement_raw = ()
}
HydrationMode
HydrationMode_Hydrating -> do
((Element er HydrationDomSpace t
e, ()
_), IORef Element
domElementRef) <- Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, ()), IORef Element)
forall (er :: EventTag -> *) t (m :: * -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
"input" (InputElementConfig er t HydrationDomSpace
cfg InputElementConfig er t HydrationDomSpace
-> Getting
(ElementConfig er t HydrationDomSpace)
(InputElementConfig er t HydrationDomSpace)
(ElementConfig er t HydrationDomSpace)
-> ElementConfig er t HydrationDomSpace
forall s a. s -> Getting a s a -> a
^. Getting
(ElementConfig er t HydrationDomSpace)
(InputElementConfig er t HydrationDomSpace)
(ElementConfig er t HydrationDomSpace)
forall k1 k2 k3 (er :: EventTag -> *) (t :: k1) (s :: k2)
(er2 :: EventTag -> *) (s2 :: k3).
Lens
(InputElementConfig er t s)
(InputElementConfig er2 t s2)
(ElementConfig er t s)
(ElementConfig er2 t s2)
inputElementConfig_elementConfig) (HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, ()), IORef Element))
-> HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, ()), IORef Element)
forall a b. (a -> b) -> a -> b
$ () -> HydrationDomBuilderT HydrationDomSpace t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Event t Text
valueChangedByUI, Text -> IO ()
triggerChangeByUI) <- HydrationDomBuilderT
HydrationDomSpace t m (Event t Text, Text -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
(Event t Text
valueChangedBySetValue, Text -> IO ()
triggerChangeBySetValue) <- HydrationDomBuilderT
HydrationDomSpace t m (Event t Text, Text -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
(Event t Bool
focusChange, Bool -> IO ()
triggerFocusChange) <- HydrationDomBuilderT
HydrationDomSpace t m (Event t Bool, Bool -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
(Event t Bool
checkedChangedByUI, Bool -> IO ()
triggerCheckedChangedByUI) <- HydrationDomBuilderT
HydrationDomSpace t m (Event t Bool, Bool -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
(Event t Bool
checkedChangedBySetChecked, Bool -> IO ()
triggerCheckedChangedBySetChecked) <- HydrationDomBuilderT
HydrationDomSpace t m (Event t Bool, Bool -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
(Event t [File]
fileChange, [File] -> IO ()
triggerFileChange) <- HydrationDomBuilderT
HydrationDomSpace t m (Event t [File], [File] -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
Document
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
let v0 :: Text
v0 = InputElementConfig er t HydrationDomSpace -> Text
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Text
_inputElementConfig_initialValue InputElementConfig er t HydrationDomSpace
cfg
c0 :: Bool
c0 = InputElementConfig er t HydrationDomSpace -> Bool
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Bool
_inputElementConfig_initialChecked InputElementConfig er t HydrationDomSpace
cfg
valuesAtSwitchover :: m (Behavior t Text, Behavior t Bool)
valuesAtSwitchover = do
Behavior t Text
v <- m (Behavior t Text)
-> (Event t Text -> m (Behavior t Text))
-> Maybe (Event t Text)
-> m (Behavior t Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Text -> m (Behavior t Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text -> m (Behavior t Text))
-> Behavior t Text -> m (Behavior t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Behavior t Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v0) (Text -> Event t Text -> m (Behavior t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Text
v0) (InputElementConfig er t HydrationDomSpace -> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Maybe (Event t Text)
_inputElementConfig_setValue InputElementConfig er t HydrationDomSpace
cfg)
Behavior t Bool
c <- m (Behavior t Bool)
-> (Event t Bool -> m (Behavior t Bool))
-> Maybe (Event t Bool)
-> m (Behavior t Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Bool -> m (Behavior t Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Bool -> m (Behavior t Bool))
-> Behavior t Bool -> m (Behavior t Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Behavior t Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
c0) (Bool -> Event t Bool -> m (Behavior t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Bool
c0) (InputElementConfig er t HydrationDomSpace -> Maybe (Event t Bool)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Maybe (Event t Bool)
_inputElementConfig_setChecked InputElementConfig er t HydrationDomSpace
cfg)
(Behavior t Text, Behavior t Bool)
-> m (Behavior t Text, Behavior t Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text
v, Behavior t Bool
c)
m (Behavior t Text, Behavior t Bool)
-> ((Behavior t Text, Behavior t Bool) -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup m (Behavior t Text, Behavior t Bool)
valuesAtSwitchover (((Behavior t Text, Behavior t Bool) -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ())
-> ((Behavior t Text, Behavior t Bool) -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ \(Behavior t Text
switchoverValue', Behavior t Bool
switchoverChecked') -> do
Text
switchoverValue <- Behavior t Text -> HydrationRunnerT t m Text
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
switchoverValue'
Bool
switchoverChecked <- Behavior t Bool -> HydrationRunnerT t m Bool
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Bool
switchoverChecked'
Element
domElement <- IO Element -> HydrationRunnerT t m Element
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Element -> HydrationRunnerT t m Element)
-> IO Element -> HydrationRunnerT t m Element
forall a b. (a -> b) -> a -> b
$ IORef Element -> IO Element
forall a. IORef a -> IO a
readIORef IORef Element
domElementRef
let domInputElement :: HTMLInputElement
domInputElement = (JSVal -> HTMLInputElement) -> Element -> HTMLInputElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLInputElement
DOM.HTMLInputElement Element
domElement
getValue :: JSM Text
getValue = HTMLInputElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLInputElement -> m result
Input.getValue HTMLInputElement
domInputElement
Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
v0 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
switchoverValue) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeBySetValue Text
switchoverValue
JSM Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getValue HydrationRunnerT t m Text
-> (Text -> HydrationRunnerT t m ()) -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
realValue -> Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
realValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
switchoverValue) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeByUI Text
realValue
Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (JSM Text -> JSM Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getValue JSM Text -> (Text -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (Text -> IO ()) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
triggerChangeByUI) JSM () -> Event t (er 'InputTag) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'InputTag) -> Event t (er 'InputTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'InputTag -> WrapArg er EventName (er 'InputTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'InputTag
Input)
Maybe (Event t Text)
-> (Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (InputElementConfig er t HydrationDomSpace -> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Maybe (Event t Text)
_inputElementConfig_setValue InputElementConfig er t HydrationDomSpace
cfg) ((Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ())
-> (Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ \Event t Text
eSetValue ->
Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM ()) -> Event t (JSM ()))
-> (Text -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
HTMLInputElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLInputElement -> val -> m ()
Input.setValue HTMLInputElement
domInputElement Text
v'
Text
v <- JSM Text
getValue
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeBySetValue Text
v
let focusChange' :: Event t Bool
focusChange' = [Event t Bool] -> Event t Bool
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Bool
False Bool -> Event t (er 'BlurTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'BlurTag) -> Event t (er 'BlurTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'BlurTag -> WrapArg er EventName (er 'BlurTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'BlurTag
Blur)
, Bool
True Bool -> Event t (er 'FocusTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'FocusTag) -> Event t (er 'FocusTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'FocusTag -> WrapArg er EventName (er 'FocusTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'FocusTag
Focus)
]
IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> (Bool -> IO ()) -> Bool -> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerFocusChange (Bool -> HydrationRunnerT t m ())
-> HydrationRunnerT t m Bool -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Node -> Maybe Node -> HydrationRunnerT t m Bool
forall (m :: * -> *) self other.
(MonadDOM m, IsNode self, IsNode other) =>
self -> Maybe other -> m Bool
Node.isSameNode (Element -> Node
forall o. IsNode o => o -> Node
toNode Element
domElement) (Maybe Node -> HydrationRunnerT t m Bool)
-> (Maybe Element -> Maybe Node)
-> Maybe Element
-> HydrationRunnerT t m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Node) -> Maybe Element -> Maybe Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Node
forall o. IsNode o => o -> Node
toNode (Maybe Element -> HydrationRunnerT t m Bool)
-> HydrationRunnerT t m (Maybe Element)
-> HydrationRunnerT t m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Document -> HydrationRunnerT t m (Maybe Element)
forall (m :: * -> *) self.
(MonadDOM m, IsDocumentOrShadowRoot self) =>
self -> m (Maybe Element)
Document.getActiveElement Document
doc
Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (Bool -> IO ()) -> Bool -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerFocusChange (Bool -> JSM ()) -> Event t Bool -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t Bool
focusChange'
Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
c0 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
switchoverChecked) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO ()
triggerCheckedChangedBySetChecked Bool
switchoverChecked
JSM Bool -> HydrationRunnerT t m Bool
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (HTMLInputElement -> JSM Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement) HydrationRunnerT t m Bool
-> (Bool -> HydrationRunnerT t m ()) -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
realChecked -> Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
realChecked Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
switchoverChecked) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$
IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO ()
triggerCheckedChangedByUI Bool
realChecked
JSM ()
_ <- JSM (JSM ()) -> HydrationRunnerT t m (JSM ())
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM (JSM ()) -> HydrationRunnerT t m (JSM ()))
-> JSM (JSM ()) -> HydrationRunnerT t m (JSM ())
forall a b. (a -> b) -> a -> b
$ HTMLInputElement
domInputElement HTMLInputElement
-> EventName HTMLInputElement MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName HTMLInputElement MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.click (EventM HTMLInputElement MouseEvent () -> JSM (JSM ()))
-> EventM HTMLInputElement MouseEvent () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
IO () -> EventM HTMLInputElement MouseEvent ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM HTMLInputElement MouseEvent ())
-> (Bool -> IO ()) -> Bool -> EventM HTMLInputElement MouseEvent ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerCheckedChangedByUI (Bool -> EventM HTMLInputElement MouseEvent ())
-> EventM HTMLInputElement MouseEvent Bool
-> EventM HTMLInputElement MouseEvent ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HTMLInputElement -> EventM HTMLInputElement MouseEvent Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement
Maybe (Event t Bool)
-> (Event t Bool -> HydrationRunnerT t m (Event t ()))
-> HydrationRunnerT t m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (InputElementConfig er t HydrationDomSpace -> Maybe (Event t Bool)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2).
InputElementConfig er t s -> Maybe (Event t Bool)
_inputElementConfig_setChecked InputElementConfig er t HydrationDomSpace
cfg) ((Event t Bool -> HydrationRunnerT t m (Event t ()))
-> HydrationRunnerT t m ())
-> (Event t Bool -> HydrationRunnerT t m (Event t ()))
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ \Event t Bool
eNewchecked ->
Event t (JSM ()) -> HydrationRunnerT t m (Event t ())
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM ()) -> HydrationRunnerT t m (Event t ()))
-> Event t (JSM ()) -> HydrationRunnerT t m (Event t ())
forall a b. (a -> b) -> a -> b
$ Event t Bool -> (Bool -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Bool
eNewchecked ((Bool -> JSM ()) -> Event t (JSM ()))
-> (Bool -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \Bool
newChecked -> do
Bool
oldChecked <- HTMLInputElement -> JSM Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement
HTMLInputElement -> Bool -> JSM ()
forall (m :: * -> *).
MonadDOM m =>
HTMLInputElement -> Bool -> m ()
Input.setChecked HTMLInputElement
domInputElement Bool
newChecked
Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
newChecked Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
oldChecked) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO ()
triggerCheckedChangedBySetChecked Bool
newChecked
JSM ()
_ <- JSM (JSM ()) -> HydrationRunnerT t m (JSM ())
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM (JSM ()) -> HydrationRunnerT t m (JSM ()))
-> JSM (JSM ()) -> HydrationRunnerT t m (JSM ())
forall a b. (a -> b) -> a -> b
$ HTMLInputElement
domInputElement HTMLInputElement
-> EventName HTMLInputElement Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
`on` EventName HTMLInputElement Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.change (EventM HTMLInputElement Event () -> JSM (JSM ()))
-> EventM HTMLInputElement Event () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
Maybe FileList
mfiles <- HTMLInputElement -> ReaderT Event JSM (Maybe FileList)
forall (m :: * -> *).
MonadDOM m =>
HTMLInputElement -> m (Maybe FileList)
Input.getFiles HTMLInputElement
domInputElement
let getMyFiles :: FileList -> m [File]
getMyFiles FileList
xs = ([Maybe File] -> [File]) -> m [Maybe File] -> m [File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe File] -> [File]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe File] -> m [File])
-> (Word -> m [Maybe File]) -> Word -> m [File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> m (Maybe File)) -> [Word] -> m [Maybe File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FileList -> Word -> m (Maybe File)
forall (m :: * -> *).
MonadDOM m =>
FileList -> Word -> m (Maybe File)
FileList.item FileList
xs) ([Word] -> m [Maybe File])
-> (Word -> [Word]) -> Word -> m [Maybe File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Word] -> [Word]) -> [Word] -> Int -> [Word]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [Word] -> [Word]
forall a. Int -> [a] -> [a]
take [Word
0..] (Int -> [Word]) -> (Word -> Int) -> Word -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> m [File]) -> m Word -> m [File]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FileList -> m Word
forall (m :: * -> *). MonadDOM m => FileList -> m Word
FileList.getLength FileList
xs
IO () -> EventM HTMLInputElement Event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM HTMLInputElement Event ())
-> ([File] -> IO ()) -> [File] -> EventM HTMLInputElement Event ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [File] -> IO ()
triggerFileChange ([File] -> EventM HTMLInputElement Event ())
-> EventM HTMLInputElement Event [File]
-> EventM HTMLInputElement Event ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EventM HTMLInputElement Event [File]
-> (FileList -> EventM HTMLInputElement Event [File])
-> Maybe FileList
-> EventM HTMLInputElement Event [File]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([File] -> EventM HTMLInputElement Event [File]
forall (m :: * -> *) a. Monad m => a -> m a
return []) FileList -> EventM HTMLInputElement Event [File]
forall (m :: * -> *). MonadJSM m => FileList -> m [File]
getMyFiles Maybe FileList
mfiles
() -> HydrationRunnerT t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Dynamic t Bool
checked' <- Bool
-> Event t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
c0 (Event t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool))
-> Event t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall a b. (a -> b) -> a -> b
$ [Event t Bool] -> Event t Bool
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Event t Bool
checkedChangedBySetChecked
, Event t Bool
checkedChangedByUI
]
Dynamic t Bool
checked <- Dynamic t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn Dynamic t Bool
checked'
let initialFocus :: Bool
initialFocus = Bool
False
Dynamic t Bool
hasFocus <- Dynamic t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn (Dynamic t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool))
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool
-> Event t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
initialFocus Event t Bool
focusChange
Dynamic t Text
v <- Text
-> Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
v0 (Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text))
-> Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ [Event t Text] -> Event t Text
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Event t Text
valueChangedBySetValue
, Event t Text
valueChangedByUI
]
Dynamic t [File]
files <- [File]
-> Event t [File]
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t [File])
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn [File]
forall a. Monoid a => a
mempty Event t [File]
fileChange
InputElement er HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall (m :: * -> *) a. Monad m => a -> m a
return (InputElement er HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t))
-> InputElement er HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ InputElement :: forall k k (er :: EventTag -> *) (d :: k) (t :: k).
Dynamic t Text
-> Dynamic t Bool
-> Event t Bool
-> Event t Text
-> Dynamic t Bool
-> Element er d t
-> RawInputElement d
-> Dynamic t [File]
-> InputElement er d t
InputElement
{ _inputElement_value :: Dynamic t Text
_inputElement_value = Dynamic t Text
v
, _inputElement_checked :: Dynamic t Bool
_inputElement_checked = Dynamic t Bool
checked
, _inputElement_checkedChange :: Event t Bool
_inputElement_checkedChange = Event t Bool
checkedChangedByUI
, _inputElement_input :: Event t Text
_inputElement_input = Event t Text
valueChangedByUI
, _inputElement_hasFocus :: Dynamic t Bool
_inputElement_hasFocus = Dynamic t Bool
hasFocus
, _inputElement_element :: Element er HydrationDomSpace t
_inputElement_element = Element er HydrationDomSpace t
e
, _inputElement_raw :: RawInputElement HydrationDomSpace
_inputElement_raw = ()
, _inputElement_files :: Dynamic t [File]
_inputElement_files = Dynamic t [File]
files
}
{-# INLINE textAreaElementImmediate #-}
textAreaElementImmediate
:: ( RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, EventSpec s ~ GhcjsEventSpec
, MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
, MonadRef m, Ref m ~ IORef )
=> TextAreaElementConfig er t s -> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
textAreaElementImmediate :: TextAreaElementConfig er t s
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
textAreaElementImmediate TextAreaElementConfig er t s
cfg = do
(e :: Element er GhcjsDomSpace t
e@(Element EventSelector t (WrapArg er EventName)
eventSelector RawElement GhcjsDomSpace
domElement), ()
_) <- Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ())
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
"textarea" (TextAreaElementConfig er t s
cfg TextAreaElementConfig er t s
-> Getting
(ElementConfig er t s)
(TextAreaElementConfig er t s)
(ElementConfig er t s)
-> ElementConfig er t s
forall s a. s -> Getting a s a -> a
^. Getting
(ElementConfig er t s)
(TextAreaElementConfig er t s)
(ElementConfig er t s)
forall k1 k2 k3 (er :: EventTag -> *) (t :: k1) (m :: k2)
(er2 :: EventTag -> *) (m2 :: k3).
Lens
(TextAreaElementConfig er t m)
(TextAreaElementConfig er2 t m2)
(ElementConfig er t m)
(ElementConfig er2 t m2)
textAreaElementConfig_elementConfig) (HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ()))
-> HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ())
forall a b. (a -> b) -> a -> b
$ () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
let domTextAreaElement :: HTMLTextAreaElement
domTextAreaElement = (JSVal -> HTMLTextAreaElement) -> Element -> HTMLTextAreaElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLTextAreaElement
DOM.HTMLTextAreaElement Element
RawElement GhcjsDomSpace
domElement
HTMLTextAreaElement -> Text -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLTextAreaElement -> val -> m ()
TextArea.setValue HTMLTextAreaElement
domTextAreaElement (Text -> HydrationDomBuilderT s t m ())
-> Text -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ TextAreaElementConfig er t s
cfg TextAreaElementConfig er t s
-> Getting Text (TextAreaElementConfig er t s) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (TextAreaElementConfig er t s) Text
forall k1 k2 (er :: EventTag -> *) (t :: k1) (m :: k2).
Lens' (TextAreaElementConfig er t m) Text
textAreaElementConfig_initialValue
Text
v0 <- HTMLTextAreaElement -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLTextAreaElement -> m result
TextArea.getValue HTMLTextAreaElement
domTextAreaElement
let getMyValue :: JSM Text
getMyValue = HTMLTextAreaElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLTextAreaElement -> m result
TextArea.getValue HTMLTextAreaElement
domTextAreaElement
Event t Text
valueChangedByUI <- Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ JSM Text -> JSM Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getMyValue JSM Text -> Event t (er 'InputTag) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'InputTag) -> Event t (er 'InputTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select EventSelector t (WrapArg er EventName)
eventSelector (EventName 'InputTag -> WrapArg er EventName (er 'InputTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'InputTag
Input)
Event t Text
valueChangedBySetValue <- case TextAreaElementConfig er t s -> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
TextAreaElementConfig er t m -> Maybe (Event t Text)
_textAreaElementConfig_setValue TextAreaElementConfig er t s
cfg of
Maybe (Event t Text)
Nothing -> Event t Text -> HydrationDomBuilderT s t m (Event t Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Event t Text
forall k (t :: k) a. Reflex t => Event t a
never
Just Event t Text
eSetValue -> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM Text) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM Text) -> Event t (JSM Text))
-> (Text -> JSM Text) -> Event t (JSM Text)
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
HTMLTextAreaElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLTextAreaElement -> val -> m ()
TextArea.setValue HTMLTextAreaElement
domTextAreaElement Text
v'
JSM Text
getMyValue
Dynamic t Text
v <- Text -> Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
v0 (Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text))
-> Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ [Event t Text] -> Event t Text
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Event t Text
valueChangedBySetValue
, Event t Text
valueChangedByUI
]
Dynamic t Bool
hasFocus <- Element er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (Dynamic t Bool)
forall k k (m :: * -> *) (d :: k) (t :: k) (er :: EventTag -> *).
(HasDocument m, MonadJSM m, IsNode (RawElement d), MonadHold t m,
Reflex t,
IsDocumentOrShadowRoot (RawDocument (DomBuilderSpace m))) =>
Element er d t -> m (Dynamic t Bool)
mkHasFocus Element er GhcjsDomSpace t
e
TextAreaElement er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
forall (m :: * -> *) a. Monad m => a -> m a
return (TextAreaElement er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t))
-> TextAreaElement er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
forall a b. (a -> b) -> a -> b
$ TextAreaElement :: forall k k (er :: EventTag -> *) (d :: k) (t :: k).
Dynamic t Text
-> Event t Text
-> Dynamic t Bool
-> Element er d t
-> RawTextAreaElement d
-> TextAreaElement er d t
TextAreaElement
{ _textAreaElement_value :: Dynamic t Text
_textAreaElement_value = Dynamic t Text
v
, _textAreaElement_input :: Event t Text
_textAreaElement_input = Event t Text
valueChangedByUI
, _textAreaElement_hasFocus :: Dynamic t Bool
_textAreaElement_hasFocus = Dynamic t Bool
hasFocus
, _textAreaElement_element :: Element er GhcjsDomSpace t
_textAreaElement_element = Element er GhcjsDomSpace t
e
, _textAreaElement_raw :: RawTextAreaElement GhcjsDomSpace
_textAreaElement_raw = HTMLTextAreaElement
RawTextAreaElement GhcjsDomSpace
domTextAreaElement
}
{-# INLINE textAreaElementInternal #-}
textAreaElementInternal
:: ( MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
, MonadRef m, Ref m ~ IORef )
=> TextAreaElementConfig er t HydrationDomSpace -> HydrationDomBuilderT HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
textAreaElementInternal :: TextAreaElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
textAreaElementInternal TextAreaElementConfig er t HydrationDomSpace
cfg = HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t))
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er GhcjsDomSpace t)
-> (TextAreaElement er GhcjsDomSpace t
-> TextAreaElement er HydrationDomSpace t)
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (TextAreaElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er GhcjsDomSpace t)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
MonadRef m, Ref m ~ IORef) =>
TextAreaElementConfig er t s
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
textAreaElementImmediate TextAreaElementConfig er t HydrationDomSpace
cfg) ((TextAreaElement er GhcjsDomSpace t
-> TextAreaElement er HydrationDomSpace t)
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t))
-> (TextAreaElement er GhcjsDomSpace t
-> TextAreaElement er HydrationDomSpace t)
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ \TextAreaElement er GhcjsDomSpace t
result -> TextAreaElement er GhcjsDomSpace t
result
{ _textAreaElement_element :: Element er HydrationDomSpace t
_textAreaElement_element = EventSelector t (WrapArg er EventName)
-> RawElement HydrationDomSpace -> Element er HydrationDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element (Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events (Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName))
-> Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName)
forall a b. (a -> b) -> a -> b
$ TextAreaElement er GhcjsDomSpace t -> Element er GhcjsDomSpace t
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
TextAreaElement er d t -> Element er d t
_textAreaElement_element TextAreaElement er GhcjsDomSpace t
result) ()
, _textAreaElement_raw :: RawTextAreaElement HydrationDomSpace
_textAreaElement_raw = ()
}
HydrationMode
HydrationMode_Hydrating -> do
((Element er HydrationDomSpace t
e, ()
_), IORef Element
domElementRef) <- Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, ()), IORef Element)
forall (er :: EventTag -> *) t (m :: * -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
"textarea" (TextAreaElementConfig er t HydrationDomSpace
cfg TextAreaElementConfig er t HydrationDomSpace
-> Getting
(ElementConfig er t HydrationDomSpace)
(TextAreaElementConfig er t HydrationDomSpace)
(ElementConfig er t HydrationDomSpace)
-> ElementConfig er t HydrationDomSpace
forall s a. s -> Getting a s a -> a
^. Getting
(ElementConfig er t HydrationDomSpace)
(TextAreaElementConfig er t HydrationDomSpace)
(ElementConfig er t HydrationDomSpace)
forall k1 k2 k3 (er :: EventTag -> *) (t :: k1) (m :: k2)
(er2 :: EventTag -> *) (m2 :: k3).
Lens
(TextAreaElementConfig er t m)
(TextAreaElementConfig er2 t m2)
(ElementConfig er t m)
(ElementConfig er2 t m2)
textAreaElementConfig_elementConfig) (HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, ()), IORef Element))
-> HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, ()), IORef Element)
forall a b. (a -> b) -> a -> b
$ () -> HydrationDomBuilderT HydrationDomSpace t m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Event t Text
valueChangedByUI, Text -> IO ()
triggerChangeByUI) <- HydrationDomBuilderT
HydrationDomSpace t m (Event t Text, Text -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
(Event t Text
valueChangedBySetValue, Text -> IO ()
triggerChangeBySetValue) <- HydrationDomBuilderT
HydrationDomSpace t m (Event t Text, Text -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
(Event t Bool
focusChange, Bool -> IO ()
triggerFocusChange) <- HydrationDomBuilderT
HydrationDomSpace t m (Event t Bool, Bool -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
Document
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
let v0 :: Text
v0 = TextAreaElementConfig er t HydrationDomSpace -> Text
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
TextAreaElementConfig er t m -> Text
_textAreaElementConfig_initialValue TextAreaElementConfig er t HydrationDomSpace
cfg
valueAtSwitchover :: m (Behavior t Text)
valueAtSwitchover = m (Behavior t Text)
-> (Event t Text -> m (Behavior t Text))
-> Maybe (Event t Text)
-> m (Behavior t Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Text -> m (Behavior t Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text -> m (Behavior t Text))
-> Behavior t Text -> m (Behavior t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Behavior t Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v0) (Text -> Event t Text -> m (Behavior t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Text
v0) (TextAreaElementConfig er t HydrationDomSpace
-> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
TextAreaElementConfig er t m -> Maybe (Event t Text)
_textAreaElementConfig_setValue TextAreaElementConfig er t HydrationDomSpace
cfg)
m (Behavior t Text)
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup m (Behavior t Text)
valueAtSwitchover ((Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ())
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ \Behavior t Text
switchoverValue' -> do
Text
switchoverValue <- Behavior t Text -> HydrationRunnerT t m Text
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
switchoverValue'
Element
domElement <- IO Element -> HydrationRunnerT t m Element
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Element -> HydrationRunnerT t m Element)
-> IO Element -> HydrationRunnerT t m Element
forall a b. (a -> b) -> a -> b
$ IORef Element -> IO Element
forall a. IORef a -> IO a
readIORef IORef Element
domElementRef
let domTextAreaElement :: HTMLTextAreaElement
domTextAreaElement = (JSVal -> HTMLTextAreaElement) -> Element -> HTMLTextAreaElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLTextAreaElement
DOM.HTMLTextAreaElement Element
domElement
getValue :: JSM Text
getValue = HTMLTextAreaElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLTextAreaElement -> m result
TextArea.getValue HTMLTextAreaElement
domTextAreaElement
Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
v0 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
switchoverValue) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeBySetValue Text
switchoverValue
JSM Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getValue HydrationRunnerT t m Text
-> (Text -> HydrationRunnerT t m ()) -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
realValue -> Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
realValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
switchoverValue) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeByUI Text
realValue
Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (JSM Text -> JSM Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getValue JSM Text -> (Text -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (Text -> IO ()) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
triggerChangeByUI) JSM () -> Event t (er 'InputTag) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'InputTag) -> Event t (er 'InputTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'InputTag -> WrapArg er EventName (er 'InputTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'InputTag
Input)
Maybe (Event t Text)
-> (Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (TextAreaElementConfig er t HydrationDomSpace
-> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
TextAreaElementConfig er t m -> Maybe (Event t Text)
_textAreaElementConfig_setValue TextAreaElementConfig er t HydrationDomSpace
cfg) ((Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ())
-> (Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ \Event t Text
eSetValue ->
Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM ()) -> Event t (JSM ()))
-> (Text -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
HTMLTextAreaElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLTextAreaElement -> val -> m ()
TextArea.setValue HTMLTextAreaElement
domTextAreaElement Text
v'
Text
v <- JSM Text
getValue
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeBySetValue Text
v
let focusChange' :: Event t Bool
focusChange' = [Event t Bool] -> Event t Bool
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Bool
False Bool -> Event t (er 'BlurTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'BlurTag) -> Event t (er 'BlurTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'BlurTag -> WrapArg er EventName (er 'BlurTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'BlurTag
Blur)
, Bool
True Bool -> Event t (er 'FocusTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'FocusTag) -> Event t (er 'FocusTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'FocusTag -> WrapArg er EventName (er 'FocusTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'FocusTag
Focus)
]
IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> (Bool -> IO ()) -> Bool -> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerFocusChange (Bool -> HydrationRunnerT t m ())
-> HydrationRunnerT t m Bool -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Node -> Maybe Node -> HydrationRunnerT t m Bool
forall (m :: * -> *) self other.
(MonadDOM m, IsNode self, IsNode other) =>
self -> Maybe other -> m Bool
Node.isSameNode (Element -> Node
forall o. IsNode o => o -> Node
toNode Element
domElement) (Maybe Node -> HydrationRunnerT t m Bool)
-> (Maybe Element -> Maybe Node)
-> Maybe Element
-> HydrationRunnerT t m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Node) -> Maybe Element -> Maybe Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Node
forall o. IsNode o => o -> Node
toNode (Maybe Element -> HydrationRunnerT t m Bool)
-> HydrationRunnerT t m (Maybe Element)
-> HydrationRunnerT t m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Document -> HydrationRunnerT t m (Maybe Element)
forall (m :: * -> *) self.
(MonadDOM m, IsDocumentOrShadowRoot self) =>
self -> m (Maybe Element)
Document.getActiveElement Document
doc
Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (Bool -> IO ()) -> Bool -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerFocusChange (Bool -> JSM ()) -> Event t Bool -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t Bool
focusChange'
let initialFocus :: Bool
initialFocus = Bool
False
Dynamic t Bool
hasFocus <- Dynamic t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn (Dynamic t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool))
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool
-> Event t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
initialFocus Event t Bool
focusChange
Dynamic t Text
v <- Text
-> Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
v0 (Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text))
-> Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ [Event t Text] -> Event t Text
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Event t Text
valueChangedBySetValue
, Event t Text
valueChangedByUI
]
TextAreaElement er HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall (m :: * -> *) a. Monad m => a -> m a
return (TextAreaElement er HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t))
-> TextAreaElement er HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ TextAreaElement :: forall k k (er :: EventTag -> *) (d :: k) (t :: k).
Dynamic t Text
-> Event t Text
-> Dynamic t Bool
-> Element er d t
-> RawTextAreaElement d
-> TextAreaElement er d t
TextAreaElement
{ _textAreaElement_value :: Dynamic t Text
_textAreaElement_value = Dynamic t Text
v
, _textAreaElement_input :: Event t Text
_textAreaElement_input = Event t Text
valueChangedByUI
, _textAreaElement_hasFocus :: Dynamic t Bool
_textAreaElement_hasFocus = Dynamic t Bool
hasFocus
, _textAreaElement_element :: Element er HydrationDomSpace t
_textAreaElement_element = Element er HydrationDomSpace t
e
, _textAreaElement_raw :: RawTextAreaElement HydrationDomSpace
_textAreaElement_raw = ()
}
{-# INLINE selectElementImmediate #-}
selectElementImmediate
:: ( EventSpec s ~ GhcjsEventSpec, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document
, MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m )
=> SelectElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
selectElementImmediate :: SelectElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
selectElementImmediate SelectElementConfig er t s
cfg HydrationDomBuilderT s t m a
child = do
(e :: Element er GhcjsDomSpace t
e@(Element EventSelector t (WrapArg er EventName)
eventSelector RawElement GhcjsDomSpace
domElement), a
result) <- Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
"select" (SelectElementConfig er t s
cfg SelectElementConfig er t s
-> Getting
(ElementConfig er t s)
(SelectElementConfig er t s)
(ElementConfig er t s)
-> ElementConfig er t s
forall s a. s -> Getting a s a -> a
^. Getting
(ElementConfig er t s)
(SelectElementConfig er t s)
(ElementConfig er t s)
forall k1 k2 k3 (er :: EventTag -> *) (t :: k1) (m :: k2)
(er2 :: EventTag -> *) (m2 :: k3).
Lens
(SelectElementConfig er t m)
(SelectElementConfig er2 t m2)
(ElementConfig er t m)
(ElementConfig er2 t m2)
selectElementConfig_elementConfig) HydrationDomBuilderT s t m a
child
let domSelectElement :: HTMLSelectElement
domSelectElement = (JSVal -> HTMLSelectElement) -> Element -> HTMLSelectElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLSelectElement
DOM.HTMLSelectElement Element
RawElement GhcjsDomSpace
domElement
HTMLSelectElement -> Text -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLSelectElement -> val -> m ()
Select.setValue HTMLSelectElement
domSelectElement (Text -> HydrationDomBuilderT s t m ())
-> Text -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ SelectElementConfig er t s
cfg SelectElementConfig er t s
-> Getting Text (SelectElementConfig er t s) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (SelectElementConfig er t s) Text
forall k1 k2 (er :: EventTag -> *) (t :: k1) (m :: k2).
Lens' (SelectElementConfig er t m) Text
selectElementConfig_initialValue
Text
v0 <- HTMLSelectElement -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLSelectElement -> m result
Select.getValue HTMLSelectElement
domSelectElement
let getMyValue :: JSM Text
getMyValue = HTMLSelectElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLSelectElement -> m result
Select.getValue HTMLSelectElement
domSelectElement
Event t Text
valueChangedByUI <- Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ JSM Text -> JSM Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getMyValue JSM Text -> Event t (er 'ChangeTag) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'ChangeTag) -> Event t (er 'ChangeTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select EventSelector t (WrapArg er EventName)
eventSelector (EventName 'ChangeTag -> WrapArg er EventName (er 'ChangeTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'ChangeTag
Change)
Event t Text
valueChangedBySetValue <- case SelectElementConfig er t s -> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
SelectElementConfig er t m -> Maybe (Event t Text)
_selectElementConfig_setValue SelectElementConfig er t s
cfg of
Maybe (Event t Text)
Nothing -> Event t Text -> HydrationDomBuilderT s t m (Event t Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Event t Text
forall k (t :: k) a. Reflex t => Event t a
never
Just Event t Text
eSetValue -> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM Text) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM Text) -> Event t (JSM Text))
-> (Text -> JSM Text) -> Event t (JSM Text)
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
HTMLSelectElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLSelectElement -> val -> m ()
Select.setValue HTMLSelectElement
domSelectElement Text
v'
JSM Text
getMyValue
Dynamic t Text
v <- Text -> Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
v0 (Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text))
-> Event t Text -> HydrationDomBuilderT s t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ [Event t Text] -> Event t Text
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Event t Text
valueChangedBySetValue
, Event t Text
valueChangedByUI
]
Dynamic t Bool
hasFocus <- Element er GhcjsDomSpace t
-> HydrationDomBuilderT s t m (Dynamic t Bool)
forall k k (m :: * -> *) (d :: k) (t :: k) (er :: EventTag -> *).
(HasDocument m, MonadJSM m, IsNode (RawElement d), MonadHold t m,
Reflex t,
IsDocumentOrShadowRoot (RawDocument (DomBuilderSpace m))) =>
Element er d t -> m (Dynamic t Bool)
mkHasFocus Element er GhcjsDomSpace t
e
let wrapped :: SelectElement er GhcjsDomSpace t
wrapped = SelectElement :: forall k k (er :: EventTag -> *) (d :: k) (t :: k).
Element er d t
-> Dynamic t Text
-> Event t Text
-> Dynamic t Bool
-> RawSelectElement d
-> SelectElement er d t
SelectElement
{ _selectElement_value :: Dynamic t Text
_selectElement_value = Dynamic t Text
v
, _selectElement_change :: Event t Text
_selectElement_change = Event t Text
valueChangedByUI
, _selectElement_hasFocus :: Dynamic t Bool
_selectElement_hasFocus = Dynamic t Bool
hasFocus
, _selectElement_element :: Element er GhcjsDomSpace t
_selectElement_element = Element er GhcjsDomSpace t
e
, _selectElement_raw :: RawSelectElement GhcjsDomSpace
_selectElement_raw = HTMLSelectElement
RawSelectElement GhcjsDomSpace
domSelectElement
}
(SelectElement er GhcjsDomSpace t, a)
-> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SelectElement er GhcjsDomSpace t
wrapped, a
result)
{-# INLINE selectElementInternal #-}
selectElementInternal
:: ( MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
, MonadRef m, Ref m ~ IORef )
=> SelectElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
selectElementInternal :: SelectElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
selectElementInternal SelectElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child = HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a))
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er GhcjsDomSpace t, a)
-> ((SelectElement er GhcjsDomSpace t, a)
-> (SelectElement er HydrationDomSpace t, a))
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (SelectElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er GhcjsDomSpace t, a)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(EventSpec s ~ GhcjsEventSpec,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m) =>
SelectElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
selectElementImmediate SelectElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child) (((SelectElement er GhcjsDomSpace t, a)
-> (SelectElement er HydrationDomSpace t, a))
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a))
-> ((SelectElement er GhcjsDomSpace t, a)
-> (SelectElement er HydrationDomSpace t, a))
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall a b. (a -> b) -> a -> b
$ \(SelectElement er GhcjsDomSpace t
e, a
result) -> (SelectElement er GhcjsDomSpace t
e
{ _selectElement_element :: Element er HydrationDomSpace t
_selectElement_element = EventSelector t (WrapArg er EventName)
-> RawElement HydrationDomSpace -> Element er HydrationDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element (Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events (Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName))
-> Element er GhcjsDomSpace t
-> EventSelector t (WrapArg er EventName)
forall a b. (a -> b) -> a -> b
$ SelectElement er GhcjsDomSpace t -> Element er GhcjsDomSpace t
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
SelectElement er d t -> Element er d t
_selectElement_element SelectElement er GhcjsDomSpace t
e) ()
, _selectElement_raw :: RawSelectElement HydrationDomSpace
_selectElement_raw = ()
}, a
result)
HydrationMode
HydrationMode_Hydrating -> do
((Element er HydrationDomSpace t
e, a
result), IORef Element
domElementRef) <- Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
forall (er :: EventTag -> *) t (m :: * -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
"select" (SelectElementConfig er t HydrationDomSpace
cfg SelectElementConfig er t HydrationDomSpace
-> Getting
(ElementConfig er t HydrationDomSpace)
(SelectElementConfig er t HydrationDomSpace)
(ElementConfig er t HydrationDomSpace)
-> ElementConfig er t HydrationDomSpace
forall s a. s -> Getting a s a -> a
^. Getting
(ElementConfig er t HydrationDomSpace)
(SelectElementConfig er t HydrationDomSpace)
(ElementConfig er t HydrationDomSpace)
forall k1 k2 k3 (er :: EventTag -> *) (t :: k1) (m :: k2)
(er2 :: EventTag -> *) (m2 :: k3).
Lens
(SelectElementConfig er t m)
(SelectElementConfig er2 t m2)
(ElementConfig er t m)
(ElementConfig er2 t m2)
selectElementConfig_elementConfig) HydrationDomBuilderT HydrationDomSpace t m a
child
(Event t Text
valueChangedByUI, Text -> IO ()
triggerChangeByUI) <- HydrationDomBuilderT
HydrationDomSpace t m (Event t Text, Text -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
(Event t Text
valueChangedBySetValue, Text -> IO ()
triggerChangeBySetValue) <- HydrationDomBuilderT
HydrationDomSpace t m (Event t Text, Text -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
(Event t Bool
focusChange, Bool -> IO ()
triggerFocusChange) <- HydrationDomBuilderT
HydrationDomSpace t m (Event t Bool, Bool -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
Document
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
let v0 :: Text
v0 = SelectElementConfig er t HydrationDomSpace -> Text
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
SelectElementConfig er t m -> Text
_selectElementConfig_initialValue SelectElementConfig er t HydrationDomSpace
cfg
HydrationRunnerT t m ()
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall k (m :: * -> *) t (s :: k).
MonadIO m =>
HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
addHydrationStep (HydrationRunnerT t m ()
-> HydrationDomBuilderT HydrationDomSpace t m ())
-> HydrationRunnerT t m ()
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ do
Element
domElement <- IO Element -> HydrationRunnerT t m Element
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Element -> HydrationRunnerT t m Element)
-> IO Element -> HydrationRunnerT t m Element
forall a b. (a -> b) -> a -> b
$ IORef Element -> IO Element
forall a. IORef a -> IO a
readIORef IORef Element
domElementRef
let domSelectElement :: HTMLSelectElement
domSelectElement = (JSVal -> HTMLSelectElement) -> Element -> HTMLSelectElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLSelectElement
DOM.HTMLSelectElement Element
domElement
getValue :: JSM Text
getValue = HTMLSelectElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLSelectElement -> m result
Select.getValue HTMLSelectElement
domSelectElement
JSM Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getValue HydrationRunnerT t m Text
-> (Text -> HydrationRunnerT t m ()) -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
v0' -> do
Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
v0' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
v0) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeByUI Text
v0'
Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (JSM Text -> JSM Text
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM JSM Text
getValue JSM Text -> (Text -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (Text -> IO ()) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
triggerChangeByUI) JSM () -> Event t (er 'ChangeTag) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'ChangeTag) -> Event t (er 'ChangeTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'ChangeTag -> WrapArg er EventName (er 'ChangeTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'ChangeTag
Change)
Maybe (Event t Text)
-> (Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (SelectElementConfig er t HydrationDomSpace -> Maybe (Event t Text)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2).
SelectElementConfig er t m -> Maybe (Event t Text)
_selectElementConfig_setValue SelectElementConfig er t HydrationDomSpace
cfg) ((Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ())
-> (Event t Text -> HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ \Event t Text
eSetValue ->
Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM ()) -> Event t (JSM ()))
-> (Text -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
HTMLSelectElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLSelectElement -> val -> m ()
Select.setValue HTMLSelectElement
domSelectElement Text
v'
Text
v <- JSM Text
getValue
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeBySetValue Text
v
let focusChange' :: Event t Bool
focusChange' = [Event t Bool] -> Event t Bool
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Bool
False Bool -> Event t (er 'BlurTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'BlurTag) -> Event t (er 'BlurTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'BlurTag -> WrapArg er EventName (er 'BlurTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'BlurTag
Blur)
, Bool
True Bool -> Event t (er 'FocusTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'FocusTag) -> Event t (er 'FocusTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'FocusTag -> WrapArg er EventName (er 'FocusTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'FocusTag
Focus)
]
IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> (Bool -> IO ()) -> Bool -> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerFocusChange (Bool -> HydrationRunnerT t m ())
-> HydrationRunnerT t m Bool -> HydrationRunnerT t m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Node -> Maybe Node -> HydrationRunnerT t m Bool
forall (m :: * -> *) self other.
(MonadDOM m, IsNode self, IsNode other) =>
self -> Maybe other -> m Bool
Node.isSameNode (Element -> Node
forall o. IsNode o => o -> Node
toNode Element
domElement) (Maybe Node -> HydrationRunnerT t m Bool)
-> (Maybe Element -> Maybe Node)
-> Maybe Element
-> HydrationRunnerT t m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Node) -> Maybe Element -> Maybe Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Node
forall o. IsNode o => o -> Node
toNode (Maybe Element -> HydrationRunnerT t m Bool)
-> HydrationRunnerT t m (Maybe Element)
-> HydrationRunnerT t m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Document -> HydrationRunnerT t m (Maybe Element)
forall (m :: * -> *) self.
(MonadDOM m, IsDocumentOrShadowRoot self) =>
self -> m (Maybe Element)
Document.getActiveElement Document
doc
Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> (Bool -> IO ()) -> Bool -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> IO ()
triggerFocusChange (Bool -> JSM ()) -> Event t Bool -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t Bool
focusChange'
let initialFocus :: Bool
initialFocus = Bool
False
Dynamic t Bool
hasFocus <- Dynamic t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn (Dynamic t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool))
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool
-> Event t Bool
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
initialFocus Event t Bool
focusChange
Dynamic t Text
v <- Text
-> Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Text
v0 (Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text))
-> Event t Text
-> HydrationDomBuilderT HydrationDomSpace t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ [Event t Text] -> Event t Text
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Event t Text
valueChangedBySetValue
, Event t Text
valueChangedByUI
]
(SelectElement er HydrationDomSpace t, a)
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SelectElement er HydrationDomSpace t, a)
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a))
-> (SelectElement er HydrationDomSpace t, a)
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall a b. (a -> b) -> a -> b
$ (,a
result) (SelectElement er HydrationDomSpace t
-> (SelectElement er HydrationDomSpace t, a))
-> SelectElement er HydrationDomSpace t
-> (SelectElement er HydrationDomSpace t, a)
forall a b. (a -> b) -> a -> b
$ SelectElement :: forall k k (er :: EventTag -> *) (d :: k) (t :: k).
Element er d t
-> Dynamic t Text
-> Event t Text
-> Dynamic t Bool
-> RawSelectElement d
-> SelectElement er d t
SelectElement
{ _selectElement_value :: Dynamic t Text
_selectElement_value = Dynamic t Text
v
, _selectElement_change :: Event t Text
_selectElement_change = Event t Text
valueChangedByUI
, _selectElement_hasFocus :: Dynamic t Bool
_selectElement_hasFocus = Dynamic t Bool
hasFocus
, _selectElement_element :: Element er HydrationDomSpace t
_selectElement_element = Element er HydrationDomSpace t
e
, _selectElement_raw :: RawSelectElement HydrationDomSpace
_selectElement_raw = ()
}
{-# INLINE textNodeImmediate #-}
textNodeImmediate
:: (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, MonadJSM m, Reflex t, MonadFix m)
=> TextNodeConfig t -> HydrationDomBuilderT s t m DOM.Text
textNodeImmediate :: TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate (TextNodeConfig !Text
t Maybe (Event t Text)
mSetContents) = do
Node
p <- HydrationDomBuilderT s t m Node
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
Text
n <- Document -> Text -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc Text
t
Node -> Text -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
appendChild_ Node
p Text
n
(Event t Text -> HydrationDomBuilderT s t m ())
-> Maybe (Event t Text) -> HydrationDomBuilderT s t m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ())
-> (Event t Text -> Event t (JSM ()))
-> Event t Text
-> HydrationDomBuilderT s t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> JSM ()) -> Event t Text -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Maybe Text -> JSM ()
forall (m :: * -> *) self val.
(MonadDOM m, IsNode self, ToJSString val) =>
self -> Maybe val -> m ()
setNodeValue Text
n (Maybe Text -> JSM ()) -> (Text -> Maybe Text) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just)) Maybe (Event t Text)
mSetContents
Text -> HydrationDomBuilderT s t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
n
{-# SPECIALIZE textNodeImmediate
:: TextNodeConfig DomTimeline
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM DOM.Text
#-}
{-# SPECIALIZE textNodeImmediate
:: TextNodeConfig DomTimeline
-> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM DOM.Text
#-}
{-# INLINE textNodeInternal #-}
textNodeInternal
:: (Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m, Reflex t)
=> TextNodeConfig t -> HydrationDomBuilderT HydrationDomSpace t m (TextNode HydrationDomSpace t)
textNodeInternal :: TextNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace t m (TextNode HydrationDomSpace t)
textNodeInternal tc :: TextNodeConfig t
tc@(TextNodeConfig !Text
t Maybe (Event t Text)
mSetContents) = do
Document
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode -> HydrationDomBuilderT HydrationDomSpace t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT HydrationDomSpace t m Text
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (HydrationDomBuilderT HydrationDomSpace t m Text
-> HydrationDomBuilderT HydrationDomSpace t m ())
-> HydrationDomBuilderT HydrationDomSpace t m Text
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ TextNodeConfig t -> HydrationDomBuilderT HydrationDomSpace t m Text
forall k (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate TextNodeConfig t
tc
HydrationMode
HydrationMode_Hydrating -> m (Behavior t Text)
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (m (Behavior t Text)
-> (Event t Text -> m (Behavior t Text))
-> Maybe (Event t Text)
-> m (Behavior t Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Text -> m (Behavior t Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text -> m (Behavior t Text))
-> Behavior t Text -> m (Behavior t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Behavior t Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t) (Text -> Event t Text -> m (Behavior t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Text
t) Maybe (Event t Text)
mSetContents) ((Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ())
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ \Behavior t Text
currentText -> do
Text
n <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) t.
MonadJSM m =>
Document -> Text -> HydrationRunnerT t m Text
hydrateTextNode Document
doc (Text -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Behavior t Text -> HydrationRunnerT t m Text
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
currentText
(Event t Text -> HydrationRunnerT t m ())
-> Maybe (Event t Text) -> HydrationRunnerT t m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> (Event t Text -> Event t (JSM ()))
-> Event t Text
-> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> JSM ()) -> Event t Text -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Maybe Text -> JSM ()
forall (m :: * -> *) self val.
(MonadDOM m, IsNode self, ToJSString val) =>
self -> Maybe val -> m ()
setNodeValue Text
n (Maybe Text -> JSM ()) -> (Text -> Maybe Text) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just)) Maybe (Event t Text)
mSetContents
TextNode HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (TextNode HydrationDomSpace t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextNode HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (TextNode HydrationDomSpace t))
-> TextNode HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (TextNode HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ RawTextNode HydrationDomSpace -> TextNode HydrationDomSpace t
forall k k (d :: k) (t :: k). RawTextNode d -> TextNode d t
TextNode ()
{-# SPECIALIZE textNodeInternal
:: TextNodeConfig DomTimeline
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (TextNode HydrationDomSpace DomTimeline)
#-}
{-# INLINE hydrateTextNode #-}
hydrateTextNode :: MonadJSM m => Document -> Text -> HydrationRunnerT t m DOM.Text
hydrateTextNode :: Document -> Text -> HydrationRunnerT t m Text
hydrateTextNode Document
doc t :: Text
t@Text
"" = do
Text
tn <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc Text
t
Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
tn
Text -> HydrationRunnerT t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
tn
hydrateTextNode Document
doc Text
t = do
Text
n <- HydrationRunnerT t m (HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (HydrationRunnerT t m (HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text)
-> HydrationRunnerT t m (HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node -> HydrationRunnerT t m Text
go (Node -> Maybe Node -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m Node
-> HydrationRunnerT t m (Maybe Node -> HydrationRunnerT t m Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent HydrationRunnerT t m (Maybe Node -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m (Maybe Node)
-> HydrationRunnerT t m (HydrationRunnerT t m Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) t.
Monad m =>
HydrationRunnerT t m (Maybe Node)
getPreviousNode
Maybe Node -> HydrationRunnerT t m ()
forall (m :: * -> *) t.
Monad m =>
Maybe Node -> HydrationRunnerT t m ()
setPreviousNode (Maybe Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Text -> Node
forall o. IsNode o => o -> Node
toNode Text
n
Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
n
where
go :: Node -> Maybe Node -> HydrationRunnerT t m Text
go Node
parent Maybe Node
mLastNode = HydrationRunnerT t m (Maybe Node)
-> (Node -> HydrationRunnerT t m (Maybe Node))
-> Maybe Node
-> HydrationRunnerT t m (Maybe Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getFirstChild Node
parent) Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling Maybe Node
mLastNode HydrationRunnerT t m (Maybe Node)
-> (Maybe Node -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Node
Nothing -> do
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
s -> HydrationState
s { _hydrationState_failed :: Bool
_hydrationState_failed = Bool
True }
Text
n <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc Text
t
Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
n
Text -> HydrationRunnerT t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
n
Just Node
node -> (JSVal -> Text) -> Node -> HydrationRunnerT t m (Maybe Text)
forall obj obj' (m :: * -> *).
(Coercible obj JSVal, IsGObject obj', MonadJSM m) =>
(JSVal -> obj') -> obj -> m (Maybe obj')
DOM.castTo JSVal -> Text
DOM.Text Node
node HydrationRunnerT t m (Maybe Text)
-> (Maybe Text -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Text
Nothing -> Node -> Maybe Node -> HydrationRunnerT t m Text
go Node
parent (Maybe Node -> HydrationRunnerT t m Text)
-> Maybe Node -> HydrationRunnerT t m Text
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node
Just Text
originalNode -> do
Text
originalText <- Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self result.
(MonadDOM m, IsNode self, FromJSString result) =>
self -> m result
Node.getTextContentUnchecked Text
originalNode
case Text -> Text -> Maybe Text
T.stripPrefix Text
t Text
originalText of
Just Text
"" -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
originalNode
Just Text
_ -> do
Text -> Word -> HydrationRunnerT t m ()
forall (m :: * -> *) self.
(MonadDOM m, IsText self) =>
self -> Word -> m ()
DOM.splitText_ Text
originalNode (Word -> HydrationRunnerT t m ())
-> Word -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
t
Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
originalNode
Maybe Text
Nothing -> do
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
s -> HydrationState
s { _hydrationState_failed :: Bool
_hydrationState_failed = Bool
True }
Text
n <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc Text
t
Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
n
Text -> HydrationRunnerT t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
n
{-# INLINE commentNodeImmediate #-}
commentNodeImmediate
:: (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, MonadJSM m, Reflex t, MonadFix m)
=> CommentNodeConfig t -> HydrationDomBuilderT s t m DOM.Comment
(CommentNodeConfig !Text
t Maybe (Event t Text)
mSetContents) = do
Node
p <- HydrationDomBuilderT s t m Node
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
Comment
n <- Document -> Text -> HydrationDomBuilderT s t m Comment
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Comment
createComment Document
doc Text
t
Node -> Comment -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
appendChild_ Node
p Comment
n
(Event t Text -> HydrationDomBuilderT s t m ())
-> Maybe (Event t Text) -> HydrationDomBuilderT s t m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ())
-> (Event t Text -> Event t (JSM ()))
-> Event t Text
-> HydrationDomBuilderT s t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> JSM ()) -> Event t Text -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Comment -> Maybe Text -> JSM ()
forall (m :: * -> *) self val.
(MonadDOM m, IsNode self, ToJSString val) =>
self -> Maybe val -> m ()
setNodeValue Comment
n (Maybe Text -> JSM ()) -> (Text -> Maybe Text) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just)) Maybe (Event t Text)
mSetContents
Comment -> HydrationDomBuilderT s t m Comment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
n
{-# INLINE commentNodeInternal #-}
commentNodeInternal
:: (Ref m ~ IORef, MonadRef m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadJSM m, MonadFix m, Reflex t, Adjustable t m, MonadHold t m, MonadSample t m)
=> CommentNodeConfig t -> HydrationDomBuilderT HydrationDomSpace t m (CommentNode HydrationDomSpace t)
tc :: CommentNodeConfig t
tc@(CommentNodeConfig Text
t0 Maybe (Event t Text)
mSetContents) = do
Document
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode -> HydrationDomBuilderT HydrationDomSpace t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
-> HydrationDomBuilderT HydrationDomSpace t m ())
-> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ CommentNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
forall (m :: * -> *) t.
(Ref m ~ IORef, MonadRef m, PerformEvent t m,
MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadJSM m,
MonadFix m, Reflex t, Adjustable t m, MonadHold t m,
MonadSample t m) =>
CommentNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
commentNodeInternal CommentNodeConfig t
tc
HydrationMode
HydrationMode_Hydrating -> m (Behavior t Text)
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (m (Behavior t Text)
-> (Event t Text -> m (Behavior t Text))
-> Maybe (Event t Text)
-> m (Behavior t Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Text -> m (Behavior t Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text -> m (Behavior t Text))
-> Behavior t Text -> m (Behavior t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Behavior t Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t0) (Text -> Event t Text -> m (Behavior t Text)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Text
t0) Maybe (Event t Text)
mSetContents) ((Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ())
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ \Behavior t Text
bt -> do
Text
t <- Behavior t Text -> HydrationRunnerT t m Text
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
bt
HydrationRunnerT t m Comment -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (HydrationRunnerT t m Comment -> HydrationRunnerT t m ())
-> HydrationRunnerT t m Comment -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Document
-> Text -> Maybe (Event t Text) -> HydrationRunnerT t m Comment
forall (m :: * -> *) t.
(MonadJSM m, Reflex t, MonadFix m) =>
Document
-> Text -> Maybe (Event t Text) -> HydrationRunnerT t m Comment
hydrateComment Document
doc Text
t Maybe (Event t Text)
mSetContents
CommentNode HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommentNode HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t))
-> CommentNode HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ RawCommentNode HydrationDomSpace -> CommentNode HydrationDomSpace t
forall k k (d :: k) (t :: k). RawCommentNode d -> CommentNode d t
CommentNode ()
{-# INLINE hydrateComment #-}
hydrateComment :: (MonadJSM m, Reflex t, MonadFix m) => Document -> Text -> Maybe (Event t Text) -> HydrationRunnerT t m DOM.Comment
Document
doc Text
t Maybe (Event t Text)
mSetContents = do
Node
parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
let go :: Maybe Node -> HydrationRunnerT t m Comment
go Maybe Node
mLastNode = HydrationRunnerT t m (Maybe Node)
-> (Node -> HydrationRunnerT t m (Maybe Node))
-> Maybe Node
-> HydrationRunnerT t m (Maybe Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getFirstChild Node
parent) Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling Maybe Node
mLastNode HydrationRunnerT t m (Maybe Node)
-> (Maybe Node -> HydrationRunnerT t m Comment)
-> HydrationRunnerT t m Comment
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Node
Nothing -> do
Comment
c <- Document -> Text -> HydrationRunnerT t m Comment
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Comment
createComment Document
doc Text
t
Comment -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Comment
c
Comment -> HydrationRunnerT t m Comment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
c
Just Node
node -> (JSVal -> Comment) -> Node -> HydrationRunnerT t m (Maybe Comment)
forall obj obj' (m :: * -> *).
(Coercible obj JSVal, IsGObject obj', MonadJSM m) =>
(JSVal -> obj') -> obj -> m (Maybe obj')
DOM.castTo JSVal -> Comment
DOM.Comment Node
node HydrationRunnerT t m (Maybe Comment)
-> (Maybe Comment -> HydrationRunnerT t m Comment)
-> HydrationRunnerT t m Comment
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Comment
Nothing -> Maybe Node -> HydrationRunnerT t m Comment
go (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
Just Comment
c -> do
Text
t' <- Comment -> HydrationRunnerT t m Text
forall (m :: * -> *) self result.
(MonadDOM m, IsNode self, FromJSString result) =>
self -> m result
Node.getTextContentUnchecked Comment
c
if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t'
then Comment -> HydrationRunnerT t m Comment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
c
else do
Comment
c' <- Document -> Text -> HydrationRunnerT t m Comment
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Comment
createComment Document
doc Text
t
Comment -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Comment
c'
Comment -> HydrationRunnerT t m Comment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
c'
Comment
n <- Maybe Node -> HydrationRunnerT t m Comment
go (Maybe Node -> HydrationRunnerT t m Comment)
-> HydrationRunnerT t m (Maybe Node)
-> HydrationRunnerT t m Comment
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) t.
Monad m =>
HydrationRunnerT t m (Maybe Node)
getPreviousNode
Maybe Node -> HydrationRunnerT t m ()
forall (m :: * -> *) t.
Monad m =>
Maybe Node -> HydrationRunnerT t m ()
setPreviousNode (Maybe Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Comment -> Node
forall o. IsNode o => o -> Node
toNode Comment
n
(Event t Text -> HydrationRunnerT t m ())
-> Maybe (Event t Text) -> HydrationRunnerT t m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Event t (JSM ()) -> HydrationRunnerT t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> (Event t Text -> Event t (JSM ()))
-> Event t Text
-> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> JSM ()) -> Event t Text -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Comment -> Maybe Text -> JSM ()
forall (m :: * -> *) self val.
(MonadDOM m, IsNode self, ToJSString val) =>
self -> Maybe val -> m ()
setNodeValue Comment
n (Maybe Text -> JSM ()) -> (Text -> Maybe Text) -> Text -> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just)) Maybe (Event t Text)
mSetContents
Comment -> HydrationRunnerT t m Comment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Comment
n
{-# INLINABLE skipToAndReplaceComment #-}
skipToAndReplaceComment
:: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)
=> Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text, IORef (Maybe Text))
skipToAndReplaceComment :: Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToAndReplaceComment Text
prefix IORef (Maybe Text)
key0Ref = HydrationDomBuilderT s t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT s t m HydrationMode
-> (HydrationMode
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text)))
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> do
Text
t <- TextNodeConfig t -> HydrationDomBuilderT s t m Text
forall k (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate (TextNodeConfig t -> HydrationDomBuilderT s t m Text)
-> TextNodeConfig t -> HydrationDomBuilderT s t m Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Event t Text) -> TextNodeConfig t
forall k (t :: k). Text -> Maybe (Event t Text) -> TextNodeConfig t
TextNodeConfig (Text
"" :: Text) Maybe (Event t Text)
forall a. Maybe a
Nothing
Node -> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT s t m ())
-> Node -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Text -> Node
forall o. IsNode o => o -> Node
toNode Text
t
IORef Text
textNodeRef <- IO (IORef Text) -> HydrationDomBuilderT s t m (IORef Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Text) -> HydrationDomBuilderT s t m (IORef Text))
-> IO (IORef Text) -> HydrationDomBuilderT s t m (IORef Text)
forall a b. (a -> b) -> a -> b
$ Text -> IO (IORef Text)
forall a. a -> IO (IORef a)
newIORef Text
t
IORef (Maybe Text)
keyRef <- IO (IORef (Maybe Text))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe Text))
-> HydrationDomBuilderT s t m (IORef (Maybe Text)))
-> IO (IORef (Maybe Text))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Maybe Text -> IO (IORef (Maybe Text))
forall a. a -> IO (IORef a)
newIORef Maybe Text
forall a. Maybe a
Nothing
(HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (), IORef Text
textNodeRef, IORef (Maybe Text)
keyRef)
HydrationMode
HydrationMode_Hydrating -> do
Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
IORef Text
textNodeRef <- IO (IORef Text) -> HydrationDomBuilderT s t m (IORef Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Text) -> HydrationDomBuilderT s t m (IORef Text))
-> IO (IORef Text) -> HydrationDomBuilderT s t m (IORef Text)
forall a b. (a -> b) -> a -> b
$ Text -> IO (IORef Text)
forall a. a -> IO (IORef a)
newIORef (Text -> IO (IORef Text)) -> Text -> IO (IORef Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. HasCallStack => String -> a
error String
"textNodeRef not yet initialized"
IORef (Maybe Text)
keyRef <- IO (IORef (Maybe Text))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe Text))
-> HydrationDomBuilderT s t m (IORef (Maybe Text)))
-> IO (IORef (Maybe Text))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Maybe Text -> IO (IORef (Maybe Text))
forall a. a -> IO (IORef a)
newIORef (Maybe Text -> IO (IORef (Maybe Text)))
-> Maybe Text -> IO (IORef (Maybe Text))
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text
forall a. HasCallStack => String -> a
error String
"keyRef not yet initialized"
let
go :: Maybe Text -> Maybe Node -> HydrationRunnerT t m (Text, Maybe Text)
go Maybe Text
Nothing Maybe Node
_ = do
Text
tn <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
tn
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
s -> HydrationState
s { _hydrationState_failed :: Bool
_hydrationState_failed = Bool
True }
(Text, Maybe Text) -> HydrationRunnerT t m (Text, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
tn, Maybe Text
forall a. Maybe a
Nothing)
go (Just Text
key0) Maybe Node
mLastNode = do
Node
parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
HydrationRunnerT t m (Maybe Node)
-> (Node -> HydrationRunnerT t m (Maybe Node))
-> Maybe Node
-> HydrationRunnerT t m (Maybe Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getFirstChild Node
parent) Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling Maybe Node
mLastNode HydrationRunnerT t m (Maybe Node)
-> (Maybe Node -> HydrationRunnerT t m (Text, Maybe Text))
-> HydrationRunnerT t m (Text, Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Node
Nothing -> Maybe Text -> Maybe Node -> HydrationRunnerT t m (Text, Maybe Text)
go Maybe Text
forall a. Maybe a
Nothing Maybe Node
forall a. Maybe a
Nothing
Just Node
node -> (JSVal -> Comment) -> Node -> HydrationRunnerT t m (Maybe Comment)
forall obj obj' (m :: * -> *).
(Coercible obj JSVal, IsGObject obj', MonadJSM m) =>
(JSVal -> obj') -> obj -> m (Maybe obj')
DOM.castTo JSVal -> Comment
DOM.Comment Node
node HydrationRunnerT t m (Maybe Comment)
-> (Maybe Comment -> HydrationRunnerT t m (Text, Maybe Text))
-> HydrationRunnerT t m (Text, Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Comment
comment -> do
Text
commentText <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
forall a. HasCallStack => String -> a
error String
"Cannot get text content of comment node") (Maybe Text -> Text)
-> HydrationRunnerT t m (Maybe Text) -> HydrationRunnerT t m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Comment -> HydrationRunnerT t m (Maybe Text)
forall (m :: * -> *) self result.
(MonadDOM m, IsNode self, FromJSString result) =>
self -> m (Maybe result)
Node.getTextContent Comment
comment
case Text -> Text -> Maybe Text
T.stripPrefix (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key0) Text
commentText of
Just Text
key -> do
Text
tn <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
Node -> Text -> Comment -> HydrationRunnerT t m ()
forall (m :: * -> *) self node child.
(MonadDOM m, IsNode self, IsNode node, IsNode child) =>
self -> node -> child -> m ()
Node.replaceChild_ Node
parent Text
tn Comment
comment
(Text, Maybe Text) -> HydrationRunnerT t m (Text, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
tn, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key)
Maybe Text
Nothing -> do
Maybe Text -> Maybe Node -> HydrationRunnerT t m (Text, Maybe Text)
go (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key0) (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
Maybe Comment
Nothing -> do
Maybe Text -> Maybe Node -> HydrationRunnerT t m (Text, Maybe Text)
go (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key0) (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
switchComment :: HydrationRunnerT t m ()
switchComment = do
Maybe Text
key0 <- IO (Maybe Text) -> HydrationRunnerT t m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> HydrationRunnerT t m (Maybe Text))
-> IO (Maybe Text) -> HydrationRunnerT t m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe Text) -> IO (Maybe Text)
forall a. IORef a -> IO a
readIORef IORef (Maybe Text)
key0Ref
(Text
tn, Maybe Text
key) <- Maybe Text -> Maybe Node -> HydrationRunnerT t m (Text, Maybe Text)
go Maybe Text
key0 (Maybe Node -> HydrationRunnerT t m (Text, Maybe Text))
-> HydrationRunnerT t m (Maybe Node)
-> HydrationRunnerT t m (Text, Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) t.
Monad m =>
HydrationRunnerT t m (Maybe Node)
getPreviousNode
Maybe Node -> HydrationRunnerT t m ()
forall (m :: * -> *) t.
Monad m =>
Maybe Node -> HydrationRunnerT t m ()
setPreviousNode (Maybe Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Text -> Node
forall o. IsNode o => o -> Node
toNode Text
tn
IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ do
IORef Text -> Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Text
textNodeRef Text
tn
IORef (Maybe Text) -> Maybe Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Text)
keyRef Maybe Text
key
(HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HydrationRunnerT t m ()
switchComment, IORef Text
textNodeRef, IORef (Maybe Text)
keyRef)
{-# INLINABLE skipToReplaceStart #-}
skipToReplaceStart :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text, IORef (Maybe Text))
skipToReplaceStart :: HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToReplaceStart = Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall k (m :: * -> *) t (s :: k).
(MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToAndReplaceComment Text
"replace-start" (IORef (Maybe Text)
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text)))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (IORef (Maybe Text))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe Text -> IO (IORef (Maybe Text))
forall a. a -> IO (IORef a)
newIORef (Maybe Text -> IO (IORef (Maybe Text)))
-> Maybe Text -> IO (IORef (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"")
{-# INLINABLE skipToReplaceEnd #-}
skipToReplaceEnd :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => IORef (Maybe Text) -> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text)
skipToReplaceEnd :: IORef (Maybe Text)
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef Text)
skipToReplaceEnd IORef (Maybe Text)
key = ((HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> (HydrationRunnerT t m (), IORef Text))
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(HydrationRunnerT t m ()
m,IORef Text
e,IORef (Maybe Text)
_) -> (HydrationRunnerT t m ()
m,IORef Text
e)) (HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text))
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef Text)
forall a b. (a -> b) -> a -> b
$ Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall k (m :: * -> *) t (s :: k).
(MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToAndReplaceComment Text
"replace-end" IORef (Maybe Text)
key
instance SupportsHydrationDomBuilder t m => NotReady t (HydrationDomBuilderT s t m) where
notReadyUntil :: Event t a -> HydrationDomBuilderT s t m ()
notReadyUntil Event t a
e = do
Event t a
eOnce <- Event t a -> HydrationDomBuilderT s t m (Event t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
Event t a -> m (Event t a)
headE Event t a
e
IORef Word
unreadyChildren <- HydrationDomBuilderT s t m (IORef Word)
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT s t m (IORef Word)
askUnreadyChildren
JSM ()
commitAction <- HydrationDomBuilderT s t m (JSM ())
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT s t m (JSM ())
askCommitAction
IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> (Word -> Word) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Word
unreadyChildren Word -> Word
forall a. Enum a => a -> a
succ
let ready :: JSM ()
ready = do
Word
old <- IO Word -> JSM Word
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> JSM Word) -> IO Word -> JSM Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
unreadyChildren
let new :: Word
new = Word -> Word
forall a. Enum a => a -> a
pred Word
old
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> Word -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Word
unreadyChildren (Word -> IO ()) -> Word -> IO ()
forall a b. (a -> b) -> a -> b
$! Word
new
Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
new Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) JSM ()
commitAction
Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ())
-> Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ JSM ()
ready JSM () -> Event t a -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t a
eOnce
notReady :: HydrationDomBuilderT s t m ()
notReady = do
IORef Word
unreadyChildren <- HydrationDomBuilderT s t m (IORef Word)
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT s t m (IORef Word)
askUnreadyChildren
IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> (Word -> Word) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Word
unreadyChildren Word -> Word
forall a. Enum a => a -> a
succ
data HydrationDomSpace
instance DomSpace HydrationDomSpace where
type EventSpec HydrationDomSpace = GhcjsEventSpec
type RawDocument HydrationDomSpace = DOM.Document
type RawTextNode HydrationDomSpace = ()
type HydrationDomSpace = ()
type RawElement HydrationDomSpace = ()
type RawInputElement HydrationDomSpace = ()
type RawTextAreaElement HydrationDomSpace = ()
type RawSelectElement HydrationDomSpace = ()
addEventSpecFlags :: proxy HydrationDomSpace
-> EventName en
-> (Maybe (er en) -> EventFlags)
-> EventSpec HydrationDomSpace er
-> EventSpec HydrationDomSpace er
addEventSpecFlags proxy HydrationDomSpace
_ EventName en
en Maybe (er en) -> EventFlags
f EventSpec HydrationDomSpace er
es = EventSpec HydrationDomSpace er
GhcjsEventSpec er
es
{ _ghcjsEventSpec_filters :: DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters =
let f' :: Maybe (GhcjsEventFilter er en) -> Maybe (GhcjsEventFilter er en)
f' = GhcjsEventFilter er en -> Maybe (GhcjsEventFilter er en)
forall a. a -> Maybe a
Just (GhcjsEventFilter er en -> Maybe (GhcjsEventFilter er en))
-> (Maybe (GhcjsEventFilter er en) -> GhcjsEventFilter er en)
-> Maybe (GhcjsEventFilter er en)
-> Maybe (GhcjsEventFilter er en)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
forall (er :: EventTag -> *) (en :: EventTag).
(GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
GhcjsEventFilter ((GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en)
-> (Maybe (GhcjsEventFilter er en)
-> GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> Maybe (GhcjsEventFilter er en)
-> GhcjsEventFilter er en
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Maybe (GhcjsEventFilter er en)
Nothing -> \GhcjsDomEvent en
evt -> do
Maybe (er en)
mEventResult <- GhcjsEventHandler er
-> (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
forall (er :: EventTag -> *).
GhcjsEventHandler er
-> forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
unGhcjsEventHandler (GhcjsEventSpec er -> GhcjsEventHandler er
forall (er :: EventTag -> *).
GhcjsEventSpec er -> GhcjsEventHandler er
_ghcjsEventSpec_handler EventSpec HydrationDomSpace er
GhcjsEventSpec er
es) (EventName en
en, GhcjsDomEvent en
evt)
(EventFlags, JSM (Maybe (er en)))
-> JSM (EventFlags, JSM (Maybe (er en)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (er en) -> EventFlags
f Maybe (er en)
mEventResult, Maybe (er en) -> JSM (Maybe (er en))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (er en)
mEventResult)
Just (GhcjsEventFilter GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter) -> \GhcjsDomEvent en
evt -> do
(EventFlags
oldFlags, JSM (Maybe (er en))
oldContinuation) <- GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter GhcjsDomEvent en
evt
Maybe (er en)
mEventResult <- JSM (Maybe (er en))
oldContinuation
let newFlags :: EventFlags
newFlags = EventFlags
oldFlags EventFlags -> EventFlags -> EventFlags
forall a. Semigroup a => a -> a -> a
<> Maybe (er en) -> EventFlags
f Maybe (er en)
mEventResult
(EventFlags, JSM (Maybe (er en)))
-> JSM (EventFlags, JSM (Maybe (er en)))
forall (m :: * -> *) a. Monad m => a -> m a
return (EventFlags
newFlags, Maybe (er en) -> JSM (Maybe (er en))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (er en)
mEventResult)
in (Maybe (GhcjsEventFilter er en) -> Maybe (GhcjsEventFilter er en))
-> EventName en
-> DMap EventName (GhcjsEventFilter er)
-> DMap EventName (GhcjsEventFilter er)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
(Maybe (f v) -> Maybe (f v)) -> k2 v -> DMap k2 f -> DMap k2 f
DMap.alter Maybe (GhcjsEventFilter er en) -> Maybe (GhcjsEventFilter er en)
f' EventName en
en (DMap EventName (GhcjsEventFilter er)
-> DMap EventName (GhcjsEventFilter er))
-> DMap EventName (GhcjsEventFilter er)
-> DMap EventName (GhcjsEventFilter er)
forall a b. (a -> b) -> a -> b
$ GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
forall (er :: EventTag -> *).
GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters EventSpec HydrationDomSpace er
GhcjsEventSpec er
es
}
instance SupportsHydrationDomBuilder t m => DomBuilder t (HydrationDomBuilderT HydrationDomSpace t m) where
type DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m) = HydrationDomSpace
{-# INLINABLE element #-}
element :: Text
-> ElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(Element
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t,
a)
element = Text
-> ElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(Element
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t,
a)
forall (m :: * -> *) t (er :: EventTag -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t, a)
elementInternal
{-# INLINABLE textNode #-}
textNode :: TextNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(TextNode
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t)
textNode = TextNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(TextNode
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t)
forall t (m :: * -> *).
(Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m,
Reflex t) =>
TextNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace t m (TextNode HydrationDomSpace t)
textNodeInternal
{-# INLINABLE commentNode #-}
commentNode :: CommentNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(CommentNode
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t)
commentNode = CommentNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(CommentNode
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t)
forall (m :: * -> *) t.
(Ref m ~ IORef, MonadRef m, PerformEvent t m,
MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadJSM m,
MonadFix m, Reflex t, Adjustable t m, MonadHold t m,
MonadSample t m) =>
CommentNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
commentNodeInternal
{-# INLINABLE inputElement #-}
inputElement :: InputElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(InputElement
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t)
inputElement = InputElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(InputElement
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t)
forall (m :: * -> *) t (er :: EventTag -> *).
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m, MonadRef m, Ref m ~ IORef) =>
InputElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t)
inputElementInternal
{-# INLINABLE textAreaElement #-}
textAreaElement :: TextAreaElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(TextAreaElement
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t)
textAreaElement = TextAreaElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(TextAreaElement
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t)
forall (m :: * -> *) t (er :: EventTag -> *).
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m, MonadRef m, Ref m ~ IORef) =>
TextAreaElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
textAreaElementInternal
{-# INLINABLE selectElement #-}
selectElement :: SelectElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(SelectElement
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t,
a)
selectElement = SelectElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(SelectElement
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t,
a)
forall (m :: * -> *) t (er :: EventTag -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m, MonadRef m, Ref m ~ IORef) =>
SelectElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
selectElementInternal
placeRawElement :: RawElement
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m ()
placeRawElement () = () -> HydrationDomBuilderT HydrationDomSpace t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
wrapRawElement :: RawElement
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> RawElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(Element
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t)
wrapRawElement () RawElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
_cfg = Element er HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Element er HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t))
-> Element er HydrationDomSpace t
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ EventSelector t (WrapArg er EventName)
-> RawElement HydrationDomSpace -> Element er HydrationDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element ((forall a. WrapArg er EventName a -> Event t a)
-> EventSelector t (WrapArg er EventName)
forall k (t :: k) (k1 :: * -> *).
(forall a. k1 a -> Event t a) -> EventSelector t k1
EventSelector ((forall a. WrapArg er EventName a -> Event t a)
-> EventSelector t (WrapArg er EventName))
-> (forall a. WrapArg er EventName a -> Event t a)
-> EventSelector t (WrapArg er EventName)
forall a b. (a -> b) -> a -> b
$ Event t a -> WrapArg er EventName a -> Event t a
forall a b. a -> b -> a
const Event t a
forall k (t :: k) a. Reflex t => Event t a
never) ()
instance SupportsHydrationDomBuilder t m => DomBuilder t (HydrationDomBuilderT GhcjsDomSpace t m) where
type DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m) = GhcjsDomSpace
{-# INLINABLE element #-}
element :: Text
-> ElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(Element
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t,
a)
element = Text
-> ElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(Element
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t,
a)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate
{-# INLINABLE textNode #-}
textNode :: TextNodeConfig t
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(TextNode
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
textNode = (Text -> TextNode GhcjsDomSpace t)
-> HydrationDomBuilderT GhcjsDomSpace t m Text
-> HydrationDomBuilderT
GhcjsDomSpace t m (TextNode GhcjsDomSpace t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TextNode GhcjsDomSpace t
forall k k (d :: k) (t :: k). RawTextNode d -> TextNode d t
TextNode (HydrationDomBuilderT GhcjsDomSpace t m Text
-> HydrationDomBuilderT
GhcjsDomSpace t m (TextNode GhcjsDomSpace t))
-> (TextNodeConfig t
-> HydrationDomBuilderT GhcjsDomSpace t m Text)
-> TextNodeConfig t
-> HydrationDomBuilderT
GhcjsDomSpace t m (TextNode GhcjsDomSpace t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text
forall k (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate
{-# INLINABLE commentNode #-}
commentNode :: CommentNodeConfig t
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(CommentNode
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
commentNode = (Comment -> CommentNode GhcjsDomSpace t)
-> HydrationDomBuilderT GhcjsDomSpace t m Comment
-> HydrationDomBuilderT
GhcjsDomSpace t m (CommentNode GhcjsDomSpace t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Comment -> CommentNode GhcjsDomSpace t
forall k k (d :: k) (t :: k). RawCommentNode d -> CommentNode d t
CommentNode (HydrationDomBuilderT GhcjsDomSpace t m Comment
-> HydrationDomBuilderT
GhcjsDomSpace t m (CommentNode GhcjsDomSpace t))
-> (CommentNodeConfig t
-> HydrationDomBuilderT GhcjsDomSpace t m Comment)
-> CommentNodeConfig t
-> HydrationDomBuilderT
GhcjsDomSpace t m (CommentNode GhcjsDomSpace t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentNodeConfig t
-> HydrationDomBuilderT GhcjsDomSpace t m Comment
forall k (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadFix m) =>
CommentNodeConfig t -> HydrationDomBuilderT s t m Comment
commentNodeImmediate
{-# INLINABLE inputElement #-}
inputElement :: InputElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(InputElement
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
inputElement = InputElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(InputElement
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
MonadRef m, Ref m ~ IORef) =>
InputElementConfig er t s
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
inputElementImmediate
{-# INLINABLE textAreaElement #-}
textAreaElement :: TextAreaElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(TextAreaElement
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
textAreaElement = TextAreaElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(TextAreaElement
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
MonadRef m, Ref m ~ IORef) =>
TextAreaElementConfig er t s
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
textAreaElementImmediate
{-# INLINABLE selectElement #-}
selectElement :: SelectElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(SelectElement
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t,
a)
selectElement = SelectElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(SelectElement
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t,
a)
forall k (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(EventSpec s ~ GhcjsEventSpec,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m) =>
SelectElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
selectElementImmediate
placeRawElement :: RawElement
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m ()
placeRawElement = Node -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall k (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT GhcjsDomSpace t m ())
-> (Element -> Node)
-> Element
-> HydrationDomBuilderT GhcjsDomSpace t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Node
forall o. IsNode o => o -> Node
toNode
wrapRawElement :: RawElement
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> RawElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(Element
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
wrapRawElement RawElement
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
e RawElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
rawCfg = do
Chan [DSum (EventTriggerRef t) TriggerInvocation]
events <- HydrationDomBuilderT
GhcjsDomSpace
t
m
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents
JSContextRef
ctx <- HydrationDomBuilderT GhcjsDomSpace t m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs <- Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t GhcjsDomSpace
-> HydrationDomBuilderT
GhcjsDomSpace t m (DMap EventName (EventFilterTriggerRef t er))
forall k (s :: k) (m :: * -> *) (er :: EventTag -> *) t.
(Reflex t, MonadJSM m, MonadReflexCreateTrigger t m,
DomRenderHook t m, EventSpec s ~ GhcjsEventSpec) =>
Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t s
-> m (DMap EventName (EventFilterTriggerRef t er))
wrap Chan [DSum (EventTriggerRef t) TriggerInvocation]
events Element
RawElement
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
e RawElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
RawElementConfig er t GhcjsDomSpace
rawCfg
EventSelector t (WrapArg er EventName)
es <- (forall a.
WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
GhcjsDomSpace t m (EventSelector t (WrapArg er EventName))
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger ((forall a.
WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
GhcjsDomSpace t m (EventSelector t (WrapArg er EventName)))
-> (forall a.
WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT
GhcjsDomSpace t m (EventSelector t (WrapArg er EventName))
forall a b. (a -> b) -> a -> b
$ JSContextRef
-> RawElementConfig er t GhcjsDomSpace
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName a
-> EventTrigger t a
-> IO (IO ())
forall k (s :: k) (er :: EventTag -> *) t x.
(EventSpec s ~ GhcjsEventSpec) =>
JSContextRef
-> RawElementConfig er t s
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName x
-> EventTrigger t x
-> IO (IO ())
triggerBody JSContextRef
ctx RawElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
RawElementConfig er t GhcjsDomSpace
rawCfg Chan [DSum (EventTriggerRef t) TriggerInvocation]
events DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs Element
RawElement
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
e
Element er GhcjsDomSpace t
-> HydrationDomBuilderT
GhcjsDomSpace t m (Element er GhcjsDomSpace t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Element er GhcjsDomSpace t
-> HydrationDomBuilderT
GhcjsDomSpace t m (Element er GhcjsDomSpace t))
-> Element er GhcjsDomSpace t
-> HydrationDomBuilderT
GhcjsDomSpace t m (Element er GhcjsDomSpace t)
forall a b. (a -> b) -> a -> b
$ EventSelector t (WrapArg er EventName)
-> RawElement GhcjsDomSpace -> Element er GhcjsDomSpace t
forall k k (er :: EventTag -> *) (d :: k) (t :: k).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element EventSelector t (WrapArg er EventName)
es RawElement
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
RawElement GhcjsDomSpace
e
data FragmentState
= FragmentState_Unmounted
| FragmentState_Mounted (DOM.Text, DOM.Text)
data ImmediateDomFragment = ImmediateDomFragment
{ ImmediateDomFragment -> DocumentFragment
_immediateDomFragment_document :: DOM.DocumentFragment
, ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state :: IORef FragmentState
}
extractFragment :: MonadJSM m => ImmediateDomFragment -> m ()
ImmediateDomFragment
fragment = do
FragmentState
state <- IO FragmentState -> m FragmentState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FragmentState -> m FragmentState)
-> IO FragmentState -> m FragmentState
forall a b. (a -> b) -> a -> b
$ IORef FragmentState -> IO FragmentState
forall a. IORef a -> IO a
readIORef (IORef FragmentState -> IO FragmentState)
-> IORef FragmentState -> IO FragmentState
forall a b. (a -> b) -> a -> b
$ ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state ImmediateDomFragment
fragment
case FragmentState
state of
FragmentState
FragmentState_Unmounted -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
FragmentState_Mounted (Text
before, Text
after) -> do
DocumentFragment -> Text -> Text -> m ()
forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
DocumentFragment -> start -> end -> m ()
extractBetweenExclusive (ImmediateDomFragment -> DocumentFragment
_immediateDomFragment_document ImmediateDomFragment
fragment) Text
before Text
after
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef FragmentState -> FragmentState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state ImmediateDomFragment
fragment) FragmentState
FragmentState_Unmounted
instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomBuilderT GhcjsDomSpace t m) where
type DomFragment (HydrationDomBuilderT GhcjsDomSpace t m) = ImmediateDomFragment
buildDomFragment :: HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(DomFragment (HydrationDomBuilderT GhcjsDomSpace t m), a)
buildDomFragment HydrationDomBuilderT GhcjsDomSpace t m a
w = do
DocumentFragment
df <- Document -> HydrationDomBuilderT GhcjsDomSpace t m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment (Document
-> HydrationDomBuilderT GhcjsDomSpace t m DocumentFragment)
-> HydrationDomBuilderT GhcjsDomSpace t m Document
-> HydrationDomBuilderT GhcjsDomSpace t m DocumentFragment
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HydrationDomBuilderT GhcjsDomSpace t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
a
result <- ((HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT GhcjsDomSpace t m a)
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT GhcjsDomSpace t m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT GhcjsDomSpace t m a
forall k (m :: * -> *) t (s :: k) a.
Monad m =>
(HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
localEnv HydrationDomBuilderT GhcjsDomSpace t m a
w ((HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT GhcjsDomSpace t m a)
-> (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT GhcjsDomSpace t m a
forall a b. (a -> b) -> a -> b
$ \HydrationDomBuilderEnv t m
env -> HydrationDomBuilderEnv t m
env
{ _hydrationDomBuilderEnv_parent :: Either Node (IORef Node)
_hydrationDomBuilderEnv_parent = Node -> Either Node (IORef Node)
forall a b. a -> Either a b
Left (Node -> Either Node (IORef Node))
-> Node -> Either Node (IORef Node)
forall a b. (a -> b) -> a -> b
$ DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode DocumentFragment
df
}
IORef FragmentState
state <- IO (IORef FragmentState)
-> HydrationDomBuilderT GhcjsDomSpace t m (IORef FragmentState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef FragmentState)
-> HydrationDomBuilderT GhcjsDomSpace t m (IORef FragmentState))
-> IO (IORef FragmentState)
-> HydrationDomBuilderT GhcjsDomSpace t m (IORef FragmentState)
forall a b. (a -> b) -> a -> b
$ FragmentState -> IO (IORef FragmentState)
forall a. a -> IO (IORef a)
newIORef FragmentState
FragmentState_Unmounted
(ImmediateDomFragment, a)
-> HydrationDomBuilderT GhcjsDomSpace t m (ImmediateDomFragment, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (DocumentFragment -> IORef FragmentState -> ImmediateDomFragment
ImmediateDomFragment DocumentFragment
df IORef FragmentState
state, a
result)
mountDomFragment :: DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
-> Event t (DomFragment (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m ()
mountDomFragment DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
fragment Event t (DomFragment (HydrationDomBuilderT GhcjsDomSpace t m))
setFragment = do
Node
parent <- HydrationDomBuilderT GhcjsDomSpace t m Node
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
ImmediateDomFragment -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall (m :: * -> *). MonadJSM m => ImmediateDomFragment -> m ()
extractFragment DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
ImmediateDomFragment
fragment
Text
before <- TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text
forall k (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate (TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text)
-> TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Event t Text) -> TextNodeConfig t
forall k (t :: k). Text -> Maybe (Event t Text) -> TextNodeConfig t
TextNodeConfig (Text
"" :: Text) Maybe (Event t Text)
forall a. Maybe a
Nothing
Node
-> DocumentFragment -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
appendChild_ Node
parent (DocumentFragment -> HydrationDomBuilderT GhcjsDomSpace t m ())
-> DocumentFragment -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ ImmediateDomFragment -> DocumentFragment
_immediateDomFragment_document DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
ImmediateDomFragment
fragment
Text
after <- TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text
forall k (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate (TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text)
-> TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Event t Text) -> TextNodeConfig t
forall k (t :: k). Text -> Maybe (Event t Text) -> TextNodeConfig t
TextNodeConfig (Text
"" :: Text) Maybe (Event t Text)
forall a. Maybe a
Nothing
Dynamic t (ImmediateDomFragment, Maybe ImmediateDomFragment)
xs <- (ImmediateDomFragment
-> (ImmediateDomFragment, Maybe ImmediateDomFragment)
-> (ImmediateDomFragment, Maybe ImmediateDomFragment))
-> (ImmediateDomFragment, Maybe ImmediateDomFragment)
-> Event t ImmediateDomFragment
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(Dynamic t (ImmediateDomFragment, Maybe ImmediateDomFragment))
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn (\ImmediateDomFragment
new (ImmediateDomFragment
previous, Maybe ImmediateDomFragment
_) -> (ImmediateDomFragment
new, ImmediateDomFragment -> Maybe ImmediateDomFragment
forall a. a -> Maybe a
Just ImmediateDomFragment
previous)) (DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
ImmediateDomFragment
fragment, Maybe ImmediateDomFragment
forall a. Maybe a
Nothing) Event t (DomFragment (HydrationDomBuilderT GhcjsDomSpace t m))
Event t ImmediateDomFragment
setFragment
Event t (JSM ()) -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT GhcjsDomSpace t m ())
-> Event t (JSM ()) -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ Event t (ImmediateDomFragment, Maybe ImmediateDomFragment)
-> ((ImmediateDomFragment, Maybe ImmediateDomFragment) -> JSM ())
-> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (Dynamic t (ImmediateDomFragment, Maybe ImmediateDomFragment)
-> Event t (ImmediateDomFragment, Maybe ImmediateDomFragment)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (ImmediateDomFragment, Maybe ImmediateDomFragment)
xs) (((ImmediateDomFragment, Maybe ImmediateDomFragment) -> JSM ())
-> Event t (JSM ()))
-> ((ImmediateDomFragment, Maybe ImmediateDomFragment) -> JSM ())
-> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \(ImmediateDomFragment
childFragment, Just ImmediateDomFragment
previousFragment) -> do
ImmediateDomFragment -> JSM ()
forall (m :: * -> *). MonadJSM m => ImmediateDomFragment -> m ()
extractFragment ImmediateDomFragment
previousFragment
ImmediateDomFragment -> JSM ()
forall (m :: * -> *). MonadJSM m => ImmediateDomFragment -> m ()
extractFragment ImmediateDomFragment
childFragment
DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
insertBefore (ImmediateDomFragment -> DocumentFragment
_immediateDomFragment_document ImmediateDomFragment
childFragment) Text
after
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef FragmentState -> FragmentState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state ImmediateDomFragment
childFragment) (FragmentState -> IO ()) -> FragmentState -> IO ()
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> FragmentState
FragmentState_Mounted (Text
before, Text
after)
IO () -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT GhcjsDomSpace t m ())
-> IO () -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ IORef FragmentState -> FragmentState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
ImmediateDomFragment
fragment) (FragmentState -> IO ()) -> FragmentState -> IO ()
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> FragmentState
FragmentState_Mounted (Text
before, Text
after)
instance (Reflex t, Monad m, Adjustable t m, MonadHold t m, MonadFix m) => Adjustable t (DomRenderHookT t m) where
runWithReplace :: DomRenderHookT t m a
-> Event t (DomRenderHookT t m b)
-> DomRenderHookT t m (a, Event t b)
runWithReplace DomRenderHookT t m a
a0 Event t (DomRenderHookT t m b)
a' = RequesterT t JSM Identity (TriggerEventT t m) (a, Event t b)
-> DomRenderHookT t m (a, Event t b)
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) (a, Event t b)
-> DomRenderHookT t m (a, Event t b))
-> RequesterT t JSM Identity (TriggerEventT t m) (a, Event t b)
-> DomRenderHookT t m (a, Event t b)
forall a b. (a -> b) -> a -> b
$ RequesterT t JSM Identity (TriggerEventT t m) a
-> Event t (RequesterT t JSM Identity (TriggerEventT t m) b)
-> RequesterT t JSM Identity (TriggerEventT t m) (a, Event t b)
forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace (DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT DomRenderHookT t m a
a0) ((DomRenderHookT t m b
-> RequesterT t JSM Identity (TriggerEventT t m) b)
-> Event t (DomRenderHookT t m b)
-> Event t (RequesterT t JSM Identity (TriggerEventT t m) b)
forall k (t :: k) a b.
Reflex t =>
(a -> b) -> Event t a -> Event t b
fmapCheap DomRenderHookT t m b
-> RequesterT t JSM Identity (TriggerEventT t m) b
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT Event t (DomRenderHookT t m b)
a')
traverseIntMapWithKeyWithAdjust :: (Int -> v -> DomRenderHookT t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> DomRenderHookT t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust Int -> v -> DomRenderHookT t m v'
f IntMap v
m = RequesterT
t
JSM
Identity
(TriggerEventT t m)
(IntMap v', Event t (PatchIntMap v'))
-> DomRenderHookT t m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
t
JSM
Identity
(TriggerEventT t m)
(IntMap v', Event t (PatchIntMap v'))
-> DomRenderHookT t m (IntMap v', Event t (PatchIntMap v')))
-> (Event t (PatchIntMap v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(IntMap v', Event t (PatchIntMap v')))
-> Event t (PatchIntMap v)
-> DomRenderHookT t m (IntMap v', Event t (PatchIntMap v'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> v -> RequesterT t JSM Identity (TriggerEventT t m) v')
-> IntMap v
-> Event t (PatchIntMap v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Int -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust (\Int
k -> DomRenderHookT t m v'
-> RequesterT t JSM Identity (TriggerEventT t m) v'
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT (DomRenderHookT t m v'
-> RequesterT t JSM Identity (TriggerEventT t m) v')
-> (v -> DomRenderHookT t m v')
-> v
-> RequesterT t JSM Identity (TriggerEventT t m) v'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> v -> DomRenderHookT t m v'
f Int
k) IntMap v
m
traverseDMapWithKeyWithAdjust :: (forall a. k a -> v a -> DomRenderHookT t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust forall a. k a -> v a -> DomRenderHookT t m (v' a)
f DMap k v
m = RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMap k v'))
-> DomRenderHookT t m (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMap k v'))
-> DomRenderHookT t m (DMap k v', Event t (PatchDMap k v')))
-> (Event t (PatchDMap k v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMap k v')))
-> Event t (PatchDMap k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMap k v'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
k a -> v a -> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust (\k a
k -> DomRenderHookT t m (v' a)
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a)
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT (DomRenderHookT t m (v' a)
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> (v a -> DomRenderHookT t m (v' a))
-> v a
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k a -> v a -> DomRenderHookT t m (v' a)
forall a. k a -> v a -> DomRenderHookT t m (v' a)
f k a
k) DMap k v
m
traverseDMapWithKeyWithAdjustWithMove :: (forall a. k a -> v a -> DomRenderHookT t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove forall a. k a -> v a -> DomRenderHookT t m (v' a)
f DMap k v
m = RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMapWithMove k v'))
-> DomRenderHookT t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMapWithMove k v'))
-> DomRenderHookT
t m (DMap k v', Event t (PatchDMapWithMove k v')))
-> (Event t (PatchDMapWithMove k v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMapWithMove k v')))
-> Event t (PatchDMapWithMove k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
k a -> v a -> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove (\k a
k -> DomRenderHookT t m (v' a)
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a)
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT (DomRenderHookT t m (v' a)
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> (v a -> DomRenderHookT t m (v' a))
-> v a
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k a -> v a -> DomRenderHookT t m (v' a)
forall a. k a -> v a -> DomRenderHookT t m (v' a)
f k a
k) DMap k v
m
instance (Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => Adjustable t (HydrationDomBuilderT s t m) where
{-# INLINABLE runWithReplace #-}
runWithReplace :: HydrationDomBuilderT s t m a
-> Event t (HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m (a, Event t b)
runWithReplace HydrationDomBuilderT s t m a
a0 Event t (HydrationDomBuilderT s t m b)
a' = do
HydrationDomBuilderEnv t m
initialEnv <- ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s t m (HydrationDomBuilderEnv t m)
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(HydrationDomBuilderEnv t m)
forall r (m :: * -> *). MonadReader r m => m r
ask
let hydrating :: IORef HydrationMode
hydrating = HydrationDomBuilderEnv t m -> IORef HydrationMode
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode HydrationDomBuilderEnv t m
initialEnv
(HydrationRunnerT t m ()
hydrateStart, IORef Text
before, IORef (Maybe Text)
beforeKey) <- HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall k (m :: * -> *) t (s :: k).
(MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToReplaceStart
let parentUnreadyChildren :: IORef Word
parentUnreadyChildren = HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren HydrationDomBuilderEnv t m
initialEnv
IORef Bool
haveEverBeenReady <- IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool))
-> IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
IORef Int
currentCohort <- IO (IORef Int) -> HydrationDomBuilderT s t m (IORef Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Int) -> HydrationDomBuilderT s t m (IORef Int))
-> IO (IORef Int) -> HydrationDomBuilderT s t m (IORef Int)
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef (-Int
1 :: Int)
let myCommitAction :: JSM ()
myCommitAction = do
IO Bool -> JSM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
haveEverBeenReady) JSM Bool -> (Bool -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> do
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
Word
old <- IO Word -> JSM Word
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> JSM Word) -> IO Word -> JSM Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
parentUnreadyChildren
let new :: Word
new = Word -> Word
forall a. Enum a => a -> a
pred Word
old
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> Word -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Word
parentUnreadyChildren (Word -> IO ()) -> Word -> IO ()
forall a b. (a -> b) -> a -> b
$! Word
new
Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
new Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> JSM ()
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> JSM ()
_hydrationDomBuilderEnv_commitAction HydrationDomBuilderEnv t m
initialEnv
Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
Node
parent <- HydrationDomBuilderT s t m Node
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
(HydrationRunnerT t m ()
hydrateEnd, IORef Text
after) <- IORef (Maybe Text)
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef Text)
forall k (m :: * -> *) t (s :: k).
(MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
IORef (Maybe Text)
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef Text)
skipToReplaceEnd IORef (Maybe Text)
beforeKey
let drawInitialChild :: DomRenderHookT t m (HydrationRunnerT t m (), a)
drawInitialChild = do
HydrationMode
h <- IO HydrationMode -> DomRenderHookT t m HydrationMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HydrationMode -> DomRenderHookT t m HydrationMode)
-> IO HydrationMode -> DomRenderHookT t m HydrationMode
forall a b. (a -> b) -> a -> b
$ IORef HydrationMode -> IO HydrationMode
forall a. IORef a -> IO a
readIORef IORef HydrationMode
hydrating
Node
p' <- case HydrationMode
h of
HydrationMode
HydrationMode_Hydrating -> Node -> DomRenderHookT t m Node
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
parent
HydrationMode
HydrationMode_Immediate -> DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode (DocumentFragment -> Node)
-> DomRenderHookT t m DocumentFragment -> DomRenderHookT t m Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Document -> DomRenderHookT t m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment Document
doc
IORef Word
unreadyChildren <- IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Word) -> DomRenderHookT t m (IORef Word))
-> IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall a b. (a -> b) -> a -> b
$ Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef Word
0
let a0' :: HydrationDomBuilderT s t m a
a0' = case HydrationMode
h of
HydrationMode
HydrationMode_Hydrating -> HydrationDomBuilderT s t m a
a0
HydrationMode
HydrationMode_Immediate -> do
a
a <- HydrationDomBuilderT s t m a
a0
Node -> Text -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
insertBefore Node
p' (Text -> HydrationDomBuilderT s t m ())
-> HydrationDomBuilderT s t m Text -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Text -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Text -> IO Text
forall a. IORef a -> IO a
readIORef IORef Text
after)
a -> HydrationDomBuilderT s t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
IORef (HydrationRunnerT t m ())
delayed <- case HydrationMode
h of
HydrationMode
HydrationMode_Hydrating -> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a. a -> IO (IORef a)
newIORef (HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ())))
-> HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
HydrationMode
HydrationMode_Immediate -> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed HydrationDomBuilderEnv t m
initialEnv
a
result <- ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT HydrationDomBuilderT s t m a
a0') HydrationDomBuilderEnv t m
initialEnv
{ _hydrationDomBuilderEnv_unreadyChildren :: IORef Word
_hydrationDomBuilderEnv_unreadyChildren = IORef Word
unreadyChildren
, _hydrationDomBuilderEnv_commitAction :: JSM ()
_hydrationDomBuilderEnv_commitAction = JSM ()
myCommitAction
, _hydrationDomBuilderEnv_parent :: Either Node (IORef Node)
_hydrationDomBuilderEnv_parent = Node -> Either Node (IORef Node)
forall a b. a -> Either a b
Left Node
p'
, _hydrationDomBuilderEnv_delayed :: IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed = IORef (HydrationRunnerT t m ())
delayed
}
HydrationRunnerT t m ()
dom <- case HydrationMode
h of
HydrationMode
HydrationMode_Hydrating -> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ()))
-> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ IORef (HydrationRunnerT t m ()) -> IO (HydrationRunnerT t m ())
forall a. IORef a -> IO a
readIORef IORef (HydrationRunnerT t m ())
delayed
HydrationMode
HydrationMode_Immediate -> HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ()))
-> HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
IO () -> DomRenderHookT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DomRenderHookT t m ()) -> IO () -> DomRenderHookT t m ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
unreadyChildren IO Word -> (Word -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Word
0 -> IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
Word
_ -> IORef Word -> (Word -> Word) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Word
parentUnreadyChildren Word -> Word
forall a. Enum a => a -> a
succ
(HydrationRunnerT t m (), a)
-> DomRenderHookT t m (HydrationRunnerT t m (), a)
forall (m :: * -> *) a. Monad m => a -> m a
return (HydrationRunnerT t m ()
dom, a
result)
Event t (Int, HydrationDomBuilderT s t m b)
a'' <- Event t (HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT
s t m (Event t (Int, HydrationDomBuilderT s t m b))
forall k (t :: k) (m :: * -> *) b a.
(Reflex t, MonadHold t m, MonadFix m, Num b) =>
Event t a -> m (Event t (b, a))
numberOccurrences Event t (HydrationDomBuilderT s t m b)
a'
((HydrationRunnerT t m ()
hydrate0, a
result0), Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
child') <- ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> HydrationDomBuilderT
s
t
m
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> HydrationDomBuilderT
s
t
m
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> HydrationDomBuilderT
s
t
m
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall a b. (a -> b) -> a -> b
$ DomRenderHookT
t
m
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT
t
m
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)))
-> DomRenderHookT
t
m
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall a b. (a -> b) -> a -> b
$ DomRenderHookT t m (HydrationRunnerT t m (), a)
-> Event
t
(DomRenderHookT
t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> DomRenderHookT
t
m
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace DomRenderHookT t m (HydrationRunnerT t m (), a)
drawInitialChild (Event
t
(DomRenderHookT
t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> DomRenderHookT
t
m
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)))
-> Event
t
(DomRenderHookT
t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> DomRenderHookT
t
m
((HydrationRunnerT t m (), a),
Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall a b. (a -> b) -> a -> b
$ Event t (Int, HydrationDomBuilderT s t m b)
-> ((Int, HydrationDomBuilderT s t m b)
-> DomRenderHookT
t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> Event
t
(DomRenderHookT
t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (Int, HydrationDomBuilderT s t m b)
a'' (((Int, HydrationDomBuilderT s t m b)
-> DomRenderHookT
t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> Event
t
(DomRenderHookT
t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)))
-> ((Int, HydrationDomBuilderT s t m b)
-> DomRenderHookT
t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
-> Event
t
(DomRenderHookT
t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b))
forall a b. (a -> b) -> a -> b
$ \(Int
cohortId, HydrationDomBuilderT s t m b
child) -> do
HydrationMode
h <- IO HydrationMode -> DomRenderHookT t m HydrationMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HydrationMode -> DomRenderHookT t m HydrationMode)
-> IO HydrationMode -> DomRenderHookT t m HydrationMode
forall a b. (a -> b) -> a -> b
$ IORef HydrationMode -> IO HydrationMode
forall a. IORef a -> IO a
readIORef IORef HydrationMode
hydrating
Node
p' <- case HydrationMode
h of
HydrationMode
HydrationMode_Hydrating -> Node -> DomRenderHookT t m Node
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
parent
HydrationMode
HydrationMode_Immediate -> DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode (DocumentFragment -> Node)
-> DomRenderHookT t m DocumentFragment -> DomRenderHookT t m Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Document -> DomRenderHookT t m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment Document
doc
IORef Word
unreadyChildren <- IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Word) -> DomRenderHookT t m (IORef Word))
-> IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall a b. (a -> b) -> a -> b
$ Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef Word
0
let commitAction :: JSM ()
commitAction = do
Int
c <- IO Int -> JSM Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> JSM Int) -> IO Int -> JSM Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
currentCohort
Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cohortId) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
!Text
before' <- IO Text -> JSM Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> JSM Text) -> IO Text -> JSM Text
forall a b. (a -> b) -> a -> b
$ IORef Text -> IO Text
forall a. IORef a -> IO a
readIORef IORef Text
before
!Text
after' <- IO Text -> JSM Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> JSM Text) -> IO Text -> JSM Text
forall a b. (a -> b) -> a -> b
$ IORef Text -> IO Text
forall a. IORef a -> IO a
readIORef IORef Text
after
Text -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
deleteBetweenExclusive Text
before' Text
after'
Node -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
insertBefore Node
p' Text
after'
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
currentCohort Int
cohortId
JSM ()
myCommitAction
IORef (HydrationRunnerT t m ())
delayed <- case HydrationMode
h of
HydrationMode
HydrationMode_Hydrating -> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a. a -> IO (IORef a)
newIORef (HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ())))
-> HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
HydrationMode
HydrationMode_Immediate -> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed HydrationDomBuilderEnv t m
initialEnv
b
result <- ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) b
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (HydrationDomBuilderT s t m b
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) b
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT HydrationDomBuilderT s t m b
child) (HydrationDomBuilderEnv t m -> DomRenderHookT t m b)
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m b
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m
initialEnv
{ _hydrationDomBuilderEnv_unreadyChildren :: IORef Word
_hydrationDomBuilderEnv_unreadyChildren = IORef Word
unreadyChildren
, _hydrationDomBuilderEnv_commitAction :: JSM ()
_hydrationDomBuilderEnv_commitAction = case HydrationMode
h of
HydrationMode
HydrationMode_Hydrating -> JSM ()
myCommitAction
HydrationMode
HydrationMode_Immediate -> JSM ()
commitAction
, _hydrationDomBuilderEnv_parent :: Either Node (IORef Node)
_hydrationDomBuilderEnv_parent = Node -> Either Node (IORef Node)
forall a b. a -> Either a b
Left Node
p'
, _hydrationDomBuilderEnv_delayed :: IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed = IORef (HydrationRunnerT t m ())
delayed
}
HydrationRunnerT t m ()
dom <- case HydrationMode
h of
HydrationMode
HydrationMode_Hydrating -> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ()))
-> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ IORef (HydrationRunnerT t m ()) -> IO (HydrationRunnerT t m ())
forall a. IORef a -> IO a
readIORef IORef (HydrationRunnerT t m ())
delayed
HydrationMode
HydrationMode_Immediate -> HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ()))
-> HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Word
uc <- IO Word -> DomRenderHookT t m Word
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> DomRenderHookT t m Word)
-> IO Word -> DomRenderHookT t m Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
unreadyChildren
let commitActionToRunNow :: Maybe (JSM ())
commitActionToRunNow = if Word
uc Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
then JSM () -> Maybe (JSM ())
forall a. a -> Maybe a
Just (JSM () -> Maybe (JSM ())) -> JSM () -> Maybe (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM ()
commitAction
else Maybe (JSM ())
forall a. Maybe a
Nothing
actions :: Either (HydrationRunnerT t m ()) (Maybe (JSM ()))
actions = case HydrationMode
h of
HydrationMode
HydrationMode_Hydrating -> HydrationRunnerT t m ()
-> Either (HydrationRunnerT t m ()) (Maybe (JSM ()))
forall a b. a -> Either a b
Left HydrationRunnerT t m ()
dom
HydrationMode
HydrationMode_Immediate -> Maybe (JSM ()) -> Either (HydrationRunnerT t m ()) (Maybe (JSM ()))
forall a b. b -> Either a b
Right Maybe (JSM ())
commitActionToRunNow
(Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
-> DomRenderHookT
t m (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (HydrationRunnerT t m ()) (Maybe (JSM ()))
actions, b
result)
let (Event t (HydrationRunnerT t m ())
hydrate', Event t (Maybe (JSM ()))
commitAction) = Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())))
-> (Event t (HydrationRunnerT t m ()), Event t (Maybe (JSM ())))
forall k (t :: k) a b.
Reflex t =>
Event t (Either a b) -> (Event t a, Event t b)
fanEither (Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())))
-> (Event t (HydrationRunnerT t m ()), Event t (Maybe (JSM ()))))
-> Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())))
-> (Event t (HydrationRunnerT t m ()), Event t (Maybe (JSM ())))
forall a b. (a -> b) -> a -> b
$ ((Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
-> Either (HydrationRunnerT t m ()) (Maybe (JSM ())))
-> Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
-> Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
-> Either (HydrationRunnerT t m ()) (Maybe (JSM ()))
forall a b. (a, b) -> a
fst Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
child'
m (Behavior t (HydrationRunnerT t m ()))
-> (Behavior t (HydrationRunnerT t m ())
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (HydrationRunnerT t m ()
-> Event t (HydrationRunnerT t m ())
-> m (Behavior t (HydrationRunnerT t m ()))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold HydrationRunnerT t m ()
hydrate0 Event t (HydrationRunnerT t m ())
hydrate') ((Behavior t (HydrationRunnerT t m ()) -> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ())
-> (Behavior t (HydrationRunnerT t m ())
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ \Behavior t (HydrationRunnerT t m ())
contents -> do
HydrationRunnerT t m ()
hydrateStart
HydrationRunnerT t m (HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (HydrationRunnerT t m (HydrationRunnerT t m ())
-> HydrationRunnerT t m ())
-> HydrationRunnerT t m (HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Behavior t (HydrationRunnerT t m ())
-> HydrationRunnerT t m (HydrationRunnerT t m ())
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t (HydrationRunnerT t m ())
contents
HydrationRunnerT t m ()
hydrateEnd
Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ())
-> Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ (Maybe (JSM ()) -> Maybe (JSM ()))
-> Event t (Maybe (JSM ())) -> Event t (JSM ())
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
fmapMaybe Maybe (JSM ()) -> Maybe (JSM ())
forall a. a -> a
id Event t (Maybe (JSM ()))
commitAction
(a, Event t b) -> HydrationDomBuilderT s t m (a, Event t b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
result0, (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b) -> b
forall a b. (a, b) -> b
snd ((Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b) -> b)
-> Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
-> Event t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (Either (HydrationRunnerT t m ()) (Maybe (JSM ())), b)
child')
{-# INLINABLE traverseIntMapWithKeyWithAdjust #-}
traverseIntMapWithKeyWithAdjust :: (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust = (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
forall k (s :: k) t (m :: * -> *) v v'.
(Adjustable t m, MonadJSM m, MonadFix m, PrimMonad m,
MonadHold t m,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
(Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust'
{-# INLINABLE traverseDMapWithKeyWithAdjust #-}
traverseDMapWithKeyWithAdjust :: (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust = (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
forall k (s :: k) t (m :: * -> *) (k :: * -> *) (v :: * -> *)
(v' :: * -> *).
(Adjustable t m, MonadHold t m, MonadFix m, MonadJSM m,
PrimMonad m, GCompare k,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
(forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust'
{-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}
traverseDMapWithKeyWithAdjustWithMove :: (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> HydrationDomBuilderT
s t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove = do
let updateChildUnreadiness :: PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness (PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p :: PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')) DMap k (Constant (IORef (ChildReadyState (Some k))))
old = do
let new :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseChild t m (Some k)) v') a -> IO (PatchDMapWithMove.NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
new :: k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
new k a
k = (From k (Compose (TraverseChild t m (Some k)) v') a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
forall k1 (f :: * -> *) (k2 :: k1 -> *) (v :: k1 -> *) (a :: k1)
(v' :: k1 -> *).
Functor f =>
(From k2 v a -> f (From k2 v' a))
-> NodeInfo k2 v a -> f (NodeInfo k2 v' a)
PatchDMapWithMove.nodeInfoMapFromM ((From k (Compose (TraverseChild t m (Some k)) v') a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a))
-> (From k (Compose (TraverseChild t m (Some k)) v') a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a b. (a -> b) -> a -> b
$ \case
PatchDMapWithMove.From_Insert (Compose (TraverseChild (Left TraverseChildHydration t m
_hydration) v' a
_)) -> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall (m :: * -> *) a. Monad m => a -> m a
return From k (Constant (IORef (ChildReadyState (Some k)))) a
forall a (k :: a -> *) (v :: a -> *) (b :: a). From k v b
PatchDMapWithMove.From_Delete
PatchDMapWithMove.From_Insert (Compose (TraverseChild (Right TraverseChildImmediate (Some k)
immediate) v' a
_)) -> do
IORef (ChildReadyState (Some k)) -> IO (ChildReadyState (Some k))
forall a. IORef a -> IO a
readIORef (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate) IO (ChildReadyState (Some k))
-> (ChildReadyState (Some k)
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState (Some k)
ChildReadyState_Ready -> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall (m :: * -> *) a. Monad m => a -> m a
return From k (Constant (IORef (ChildReadyState (Some k)))) a
forall a (k :: a -> *) (v :: a -> *) (b :: a). From k v b
PatchDMapWithMove.From_Delete
ChildReadyState_Unready Maybe (Some k)
_ -> do
IORef (ChildReadyState (Some k))
-> ChildReadyState (Some k) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate) (ChildReadyState (Some k) -> IO ())
-> ChildReadyState (Some k) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Some k) -> ChildReadyState (Some k)
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe (Some k) -> ChildReadyState (Some k))
-> Maybe (Some k) -> ChildReadyState (Some k)
forall a b. (a -> b) -> a -> b
$ Some k -> Maybe (Some k)
forall a. a -> Maybe a
Just (Some k -> Maybe (Some k)) -> Some k -> Maybe (Some k)
forall a b. (a -> b) -> a -> b
$ k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k
From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a b. (a -> b) -> a -> b
$ Constant (IORef (ChildReadyState (Some k))) a
-> From k (Constant (IORef (ChildReadyState (Some k)))) a
forall a (v :: a -> *) (b :: a) (k :: a -> *). v b -> From k v b
PatchDMapWithMove.From_Insert (Constant (IORef (ChildReadyState (Some k))) a
-> From k (Constant (IORef (ChildReadyState (Some k)))) a)
-> Constant (IORef (ChildReadyState (Some k))) a
-> From k (Constant (IORef (ChildReadyState (Some k)))) a
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState (Some k))
-> Constant (IORef (ChildReadyState (Some k))) a
forall k a (b :: k). a -> Constant a b
Constant (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate)
From k (Compose (TraverseChild t m (Some k)) v') a
PatchDMapWithMove.From_Delete -> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall (m :: * -> *) a. Monad m => a -> m a
return From k (Constant (IORef (ChildReadyState (Some k)))) a
forall a (k :: a -> *) (v :: a -> *) (b :: a). From k v b
PatchDMapWithMove.From_Delete
PatchDMapWithMove.From_Move k a
fromKey -> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a b. (a -> b) -> a -> b
$ k a -> From k (Constant (IORef (ChildReadyState (Some k)))) a
forall a (k :: a -> *) (b :: a) (v :: a -> *). k b -> From k v b
PatchDMapWithMove.From_Move k a
fromKey
deleteOrMove :: forall a. k a -> Product (Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k) a -> IO (Constant () a)
deleteOrMove :: k a
-> Product
(Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k) a
-> IO (Constant () a)
deleteOrMove k a
_ (Pair (Constant IORef (ChildReadyState (Some k))
sRef) (ComposeMaybe Maybe (k a)
mToKey)) = do
IORef (ChildReadyState (Some k))
-> ChildReadyState (Some k) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState (Some k))
sRef (ChildReadyState (Some k) -> IO ())
-> ChildReadyState (Some k) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Some k) -> ChildReadyState (Some k)
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe (Some k) -> ChildReadyState (Some k))
-> Maybe (Some k) -> ChildReadyState (Some k)
forall a b. (a -> b) -> a -> b
$ k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some (k a -> Some k) -> Maybe (k a) -> Maybe (Some k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (k a)
mToKey
Constant () a -> IO (Constant () a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant () a -> IO (Constant () a))
-> Constant () a -> IO (Constant () a)
forall a b. (a -> b) -> a -> b
$ () -> Constant () a
forall k a (b :: k). a -> Constant a b
Constant ()
PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k))))
p' <- (DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))))
-> PatchDMapWithMove
k (Constant (IORef (ChildReadyState (Some k)))))
-> IO
(DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
(PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k)))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))))
-> PatchDMapWithMove
k (Constant (IORef (ChildReadyState (Some k))))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *).
DMap k2 (NodeInfo k2 v) -> PatchDMapWithMove k2 v
unsafePatchDMapWithMove (IO
(DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
(PatchDMapWithMove
k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
(DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
(PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ (forall v.
k v
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') v
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) v))
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
(g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey forall v.
k v
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') v
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) v)
new (DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap
k (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))))))
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
forall a b. (a -> b) -> a -> b
$ PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *).
PatchDMapWithMove k2 v -> DMap k2 (NodeInfo k2 v)
unPatchDMapWithMove PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p
DMap k (Constant ())
_ <- (forall v.
k v
-> Product
(Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k) v
-> IO (Constant () v))
-> DMap
k
(Product
(Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k))
-> IO (DMap k (Constant ()))
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
(g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey forall v.
k v
-> Product
(Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k) v
-> IO (Constant () v)
deleteOrMove (DMap
k
(Product
(Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k))
-> IO (DMap k (Constant ())))
-> DMap
k
(Product
(Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k))
-> IO (DMap k (Constant ()))
forall a b. (a -> b) -> a -> b
$ PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> DMap
k
(Product
(Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *) (v' :: k1 -> *).
GCompare k2 =>
PatchDMapWithMove k2 v
-> DMap k2 v' -> DMap k2 (Product v' (ComposeMaybe k2))
PatchDMapWithMove.getDeletionsAndMoves PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p DMap k (Constant (IORef (ChildReadyState (Some k))))
old
DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall (m :: * -> *) a. Monad m => a -> m a
return (DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k))))
-> PatchTarget
(PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k)))))
-> PatchTarget
(PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k)))))
forall p. Patch p => p -> PatchTarget p -> PatchTarget p
applyAlways PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k))))
p' DMap k (Constant (IORef (ChildReadyState (Some k))))
PatchTarget
(PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k)))))
old
(forall (vv :: * -> *) (vv' :: * -> *).
(forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (PatchDMapWithMove k vv)
-> DomRenderHookT
t m (DMap k vv', Event t (PatchDMapWithMove k vv')))
-> (forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a)
-> PatchDMapWithMove k vv -> PatchDMapWithMove k vv')
-> (PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
-> Text
-> PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> HydrationDomBuilderT
s t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall k k t (m :: * -> *) (k :: k -> *)
(p :: (k -> *) -> (k -> *) -> *) (v :: k -> *) (v' :: k -> *)
(s :: k).
(Adjustable t m, MonadHold t m, GCompare k, MonadIO m, MonadJSM m,
PrimMonad m, MonadFix m, Patch (p k v), Patch (p k (Constant Int)),
PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int),
Patch (p k (Compose (TraverseChild t m (Some k)) v')),
PatchTarget (p k (Compose (TraverseChild t m (Some k)) v'))
~ DMap k (Compose (TraverseChild t m (Some k)) v'),
Monoid (p k (Compose (TraverseChild t m (Some k)) v')),
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
(forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
-> (forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv')
-> (p k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
-> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> (forall (a :: k).
k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (p k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (p k v'))
hoistTraverseWithKeyWithAdjust forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (PatchDMapWithMove k vv)
-> DomRenderHookT
t m (DMap k vv', Event t (PatchDMapWithMove k vv'))
traverseDMapWithKeyWithAdjustWithMove forall k1 (k2 :: k1 -> *) (v :: k1 -> *) (v' :: k1 -> *).
(forall (a :: k1). v a -> v' a)
-> PatchDMapWithMove k2 v -> PatchDMapWithMove k2 v'
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a)
-> PatchDMapWithMove k vv -> PatchDMapWithMove k vv'
mapPatchDMapWithMove PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness ((IORef (Map (Some k) Text)
-> Text
-> PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> HydrationDomBuilderT
s t m (DMap k v', Event t (PatchDMapWithMove k v')))
-> (IORef (Map (Some k) Text)
-> Text
-> PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> HydrationDomBuilderT
s t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall a b. (a -> b) -> a -> b
$ \IORef (Map (Some k) Text)
placeholders Text
lastPlaceholder (PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p_ :: PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')) -> do
let p :: DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
p = PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *).
PatchDMapWithMove k2 v -> DMap k2 (NodeInfo k2 v)
unPatchDMapWithMove PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p_
Map (Some k) Text
phsBefore <- IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map (Some k) Text) -> JSM (Map (Some k) Text))
-> IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> IO (Map (Some k) Text)
forall a. IORef a -> IO a
readIORef IORef (Map (Some k) Text)
placeholders
let collectIfMoved :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseChild t m (Some k)) v') a -> JSM (Constant (Maybe DOM.DocumentFragment) a)
collectIfMoved :: k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> JSM (Constant (Maybe DocumentFragment) a)
collectIfMoved k a
k NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
e = do
let mThisPlaceholder :: Maybe Text
mThisPlaceholder = Some k -> Map (Some k) Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k) Map (Some k) Text
phsBefore
nextPlaceholder :: Text
nextPlaceholder = Text -> ((Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
lastPlaceholder (Some k, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Some k -> Map (Some k) Text -> Maybe (Some k, Text)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGT (k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k) Map (Some k) Text
phsBefore
case Maybe (k a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (k a) -> Bool) -> Maybe (k a) -> Bool
forall a b. (a -> b) -> a -> b
$ ComposeMaybe k a -> Maybe (k a)
forall k (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe (ComposeMaybe k a -> Maybe (k a))
-> ComposeMaybe k a -> Maybe (k a)
forall a b. (a -> b) -> a -> b
$ NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> ComposeMaybe k a
forall k1 (k2 :: k1 -> *) (v :: k1 -> *) (a :: k1).
NodeInfo k2 v a -> To k2 a
PatchDMapWithMove._nodeInfo_to NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
e of
Bool
False -> do
(Text -> JSM ()) -> Maybe Text -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`deleteUpTo` Text
nextPlaceholder) Maybe Text
mThisPlaceholder
Constant (Maybe DocumentFragment) a
-> JSM (Constant (Maybe DocumentFragment) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant (Maybe DocumentFragment) a
-> JSM (Constant (Maybe DocumentFragment) a))
-> Constant (Maybe DocumentFragment) a
-> JSM (Constant (Maybe DocumentFragment) a)
forall a b. (a -> b) -> a -> b
$ Maybe DocumentFragment -> Constant (Maybe DocumentFragment) a
forall k a (b :: k). a -> Constant a b
Constant Maybe DocumentFragment
forall a. Maybe a
Nothing
Bool
True -> do
Maybe DocumentFragment -> Constant (Maybe DocumentFragment) a
forall k a (b :: k). a -> Constant a b
Constant (Maybe DocumentFragment -> Constant (Maybe DocumentFragment) a)
-> JSM (Maybe DocumentFragment)
-> JSM (Constant (Maybe DocumentFragment) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> JSM DocumentFragment)
-> Maybe Text -> JSM (Maybe DocumentFragment)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Text -> JSM DocumentFragment
forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
start -> end -> m DocumentFragment
`collectUpTo` Text
nextPlaceholder) Maybe Text
mThisPlaceholder
DMap k (Constant (Maybe DocumentFragment))
collected <- (forall v.
k v
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') v
-> JSM (Constant (Maybe DocumentFragment) v))
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
-> JSM (DMap k (Constant (Maybe DocumentFragment)))
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
(g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey forall v.
k v
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') v
-> JSM (Constant (Maybe DocumentFragment) v)
collectIfMoved DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
p
let !phsAfter :: Map (Some k) Text
phsAfter = Map (Some k) Text -> Maybe (Map (Some k) Text) -> Map (Some k) Text
forall a. a -> Maybe a -> a
fromMaybe Map (Some k) Text
phsBefore (Maybe (Map (Some k) Text) -> Map (Some k) Text)
-> Maybe (Map (Some k) Text) -> Map (Some k) Text
forall a b. (a -> b) -> a -> b
$ PatchMapWithMove (Some k) Text
-> PatchTarget (PatchMapWithMove (Some k) Text)
-> Maybe (PatchTarget (PatchMapWithMove (Some k) Text))
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply PatchMapWithMove (Some k) Text
filtered Map (Some k) Text
PatchTarget (PatchMapWithMove (Some k) Text)
phsBefore
weakened :: PatchMapWithMove (Some k) (Either (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened :: PatchMapWithMove
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened = (forall a.
Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> PatchMapWithMove
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *) v'.
(forall (a :: k1). v a -> v')
-> PatchDMapWithMove k2 v -> PatchMapWithMove (Some k2) v'
weakenPatchDMapWithMoveWith (TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode (TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> (Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p_
filtered :: PatchMapWithMove (Some k) DOM.Text
filtered :: PatchMapWithMove (Some k) Text
filtered = Map (Some k) (NodeInfo (Some k) Text)
-> PatchMapWithMove (Some k) Text
forall k v. Map k (NodeInfo k v) -> PatchMapWithMove k v
PatchMapWithMove (Map (Some k) (NodeInfo (Some k) Text)
-> PatchMapWithMove (Some k) Text)
-> Map (Some k) (NodeInfo (Some k) Text)
-> PatchMapWithMove (Some k) Text
forall a b. (a -> b) -> a -> b
$ ((NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (NodeInfo (Some k) Text))
-> Map
(Some k)
(NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> Map (Some k) (NodeInfo (Some k) Text))
-> Map
(Some k)
(NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> (NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (NodeInfo (Some k) Text))
-> Map (Some k) (NodeInfo (Some k) Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (NodeInfo (Some k) Text))
-> Map
(Some k)
(NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> Map (Some k) (NodeInfo (Some k) Text)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (PatchMapWithMove
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Map
(Some k)
(NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
forall k v. PatchMapWithMove k v -> Map k (NodeInfo k v)
unPatchMapWithMove PatchMapWithMove
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened) ((NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (NodeInfo (Some k) Text))
-> Map (Some k) (NodeInfo (Some k) Text))
-> (NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (NodeInfo (Some k) Text))
-> Map (Some k) (NodeInfo (Some k) Text)
forall a b. (a -> b) -> a -> b
$ \(PatchMapWithMove.NodeInfo From
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
from Maybe (Some k)
to) -> (From (Some k) Text -> Maybe (Some k) -> NodeInfo (Some k) Text)
-> Maybe (Some k) -> From (Some k) Text -> NodeInfo (Some k) Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip From (Some k) Text -> Maybe (Some k) -> NodeInfo (Some k) Text
forall k v. From k v -> To k -> NodeInfo k v
PatchMapWithMove.NodeInfo Maybe (Some k)
to (From (Some k) Text -> NodeInfo (Some k) Text)
-> Maybe (From (Some k) Text) -> Maybe (NodeInfo (Some k) Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case From
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
from of
PatchMapWithMove.From_Insert (Left TraverseChildHydration t m
_hydration) -> Maybe (From (Some k) Text)
forall a. Maybe a
Nothing
PatchMapWithMove.From_Insert (Right TraverseChildImmediate (Some k)
immediate) -> From (Some k) Text -> Maybe (From (Some k) Text)
forall a. a -> Maybe a
Just (From (Some k) Text -> Maybe (From (Some k) Text))
-> From (Some k) Text -> Maybe (From (Some k) Text)
forall a b. (a -> b) -> a -> b
$ Text -> From (Some k) Text
forall k v. v -> From k v
PatchMapWithMove.From_Insert (Text -> From (Some k) Text) -> Text -> From (Some k) Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate (Some k) -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate (Some k)
immediate
From
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
PatchMapWithMove.From_Delete -> From (Some k) Text -> Maybe (From (Some k) Text)
forall a. a -> Maybe a
Just (From (Some k) Text -> Maybe (From (Some k) Text))
-> From (Some k) Text -> Maybe (From (Some k) Text)
forall a b. (a -> b) -> a -> b
$ From (Some k) Text
forall k v. From k v
PatchMapWithMove.From_Delete
PatchMapWithMove.From_Move Some k
k -> From (Some k) Text -> Maybe (From (Some k) Text)
forall a. a -> Maybe a
Just (From (Some k) Text -> Maybe (From (Some k) Text))
-> From (Some k) Text -> Maybe (From (Some k) Text)
forall a b. (a -> b) -> a -> b
$ Some k -> From (Some k) Text
forall k v. k -> From k v
PatchMapWithMove.From_Move Some k
k
let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseChild t m (Some k)) v') a -> JSM (Constant () a)
placeFragment :: k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> JSM (Constant () a)
placeFragment k a
k NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
e = do
let nextPlaceholder :: Text
nextPlaceholder = Text -> ((Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
lastPlaceholder (Some k, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Some k -> Map (Some k) Text -> Maybe (Some k, Text)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGT (k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k) Map (Some k) Text
phsAfter
case NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> From k (Compose (TraverseChild t m (Some k)) v') a
forall k1 (k2 :: k1 -> *) (v :: k1 -> *) (a :: k1).
NodeInfo k2 v a -> From k2 v a
PatchDMapWithMove._nodeInfo_from NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
e of
PatchDMapWithMove.From_Insert (Compose (TraverseChild Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
x v' a
_)) -> case Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
x of
Left TraverseChildHydration t m
_ -> () -> JSM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Right TraverseChildImmediate (Some k)
immediate -> TraverseChildImmediate (Some k) -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate (Some k)
immediate DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`insertBefore` Text
nextPlaceholder
From k (Compose (TraverseChild t m (Some k)) v') a
PatchDMapWithMove.From_Delete -> do
() -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
PatchDMapWithMove.From_Move k a
fromKey -> do
Just (Constant mdf) <- Maybe (Constant (Maybe DocumentFragment) a)
-> JSM (Maybe (Constant (Maybe DocumentFragment) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Constant (Maybe DocumentFragment) a)
-> JSM (Maybe (Constant (Maybe DocumentFragment) a)))
-> Maybe (Constant (Maybe DocumentFragment) a)
-> JSM (Maybe (Constant (Maybe DocumentFragment) a))
forall a b. (a -> b) -> a -> b
$ k a
-> DMap k (Constant (Maybe DocumentFragment))
-> Maybe (Constant (Maybe DocumentFragment) a)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup k a
fromKey DMap k (Constant (Maybe DocumentFragment))
collected
(DocumentFragment -> JSM ()) -> Maybe DocumentFragment -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`insertBefore` Text
nextPlaceholder) Maybe DocumentFragment
mdf
Constant () a -> JSM (Constant () a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant () a -> JSM (Constant () a))
-> Constant () a -> JSM (Constant () a)
forall a b. (a -> b) -> a -> b
$ () -> Constant () a
forall k a (b :: k). a -> Constant a b
Constant ()
(DSum k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
-> JSM ())
-> [DSum k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))]
-> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(k a
k :=> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
v) -> JSM (Constant () a) -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM (Constant () a) -> JSM ()) -> JSM (Constant () a) -> JSM ()
forall a b. (a -> b) -> a -> b
$ k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> JSM (Constant () a)
forall a.
k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> JSM (Constant () a)
placeFragment k a
k NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
v) ([DSum k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))]
-> JSM ())
-> [DSum k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))]
-> JSM ()
forall a b. (a -> b) -> a -> b
$ DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
-> [DSum k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toDescList DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
p
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> Map (Some k) Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map (Some k) Text)
placeholders (Map (Some k) Text -> IO ()) -> Map (Some k) Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Map (Some k) Text
phsAfter
{-# INLINABLE traverseDMapWithKeyWithAdjust' #-}
traverseDMapWithKeyWithAdjust'
:: forall s t m (k :: * -> *) v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadJSM m, PrimMonad m, GCompare k, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)
=> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust' :: (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust' = do
let updateChildUnreadiness :: PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness (PatchDMap k (Compose (TraverseChild t m (Some k)) v')
p :: PatchDMap k (Compose (TraverseChild t m (Some k)) v')) DMap k (Constant (IORef (ChildReadyState (Some k))))
old = do
let new :: forall a. k a -> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') a -> IO (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
new :: k a
-> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') a
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
new k a
k (ComposeMaybe Maybe (Compose (TraverseChild t m (Some k)) v' a)
m) = Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a
forall k (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe (Compose (TraverseChild t m (Some k)) v' a)
m of
Maybe (Compose (TraverseChild t m (Some k)) v' a)
Nothing -> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a. Maybe a
Nothing
Just (Compose (TraverseChild (Left TraverseChildHydration t m
_hydration) v' a
_)) -> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a. Maybe a
Nothing
Just (Compose (TraverseChild (Right TraverseChildImmediate (Some k)
immediate) v' a
_)) -> do
IORef (ChildReadyState (Some k)) -> IO (ChildReadyState (Some k))
forall a. IORef a -> IO a
readIORef (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate) IO (ChildReadyState (Some k))
-> (ChildReadyState (Some k)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a)))
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState (Some k)
ChildReadyState_Ready -> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a. Maybe a
Nothing
ChildReadyState_Unready Maybe (Some k)
_ -> do
IORef (ChildReadyState (Some k))
-> ChildReadyState (Some k) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate) (ChildReadyState (Some k) -> IO ())
-> ChildReadyState (Some k) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Some k) -> ChildReadyState (Some k)
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe (Some k) -> ChildReadyState (Some k))
-> Maybe (Some k) -> ChildReadyState (Some k)
forall a b. (a -> b) -> a -> b
$ Some k -> Maybe (Some k)
forall a. a -> Maybe a
Just (Some k -> Maybe (Some k)) -> Some k -> Maybe (Some k)
forall a b. (a -> b) -> a -> b
$ k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k
Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a)))
-> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall a b. (a -> b) -> a -> b
$ Constant (IORef (ChildReadyState (Some k))) a
-> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a. a -> Maybe a
Just (Constant (IORef (ChildReadyState (Some k))) a
-> Maybe (Constant (IORef (ChildReadyState (Some k))) a))
-> Constant (IORef (ChildReadyState (Some k))) a
-> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState (Some k))
-> Constant (IORef (ChildReadyState (Some k))) a
forall k a (b :: k). a -> Constant a b
Constant (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate)
delete :: p -> Constant (IORef (ChildReadyState a)) b -> IO (Constant () b)
delete p
_ (Constant IORef (ChildReadyState a)
sRef) = do
IORef (ChildReadyState a) -> ChildReadyState a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState a)
sRef (ChildReadyState a -> IO ()) -> ChildReadyState a -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe a -> ChildReadyState a
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready Maybe a
forall a. Maybe a
Nothing
Constant () b -> IO (Constant () b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant () b -> IO (Constant () b))
-> Constant () b -> IO (Constant () b)
forall a b. (a -> b) -> a -> b
$ () -> Constant () b
forall k a (b :: k). a -> Constant a b
Constant ()
PatchDMap k (Constant (IORef (ChildReadyState (Some k))))
p' <- (DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))))
-> PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
-> IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
-> IO (PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DMap k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))))
-> PatchDMap k (Constant (IORef (ChildReadyState (Some k))))
forall k (k1 :: k -> *) (v :: k -> *).
DMap k1 (ComposeMaybe v) -> PatchDMap k1 v
PatchDMap (IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
-> IO (PatchDMap k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
-> IO (PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ (forall v.
k v
-> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') v
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v))
-> DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
(g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey forall v.
k v
-> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') v
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v)
new (DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))))))
-> DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
forall a b. (a -> b) -> a -> b
$ PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *).
PatchDMap k2 v -> DMap k2 (ComposeMaybe v)
unPatchDMap PatchDMap k (Compose (TraverseChild t m (Some k)) v')
p
DMap k (Constant ())
_ <- (forall v.
k v
-> Constant (IORef (ChildReadyState (Some k))) v
-> IO (Constant () v))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant ()))
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
(g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey forall v.
k v
-> Constant (IORef (ChildReadyState (Some k))) v
-> IO (Constant () v)
forall k k p a (b :: k) (b :: k).
p -> Constant (IORef (ChildReadyState a)) b -> IO (Constant () b)
delete (DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant ())))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant ()))
forall a b. (a -> b) -> a -> b
$ PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
forall k1 (k2 :: k1 -> *) (v :: k1 -> *) (v' :: k1 -> *).
GCompare k2 =>
PatchDMap k2 v -> DMap k2 v' -> DMap k2 v'
PatchDMap.getDeletions PatchDMap k (Compose (TraverseChild t m (Some k)) v')
p DMap k (Constant (IORef (ChildReadyState (Some k))))
old
DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall (m :: * -> *) a. Monad m => a -> m a
return (DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ PatchDMap k (Constant (IORef (ChildReadyState (Some k))))
-> PatchTarget
(PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
-> PatchTarget
(PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
forall p. Patch p => p -> PatchTarget p -> PatchTarget p
applyAlways PatchDMap k (Constant (IORef (ChildReadyState (Some k))))
p' DMap k (Constant (IORef (ChildReadyState (Some k))))
PatchTarget
(PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
old
(forall (vv :: * -> *) (vv' :: * -> *).
(forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (PatchDMap k vv)
-> DomRenderHookT t m (DMap k vv', Event t (PatchDMap k vv')))
-> (forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a) -> PatchDMap k vv -> PatchDMap k vv')
-> (PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
-> Text
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
forall k k t (m :: * -> *) (k :: k -> *)
(p :: (k -> *) -> (k -> *) -> *) (v :: k -> *) (v' :: k -> *)
(s :: k).
(Adjustable t m, MonadHold t m, GCompare k, MonadIO m, MonadJSM m,
PrimMonad m, MonadFix m, Patch (p k v), Patch (p k (Constant Int)),
PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int),
Patch (p k (Compose (TraverseChild t m (Some k)) v')),
PatchTarget (p k (Compose (TraverseChild t m (Some k)) v'))
~ DMap k (Compose (TraverseChild t m (Some k)) v'),
Monoid (p k (Compose (TraverseChild t m (Some k)) v')),
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
(forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
-> (forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv')
-> (p k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
-> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> (forall (a :: k).
k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (p k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (p k v'))
hoistTraverseWithKeyWithAdjust forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (PatchDMap k vv)
-> DomRenderHookT t m (DMap k vv', Event t (PatchDMap k vv'))
traverseDMapWithKeyWithAdjust forall k1 (v :: k1 -> *) (v' :: k1 -> *) (k2 :: k1 -> *).
(forall (a :: k1). v a -> v' a)
-> PatchDMap k2 v -> PatchDMap k2 v'
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a) -> PatchDMap k vv -> PatchDMap k vv'
mapPatchDMap PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness ((IORef (Map (Some k) Text)
-> Text
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT
s t m (DMap k v', Event t (PatchDMap k v')))
-> (IORef (Map (Some k) Text)
-> Text
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
forall a b. (a -> b) -> a -> b
$ \IORef (Map (Some k) Text)
placeholders Text
lastPlaceholder (PatchDMap DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
patch) -> do
Map (Some k) Text
phs <- IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map (Some k) Text) -> JSM (Map (Some k) Text))
-> IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> IO (Map (Some k) Text)
forall a. IORef a -> IO a
readIORef IORef (Map (Some k) Text)
placeholders
[DSum k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))]
-> (DSum k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> JSM ())
-> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> [DSum
k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
patch) ((DSum k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> JSM ())
-> JSM ())
-> (DSum k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> JSM ())
-> JSM ()
forall a b. (a -> b) -> a -> b
$ \(k a
k :=> ComposeMaybe Maybe (Compose (TraverseChild t m (Some k)) v' a)
mv) -> do
let nextPlaceholder :: Text
nextPlaceholder = Text -> ((Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
lastPlaceholder (Some k, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Some k -> Map (Some k) Text -> Maybe (Some k, Text)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGT (k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k) Map (Some k) Text
phs
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
Maybe (Compose (TraverseChild t m (Some k)) v' a)
-> (Compose (TraverseChild t m (Some k)) v' a -> JSM ()) -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Compose (TraverseChild t m (Some k)) v' a)
mv ((Compose (TraverseChild t m (Some k)) v' a -> JSM ()) -> JSM ())
-> (Compose (TraverseChild t m (Some k)) v' a -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \(Compose (TraverseChild Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
e v' a
_)) -> case Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
e of
Left TraverseChildHydration t m
_hydration -> () -> JSM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Right TraverseChildImmediate (Some k)
immediate -> do
TraverseChildImmediate (Some k) -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate (Some k)
immediate DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`insertBefore` Text
nextPlaceholder
let weakened :: PatchMap (Some k) (Either (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened :: PatchMap
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened = (forall a.
Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> PatchMap
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
forall k1 (v :: k1 -> *) v' (k2 :: k1 -> *).
(forall (a :: k1). v a -> v')
-> PatchDMap k2 v -> PatchMap (Some k2) v'
weakenPatchDMapWith (TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode (TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> (Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> PatchMap
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> PatchMap
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
forall a b. (a -> b) -> a -> b
$ DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
forall k (k1 :: k -> *) (v :: k -> *).
DMap k1 (ComposeMaybe v) -> PatchDMap k1 v
PatchDMap DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
patch
filtered :: PatchMap (Some k) DOM.Text
filtered :: PatchMap (Some k) Text
filtered = Map (Some k) (Maybe Text) -> PatchMap (Some k) Text
forall k v. Map k (Maybe v) -> PatchMap k v
PatchMap (Map (Some k) (Maybe Text) -> PatchMap (Some k) Text)
-> Map (Some k) (Maybe Text) -> PatchMap (Some k) Text
forall a b. (a -> b) -> a -> b
$ ((Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (Maybe Text))
-> Map
(Some k)
(Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> Map (Some k) (Maybe Text))
-> Map
(Some k)
(Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> (Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (Maybe Text))
-> Map (Some k) (Maybe Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (Maybe Text))
-> Map
(Some k)
(Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> Map (Some k) (Maybe Text)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (PatchMap
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Map
(Some k)
(Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
forall k v. PatchMap k v -> Map k (Maybe v)
unPatchMap PatchMap
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened) ((Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (Maybe Text))
-> Map (Some k) (Maybe Text))
-> (Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (Maybe Text))
-> Map (Some k) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \case
Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
Nothing -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
forall a. Maybe a
Nothing
Just (Left TraverseChildHydration t m
_) -> Maybe (Maybe Text)
forall a. Maybe a
Nothing
Just (Right TraverseChildImmediate (Some k)
immediate) -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Maybe Text -> Maybe (Maybe Text))
-> Maybe Text -> Maybe (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate (Some k) -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate (Some k)
immediate
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> Map (Some k) Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map (Some k) Text)
placeholders (Map (Some k) Text -> IO ()) -> Map (Some k) Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Map (Some k) Text -> Maybe (Map (Some k) Text) -> Map (Some k) Text
forall a. a -> Maybe a -> a
fromMaybe Map (Some k) Text
phs (Maybe (Map (Some k) Text) -> Map (Some k) Text)
-> Maybe (Map (Some k) Text) -> Map (Some k) Text
forall a b. (a -> b) -> a -> b
$ PatchMap (Some k) Text
-> PatchTarget (PatchMap (Some k) Text)
-> Maybe (PatchTarget (PatchMap (Some k) Text))
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply PatchMap (Some k) Text
filtered Map (Some k) Text
PatchTarget (PatchMap (Some k) Text)
phs
{-# INLINABLE traverseIntMapWithKeyWithAdjust' #-}
traverseIntMapWithKeyWithAdjust'
:: forall s t m v v'. (Adjustable t m, MonadJSM m, MonadFix m, PrimMonad m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)
=> (IntMap.Key -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust' :: (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust' = do
let updateChildUnreadiness :: PatchIntMap (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
updateChildUnreadiness (p :: PatchIntMap (TraverseChild t m Int v')
p@(PatchIntMap IntMap (Maybe (TraverseChild t m Int v'))
pInner) :: PatchIntMap (TraverseChild t m Int v')) IntMap (IORef (ChildReadyState Int))
old = do
let new :: IntMap.Key -> Maybe (TraverseChild t m Int v') -> IO (Maybe (IORef (ChildReadyState Int)))
new :: Int
-> Maybe (TraverseChild t m Int v')
-> IO (Maybe (IORef (ChildReadyState Int)))
new Int
k Maybe (TraverseChild t m Int v')
m = case Maybe (TraverseChild t m Int v')
m of
Maybe (TraverseChild t m Int v')
Nothing -> Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IORef (ChildReadyState Int))
forall a. Maybe a
Nothing
Just (TraverseChild (Left TraverseChildHydration t m
_hydration) v'
_) -> Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (IORef (ChildReadyState Int))
forall a. Maybe a
Nothing
Just (TraverseChild (Right TraverseChildImmediate Int
immediate) v'
_) -> do
let sRef :: IORef (ChildReadyState Int)
sRef = TraverseChildImmediate Int -> IORef (ChildReadyState Int)
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate Int
immediate
IORef (ChildReadyState Int) -> IO (ChildReadyState Int)
forall a. IORef a -> IO a
readIORef IORef (ChildReadyState Int)
sRef IO (ChildReadyState Int)
-> (ChildReadyState Int
-> IO (Maybe (IORef (ChildReadyState Int))))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState Int
ChildReadyState_Ready -> Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IORef (ChildReadyState Int))
forall a. Maybe a
Nothing
ChildReadyState_Unready Maybe Int
_ -> do
IORef (ChildReadyState Int) -> ChildReadyState Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState Int)
sRef (ChildReadyState Int -> IO ()) -> ChildReadyState Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Int -> ChildReadyState Int
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe Int -> ChildReadyState Int)
-> Maybe Int -> ChildReadyState Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
k
Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int))))
-> Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState Int) -> Maybe (IORef (ChildReadyState Int))
forall a. a -> Maybe a
Just IORef (ChildReadyState Int)
sRef
delete :: p -> IORef (ChildReadyState a) -> IO ()
delete p
_ IORef (ChildReadyState a)
sRef = do
IORef (ChildReadyState a) -> ChildReadyState a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState a)
sRef (ChildReadyState a -> IO ()) -> ChildReadyState a -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe a -> ChildReadyState a
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready Maybe a
forall a. Maybe a
Nothing
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
PatchIntMap (IORef (ChildReadyState Int))
p' <- IntMap (Maybe (IORef (ChildReadyState Int)))
-> PatchIntMap (IORef (ChildReadyState Int))
forall a. IntMap (Maybe a) -> PatchIntMap a
PatchIntMap (IntMap (Maybe (IORef (ChildReadyState Int)))
-> PatchIntMap (IORef (ChildReadyState Int)))
-> IO (IntMap (Maybe (IORef (ChildReadyState Int))))
-> IO (PatchIntMap (IORef (ChildReadyState Int)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int
-> Maybe (TraverseChild t m Int v')
-> IO (Maybe (IORef (ChildReadyState Int))))
-> IntMap (Maybe (TraverseChild t m Int v'))
-> IO (IntMap (Maybe (IORef (ChildReadyState Int))))
forall (t :: * -> *) a b.
Applicative t =>
(Int -> a -> t b) -> IntMap a -> t (IntMap b)
IntMap.traverseWithKey Int
-> Maybe (TraverseChild t m Int v')
-> IO (Maybe (IORef (ChildReadyState Int)))
new IntMap (Maybe (TraverseChild t m Int v'))
pInner
IntMap ()
_ <- (Int -> IORef (ChildReadyState Int) -> IO ())
-> IntMap (IORef (ChildReadyState Int)) -> IO (IntMap ())
forall (t :: * -> *) a b.
Applicative t =>
(Int -> a -> t b) -> IntMap a -> t (IntMap b)
IntMap.traverseWithKey Int -> IORef (ChildReadyState Int) -> IO ()
forall p a. p -> IORef (ChildReadyState a) -> IO ()
delete (IntMap (IORef (ChildReadyState Int)) -> IO (IntMap ()))
-> IntMap (IORef (ChildReadyState Int)) -> IO (IntMap ())
forall a b. (a -> b) -> a -> b
$ PatchIntMap (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IntMap (IORef (ChildReadyState Int))
forall v v'. PatchIntMap v -> IntMap v' -> IntMap v'
FastMutableIntMap.getDeletions PatchIntMap (TraverseChild t m Int v')
p IntMap (IORef (ChildReadyState Int))
old
IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int))))
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
forall a b. (a -> b) -> a -> b
$ PatchIntMap (IORef (ChildReadyState Int))
-> PatchTarget (PatchIntMap (IORef (ChildReadyState Int)))
-> PatchTarget (PatchIntMap (IORef (ChildReadyState Int)))
forall p. Patch p => p -> PatchTarget p -> PatchTarget p
applyAlways PatchIntMap (IORef (ChildReadyState Int))
p' IntMap (IORef (ChildReadyState Int))
PatchTarget (PatchIntMap (IORef (ChildReadyState Int)))
old
((Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (PatchIntMap v)
-> DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (PatchIntMap (TraverseChild t m Int v'))))
-> (PatchIntMap (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap Text)
-> Text -> PatchIntMap (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
forall k t (m :: * -> *) (p :: * -> *) v' (s :: k) v.
(Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m,
PrimMonad m, Monoid (p (TraverseChild t m Int v')), Functor p,
PatchTarget (p (HydrationRunnerT t m ()))
~ IntMap (HydrationRunnerT t m ()),
PatchTarget (p (TraverseChild t m Int v'))
~ IntMap (TraverseChild t m Int v'),
Patch (p (HydrationRunnerT t m ())),
Patch (p (TraverseChild t m Int v')),
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
((Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (p v)
-> DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v'))))
-> (p (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap Text)
-> Text -> p (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (p v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (p v'))
hoistTraverseIntMapWithKeyWithAdjust (Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (PatchIntMap v)
-> DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (PatchIntMap (TraverseChild t m Int v')))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Int -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust PatchIntMap (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
updateChildUnreadiness ((IORef (IntMap Text)
-> Text -> PatchIntMap (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT
s t m (IntMap v', Event t (PatchIntMap v')))
-> (IORef (IntMap Text)
-> Text -> PatchIntMap (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
forall a b. (a -> b) -> a -> b
$ \IORef (IntMap Text)
placeholders Text
lastPlaceholder (PatchIntMap IntMap (Maybe (TraverseChild t m Int v'))
p) -> do
IntMap Text
phs <- IO (IntMap Text) -> JSM (IntMap Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IntMap Text) -> JSM (IntMap Text))
-> IO (IntMap Text) -> JSM (IntMap Text)
forall a b. (a -> b) -> a -> b
$ IORef (IntMap Text) -> IO (IntMap Text)
forall a. IORef a -> IO a
readIORef IORef (IntMap Text)
placeholders
[(Int, Maybe (TraverseChild t m Int v'))]
-> ((Int, Maybe (TraverseChild t m Int v')) -> JSM ()) -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (IntMap (Maybe (TraverseChild t m Int v'))
-> [(Int, Maybe (TraverseChild t m Int v'))]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap (Maybe (TraverseChild t m Int v'))
p) (((Int, Maybe (TraverseChild t m Int v')) -> JSM ()) -> JSM ())
-> ((Int, Maybe (TraverseChild t m Int v')) -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \(Int
k, Maybe (TraverseChild t m Int v')
mv) -> do
let nextPlaceholder :: Text
nextPlaceholder = Text -> ((Int, Text) -> Text) -> Maybe (Int, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
lastPlaceholder (Int, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Int, Text) -> Text) -> Maybe (Int, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Int -> IntMap Text -> Maybe (Int, Text)
forall a. Int -> IntMap a -> Maybe (Int, a)
IntMap.lookupGT Int
k IntMap Text
phs
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
Maybe (TraverseChild t m Int v')
-> (TraverseChild t m Int v' -> JSM ()) -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (TraverseChild t m Int v')
mv ((TraverseChild t m Int v' -> JSM ()) -> JSM ())
-> (TraverseChild t m Int v' -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \(TraverseChild Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
e v'
_) -> case Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
e of
Left TraverseChildHydration t m
_hydration -> () -> JSM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Right TraverseChildImmediate Int
immediate -> do
TraverseChildImmediate Int -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate Int
immediate DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`insertBefore` Text
nextPlaceholder
let filtered :: PatchIntMap DOM.Text
filtered :: PatchIntMap Text
filtered = IntMap (Maybe Text) -> PatchIntMap Text
forall a. IntMap (Maybe a) -> PatchIntMap a
PatchIntMap (IntMap (Maybe Text) -> PatchIntMap Text)
-> IntMap (Maybe Text) -> PatchIntMap Text
forall a b. (a -> b) -> a -> b
$ ((Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
-> IntMap (Maybe (TraverseChild t m Int v'))
-> IntMap (Maybe Text))
-> IntMap (Maybe (TraverseChild t m Int v'))
-> (Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
-> IntMap (Maybe Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
-> IntMap (Maybe (TraverseChild t m Int v')) -> IntMap (Maybe Text)
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe IntMap (Maybe (TraverseChild t m Int v'))
p ((Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
-> IntMap (Maybe Text))
-> (Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
-> IntMap (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \case
Maybe (TraverseChild t m Int v')
Nothing -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
forall a. Maybe a
Nothing
Just TraverseChild t m Int v'
tc
| Right TraverseChildImmediate Int
immediate <- TraverseChild t m Int v'
-> Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode TraverseChild t m Int v'
tc -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Maybe Text -> Maybe (Maybe Text))
-> Maybe Text -> Maybe (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate Int -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate Int
immediate
| Bool
otherwise -> Maybe (Maybe Text)
forall a. Maybe a
Nothing
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef (IntMap Text) -> IntMap Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap Text)
placeholders (IntMap Text -> IO ()) -> IntMap Text -> IO ()
forall a b. (a -> b) -> a -> b
$! IntMap Text -> Maybe (IntMap Text) -> IntMap Text
forall a. a -> Maybe a -> a
fromMaybe IntMap Text
phs (Maybe (IntMap Text) -> IntMap Text)
-> Maybe (IntMap Text) -> IntMap Text
forall a b. (a -> b) -> a -> b
$ PatchIntMap Text
-> PatchTarget (PatchIntMap Text)
-> Maybe (PatchTarget (PatchIntMap Text))
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply PatchIntMap Text
filtered IntMap Text
PatchTarget (PatchIntMap Text)
phs
{-# SPECIALIZE traverseIntMapWithKeyWithAdjust'
:: (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM v')
-> IntMap v
-> Event DomTimeline (PatchIntMap v)
-> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
#-}
{-# SPECIALIZE traverseIntMapWithKeyWithAdjust'
:: (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM v')
-> IntMap v
-> Event DomTimeline (PatchIntMap v)
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
#-}
data ChildReadyState a
= ChildReadyState_Ready
| ChildReadyState_Unready !(Maybe a)
deriving (Int -> ChildReadyState a -> ShowS
[ChildReadyState a] -> ShowS
ChildReadyState a -> String
(Int -> ChildReadyState a -> ShowS)
-> (ChildReadyState a -> String)
-> ([ChildReadyState a] -> ShowS)
-> Show (ChildReadyState a)
forall a. Show a => Int -> ChildReadyState a -> ShowS
forall a. Show a => [ChildReadyState a] -> ShowS
forall a. Show a => ChildReadyState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChildReadyState a] -> ShowS
$cshowList :: forall a. Show a => [ChildReadyState a] -> ShowS
show :: ChildReadyState a -> String
$cshow :: forall a. Show a => ChildReadyState a -> String
showsPrec :: Int -> ChildReadyState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ChildReadyState a -> ShowS
Show, ReadPrec [ChildReadyState a]
ReadPrec (ChildReadyState a)
Int -> ReadS (ChildReadyState a)
ReadS [ChildReadyState a]
(Int -> ReadS (ChildReadyState a))
-> ReadS [ChildReadyState a]
-> ReadPrec (ChildReadyState a)
-> ReadPrec [ChildReadyState a]
-> Read (ChildReadyState a)
forall a. Read a => ReadPrec [ChildReadyState a]
forall a. Read a => ReadPrec (ChildReadyState a)
forall a. Read a => Int -> ReadS (ChildReadyState a)
forall a. Read a => ReadS [ChildReadyState a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChildReadyState a]
$creadListPrec :: forall a. Read a => ReadPrec [ChildReadyState a]
readPrec :: ReadPrec (ChildReadyState a)
$creadPrec :: forall a. Read a => ReadPrec (ChildReadyState a)
readList :: ReadS [ChildReadyState a]
$creadList :: forall a. Read a => ReadS [ChildReadyState a]
readsPrec :: Int -> ReadS (ChildReadyState a)
$creadsPrec :: forall a. Read a => Int -> ReadS (ChildReadyState a)
Read, ChildReadyState a -> ChildReadyState a -> Bool
(ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> Eq (ChildReadyState a)
forall a. Eq a => ChildReadyState a -> ChildReadyState a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChildReadyState a -> ChildReadyState a -> Bool
$c/= :: forall a. Eq a => ChildReadyState a -> ChildReadyState a -> Bool
== :: ChildReadyState a -> ChildReadyState a -> Bool
$c== :: forall a. Eq a => ChildReadyState a -> ChildReadyState a -> Bool
Eq, Eq (ChildReadyState a)
Eq (ChildReadyState a)
-> (ChildReadyState a -> ChildReadyState a -> Ordering)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> ChildReadyState a)
-> (ChildReadyState a -> ChildReadyState a -> ChildReadyState a)
-> Ord (ChildReadyState a)
ChildReadyState a -> ChildReadyState a -> Bool
ChildReadyState a -> ChildReadyState a -> Ordering
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ChildReadyState a)
forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> Ordering
forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
min :: ChildReadyState a -> ChildReadyState a -> ChildReadyState a
$cmin :: forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
max :: ChildReadyState a -> ChildReadyState a -> ChildReadyState a
$cmax :: forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
>= :: ChildReadyState a -> ChildReadyState a -> Bool
$c>= :: forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
> :: ChildReadyState a -> ChildReadyState a -> Bool
$c> :: forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
<= :: ChildReadyState a -> ChildReadyState a -> Bool
$c<= :: forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
< :: ChildReadyState a -> ChildReadyState a -> Bool
$c< :: forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
compare :: ChildReadyState a -> ChildReadyState a -> Ordering
$ccompare :: forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (ChildReadyState a)
Ord)
insertAfterPreviousNode :: (Monad m, MonadJSM m) => DOM.IsNode node => node -> HydrationRunnerT t m ()
insertAfterPreviousNode :: node -> HydrationRunnerT t m ()
insertAfterPreviousNode node
node = do
Node
parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
Maybe Node
nextNode <- HydrationRunnerT t m (Maybe Node)
-> (Node -> HydrationRunnerT t m (Maybe Node))
-> Maybe Node
-> HydrationRunnerT t m (Maybe Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getFirstChild Node
parent) Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling (Maybe Node -> HydrationRunnerT t m (Maybe Node))
-> HydrationRunnerT t m (Maybe Node)
-> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) t.
Monad m =>
HydrationRunnerT t m (Maybe Node)
getPreviousNode
Node -> node -> Maybe Node -> HydrationRunnerT t m ()
forall (m :: * -> *) self node child.
(MonadDOM m, IsNode self, IsNode node, IsNode child) =>
self -> node -> Maybe child -> m ()
Node.insertBefore_ Node
parent node
node Maybe Node
nextNode
Maybe Node -> HydrationRunnerT t m ()
forall (m :: * -> *) t.
Monad m =>
Maybe Node -> HydrationRunnerT t m ()
setPreviousNode (Maybe Node -> HydrationRunnerT t m ())
-> Maybe Node -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ node -> Node
forall o. IsNode o => o -> Node
toNode node
node
{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}
hoistTraverseWithKeyWithAdjust
::
( Adjustable t m
, MonadHold t m
, GCompare k
, MonadIO m
, MonadJSM m
, PrimMonad m
, MonadFix m
, Patch (p k v)
, Patch (p k (Constant Int))
, PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)
, Patch (p k (Compose (TraverseChild t m (Some k)) v'))
, PatchTarget (p k (Compose (TraverseChild t m (Some k)) v')) ~ DMap k (Compose (TraverseChild t m (Some k)) v')
, Monoid (p k (Compose (TraverseChild t m (Some k)) v'))
, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document
)
=> (forall vv vv'.
(forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
-> (forall vv vv'. (forall a. 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.Map (Some k) DOM.Text) -> DOM.Text -> p 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 (p k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (p k v'))
hoistTraverseWithKeyWithAdjust :: (forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
-> (forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv')
-> (p k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
-> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> (forall (a :: k).
k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (p k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (p k v'))
hoistTraverseWithKeyWithAdjust forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> DomRenderHookT t m (DMap k vv', Event t (p k vv'))
base forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv'
mapPatch p k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness IORef (Map (Some k) Text)
-> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ()
applyDomUpdate_ forall (a :: k). k a -> v a -> HydrationDomBuilderT s t m (v' a)
f DMap k v
dm0 Event t (p k v)
dm' = do
Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
HydrationDomBuilderEnv t m
initialEnv <- ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s t m (HydrationDomBuilderEnv t m)
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(HydrationDomBuilderEnv t m)
forall r (m :: * -> *). MonadReader r m => m r
ask
let parentUnreadyChildren :: IORef Word
parentUnreadyChildren = HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren HydrationDomBuilderEnv t m
initialEnv
IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState (Some k)))), p k (Compose (TraverseChild t m (Some k)) v')) <- IO
(IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v')))
-> HydrationDomBuilderT
s
t
m
(IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v')))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v')))
-> HydrationDomBuilderT
s
t
m
(IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))))
-> IO
(IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v')))
-> HydrationDomBuilderT
s
t
m
(IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v')))
forall a b. (a -> b) -> a -> b
$ (DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO
(IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v')))
forall a. a -> IO (IORef a)
newIORef (DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall a. Monoid a => a
mempty
IORef Bool
haveEverBeenReady <- IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool))
-> IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
IORef (Map (Some k) Text)
placeholders <- IO (IORef (Map (Some k) Text))
-> HydrationDomBuilderT s t m (IORef (Map (Some k) Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Map (Some k) Text))
-> HydrationDomBuilderT s t m (IORef (Map (Some k) Text)))
-> IO (IORef (Map (Some k) Text))
-> HydrationDomBuilderT s t m (IORef (Map (Some k) Text))
forall a b. (a -> b) -> a -> b
$ Map (Some k) Text -> IO (IORef (Map (Some k) Text))
forall a. a -> IO (IORef a)
newIORef Map (Some k) Text
forall k a. Map k a
Map.empty
Text
lastPlaceholder <- Document -> Text -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
let applyDomUpdate :: p k (Compose (TraverseChild t m (Some k)) v') -> JSM ()
applyDomUpdate p k (Compose (TraverseChild t m (Some k)) v')
p = do
IORef (Map (Some k) Text)
-> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ()
applyDomUpdate_ IORef (Map (Some k) Text)
placeholders Text
lastPlaceholder p k (Compose (TraverseChild t m (Some k)) v')
p
JSM ()
markSelfReady
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> (DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange ((DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ())
-> (DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ()
forall a b. (a -> b) -> a -> b
$! (DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall a. Monoid a => a
mempty
markSelfReady :: JSM ()
markSelfReady = do
IO Bool -> JSM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
haveEverBeenReady) JSM Bool -> (Bool -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> do
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
Word
old <- IO Word -> JSM Word
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> JSM Word) -> IO Word -> JSM Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
parentUnreadyChildren
let new :: Word
new = Word -> Word
forall a. Enum a => a -> a
pred Word
old
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> Word -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Word
parentUnreadyChildren (Word -> IO ()) -> Word -> IO ()
forall a b. (a -> b) -> a -> b
$! Word
new
Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
new Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> JSM ()
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> JSM ()
_hydrationDomBuilderEnv_commitAction HydrationDomBuilderEnv t m
initialEnv
markChildReady :: IORef (ChildReadyState (Some k)) -> JSM ()
markChildReady :: IORef (ChildReadyState (Some k)) -> JSM ()
markChildReady IORef (ChildReadyState (Some k))
childReadyState = do
IO (ChildReadyState (Some k)) -> JSM (ChildReadyState (Some k))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (ChildReadyState (Some k)) -> IO (ChildReadyState (Some k))
forall a. IORef a -> IO a
readIORef IORef (ChildReadyState (Some k))
childReadyState) JSM (ChildReadyState (Some k))
-> (ChildReadyState (Some k) -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState (Some k)
ChildReadyState_Ready -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ChildReadyState_Unready Maybe (Some k)
countedAt -> do
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState (Some k))
-> ChildReadyState (Some k) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState (Some k))
childReadyState ChildReadyState (Some k)
forall a. ChildReadyState a
ChildReadyState_Ready
case Maybe (Some k)
countedAt of
Maybe (Some k)
Nothing -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Some k a
k) -> do
(DMap k (Constant (IORef (ChildReadyState (Some k))))
oldUnready, p k (Compose (TraverseChild t m (Some k)) v')
p) <- IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v')))
-> IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall a b. (a -> b) -> a -> b
$ IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall a. IORef a -> IO a
readIORef IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange
Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ DMap k (Constant (IORef (ChildReadyState (Some k)))) -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k (Constant (IORef (ChildReadyState (Some k))))
oldUnready) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
let newUnready :: DMap k (Constant (IORef (ChildReadyState (Some k))))
newUnready = k a
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> DMap k2 f
DMap.delete k a
k DMap k (Constant (IORef (ChildReadyState (Some k))))
oldUnready
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> (DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange (DMap k (Constant (IORef (ChildReadyState (Some k))))
newUnready, p k (Compose (TraverseChild t m (Some k)) v')
p)
Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DMap k (Constant (IORef (ChildReadyState (Some k)))) -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k (Constant (IORef (ChildReadyState (Some k))))
newUnready) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
p k (Compose (TraverseChild t m (Some k)) v') -> JSM ()
applyDomUpdate p k (Compose (TraverseChild t m (Some k)) v')
p
(DMap k (Compose (TraverseChild t m (Some k)) v')
children0 :: DMap k (Compose (TraverseChild t m (Some k)) v'), Event t (p k (Compose (TraverseChild t m (Some k)) v'))
children' :: Event t (p k (Compose (TraverseChild t m (Some k)) v')))
<- ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(DMap k (Compose (TraverseChild t m (Some k)) v'),
Event t (p k (Compose (TraverseChild t m (Some k)) v')))
-> HydrationDomBuilderT
s
t
m
(DMap k (Compose (TraverseChild t m (Some k)) v'),
Event t (p k (Compose (TraverseChild t m (Some k)) v')))
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(DMap k (Compose (TraverseChild t m (Some k)) v'),
Event t (p k (Compose (TraverseChild t m (Some k)) v')))
-> HydrationDomBuilderT
s
t
m
(DMap k (Compose (TraverseChild t m (Some k)) v'),
Event t (p k (Compose (TraverseChild t m (Some k)) v'))))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(DMap k (Compose (TraverseChild t m (Some k)) v'),
Event t (p k (Compose (TraverseChild t m (Some k)) v')))
-> HydrationDomBuilderT
s
t
m
(DMap k (Compose (TraverseChild t m (Some k)) v'),
Event t (p k (Compose (TraverseChild t m (Some k)) v')))
forall a b. (a -> b) -> a -> b
$ DomRenderHookT
t
m
(DMap k (Compose (TraverseChild t m (Some k)) v'),
Event t (p k (Compose (TraverseChild t m (Some k)) v')))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(DMap k (Compose (TraverseChild t m (Some k)) v'),
Event t (p k (Compose (TraverseChild t m (Some k)) v')))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT
t
m
(DMap k (Compose (TraverseChild t m (Some k)) v'),
Event t (p k (Compose (TraverseChild t m (Some k)) v')))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(DMap k (Compose (TraverseChild t m (Some k)) v'),
Event t (p k (Compose (TraverseChild t m (Some k)) v'))))
-> DomRenderHookT
t
m
(DMap k (Compose (TraverseChild t m (Some k)) v'),
Event t (p k (Compose (TraverseChild t m (Some k)) v')))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(DMap k (Compose (TraverseChild t m (Some k)) v'),
Event t (p k (Compose (TraverseChild t m (Some k)) v')))
forall a b. (a -> b) -> a -> b
$ (forall (a :: k).
k a
-> v a
-> DomRenderHookT t m (Compose (TraverseChild t m (Some k)) v' a))
-> DMap k v
-> Event t (p k v)
-> DomRenderHookT
t
m
(DMap k (Compose (TraverseChild t m (Some k)) v'),
Event t (p k (Compose (TraverseChild t m (Some k)) v')))
forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> DomRenderHookT t m (DMap k vv', Event t (p k vv'))
base (\k a
k v a
v -> HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState (Some k)) -> JSM ())
-> HydrationDomBuilderT s t m (v' a)
-> DomRenderHookT t m (Compose (TraverseChild t m (Some k)) v' a)
forall k k1 (m :: * -> *) t k (s :: k) (f :: k1 -> *) (a :: k1).
(MonadJSM m, Reflex t) =>
HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (f a)
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
drawChildUpdate HydrationDomBuilderEnv t m
initialEnv IORef (ChildReadyState (Some k)) -> JSM ()
markChildReady (HydrationDomBuilderT s t m (v' a)
-> DomRenderHookT t m (Compose (TraverseChild t m (Some k)) v' a))
-> HydrationDomBuilderT s t m (v' a)
-> DomRenderHookT t m (Compose (TraverseChild t m (Some k)) v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> HydrationDomBuilderT s t m (v' a)
forall (a :: k). k a -> v a -> HydrationDomBuilderT s t m (v' a)
f k a
k v a
v) DMap k v
dm0 Event t (p k v)
dm'
let processChild :: tag a
-> Compose (TraverseChild t m (Some tag)) g a
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
processChild tag a
k (Compose (TraverseChild Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some tag))
e g a
_)) = case Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some tag))
e of
Left TraverseChildHydration t m
_ -> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a))
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
forall a b. (a -> b) -> a -> b
$ Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
forall k (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
forall a. Maybe a
Nothing
Right TraverseChildImmediate (Some tag)
immediate -> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
forall k (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
IORef (ChildReadyState (Some tag))
-> IO (ChildReadyState (Some tag))
forall a. IORef a -> IO a
readIORef (TraverseChildImmediate (Some tag)
-> IORef (ChildReadyState (Some tag))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some tag)
immediate) IO (ChildReadyState (Some tag))
-> (ChildReadyState (Some tag)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a)))
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState (Some tag)
ChildReadyState_Ready -> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
forall a. Maybe a
Nothing
ChildReadyState_Unready Maybe (Some tag)
_ -> do
IORef (ChildReadyState (Some tag))
-> ChildReadyState (Some tag) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TraverseChildImmediate (Some tag)
-> IORef (ChildReadyState (Some tag))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some tag)
immediate) (ChildReadyState (Some tag) -> IO ())
-> ChildReadyState (Some tag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Some tag) -> ChildReadyState (Some tag)
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe (Some tag) -> ChildReadyState (Some tag))
-> Maybe (Some tag) -> ChildReadyState (Some tag)
forall a b. (a -> b) -> a -> b
$ Some tag -> Maybe (Some tag)
forall a. a -> Maybe a
Just (Some tag -> Maybe (Some tag)) -> Some tag -> Maybe (Some tag)
forall a b. (a -> b) -> a -> b
$ tag a -> Some tag
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some tag a
k
Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a)))
-> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
forall a b. (a -> b) -> a -> b
$ Constant (IORef (ChildReadyState (Some tag))) a
-> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
forall a. a -> Maybe a
Just (Constant (IORef (ChildReadyState (Some tag))) a
-> Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
-> Constant (IORef (ChildReadyState (Some tag))) a
-> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState (Some tag))
-> Constant (IORef (ChildReadyState (Some tag))) a
forall k a (b :: k). a -> Constant a b
Constant (TraverseChildImmediate (Some tag)
-> IORef (ChildReadyState (Some tag))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some tag)
immediate)
DMap k (Constant (IORef (ChildReadyState (Some k))))
initialUnready <- IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
-> HydrationDomBuilderT
s t m (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
-> HydrationDomBuilderT
s t m (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
-> HydrationDomBuilderT
s t m (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ (forall (v :: k).
k v
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v
-> Maybe (Constant (IORef (ChildReadyState (Some k))) v))
-> DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> Maybe (g v))
-> DMap k2 f -> DMap k2 g
DMap.mapMaybeWithKey (\k v
_ -> ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v
-> Maybe (Constant (IORef (ChildReadyState (Some k))) v)
forall k (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe) (DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))))
-> DMap k (Constant (IORef (ChildReadyState (Some k)))))
-> IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (v :: k).
k v
-> Compose (TraverseChild t m (Some k)) v' v
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v))
-> DMap k (Compose (TraverseChild t m (Some k)) v')
-> IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
forall k1 (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
(g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey forall (v :: k).
k v
-> Compose (TraverseChild t m (Some k)) v' v
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v)
forall k k1 k (tag :: k -> *) (a :: k) t (m :: * -> *)
(g :: k1 -> *) (a :: k1) (a :: k).
tag a
-> Compose (TraverseChild t m (Some tag)) g a
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
processChild DMap k (Compose (TraverseChild t m (Some k)) v')
children0
IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ if DMap k (Constant (IORef (ChildReadyState (Some k)))) -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k (Constant (IORef (ChildReadyState (Some k))))
initialUnready
then IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
else do
IORef Word -> (Word -> Word) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Word
parentUnreadyChildren Word -> Word
forall a. Enum a => a -> a
succ
IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> (DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange (DMap k (Constant (IORef (ChildReadyState (Some k))))
initialUnready, p k (Compose (TraverseChild t m (Some k)) v')
forall a. Monoid a => a
mempty)
HydrationDomBuilderT s t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT s t m HydrationMode
-> (HydrationMode -> HydrationDomBuilderT s t m ())
-> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Hydrating -> m (Incremental t (p k (Compose (TraverseChild t m (Some k)) v')))
-> (Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (PatchTarget (p k (Compose (TraverseChild t m (Some k)) v'))
-> Event t (p k (Compose (TraverseChild t m (Some k)) v'))
-> m (Incremental
t (p k (Compose (TraverseChild t m (Some k)) v')))
forall k (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental DMap k (Compose (TraverseChild t m (Some k)) v')
PatchTarget (p k (Compose (TraverseChild t m (Some k)) v'))
children0 Event t (p k (Compose (TraverseChild t m (Some k)) v'))
children') ((Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ())
-> (Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ \Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
children -> do
DMap k (Compose (TraverseChild t m (Some k)) v')
dm :: DMap k (Compose (TraverseChild t m (Some k)) v') <- Behavior t (DMap k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT
t m (DMap k (Compose (TraverseChild t m (Some k)) v'))
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t (DMap k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT
t m (DMap k (Compose (TraverseChild t m (Some k)) v')))
-> Behavior t (DMap k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT
t m (DMap k (Compose (TraverseChild t m (Some k)) v'))
forall a b. (a -> b) -> a -> b
$ Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
-> Behavior
t (PatchTarget (p k (Compose (TraverseChild t m (Some k)) v')))
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Behavior t (PatchTarget p)
currentIncremental Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
children
Map (Some k) Text
phs <- Map (Some k) (HydrationRunnerT t m Text)
-> HydrationRunnerT t m (Map (Some k) Text)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Map (Some k) (HydrationRunnerT t m Text)
-> HydrationRunnerT t m (Map (Some k) Text))
-> Map (Some k) (HydrationRunnerT t m Text)
-> HydrationRunnerT t m (Map (Some k) Text)
forall a b. (a -> b) -> a -> b
$ (forall (a :: k).
Compose (TraverseChild t m (Some k)) v' a
-> HydrationRunnerT t m Text)
-> DMap k (Compose (TraverseChild t m (Some k)) v')
-> Map (Some k) (HydrationRunnerT t m Text)
forall k1 (v :: k1 -> *) v' (k2 :: k1 -> *).
(forall (a :: k1). v a -> v') -> DMap k2 v -> Map (Some k2) v'
weakenDMapWith ((TraverseChildHydration t m -> HydrationRunnerT t m Text)
-> (TraverseChildImmediate (Some k) -> HydrationRunnerT t m Text)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
-> HydrationRunnerT t m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TraverseChildHydration t m -> HydrationRunnerT t m Text
forall t (m :: * -> *).
TraverseChildHydration t m -> HydrationRunnerT t m Text
_traverseChildHydration_delayed (Text -> HydrationRunnerT t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HydrationRunnerT t m Text)
-> (TraverseChildImmediate (Some k) -> Text)
-> TraverseChildImmediate (Some k)
-> HydrationRunnerT t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChildImmediate (Some k) -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder) (Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
-> HydrationRunnerT t m Text)
-> (Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Compose (TraverseChild t m (Some k)) v' a
-> HydrationRunnerT t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode (TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> (Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) DMap k (Compose (TraverseChild t m (Some k)) v')
dm
IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> Map (Some k) Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map (Some k) Text)
placeholders (Map (Some k) Text -> IO ()) -> Map (Some k) Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Map (Some k) Text
phs
Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
lastPlaceholder
HydrationMode
HydrationMode_Immediate -> do
let activate :: TraverseChildImmediate k -> HydrationDomBuilderT s t m Text
activate TraverseChildImmediate k
i = do
Node -> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT s t m ())
-> Node -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode (DocumentFragment -> Node) -> DocumentFragment -> Node
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate k -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate k
i
Text -> HydrationDomBuilderT s t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HydrationDomBuilderT s t m Text)
-> Text -> HydrationDomBuilderT s t m Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate k -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate k
i
Map (Some k) Text
phs <- Map (Some k) (HydrationDomBuilderT s t m Text)
-> HydrationDomBuilderT s t m (Map (Some k) Text)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Map (Some k) (HydrationDomBuilderT s t m Text)
-> HydrationDomBuilderT s t m (Map (Some k) Text))
-> Map (Some k) (HydrationDomBuilderT s t m Text)
-> HydrationDomBuilderT s t m (Map (Some k) Text)
forall a b. (a -> b) -> a -> b
$ (forall (a :: k).
Compose (TraverseChild t m (Some k)) v' a
-> HydrationDomBuilderT s t m Text)
-> DMap k (Compose (TraverseChild t m (Some k)) v')
-> Map (Some k) (HydrationDomBuilderT s t m Text)
forall k1 (v :: k1 -> *) v' (k2 :: k1 -> *).
(forall (a :: k1). v a -> v') -> DMap k2 v -> Map (Some k2) v'
weakenDMapWith ((TraverseChildHydration t m -> HydrationDomBuilderT s t m Text)
-> (TraverseChildImmediate (Some k)
-> HydrationDomBuilderT s t m Text)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
-> HydrationDomBuilderT s t m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String
-> TraverseChildHydration t m -> HydrationDomBuilderT s t m Text
forall a. HasCallStack => String -> a
error String
"impossible") TraverseChildImmediate (Some k) -> HydrationDomBuilderT s t m Text
forall k (m :: * -> *) k (s :: k) t.
MonadJSM m =>
TraverseChildImmediate k -> HydrationDomBuilderT s t m Text
activate (Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
-> HydrationDomBuilderT s t m Text)
-> (Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Compose (TraverseChild t m (Some k)) v' a
-> HydrationDomBuilderT s t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode (TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> (Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) DMap k (Compose (TraverseChild t m (Some k)) v')
children0
IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> Map (Some k) Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map (Some k) Text)
placeholders (Map (Some k) Text -> IO ()) -> Map (Some k) Text -> IO ()
forall a b. (a -> b) -> a -> b
$! Map (Some k) Text
phs
Node -> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT s t m ())
-> Node -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Text -> Node
forall o. IsNode o => o -> Node
toNode Text
lastPlaceholder
Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ())
-> Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Event t (p k (Compose (TraverseChild t m (Some k)) v'))
-> (p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p k (Compose (TraverseChild t m (Some k)) v'))
children' ((p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> Event t (JSM ()))
-> (p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \p k (Compose (TraverseChild t m (Some k)) v')
p -> do
(DMap k (Constant (IORef (ChildReadyState (Some k))))
oldUnready, p k (Compose (TraverseChild t m (Some k)) v')
oldP) <- IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v')))
-> IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall a b. (a -> b) -> a -> b
$ IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall a. IORef a -> IO a
readIORef IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange
DMap k (Constant (IORef (ChildReadyState (Some k))))
newUnready <- IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
-> JSM (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
-> JSM (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
-> JSM (DMap k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ p k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness p k (Compose (TraverseChild t m (Some k)) v')
p DMap k (Constant (IORef (ChildReadyState (Some k))))
oldUnready
let !newP :: p k (Compose (TraverseChild t m (Some k)) v')
newP = p k (Compose (TraverseChild t m (Some k)) v')
p p k (Compose (TraverseChild t m (Some k)) v')
-> p k (Compose (TraverseChild t m (Some k)) v')
-> p k (Compose (TraverseChild t m (Some k)) v')
forall a. Semigroup a => a -> a -> a
<> p k (Compose (TraverseChild t m (Some k)) v')
oldP
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> (DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange (DMap k (Constant (IORef (ChildReadyState (Some k))))
newUnready, p k (Compose (TraverseChild t m (Some k)) v')
newP)
Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DMap k (Constant (IORef (ChildReadyState (Some k)))) -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k (Constant (IORef (ChildReadyState (Some k))))
newUnready) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
p k (Compose (TraverseChild t m (Some k)) v') -> JSM ()
applyDomUpdate p k (Compose (TraverseChild t m (Some k)) v')
newP
let result0 :: DMap k v'
result0 = (forall (v :: k).
Compose (TraverseChild t m (Some k)) v' v -> v' v)
-> DMap k (Compose (TraverseChild t m (Some k)) v') -> DMap k v'
forall k1 (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v) -> DMap k2 f -> DMap k2 g
DMap.map (TraverseChild t m (Some k) (v' v) -> v' v
forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result (TraverseChild t m (Some k) (v' v) -> v' v)
-> (Compose (TraverseChild t m (Some k)) v' v
-> TraverseChild t m (Some k) (v' v))
-> Compose (TraverseChild t m (Some k)) v' v
-> v' v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' v
-> TraverseChild t m (Some k) (v' v)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) DMap k (Compose (TraverseChild t m (Some k)) v')
children0
result' :: Event t (p k v')
result' = Event t (p k (Compose (TraverseChild t m (Some k)) v'))
-> (p k (Compose (TraverseChild t m (Some k)) v') -> p k v')
-> Event t (p k v')
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p k (Compose (TraverseChild t m (Some k)) v'))
children' ((p k (Compose (TraverseChild t m (Some k)) v') -> p k v')
-> Event t (p k v'))
-> (p k (Compose (TraverseChild t m (Some k)) v') -> p k v')
-> Event t (p k v')
forall a b. (a -> b) -> a -> b
$ (forall (v :: k).
Compose (TraverseChild t m (Some k)) v' v -> v' v)
-> p k (Compose (TraverseChild t m (Some k)) v') -> p k v'
forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv'
mapPatch ((forall (v :: k).
Compose (TraverseChild t m (Some k)) v' v -> v' v)
-> p k (Compose (TraverseChild t m (Some k)) v') -> p k v')
-> (forall (v :: k).
Compose (TraverseChild t m (Some k)) v' v -> v' v)
-> p k (Compose (TraverseChild t m (Some k)) v')
-> p k v'
forall a b. (a -> b) -> a -> b
$ TraverseChild t m (Some k) (v' a) -> v' a
forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result (TraverseChild t m (Some k) (v' a) -> v' a)
-> (Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> v' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
(DMap k v', Event t (p k v'))
-> HydrationDomBuilderT s t m (DMap k v', Event t (p k v'))
forall (m :: * -> *) a. Monad m => a -> m a
return (DMap k v'
result0, Event t (p k v')
result')
{-# INLINE hoistTraverseIntMapWithKeyWithAdjust #-}
hoistTraverseIntMapWithKeyWithAdjust ::
( Adjustable t m
, MonadHold t m
, MonadJSM m
, MonadFix m
, PrimMonad m
, Monoid (p (TraverseChild t m Int v'))
, Functor p
, PatchTarget (p (HydrationRunnerT t m ())) ~ IntMap (HydrationRunnerT t m ())
, PatchTarget (p (TraverseChild t m Int v')) ~ IntMap (TraverseChild t m Int v')
, Patch (p (HydrationRunnerT t m ()))
, Patch (p (TraverseChild t m Int v'))
, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document
)
=> ((IntMap.Key -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (p v)
-> DomRenderHookT t m (IntMap (TraverseChild t m Int v'), Event t (p (TraverseChild t m Int v'))))
-> (p (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap DOM.Text)
-> DOM.Text
-> p (TraverseChild t m Int v')
-> JSM ())
-> (IntMap.Key -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (p v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (p v'))
hoistTraverseIntMapWithKeyWithAdjust :: ((Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (p v)
-> DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v'))))
-> (p (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap Text)
-> Text -> p (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (p v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (p v'))
hoistTraverseIntMapWithKeyWithAdjust (Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (p v)
-> DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v')))
base p (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
updateChildUnreadiness IORef (IntMap Text)
-> Text -> p (TraverseChild t m Int v') -> JSM ()
applyDomUpdate_ Int -> v -> HydrationDomBuilderT s t m v'
f IntMap v
dm0 Event t (p v)
dm' = do
Document
doc <- HydrationDomBuilderT s t m Document
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
HydrationDomBuilderEnv t m
initialEnv <- ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s t m (HydrationDomBuilderEnv t m)
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(HydrationDomBuilderEnv t m)
forall r (m :: * -> *). MonadReader r m => m r
ask
let parentUnreadyChildren :: IORef Word
parentUnreadyChildren = HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren HydrationDomBuilderEnv t m
initialEnv
IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
pendingChange :: IORef (IntMap (IORef (ChildReadyState Int)), p (TraverseChild t m Int v')) <- IO
(IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v')))
-> HydrationDomBuilderT
s
t
m
(IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v')))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v')))
-> HydrationDomBuilderT
s
t
m
(IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))))
-> IO
(IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v')))
-> HydrationDomBuilderT
s
t
m
(IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v')))
forall a b. (a -> b) -> a -> b
$ (IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO
(IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v')))
forall a. a -> IO (IORef a)
newIORef (IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall a. Monoid a => a
mempty
IORef Bool
haveEverBeenReady <- IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool))
-> IO (IORef Bool) -> HydrationDomBuilderT s t m (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
IORef (IntMap Text)
placeholders <- IO (IORef (IntMap Text))
-> HydrationDomBuilderT s t m (IORef (IntMap Text))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (IntMap Text))
-> HydrationDomBuilderT s t m (IORef (IntMap Text)))
-> IO (IORef (IntMap Text))
-> HydrationDomBuilderT s t m (IORef (IntMap Text))
forall a b. (a -> b) -> a -> b
$ IntMap Text -> IO (IORef (IntMap Text))
forall a. a -> IO (IORef a)
newIORef IntMap Text
forall a. IntMap a
IntMap.empty
Text
lastPlaceholder <- Document -> Text -> HydrationDomBuilderT s t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
let applyDomUpdate :: p (TraverseChild t m Int v') -> JSM ()
applyDomUpdate p (TraverseChild t m Int v')
p = do
IORef (IntMap Text)
-> Text -> p (TraverseChild t m Int v') -> JSM ()
applyDomUpdate_ IORef (IntMap Text)
placeholders Text
lastPlaceholder p (TraverseChild t m Int v')
p
JSM ()
markSelfReady
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> (IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
pendingChange ((IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO ())
-> (IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO ()
forall a b. (a -> b) -> a -> b
$! (IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall a. Monoid a => a
mempty
markSelfReady :: JSM ()
markSelfReady = do
IO Bool -> JSM Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
haveEverBeenReady) JSM Bool -> (Bool -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> do
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
Word
old <- IO Word -> JSM Word
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> JSM Word) -> IO Word -> JSM Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
parentUnreadyChildren
let new :: Word
new = Word -> Word
forall a. Enum a => a -> a
pred Word
old
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Word -> Word -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Word
parentUnreadyChildren (Word -> IO ()) -> Word -> IO ()
forall a b. (a -> b) -> a -> b
$! Word
new
Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
new Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> JSM ()
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> JSM ()
_hydrationDomBuilderEnv_commitAction HydrationDomBuilderEnv t m
initialEnv
markChildReady :: IORef (ChildReadyState Int) -> JSM ()
markChildReady :: IORef (ChildReadyState Int) -> JSM ()
markChildReady IORef (ChildReadyState Int)
childReadyState = do
IO (ChildReadyState Int) -> JSM (ChildReadyState Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (ChildReadyState Int) -> IO (ChildReadyState Int)
forall a. IORef a -> IO a
readIORef IORef (ChildReadyState Int)
childReadyState) JSM (ChildReadyState Int)
-> (ChildReadyState Int -> JSM ()) -> JSM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState Int
ChildReadyState_Ready -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ChildReadyState_Unready Maybe Int
countedAt -> do
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState Int) -> ChildReadyState Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState Int)
childReadyState ChildReadyState Int
forall a. ChildReadyState a
ChildReadyState_Ready
case Maybe Int
countedAt of
Maybe Int
Nothing -> () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Int
k -> do
(IntMap (IORef (ChildReadyState Int))
oldUnready, p (TraverseChild t m Int v')
p) <- IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> JSM
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> JSM
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v')))
-> IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> JSM
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall a b. (a -> b) -> a -> b
$ IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall a. IORef a -> IO a
readIORef IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
pendingChange
Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntMap (IORef (ChildReadyState Int)) -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap (IORef (ChildReadyState Int))
oldUnready) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
let newUnready :: IntMap (IORef (ChildReadyState Int))
newUnready = Int
-> IntMap (IORef (ChildReadyState Int))
-> IntMap (IORef (ChildReadyState Int))
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
k IntMap (IORef (ChildReadyState Int))
oldUnready
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> (IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
pendingChange (IntMap (IORef (ChildReadyState Int))
newUnready, p (TraverseChild t m Int v')
p)
Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IntMap (IORef (ChildReadyState Int)) -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap (IORef (ChildReadyState Int))
newUnready) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
p (TraverseChild t m Int v') -> JSM ()
applyDomUpdate p (TraverseChild t m Int v')
p
(IntMap (TraverseChild t m Int v')
children0 :: IntMap (TraverseChild t m Int v'), Event t (p (TraverseChild t m Int v'))
children' :: Event t (p (TraverseChild t m Int v')))
<- ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v')))
-> HydrationDomBuilderT
s
t
m
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v')))
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v')))
-> HydrationDomBuilderT
s
t
m
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v'))))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v')))
-> HydrationDomBuilderT
s
t
m
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v')))
forall a b. (a -> b) -> a -> b
$ DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v')))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v')))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v')))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v'))))
-> DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v')))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v')))
forall a b. (a -> b) -> a -> b
$ (Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (p v)
-> DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v')))
base (\Int
k v
v -> HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState Int) -> JSM ())
-> HydrationDomBuilderT s t m v'
-> DomRenderHookT t m (TraverseChild t m Int v')
forall k (m :: * -> *) t k (s :: k) v.
(MonadIO m, MonadJSM m, Reflex t) =>
HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m v
-> DomRenderHookT t m (TraverseChild t m k v)
drawChildUpdateInt HydrationDomBuilderEnv t m
initialEnv IORef (ChildReadyState Int) -> JSM ()
markChildReady (HydrationDomBuilderT s t m v'
-> DomRenderHookT t m (TraverseChild t m Int v'))
-> HydrationDomBuilderT s t m v'
-> DomRenderHookT t m (TraverseChild t m Int v')
forall a b. (a -> b) -> a -> b
$ Int -> v -> HydrationDomBuilderT s t m v'
f Int
k v
v) IntMap v
dm0 Event t (p v)
dm'
let processChild :: k
-> TraverseChild t m k a -> IO (Maybe (IORef (ChildReadyState k)))
processChild k
k (TraverseChild Either (TraverseChildHydration t m) (TraverseChildImmediate k)
e a
_) = case Either (TraverseChildHydration t m) (TraverseChildImmediate k)
e of
Left TraverseChildHydration t m
_ -> Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (IORef (ChildReadyState k))
forall a. Maybe a
Nothing
Right TraverseChildImmediate k
immediate -> do
IORef (ChildReadyState k) -> IO (ChildReadyState k)
forall a. IORef a -> IO a
readIORef (TraverseChildImmediate k -> IORef (ChildReadyState k)
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate k
immediate) IO (ChildReadyState k)
-> (ChildReadyState k -> IO (Maybe (IORef (ChildReadyState k))))
-> IO (Maybe (IORef (ChildReadyState k)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState k
ChildReadyState_Ready -> Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IORef (ChildReadyState k))
forall a. Maybe a
Nothing
ChildReadyState_Unready Maybe k
_ -> do
IORef (ChildReadyState k) -> ChildReadyState k -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TraverseChildImmediate k -> IORef (ChildReadyState k)
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate k
immediate) (ChildReadyState k -> IO ()) -> ChildReadyState k -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe k -> ChildReadyState k
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe k -> ChildReadyState k) -> Maybe k -> ChildReadyState k
forall a b. (a -> b) -> a -> b
$ k -> Maybe k
forall a. a -> Maybe a
Just k
k
Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k))))
-> Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k)))
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState k) -> Maybe (IORef (ChildReadyState k))
forall a. a -> Maybe a
Just (TraverseChildImmediate k -> IORef (ChildReadyState k)
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate k
immediate)
IntMap (IORef (ChildReadyState Int))
initialUnready <- IO (IntMap (IORef (ChildReadyState Int)))
-> HydrationDomBuilderT
s t m (IntMap (IORef (ChildReadyState Int)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IntMap (IORef (ChildReadyState Int)))
-> HydrationDomBuilderT
s t m (IntMap (IORef (ChildReadyState Int))))
-> IO (IntMap (IORef (ChildReadyState Int)))
-> HydrationDomBuilderT
s t m (IntMap (IORef (ChildReadyState Int)))
forall a b. (a -> b) -> a -> b
$ (Maybe (IORef (ChildReadyState Int))
-> Maybe (IORef (ChildReadyState Int)))
-> IntMap (Maybe (IORef (ChildReadyState Int)))
-> IntMap (IORef (ChildReadyState Int))
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe Maybe (IORef (ChildReadyState Int))
-> Maybe (IORef (ChildReadyState Int))
forall a. a -> a
id (IntMap (Maybe (IORef (ChildReadyState Int)))
-> IntMap (IORef (ChildReadyState Int)))
-> IO (IntMap (Maybe (IORef (ChildReadyState Int))))
-> IO (IntMap (IORef (ChildReadyState Int)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int
-> TraverseChild t m Int v'
-> IO (Maybe (IORef (ChildReadyState Int))))
-> IntMap (TraverseChild t m Int v')
-> IO (IntMap (Maybe (IORef (ChildReadyState Int))))
forall (t :: * -> *) a b.
Applicative t =>
(Int -> a -> t b) -> IntMap a -> t (IntMap b)
IntMap.traverseWithKey Int
-> TraverseChild t m Int v'
-> IO (Maybe (IORef (ChildReadyState Int)))
forall k t (m :: * -> *) a.
k
-> TraverseChild t m k a -> IO (Maybe (IORef (ChildReadyState k)))
processChild IntMap (TraverseChild t m Int v')
children0
IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ if IntMap (IORef (ChildReadyState Int)) -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap (IORef (ChildReadyState Int))
initialUnready
then IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
else do
IORef Word -> (Word -> Word) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Word
parentUnreadyChildren Word -> Word
forall a. Enum a => a -> a
succ
IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> (IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
pendingChange (IntMap (IORef (ChildReadyState Int))
initialUnready, p (TraverseChild t m Int v')
forall a. Monoid a => a
mempty)
HydrationDomBuilderT s t m HydrationMode
forall k (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT s t m HydrationMode
-> (HydrationMode -> HydrationDomBuilderT s t m ())
-> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Hydrating -> m (Incremental t (p (TraverseChild t m Int v')))
-> (Incremental t (p (TraverseChild t m Int v'))
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (PatchTarget (p (TraverseChild t m Int v'))
-> Event t (p (TraverseChild t m Int v'))
-> m (Incremental t (p (TraverseChild t m Int v')))
forall k (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental IntMap (TraverseChild t m Int v')
PatchTarget (p (TraverseChild t m Int v'))
children0 Event t (p (TraverseChild t m Int v'))
children') ((Incremental t (p (TraverseChild t m Int v'))
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ())
-> (Incremental t (p (TraverseChild t m Int v'))
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ \Incremental t (p (TraverseChild t m Int v'))
children -> do
IntMap (TraverseChild t m Int v')
dm :: IntMap (TraverseChild t m Int v') <- Behavior t (IntMap (TraverseChild t m Int v'))
-> HydrationRunnerT t m (IntMap (TraverseChild t m Int v'))
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t (IntMap (TraverseChild t m Int v'))
-> HydrationRunnerT t m (IntMap (TraverseChild t m Int v')))
-> Behavior t (IntMap (TraverseChild t m Int v'))
-> HydrationRunnerT t m (IntMap (TraverseChild t m Int v'))
forall a b. (a -> b) -> a -> b
$ Incremental t (p (TraverseChild t m Int v'))
-> Behavior t (PatchTarget (p (TraverseChild t m Int v')))
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Behavior t (PatchTarget p)
currentIncremental Incremental t (p (TraverseChild t m Int v'))
children
IntMap Text
phs <- (TraverseChild t m Int v' -> HydrationRunnerT t m Text)
-> IntMap (TraverseChild t m Int v')
-> HydrationRunnerT t m (IntMap Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((TraverseChildHydration t m -> HydrationRunnerT t m Text)
-> (TraverseChildImmediate Int -> HydrationRunnerT t m Text)
-> Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
-> HydrationRunnerT t m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TraverseChildHydration t m -> HydrationRunnerT t m Text
forall t (m :: * -> *).
TraverseChildHydration t m -> HydrationRunnerT t m Text
_traverseChildHydration_delayed (Text -> HydrationRunnerT t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HydrationRunnerT t m Text)
-> (TraverseChildImmediate Int -> Text)
-> TraverseChildImmediate Int
-> HydrationRunnerT t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChildImmediate Int -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder) (Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
-> HydrationRunnerT t m Text)
-> (TraverseChild t m Int v'
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate Int))
-> TraverseChild t m Int v'
-> HydrationRunnerT t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChild t m Int v'
-> Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode) IntMap (TraverseChild t m Int v')
dm
IO () -> HydrationRunnerT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IORef (IntMap Text) -> IntMap Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap Text)
placeholders (IntMap Text -> IO ()) -> IntMap Text -> IO ()
forall a b. (a -> b) -> a -> b
$! IntMap Text
phs
Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
lastPlaceholder
HydrationMode
HydrationMode_Immediate -> do
let activate :: TraverseChildImmediate k -> HydrationDomBuilderT s t m Text
activate TraverseChildImmediate k
i = do
Node -> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT s t m ())
-> Node -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode (DocumentFragment -> Node) -> DocumentFragment -> Node
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate k -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate k
i
Text -> HydrationDomBuilderT s t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HydrationDomBuilderT s t m Text)
-> Text -> HydrationDomBuilderT s t m Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate k -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate k
i
IntMap Text
phs <- (TraverseChild t m Int v' -> HydrationDomBuilderT s t m Text)
-> IntMap (TraverseChild t m Int v')
-> HydrationDomBuilderT s t m (IntMap Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((TraverseChildHydration t m -> HydrationDomBuilderT s t m Text)
-> (TraverseChildImmediate Int -> HydrationDomBuilderT s t m Text)
-> Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
-> HydrationDomBuilderT s t m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String
-> TraverseChildHydration t m -> HydrationDomBuilderT s t m Text
forall a. HasCallStack => String -> a
error String
"impossible") TraverseChildImmediate Int -> HydrationDomBuilderT s t m Text
forall k (m :: * -> *) k (s :: k) t.
MonadJSM m =>
TraverseChildImmediate k -> HydrationDomBuilderT s t m Text
activate (Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
-> HydrationDomBuilderT s t m Text)
-> (TraverseChild t m Int v'
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate Int))
-> TraverseChild t m Int v'
-> HydrationDomBuilderT s t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChild t m Int v'
-> Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode) IntMap (TraverseChild t m Int v')
children0
IO () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationDomBuilderT s t m ())
-> IO () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ IORef (IntMap Text) -> IntMap Text -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap Text)
placeholders (IntMap Text -> IO ()) -> IntMap Text -> IO ()
forall a b. (a -> b) -> a -> b
$! IntMap Text
phs
Node -> HydrationDomBuilderT s t m ()
forall k (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT s t m ())
-> Node -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Text -> Node
forall o. IsNode o => o -> Node
toNode Text
lastPlaceholder
Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall k (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationDomBuilderT s t m ())
-> Event t (JSM ()) -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Event t (p (TraverseChild t m Int v'))
-> (p (TraverseChild t m Int v') -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p (TraverseChild t m Int v'))
children' ((p (TraverseChild t m Int v') -> JSM ()) -> Event t (JSM ()))
-> (p (TraverseChild t m Int v') -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \p (TraverseChild t m Int v')
p -> do
(IntMap (IORef (ChildReadyState Int))
oldUnready, p (TraverseChild t m Int v')
oldP) <- IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> JSM
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> JSM
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v')))
-> IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> JSM
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall a b. (a -> b) -> a -> b
$ IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall a. IORef a -> IO a
readIORef IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
pendingChange
IntMap (IORef (ChildReadyState Int))
newUnready <- IO (IntMap (IORef (ChildReadyState Int)))
-> JSM (IntMap (IORef (ChildReadyState Int)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IntMap (IORef (ChildReadyState Int)))
-> JSM (IntMap (IORef (ChildReadyState Int))))
-> IO (IntMap (IORef (ChildReadyState Int)))
-> JSM (IntMap (IORef (ChildReadyState Int)))
forall a b. (a -> b) -> a -> b
$ p (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
updateChildUnreadiness p (TraverseChild t m Int v')
p IntMap (IORef (ChildReadyState Int))
oldUnready
let !newP :: p (TraverseChild t m Int v')
newP = p (TraverseChild t m Int v')
p p (TraverseChild t m Int v')
-> p (TraverseChild t m Int v') -> p (TraverseChild t m Int v')
forall a. Semigroup a => a -> a -> a
<> p (TraverseChild t m Int v')
oldP
IO () -> JSM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> (IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
pendingChange (IntMap (IORef (ChildReadyState Int))
newUnready, p (TraverseChild t m Int v')
newP)
Bool -> JSM () -> JSM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IntMap (IORef (ChildReadyState Int)) -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap (IORef (ChildReadyState Int))
newUnready) (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
p (TraverseChild t m Int v') -> JSM ()
applyDomUpdate p (TraverseChild t m Int v')
newP
let result0 :: IntMap v'
result0 = (TraverseChild t m Int v' -> v')
-> IntMap (TraverseChild t m Int v') -> IntMap v'
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map TraverseChild t m Int v' -> v'
forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result IntMap (TraverseChild t m Int v')
children0
result' :: Event t (p v')
result' = Event t (p (TraverseChild t m Int v'))
-> (p (TraverseChild t m Int v') -> p v') -> Event t (p v')
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p (TraverseChild t m Int v'))
children' ((p (TraverseChild t m Int v') -> p v') -> Event t (p v'))
-> (p (TraverseChild t m Int v') -> p v') -> Event t (p v')
forall a b. (a -> b) -> a -> b
$ (TraverseChild t m Int v' -> v')
-> p (TraverseChild t m Int v') -> p v'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TraverseChild t m Int v' -> v')
-> p (TraverseChild t m Int v') -> p v')
-> (TraverseChild t m Int v' -> v')
-> p (TraverseChild t m Int v')
-> p v'
forall a b. (a -> b) -> a -> b
$ TraverseChild t m Int v' -> v'
forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result
(IntMap v', Event t (p v'))
-> HydrationDomBuilderT s t m (IntMap v', Event t (p v'))
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap v'
result0, Event t (p v')
result')
{-# SPECIALIZE hoistTraverseIntMapWithKeyWithAdjust
:: ((IntMap.Key -> v -> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM Int v'))
-> IntMap v
-> Event DomTimeline (PatchIntMap v)
-> DomRenderHookT DomTimeline HydrationM (IntMap (TraverseChild DomTimeline HydrationM Int v'), Event DomTimeline (PatchIntMap (TraverseChild DomTimeline HydrationM Int v'))))
-> (PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap DOM.Text)
-> DOM.Text
-> PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
-> JSM ())
-> (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM v')
-> IntMap v
-> Event DomTimeline (PatchIntMap v)
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
#-}
{-# SPECIALIZE hoistTraverseIntMapWithKeyWithAdjust
:: ((IntMap.Key -> v -> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM Int v'))
-> IntMap v
-> Event DomTimeline (PatchIntMap v)
-> DomRenderHookT DomTimeline HydrationM (IntMap (TraverseChild DomTimeline HydrationM Int v'), Event DomTimeline (PatchIntMap (TraverseChild DomTimeline HydrationM Int v'))))
-> (PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap DOM.Text)
-> DOM.Text
-> PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
-> JSM ())
-> (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM v')
-> IntMap v
-> Event DomTimeline (PatchIntMap v)
-> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
#-}
data TraverseChildImmediate k = TraverseChildImmediate
{ TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment :: {-# UNPACK #-} !DOM.DocumentFragment
, TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder :: {-# UNPACK #-} !DOM.Text
, TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState :: {-# UNPACK #-} !(IORef (ChildReadyState k))
}
newtype TraverseChildHydration t m = TraverseChildHydration
{ TraverseChildHydration t m -> HydrationRunnerT t m Text
_traverseChildHydration_delayed :: HydrationRunnerT t m DOM.Text
}
data TraverseChild t m k a = TraverseChild
{ TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode :: !(Either (TraverseChildHydration t m) (TraverseChildImmediate k))
, TraverseChild t m k a -> a
_traverseChild_result :: !a
} deriving a -> TraverseChild t m k b -> TraverseChild t m k a
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
(forall a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b)
-> (forall a b.
a -> TraverseChild t m k b -> TraverseChild t m k a)
-> Functor (TraverseChild t m k)
forall a b. a -> TraverseChild t m k b -> TraverseChild t m k a
forall a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
forall t (m :: * -> *) k a b.
a -> TraverseChild t m k b -> TraverseChild t m k a
forall t (m :: * -> *) k a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TraverseChild t m k b -> TraverseChild t m k a
$c<$ :: forall t (m :: * -> *) k a b.
a -> TraverseChild t m k b -> TraverseChild t m k a
fmap :: (a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
$cfmap :: forall t (m :: * -> *) k a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
Functor
{-# INLINABLE drawChildUpdate #-}
drawChildUpdate :: (MonadJSM m, Reflex t)
=> HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (f a)
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
drawChildUpdate :: HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (f a)
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
drawChildUpdate HydrationDomBuilderEnv t m
initialEnv IORef (ChildReadyState k) -> JSM ()
markReady HydrationDomBuilderT s t m (f a)
child = do
let doc :: Document
doc = HydrationDomBuilderEnv t m -> Document
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> Document
_hydrationDomBuilderEnv_document HydrationDomBuilderEnv t m
initialEnv
IORef Word
unreadyChildren <- IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Word) -> DomRenderHookT t m (IORef Word))
-> IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall a b. (a -> b) -> a -> b
$ Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef Word
0
IO HydrationMode -> DomRenderHookT t m HydrationMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef HydrationMode -> IO HydrationMode
forall a. IORef a -> IO a
readIORef (IORef HydrationMode -> IO HydrationMode)
-> IORef HydrationMode -> IO HydrationMode
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> IORef HydrationMode
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode HydrationDomBuilderEnv t m
initialEnv) DomRenderHookT t m HydrationMode
-> (HydrationMode
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a))
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Hydrating -> do
IORef (HydrationRunnerT t m ())
childDelayedRef <- IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a. a -> IO (IORef a)
newIORef (HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ())))
-> HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
f a
result <- ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (f a)
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m (f a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (HydrationDomBuilderT s t m (f a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (f a)
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT HydrationDomBuilderT s t m (f a)
child) HydrationDomBuilderEnv t m
initialEnv
{ _hydrationDomBuilderEnv_unreadyChildren :: IORef Word
_hydrationDomBuilderEnv_unreadyChildren = IORef Word
unreadyChildren
, _hydrationDomBuilderEnv_delayed :: IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed = IORef (HydrationRunnerT t m ())
childDelayedRef
}
HydrationRunnerT t m ()
childDelayed <- IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ()))
-> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ IORef (HydrationRunnerT t m ()) -> IO (HydrationRunnerT t m ())
forall a. IORef a -> IO a
readIORef IORef (HydrationRunnerT t m ())
childDelayedRef
Compose (TraverseChild t m k) f a
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Compose (TraverseChild t m k) f a
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a))
-> Compose (TraverseChild t m k) f a
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
forall a b. (a -> b) -> a -> b
$ TraverseChild t m k (f a) -> Compose (TraverseChild t m k) f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (TraverseChild t m k (f a) -> Compose (TraverseChild t m k) f a)
-> TraverseChild t m k (f a) -> Compose (TraverseChild t m k) f a
forall a b. (a -> b) -> a -> b
$ TraverseChild :: forall t (m :: * -> *) k a.
Either (TraverseChildHydration t m) (TraverseChildImmediate k)
-> a -> TraverseChild t m k a
TraverseChild
{ _traverseChild_result :: f a
_traverseChild_result = f a
result
, _traverseChild_mode :: Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode = TraverseChildHydration t m
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
forall a b. a -> Either a b
Left TraverseChildHydration :: forall t (m :: * -> *).
HydrationRunnerT t m Text -> TraverseChildHydration t m
TraverseChildHydration
{ _traverseChildHydration_delayed :: HydrationRunnerT t m Text
_traverseChildHydration_delayed = do
Text
placeholder <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
Text -> HydrationRunnerT t m ()
forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode Text
placeholder
HydrationRunnerT t m ()
childDelayed
Text -> HydrationRunnerT t m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
placeholder
}
}
HydrationMode
HydrationMode_Immediate -> do
IORef (ChildReadyState k)
childReadyState <- IO (IORef (ChildReadyState k))
-> DomRenderHookT t m (IORef (ChildReadyState k))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (ChildReadyState k))
-> DomRenderHookT t m (IORef (ChildReadyState k)))
-> IO (IORef (ChildReadyState k))
-> DomRenderHookT t m (IORef (ChildReadyState k))
forall a b. (a -> b) -> a -> b
$ ChildReadyState k -> IO (IORef (ChildReadyState k))
forall a. a -> IO (IORef a)
newIORef (ChildReadyState k -> IO (IORef (ChildReadyState k)))
-> ChildReadyState k -> IO (IORef (ChildReadyState k))
forall a b. (a -> b) -> a -> b
$ Maybe k -> ChildReadyState k
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready Maybe k
forall a. Maybe a
Nothing
DocumentFragment
df <- Document -> DomRenderHookT t m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment Document
doc
Text
placeholder <- Document -> Text -> DomRenderHookT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
DocumentFragment -> Text -> DomRenderHookT t m ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
Node.appendChild_ DocumentFragment
df Text
placeholder
f a
result <- ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (f a)
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m (f a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (HydrationDomBuilderT s t m (f a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (f a)
forall k (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT HydrationDomBuilderT s t m (f a)
child) HydrationDomBuilderEnv t m
initialEnv
{ _hydrationDomBuilderEnv_parent :: Either Node (IORef Node)
_hydrationDomBuilderEnv_parent = Node -> Either Node (IORef Node)
forall a b. a -> Either a b
Left (Node -> Either Node (IORef Node))
-> Node -> Either Node (IORef Node)
forall a b. (a -> b) -> a -> b
$ DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode DocumentFragment
df
, _hydrationDomBuilderEnv_unreadyChildren :: IORef Word
_hydrationDomBuilderEnv_unreadyChildren = IORef Word
unreadyChildren
, _hydrationDomBuilderEnv_commitAction :: JSM ()
_hydrationDomBuilderEnv_commitAction = IORef (ChildReadyState k) -> JSM ()
markReady IORef (ChildReadyState k)
childReadyState
}
Word
u <- IO Word -> DomRenderHookT t m Word
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> DomRenderHookT t m Word)
-> IO Word -> DomRenderHookT t m Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
unreadyChildren
Bool -> DomRenderHookT t m () -> DomRenderHookT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
u Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0) (DomRenderHookT t m () -> DomRenderHookT t m ())
-> DomRenderHookT t m () -> DomRenderHookT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> DomRenderHookT t m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DomRenderHookT t m ()) -> IO () -> DomRenderHookT t m ()
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState k) -> ChildReadyState k -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState k)
childReadyState ChildReadyState k
forall a. ChildReadyState a
ChildReadyState_Ready
Compose (TraverseChild t m k) f a
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Compose (TraverseChild t m k) f a
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a))
-> Compose (TraverseChild t m k) f a
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
forall a b. (a -> b) -> a -> b
$ TraverseChild t m k (f a) -> Compose (TraverseChild t m k) f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (TraverseChild t m k (f a) -> Compose (TraverseChild t m k) f a)
-> TraverseChild t m k (f a) -> Compose (TraverseChild t m k) f a
forall a b. (a -> b) -> a -> b
$ TraverseChild :: forall t (m :: * -> *) k a.
Either (TraverseChildHydration t m) (TraverseChildImmediate k)
-> a -> TraverseChild t m k a
TraverseChild
{ _traverseChild_result :: f a
_traverseChild_result = f a
result
, _traverseChild_mode :: Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode = TraverseChildImmediate k
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
forall a b. b -> Either a b
Right TraverseChildImmediate :: forall k.
DocumentFragment
-> Text -> IORef (ChildReadyState k) -> TraverseChildImmediate k
TraverseChildImmediate
{ _traverseChildImmediate_fragment :: DocumentFragment
_traverseChildImmediate_fragment = DocumentFragment
df
, _traverseChildImmediate_placeholder :: Text
_traverseChildImmediate_placeholder = Text
placeholder
, _traverseChildImmediate_childReadyState :: IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState = IORef (ChildReadyState k)
childReadyState
}
}
{-# SPECIALIZE drawChildUpdate
:: HydrationDomBuilderEnv DomTimeline HydrationM
-> (IORef (ChildReadyState Int) -> JSM ())
-> HydrationDomBuilderT s DomTimeline HydrationM (Identity a)
-> DomRenderHookT DomTimeline HydrationM (Compose (TraverseChild DomTimeline HydrationM Int) Identity a)
#-}
{-# SPECIALIZE drawChildUpdate
:: HydrationDomBuilderEnv DomTimeline HydrationM
-> (IORef (ChildReadyState (Some k)) -> JSM ())
-> HydrationDomBuilderT s DomTimeline HydrationM (f a)
-> DomRenderHookT DomTimeline HydrationM (Compose (TraverseChild DomTimeline HydrationM (Some k)) f a)
#-}
{-# INLINABLE drawChildUpdateInt #-}
drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)
=> HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m v
-> DomRenderHookT t m (TraverseChild t m k v)
drawChildUpdateInt :: HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m v
-> DomRenderHookT t m (TraverseChild t m k v)
drawChildUpdateInt HydrationDomBuilderEnv t m
env IORef (ChildReadyState k) -> JSM ()
mark HydrationDomBuilderT s t m v
m = (Identity v -> v)
-> TraverseChild t m k (Identity v) -> TraverseChild t m k v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity v -> v
forall a. Identity a -> a
runIdentity (TraverseChild t m k (Identity v) -> TraverseChild t m k v)
-> (Compose (TraverseChild t m k) Identity v
-> TraverseChild t m k (Identity v))
-> Compose (TraverseChild t m k) Identity v
-> TraverseChild t m k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m k) Identity v
-> TraverseChild t m k (Identity v)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (TraverseChild t m k) Identity v -> TraverseChild t m k v)
-> DomRenderHookT t m (Compose (TraverseChild t m k) Identity v)
-> DomRenderHookT t m (TraverseChild t m k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (Identity v)
-> DomRenderHookT t m (Compose (TraverseChild t m k) Identity v)
forall k k1 (m :: * -> *) t k (s :: k) (f :: k1 -> *) (a :: k1).
(MonadJSM m, Reflex t) =>
HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (f a)
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
drawChildUpdate HydrationDomBuilderEnv t m
env IORef (ChildReadyState k) -> JSM ()
mark (v -> Identity v
forall a. a -> Identity a
Identity (v -> Identity v)
-> HydrationDomBuilderT s t m v
-> HydrationDomBuilderT s t m (Identity v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HydrationDomBuilderT s t m v
m)
{-# SPECIALIZE drawChildUpdateInt
:: HydrationDomBuilderEnv DomTimeline HydrationM
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s DomTimeline HydrationM v
-> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM k v)
#-}
{-# INLINE mkHasFocus #-}
mkHasFocus
:: (HasDocument m, MonadJSM m, IsNode (RawElement d), MonadHold t m, Reflex t, DOM.IsDocumentOrShadowRoot (RawDocument (DomBuilderSpace m)))
=> Element er d t -> m (Dynamic t Bool)
mkHasFocus :: Element er d t -> m (Dynamic t Bool)
mkHasFocus Element er d t
e = do
RawDocument (DomBuilderSpace m)
doc <- m (RawDocument (DomBuilderSpace m))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
Bool
initialFocus <- Node -> Maybe Node -> m Bool
forall (m :: * -> *) self other.
(MonadDOM m, IsNode self, IsNode other) =>
self -> Maybe other -> m Bool
Node.isSameNode (RawElement d -> Node
forall o. IsNode o => o -> Node
toNode (RawElement d -> Node) -> RawElement d -> Node
forall a b. (a -> b) -> a -> b
$ Element er d t -> RawElement d
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> RawElement d
_element_raw Element er d t
e) (Maybe Node -> m Bool)
-> (Maybe Element -> Maybe Node) -> Maybe Element -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Node) -> Maybe Element -> Maybe Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Node
forall o. IsNode o => o -> Node
toNode (Maybe Element -> m Bool) -> m (Maybe Element) -> m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RawDocument (DomBuilderSpace m) -> m (Maybe Element)
forall (m :: * -> *) self.
(MonadDOM m, IsDocumentOrShadowRoot self) =>
self -> m (Maybe Element)
Document.getActiveElement RawDocument (DomBuilderSpace m)
doc
Bool -> Event t Bool -> m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Bool
initialFocus (Event t Bool -> m (Dynamic t Bool))
-> Event t Bool -> m (Dynamic t Bool)
forall a b. (a -> b) -> a -> b
$ [Event t Bool] -> Event t Bool
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Bool
False Bool -> Event t (er 'BlurTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'BlurTag) -> Event t (er 'BlurTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er d t -> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er d t
e) (EventName 'BlurTag -> WrapArg er EventName (er 'BlurTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'BlurTag
Blur)
, Bool
True Bool -> Event t (er 'FocusTag) -> Event t Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> WrapArg er EventName (er 'FocusTag) -> Event t (er 'FocusTag)
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er d t -> EventSelector t (WrapArg er EventName)
forall (er :: EventTag -> *) k (d :: k) k (t :: k).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er d t
e) (EventName 'FocusTag -> WrapArg er EventName (er 'FocusTag)
forall k (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'FocusTag
Focus)
]
insertBefore :: (MonadJSM m, IsNode new, IsNode existing) => new -> existing -> m ()
insertBefore :: new -> existing -> m ()
insertBefore new
new existing
existing = do
Node
p <- existing -> m Node
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Node
getParentNodeUnchecked existing
existing
Node -> new -> Maybe existing -> m ()
forall (m :: * -> *) self node child.
(MonadDOM m, IsNode self, IsNode node, IsNode child) =>
self -> node -> Maybe child -> m ()
Node.insertBefore_ Node
p new
new (existing -> Maybe existing
forall a. a -> Maybe a
Just existing
existing)
type ImmediateDomBuilderT = HydrationDomBuilderT GhcjsDomSpace
instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT s t m) where
type Performable (HydrationDomBuilderT s t m) = Performable m
{-# INLINABLE performEvent_ #-}
performEvent_ :: Event t (Performable (HydrationDomBuilderT s t m) ())
-> HydrationDomBuilderT s t m ()
performEvent_ Event t (Performable (HydrationDomBuilderT s t m) ())
e = m () -> HydrationDomBuilderT s t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> HydrationDomBuilderT s t m ())
-> m () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Event t (Performable m ()) -> m ()
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_ Event t (Performable m ())
Event t (Performable (HydrationDomBuilderT s t m) ())
e
{-# INLINABLE performEvent #-}
performEvent :: Event t (Performable (HydrationDomBuilderT s t m) a)
-> HydrationDomBuilderT s t m (Event t a)
performEvent Event t (Performable (HydrationDomBuilderT s t m) a)
e = m (Event t a) -> HydrationDomBuilderT s t m (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> HydrationDomBuilderT s t m (Event t a))
-> m (Event t a) -> HydrationDomBuilderT s t m (Event t a)
forall a b. (a -> b) -> a -> b
$ Event t (Performable m a) -> m (Event t a)
forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent Event t (Performable m a)
Event t (Performable (HydrationDomBuilderT s t m) a)
e
instance PostBuild t m => PostBuild t (HydrationDomBuilderT s t m) where
{-# INLINABLE getPostBuild #-}
getPostBuild :: HydrationDomBuilderT s t m (Event t ())
getPostBuild = m (Event t ()) -> HydrationDomBuilderT s t m (Event t ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationDomBuilderT s t m) where
{-# INLINABLE newEventWithTrigger #-}
newEventWithTrigger :: (EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT s t m (Event t a)
newEventWithTrigger = m (Event t a) -> HydrationDomBuilderT s t m (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> HydrationDomBuilderT s t m (Event t a))
-> ((EventTrigger t a -> IO (IO ())) -> m (Event t a))
-> (EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT s t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventTrigger t a -> IO (IO ())) -> m (Event t a)
forall t (m :: * -> *) a.
MonadReflexCreateTrigger t m =>
(EventTrigger t a -> IO (IO ())) -> m (Event t a)
newEventWithTrigger
{-# INLINABLE newFanEventWithTrigger #-}
newFanEventWithTrigger :: (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT s t m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f = m (EventSelector t k)
-> HydrationDomBuilderT s t m (EventSelector t k)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (EventSelector t k)
-> HydrationDomBuilderT s t m (EventSelector t k))
-> m (EventSelector t k)
-> HydrationDomBuilderT s t m (EventSelector t k)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f
instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (HydrationDomBuilderT s t m) where
{-# INLINABLE newTriggerEvent #-}
newTriggerEvent :: HydrationDomBuilderT s t m (Event t a, a -> IO ())
newTriggerEvent = ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO ())
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO ()))
-> (DomRenderHookT t m (Event t a, a -> IO ())
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO ()))
-> DomRenderHookT t m (Event t a, a -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a, a -> IO ())
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a, a -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO ()))
-> DomRenderHookT t m (Event t a, a -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO ())
forall a b. (a -> b) -> a -> b
$ DomRenderHookT t m (Event t a, a -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
{-# INLINABLE newTriggerEventWithOnComplete #-}
newTriggerEventWithOnComplete :: HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete = ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO () -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ())
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO () -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ()))
-> (DomRenderHookT t m (Event t a, a -> IO () -> IO ())
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO () -> IO ()))
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a, a -> IO () -> IO ())
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO () -> IO ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a, a -> IO () -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ()))
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ())
forall a b. (a -> b) -> a -> b
$ DomRenderHookT t m (Event t a, a -> IO () -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete
{-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
newEventWithLazyTriggerWithOnComplete :: ((a -> IO () -> IO ()) -> IO (IO ()))
-> HydrationDomBuilderT s t m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
f = ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
-> HydrationDomBuilderT s t m (Event t a)
forall k (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
-> HydrationDomBuilderT s t m (Event t a))
-> (DomRenderHookT t m (Event t a)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a))
-> DomRenderHookT t m (Event t a)
-> HydrationDomBuilderT s t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a)
-> HydrationDomBuilderT s t m (Event t a))
-> DomRenderHookT t m (Event t a)
-> HydrationDomBuilderT s t m (Event t a)
forall a b. (a -> b) -> a -> b
$ ((a -> IO () -> IO ()) -> IO (IO ()))
-> DomRenderHookT t m (Event t a)
forall t (m :: * -> *) a.
TriggerEvent t m =>
((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
f
instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (DomRenderHookT t m) where
{-# INLINABLE newTriggerEvent #-}
newTriggerEvent :: DomRenderHookT t m (Event t a, a -> IO ())
newTriggerEvent = RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO ())
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO ()))
-> (TriggerEventT t m (Event t a, a -> IO ())
-> RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO ()))
-> TriggerEventT t m (Event t a, a -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT t m (Event t a, a -> IO ())
-> RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m (Event t a, a -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO ()))
-> TriggerEventT t m (Event t a, a -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO ())
forall a b. (a -> b) -> a -> b
$ TriggerEventT t m (Event t a, a -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
{-# INLINABLE newTriggerEventWithOnComplete #-}
newTriggerEventWithOnComplete :: DomRenderHookT t m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete = RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO () -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO () -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ()))
-> (TriggerEventT t m (Event t a, a -> IO () -> IO ())
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Event t a, a -> IO () -> IO ()))
-> TriggerEventT t m (Event t a, a -> IO () -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT t m (Event t a, a -> IO () -> IO ())
-> RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO () -> IO ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m (Event t a, a -> IO () -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ()))
-> TriggerEventT t m (Event t a, a -> IO () -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
forall a b. (a -> b) -> a -> b
$ TriggerEventT t m (Event t a, a -> IO () -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete
{-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
newEventWithLazyTriggerWithOnComplete :: ((a -> IO () -> IO ()) -> IO (IO ()))
-> DomRenderHookT t m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
f = RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
-> DomRenderHookT t m (Event t a)
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
-> DomRenderHookT t m (Event t a))
-> (TriggerEventT t m (Event t a)
-> RequesterT t JSM Identity (TriggerEventT t m) (Event t a))
-> TriggerEventT t m (Event t a)
-> DomRenderHookT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT t m (Event t a)
-> RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m (Event t a) -> DomRenderHookT t m (Event t a))
-> TriggerEventT t m (Event t a) -> DomRenderHookT t m (Event t a)
forall a b. (a -> b) -> a -> b
$ ((a -> IO () -> IO ()) -> IO (IO ()))
-> TriggerEventT t m (Event t a)
forall t (m :: * -> *) a.
TriggerEvent t m =>
((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
f
instance HasJSContext m => HasJSContext (HydrationDomBuilderT s t m) where
type JSContextPhantom (HydrationDomBuilderT s t m) = JSContextPhantom m
askJSContext :: HydrationDomBuilderT
s
t
m
(JSContextSingleton
(JSContextPhantom (HydrationDomBuilderT s t m)))
askJSContext = m (JSContextSingleton (JSContextPhantom m))
-> HydrationDomBuilderT
s t m (JSContextSingleton (JSContextPhantom m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (JSContextSingleton (JSContextPhantom m))
forall (m :: * -> *).
HasJSContext m =>
m (JSContextSingleton (JSContextPhantom m))
askJSContext
instance MonadRef m => MonadRef (HydrationDomBuilderT s t m) where
type Ref (HydrationDomBuilderT s t m) = Ref m
{-# INLINABLE newRef #-}
newRef :: a
-> HydrationDomBuilderT s t m (Ref (HydrationDomBuilderT s t m) a)
newRef = m (Ref m a) -> HydrationDomBuilderT s t m (Ref m a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Ref m a) -> HydrationDomBuilderT s t m (Ref m a))
-> (a -> m (Ref m a)) -> a -> HydrationDomBuilderT s t m (Ref m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
{-# INLINABLE readRef #-}
readRef :: Ref (HydrationDomBuilderT s t m) a -> HydrationDomBuilderT s t m a
readRef = m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> (Ref m a -> m a) -> Ref m a -> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
{-# INLINABLE writeRef #-}
writeRef :: Ref (HydrationDomBuilderT s t m) a
-> a -> HydrationDomBuilderT s t m ()
writeRef Ref (HydrationDomBuilderT s t m) a
r = m () -> HydrationDomBuilderT s t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> HydrationDomBuilderT s t m ())
-> (a -> m ()) -> a -> HydrationDomBuilderT s t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> a -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef Ref m a
Ref (HydrationDomBuilderT s t m) a
r
instance MonadAtomicRef m => MonadAtomicRef (HydrationDomBuilderT s t m) where
{-# INLINABLE atomicModifyRef #-}
atomicModifyRef :: Ref (HydrationDomBuilderT s t m) a
-> (a -> (a, b)) -> HydrationDomBuilderT s t m b
atomicModifyRef Ref (HydrationDomBuilderT s t m) a
r = m b -> HydrationDomBuilderT s t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> HydrationDomBuilderT s t m b)
-> ((a -> (a, b)) -> m b)
-> (a -> (a, b))
-> HydrationDomBuilderT s t m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> (a -> (a, b)) -> m b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef Ref m a
Ref (HydrationDomBuilderT s t m) a
r
instance (HasJS x m, ReflexHost t) => HasJS x (HydrationDomBuilderT s t m) where
type JSX (HydrationDomBuilderT s t m) = JSX m
liftJS :: JSX (HydrationDomBuilderT s t m) a -> HydrationDomBuilderT s t m a
liftJS = m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> (JSX m a -> m a) -> JSX m a -> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSX m a -> m a
forall x (m :: * -> *) a. HasJS x m => JSX m a -> m a
liftJS
type family EventType en where
EventType 'AbortTag = UIEvent
EventType 'BlurTag = FocusEvent
EventType 'ChangeTag = DOM.Event
EventType 'ClickTag = MouseEvent
EventType 'ContextmenuTag = MouseEvent
EventType 'DblclickTag = MouseEvent
EventType 'DragTag = MouseEvent
EventType 'DragendTag = MouseEvent
EventType 'DragenterTag = MouseEvent
EventType 'DragleaveTag = MouseEvent
EventType 'DragoverTag = MouseEvent
EventType 'DragstartTag = MouseEvent
EventType 'DropTag = MouseEvent
EventType 'ErrorTag = UIEvent
EventType 'FocusTag = FocusEvent
EventType 'InputTag = DOM.Event
EventType 'InvalidTag = DOM.Event
EventType 'KeydownTag = KeyboardEvent
EventType 'KeypressTag = KeyboardEvent
EventType 'KeyupTag = KeyboardEvent
EventType 'LoadTag = UIEvent
EventType 'MousedownTag = MouseEvent
EventType 'MouseenterTag = MouseEvent
EventType 'MouseleaveTag = MouseEvent
EventType 'MousemoveTag = MouseEvent
EventType 'MouseoutTag = MouseEvent
EventType 'MouseoverTag = MouseEvent
EventType 'MouseupTag = MouseEvent
EventType 'MousewheelTag = MouseEvent
EventType 'ScrollTag = UIEvent
EventType 'SelectTag = UIEvent
EventType 'SubmitTag = DOM.Event
EventType 'WheelTag = WheelEvent
EventType 'BeforecutTag = ClipboardEvent
EventType 'CutTag = ClipboardEvent
EventType 'BeforecopyTag = ClipboardEvent
EventType 'CopyTag = ClipboardEvent
EventType 'BeforepasteTag = ClipboardEvent
EventType 'PasteTag = ClipboardEvent
EventType 'ResetTag = DOM.Event
EventType 'SearchTag = DOM.Event
EventType 'SelectstartTag = DOM.Event
EventType 'TouchstartTag = TouchEvent
EventType 'TouchmoveTag = TouchEvent
EventType 'TouchendTag = TouchEvent
EventType 'TouchcancelTag = TouchEvent
{-# INLINABLE defaultDomEventHandler #-}
defaultDomEventHandler :: IsElement e => e -> EventName en -> EventM e (EventType en) (Maybe (EventResult en))
defaultDomEventHandler :: e
-> EventName en -> EventM e (EventType en) (Maybe (EventResult en))
defaultDomEventHandler e
e EventName en
evt = (EventResultType en -> Maybe (EventResult en))
-> ReaderT (EventType en) JSM (EventResultType en)
-> EventM e (EventType en) (Maybe (EventResult en))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EventResult en -> Maybe (EventResult en)
forall a. a -> Maybe a
Just (EventResult en -> Maybe (EventResult en))
-> (EventResultType en -> EventResult en)
-> EventResultType en
-> Maybe (EventResult en)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventResultType en -> EventResult en
forall (en :: EventTag). EventResultType en -> EventResult en
EventResult) (ReaderT (EventType en) JSM (EventResultType en)
-> EventM e (EventType en) (Maybe (EventResult en)))
-> ReaderT (EventType en) JSM (EventResultType en)
-> EventM e (EventType en) (Maybe (EventResult en))
forall a b. (a -> b) -> a -> b
$ case EventName en
evt of
EventName en
Click -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dblclick -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Keypress -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e KeyboardEvent Word
getKeyEvent
EventName en
Scroll -> Int -> EventResultType en
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> EventResultType en)
-> ReaderT (EventType en) JSM Int
-> ReaderT (EventType en) JSM (EventResultType en)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> ReaderT (EventType en) JSM Int
forall (m :: * -> *) self.
(MonadDOM m, IsElement self) =>
self -> m Int
getScrollTop e
e
EventName en
Keydown -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e KeyboardEvent Word
getKeyEvent
EventName en
Keyup -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e KeyboardEvent Word
getKeyEvent
EventName en
Mousemove -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Mouseup -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Mousedown -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Mouseenter -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Mouseleave -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Focus -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Blur -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Change -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Drag -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragend -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragenter -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragleave -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragover -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragstart -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Drop -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Abort -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Contextmenu -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Error -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Input -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Invalid -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Load -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Mouseout -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Mouseover -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Select -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Submit -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforecut -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Cut -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforecopy -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Copy -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforepaste -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Paste -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e ClipboardEvent (Maybe Text)
getPasteData
EventName en
Reset -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Search -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Selectstart -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Touchstart -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
EventName en
Touchmove -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
EventName en
Touchend -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
EventName en
Touchcancel -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
EventName en
Mousewheel -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Wheel -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e WheelEvent WheelEventResult
getWheelEvent
{-# INLINABLE defaultDomWindowEventHandler #-}
defaultDomWindowEventHandler :: DOM.Window -> EventName en -> EventM DOM.Window (EventType en) (Maybe (EventResult en))
defaultDomWindowEventHandler :: Window
-> EventName en
-> EventM Window (EventType en) (Maybe (EventResult en))
defaultDomWindowEventHandler Window
w EventName en
evt = (EventResultType en -> Maybe (EventResult en))
-> ReaderT (EventType en) JSM (EventResultType en)
-> EventM Window (EventType en) (Maybe (EventResult en))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EventResult en -> Maybe (EventResult en)
forall a. a -> Maybe a
Just (EventResult en -> Maybe (EventResult en))
-> (EventResultType en -> EventResult en)
-> EventResultType en
-> Maybe (EventResult en)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventResultType en -> EventResult en
forall (en :: EventTag). EventResultType en -> EventResult en
EventResult) (ReaderT (EventType en) JSM (EventResultType en)
-> EventM Window (EventType en) (Maybe (EventResult en)))
-> ReaderT (EventType en) JSM (EventResultType en)
-> EventM Window (EventType en) (Maybe (EventResult en))
forall a b. (a -> b) -> a -> b
$ case EventName en
evt of
EventName en
Click -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dblclick -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Keypress -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e KeyboardEvent Word
getKeyEvent
EventName en
Scroll -> Window -> ReaderT (EventType en) JSM Double
forall (m :: * -> *). MonadDOM m => Window -> m Double
Window.getScrollY Window
w
EventName en
Keydown -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e KeyboardEvent Word
getKeyEvent
EventName en
Keyup -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e KeyboardEvent Word
getKeyEvent
EventName en
Mousemove -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Mouseup -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Mousedown -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Mouseenter -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Mouseleave -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Focus -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Blur -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Change -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Drag -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragend -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragenter -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragleave -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragover -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragstart -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Drop -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Abort -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Contextmenu -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Error -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Input -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Invalid -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Load -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Mouseout -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Mouseover -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Select -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Submit -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforecut -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Cut -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforecopy -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Copy -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforepaste -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Paste -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e ClipboardEvent (Maybe Text)
getPasteData
EventName en
Reset -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Search -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Selectstart -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Touchstart -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
EventName en
Touchmove -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
EventName en
Touchend -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
EventName en
Touchcancel -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e TouchEvent TouchEventResult
getTouchEvent
EventName en
Mousewheel -> () -> ReaderT (EventType en) JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Wheel -> ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM e WheelEvent WheelEventResult
getWheelEvent
{-# INLINABLE withIsEvent #-}
withIsEvent :: EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent :: EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName en
en IsEvent (EventType en) => r
r = case EventName en
en of
EventName en
Click -> r
IsEvent (EventType en) => r
r
EventName en
Dblclick -> r
IsEvent (EventType en) => r
r
EventName en
Keypress -> r
IsEvent (EventType en) => r
r
EventName en
Scroll -> r
IsEvent (EventType en) => r
r
EventName en
Keydown -> r
IsEvent (EventType en) => r
r
EventName en
Keyup -> r
IsEvent (EventType en) => r
r
EventName en
Mousemove -> r
IsEvent (EventType en) => r
r
EventName en
Mouseup -> r
IsEvent (EventType en) => r
r
EventName en
Mousedown -> r
IsEvent (EventType en) => r
r
EventName en
Mouseenter -> r
IsEvent (EventType en) => r
r
EventName en
Mouseleave -> r
IsEvent (EventType en) => r
r
EventName en
Focus -> r
IsEvent (EventType en) => r
r
EventName en
Blur -> r
IsEvent (EventType en) => r
r
EventName en
Change -> r
IsEvent (EventType en) => r
r
EventName en
Drag -> r
IsEvent (EventType en) => r
r
EventName en
Dragend -> r
IsEvent (EventType en) => r
r
EventName en
Dragenter -> r
IsEvent (EventType en) => r
r
EventName en
Dragleave -> r
IsEvent (EventType en) => r
r
EventName en
Dragover -> r
IsEvent (EventType en) => r
r
EventName en
Dragstart -> r
IsEvent (EventType en) => r
r
EventName en
Drop -> r
IsEvent (EventType en) => r
r
EventName en
Abort -> r
IsEvent (EventType en) => r
r
EventName en
Contextmenu -> r
IsEvent (EventType en) => r
r
EventName en
Error -> r
IsEvent (EventType en) => r
r
EventName en
Input -> r
IsEvent (EventType en) => r
r
EventName en
Invalid -> r
IsEvent (EventType en) => r
r
EventName en
Load -> r
IsEvent (EventType en) => r
r
EventName en
Mouseout -> r
IsEvent (EventType en) => r
r
EventName en
Mouseover -> r
IsEvent (EventType en) => r
r
EventName en
Select -> r
IsEvent (EventType en) => r
r
EventName en
Submit -> r
IsEvent (EventType en) => r
r
EventName en
Beforecut -> r
IsEvent (EventType en) => r
r
EventName en
Cut -> r
IsEvent (EventType en) => r
r
EventName en
Beforecopy -> r
IsEvent (EventType en) => r
r
EventName en
Copy -> r
IsEvent (EventType en) => r
r
EventName en
Beforepaste -> r
IsEvent (EventType en) => r
r
EventName en
Paste -> r
IsEvent (EventType en) => r
r
EventName en
Reset -> r
IsEvent (EventType en) => r
r
EventName en
Search -> r
IsEvent (EventType en) => r
r
EventName en
Selectstart -> r
IsEvent (EventType en) => r
r
EventName en
Touchstart -> r
IsEvent (EventType en) => r
r
EventName en
Touchmove -> r
IsEvent (EventType en) => r
r
EventName en
Touchend -> r
IsEvent (EventType en) => r
r
EventName en
Touchcancel -> r
IsEvent (EventType en) => r
r
EventName en
Mousewheel -> r
IsEvent (EventType en) => r
r
EventName en
Wheel -> r
IsEvent (EventType en) => r
r
showEventName :: EventName en -> String
showEventName :: EventName en -> String
showEventName EventName en
en = case EventName en
en of
EventName en
Abort -> String
"Abort"
EventName en
Blur -> String
"Blur"
EventName en
Change -> String
"Change"
EventName en
Click -> String
"Click"
EventName en
Contextmenu -> String
"Contextmenu"
EventName en
Dblclick -> String
"Dblclick"
EventName en
Drag -> String
"Drag"
EventName en
Dragend -> String
"Dragend"
EventName en
Dragenter -> String
"Dragenter"
EventName en
Dragleave -> String
"Dragleave"
EventName en
Dragover -> String
"Dragover"
EventName en
Dragstart -> String
"Dragstart"
EventName en
Drop -> String
"Drop"
EventName en
Error -> String
"Error"
EventName en
Focus -> String
"Focus"
EventName en
Input -> String
"Input"
EventName en
Invalid -> String
"Invalid"
EventName en
Keydown -> String
"Keydown"
EventName en
Keypress -> String
"Keypress"
EventName en
Keyup -> String
"Keyup"
EventName en
Load -> String
"Load"
EventName en
Mousedown -> String
"Mousedown"
EventName en
Mouseenter -> String
"Mouseenter"
EventName en
Mouseleave -> String
"Mouseleave"
EventName en
Mousemove -> String
"Mousemove"
EventName en
Mouseout -> String
"Mouseout"
EventName en
Mouseover -> String
"Mouseover"
EventName en
Mouseup -> String
"Mouseup"
EventName en
Mousewheel -> String
"Mousewheel"
EventName en
Scroll -> String
"Scroll"
EventName en
Select -> String
"Select"
EventName en
Submit -> String
"Submit"
EventName en
Wheel -> String
"Wheel"
EventName en
Beforecut -> String
"Beforecut"
EventName en
Cut -> String
"Cut"
EventName en
Beforecopy -> String
"Beforecopy"
EventName en
Copy -> String
"Copy"
EventName en
Beforepaste -> String
"Beforepaste"
EventName en
Paste -> String
"Paste"
EventName en
Reset -> String
"Reset"
EventName en
Search -> String
"Search"
EventName en
Selectstart -> String
"Selectstart"
EventName en
Touchstart -> String
"Touchstart"
EventName en
Touchmove -> String
"Touchmove"
EventName en
Touchend -> String
"Touchend"
EventName en
Touchcancel -> String
"Touchcancel"
newtype ElementEventTarget = ElementEventTarget DOM.Element deriving (Coercible ElementEventTarget JSVal
ToJSVal ElementEventTarget
FromJSVal ElementEventTarget
ToJSVal ElementEventTarget
-> FromJSVal ElementEventTarget
-> Coercible ElementEventTarget JSVal
-> (ElementEventTarget -> JSM GType)
-> IsGObject ElementEventTarget
ElementEventTarget -> JSM GType
forall o.
ToJSVal o
-> FromJSVal o
-> Coercible o JSVal
-> (o -> JSM GType)
-> IsGObject o
typeGType :: ElementEventTarget -> JSM GType
$ctypeGType :: ElementEventTarget -> JSM GType
$cp3IsGObject :: Coercible ElementEventTarget JSVal
$cp2IsGObject :: FromJSVal ElementEventTarget
$cp1IsGObject :: ToJSVal ElementEventTarget
DOM.IsGObject, [ElementEventTarget] -> JSM JSVal
ElementEventTarget -> JSM JSVal
(ElementEventTarget -> JSM JSVal)
-> ([ElementEventTarget] -> JSM JSVal)
-> ToJSVal ElementEventTarget
forall a. (a -> JSM JSVal) -> ([a] -> JSM JSVal) -> ToJSVal a
toJSValListOf :: [ElementEventTarget] -> JSM JSVal
$ctoJSValListOf :: [ElementEventTarget] -> JSM JSVal
toJSVal :: ElementEventTarget -> JSM JSVal
$ctoJSVal :: ElementEventTarget -> JSM JSVal
DOM.ToJSVal, IsGObject ElementEventTarget
IsGObject ElementEventTarget -> IsSlotable ElementEventTarget
forall o. IsGObject o -> IsSlotable o
DOM.IsSlotable, IsGObject ElementEventTarget
IsGObject ElementEventTarget -> IsParentNode ElementEventTarget
forall o. IsGObject o -> IsParentNode o
DOM.IsParentNode, IsGObject ElementEventTarget
IsGObject ElementEventTarget
-> IsNonDocumentTypeChildNode ElementEventTarget
forall o. IsGObject o -> IsNonDocumentTypeChildNode o
DOM.IsNonDocumentTypeChildNode, IsGObject ElementEventTarget
IsGObject ElementEventTarget -> IsChildNode ElementEventTarget
forall o. IsGObject o -> IsChildNode o
DOM.IsChildNode, IsGObject ElementEventTarget
IsGObject ElementEventTarget -> IsAnimatable ElementEventTarget
forall o. IsGObject o -> IsAnimatable o
DOM.IsAnimatable, IsGObject ElementEventTarget
IsEventTarget ElementEventTarget
IsEventTarget ElementEventTarget
-> IsGObject ElementEventTarget -> IsNode ElementEventTarget
forall o. IsEventTarget o -> IsGObject o -> IsNode o
$cp2IsNode :: IsGObject ElementEventTarget
$cp1IsNode :: IsEventTarget ElementEventTarget
IsNode, IsGObject ElementEventTarget
IsAnimatable ElementEventTarget
IsChildNode ElementEventTarget
IsDocumentAndElementEventHandlers ElementEventTarget
IsEventTarget ElementEventTarget
IsNode ElementEventTarget
IsNonDocumentTypeChildNode ElementEventTarget
IsParentNode ElementEventTarget
IsSlotable ElementEventTarget
IsNode ElementEventTarget
-> IsEventTarget ElementEventTarget
-> IsSlotable ElementEventTarget
-> IsParentNode ElementEventTarget
-> IsNonDocumentTypeChildNode ElementEventTarget
-> IsDocumentAndElementEventHandlers ElementEventTarget
-> IsChildNode ElementEventTarget
-> IsAnimatable ElementEventTarget
-> IsGObject ElementEventTarget
-> IsElement ElementEventTarget
forall o.
IsNode o
-> IsEventTarget o
-> IsSlotable o
-> IsParentNode o
-> IsNonDocumentTypeChildNode o
-> IsDocumentAndElementEventHandlers o
-> IsChildNode o
-> IsAnimatable o
-> IsGObject o
-> IsElement o
$cp9IsElement :: IsGObject ElementEventTarget
$cp8IsElement :: IsAnimatable ElementEventTarget
$cp7IsElement :: IsChildNode ElementEventTarget
$cp6IsElement :: IsDocumentAndElementEventHandlers ElementEventTarget
$cp5IsElement :: IsNonDocumentTypeChildNode ElementEventTarget
$cp4IsElement :: IsParentNode ElementEventTarget
$cp3IsElement :: IsSlotable ElementEventTarget
$cp2IsElement :: IsEventTarget ElementEventTarget
$cp1IsElement :: IsNode ElementEventTarget
IsElement)
instance DOM.FromJSVal ElementEventTarget where
fromJSVal :: JSVal -> JSM (Maybe ElementEventTarget)
fromJSVal = (Maybe Element -> Maybe ElementEventTarget)
-> JSM (Maybe Element) -> JSM (Maybe ElementEventTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Element -> ElementEventTarget)
-> Maybe Element -> Maybe ElementEventTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> ElementEventTarget
ElementEventTarget) (JSM (Maybe Element) -> JSM (Maybe ElementEventTarget))
-> (JSVal -> JSM (Maybe Element))
-> JSVal
-> JSM (Maybe ElementEventTarget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSM (Maybe Element)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
DOM.fromJSVal
instance DOM.IsEventTarget ElementEventTarget
instance DOM.IsGlobalEventHandlers ElementEventTarget
instance DOM.IsDocumentAndElementEventHandlers ElementEventTarget
{-# INLINABLE elementOnEventName #-}
elementOnEventName :: IsElement e => EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
elementOnEventName :: EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
elementOnEventName EventName en
en e
e_ = let e :: ElementEventTarget
e = Element -> ElementEventTarget
ElementEventTarget (e -> Element
forall o. IsElement o => o -> Element
DOM.toElement e
e_) in case EventName en
en of
EventName en
Abort -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.abort
EventName en
Blur -> ElementEventTarget
-> EventName ElementEventTarget FocusEvent
-> EventM ElementEventTarget FocusEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget FocusEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self FocusEvent
Events.blur
EventName en
Change -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.change
EventName en
Click -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.click
EventName en
Contextmenu -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.contextMenu
EventName en
Dblclick -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dblClick
EventName en
Drag -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.drag
EventName en
Dragend -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragEnd
EventName en
Dragenter -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragEnter
EventName en
Dragleave -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragLeave
EventName en
Dragover -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragOver
EventName en
Dragstart -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragStart
EventName en
Drop -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.drop
EventName en
Error -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.error
EventName en
Focus -> ElementEventTarget
-> EventName ElementEventTarget FocusEvent
-> EventM ElementEventTarget FocusEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget FocusEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self FocusEvent
Events.focus
EventName en
Input -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.input
EventName en
Invalid -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.invalid
EventName en
Keydown -> ElementEventTarget
-> EventName ElementEventTarget KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyDown
EventName en
Keypress -> ElementEventTarget
-> EventName ElementEventTarget KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyPress
EventName en
Keyup -> ElementEventTarget
-> EventName ElementEventTarget KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyUp
EventName en
Load -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.load
EventName en
Mousedown -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseDown
EventName en
Mouseenter -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseEnter
EventName en
Mouseleave -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseLeave
EventName en
Mousemove -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseMove
EventName en
Mouseout -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseOut
EventName en
Mouseover -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseOver
EventName en
Mouseup -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseUp
EventName en
Mousewheel -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseWheel
EventName en
Scroll -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.scroll
EventName en
Select -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.select
EventName en
Submit -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.submit
EventName en
Wheel -> ElementEventTarget
-> EventName ElementEventTarget WheelEvent
-> EventM ElementEventTarget WheelEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget WheelEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self WheelEvent
Events.wheel
EventName en
Beforecut -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.beforeCut
EventName en
Cut -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.cut
EventName en
Beforecopy -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.beforeCopy
EventName en
Copy -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.copy
EventName en
Beforepaste -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.beforePaste
EventName en
Paste -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.paste
EventName en
Reset -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.reset
EventName en
Search -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.search
EventName en
Selectstart -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsElement self, IsEventTarget self) =>
EventName self Event
Element.selectStart
EventName en
Touchstart -> ElementEventTarget
-> EventName ElementEventTarget TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchStart
EventName en
Touchmove -> ElementEventTarget
-> EventName ElementEventTarget TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchMove
EventName en
Touchend -> ElementEventTarget
-> EventName ElementEventTarget TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchEnd
EventName en
Touchcancel -> ElementEventTarget
-> EventName ElementEventTarget TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchCancel
{-# INLINABLE windowOnEventName #-}
windowOnEventName :: EventName en -> DOM.Window -> EventM DOM.Window (EventType en) () -> JSM (JSM ())
windowOnEventName :: EventName en
-> Window -> EventM Window (EventType en) () -> JSM (JSM ())
windowOnEventName EventName en
en Window
e = case EventName en
en of
EventName en
Abort -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.abort
EventName en
Blur -> Window
-> EventName Window FocusEvent
-> EventM ElementEventTarget FocusEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window FocusEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self FocusEvent
Events.blur
EventName en
Change -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.change
EventName en
Click -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.click
EventName en
Contextmenu -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.contextMenu
EventName en
Dblclick -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dblClick
EventName en
Drag -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.drag
EventName en
Dragend -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragEnd
EventName en
Dragenter -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragEnter
EventName en
Dragleave -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragLeave
EventName en
Dragover -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragOver
EventName en
Dragstart -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragStart
EventName en
Drop -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.drop
EventName en
Error -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.error
EventName en
Focus -> Window
-> EventName Window FocusEvent
-> EventM ElementEventTarget FocusEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window FocusEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self FocusEvent
Events.focus
EventName en
Input -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.input
EventName en
Invalid -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.invalid
EventName en
Keydown -> Window
-> EventName Window KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyDown
EventName en
Keypress -> Window
-> EventName Window KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyPress
EventName en
Keyup -> Window
-> EventName Window KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyUp
EventName en
Load -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.load
EventName en
Mousedown -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseDown
EventName en
Mouseenter -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseEnter
EventName en
Mouseleave -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseLeave
EventName en
Mousemove -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseMove
EventName en
Mouseout -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseOut
EventName en
Mouseover -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseOver
EventName en
Mouseup -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseUp
EventName en
Mousewheel -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseWheel
EventName en
Scroll -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.scroll
EventName en
Select -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.select
EventName en
Submit -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.submit
EventName en
Wheel -> Window
-> EventName Window WheelEvent
-> EventM ElementEventTarget WheelEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window WheelEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self WheelEvent
Events.wheel
EventName en
Beforecut -> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ()))
-> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Cut -> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ()))
-> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforecopy -> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ()))
-> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Copy -> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ()))
-> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforepaste -> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ()))
-> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Paste -> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent () -> JSM (JSM ()))
-> JSM (JSM ())
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Reset -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.reset
EventName en
Search -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.search
EventName en
Selectstart -> JSM (JSM ()) -> EventM HTMLInputElement Event () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM HTMLInputElement Event () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM HTMLInputElement Event () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Touchstart -> Window
-> EventName Window TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchStart
EventName en
Touchmove -> Window
-> EventName Window TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchMove
EventName en
Touchend -> Window
-> EventName Window TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchEnd
EventName en
Touchcancel -> Window
-> EventName Window TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchCancel
{-# INLINABLE wrapDomEvent #-}
wrapDomEvent :: (TriggerEvent t m, MonadJSM m) => e -> (e -> EventM e event () -> JSM (JSM ())) -> EventM e event a -> m (Event t a)
wrapDomEvent :: e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event a
-> m (Event t a)
wrapDomEvent e
el e -> EventM e event () -> JSM (JSM ())
elementOnevent EventM e event a
getValue = e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> m (Event t a)
forall t (m :: * -> *) e event a.
(TriggerEvent t m, MonadJSM m) =>
e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> m (Event t a)
wrapDomEventMaybe e
el e -> EventM e event () -> JSM (JSM ())
elementOnevent (EventM e event (Maybe a) -> m (Event t a))
-> EventM e event (Maybe a) -> m (Event t a)
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a) -> EventM e event a -> EventM e event (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just EventM e event a
getValue
{-# INLINABLE subscribeDomEvent #-}
subscribeDomEvent :: (EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> EventTrigger t a
-> JSM (JSM ())
subscribeDomEvent :: (EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> EventTrigger t a
-> JSM (JSM ())
subscribeDomEvent EventM e event () -> JSM (JSM ())
elementOnevent EventM e event (Maybe a)
getValue Chan [DSum (EventTriggerRef t) TriggerInvocation]
eventChan EventTrigger t a
et = EventM e event () -> JSM (JSM ())
elementOnevent (EventM e event () -> JSM (JSM ()))
-> EventM e event () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
Maybe a
mv <- EventM e event (Maybe a)
getValue
Maybe a -> (a -> EventM e event ()) -> EventM e event ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe a
mv ((a -> EventM e event ()) -> EventM e event ())
-> (a -> EventM e event ()) -> EventM e event ()
forall a b. (a -> b) -> a -> b
$ \a
v -> IO () -> EventM e event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM e event ()) -> IO () -> EventM e event ()
forall a b. (a -> b) -> a -> b
$ do
IORef (Maybe (EventTrigger t a))
etr <- Maybe (EventTrigger t a) -> IO (IORef (Maybe (EventTrigger t a)))
forall a. a -> IO (IORef a)
newIORef (Maybe (EventTrigger t a) -> IO (IORef (Maybe (EventTrigger t a))))
-> Maybe (EventTrigger t a)
-> IO (IORef (Maybe (EventTrigger t a)))
forall a b. (a -> b) -> a -> b
$ EventTrigger t a -> Maybe (EventTrigger t a)
forall a. a -> Maybe a
Just EventTrigger t a
et
Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> [DSum (EventTriggerRef t) TriggerInvocation] -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan [DSum (EventTriggerRef t) TriggerInvocation]
eventChan [IORef (Maybe (EventTrigger t a)) -> EventTriggerRef t a
forall t a. IORef (Maybe (EventTrigger t a)) -> EventTriggerRef t a
EventTriggerRef IORef (Maybe (EventTrigger t a))
etr EventTriggerRef t a
-> TriggerInvocation a
-> DSum (EventTriggerRef t) TriggerInvocation
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> a -> IO () -> TriggerInvocation a
forall a. a -> IO () -> TriggerInvocation a
TriggerInvocation a
v (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())]
{-# INLINABLE wrapDomEventMaybe #-}
wrapDomEventMaybe :: (TriggerEvent t m, MonadJSM m)
=> e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> m (Event t a)
wrapDomEventMaybe :: e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> m (Event t a)
wrapDomEventMaybe e
el e -> EventM e event () -> JSM (JSM ())
elementOnevent EventM e event (Maybe a)
getValue = do
JSContextRef
ctx <- m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
forall t (m :: * -> *) a.
TriggerEvent t m =>
((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
newEventWithLazyTriggerWithOnComplete (((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a))
-> ((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
forall a b. (a -> b) -> a -> b
$ \a -> IO () -> IO ()
trigger -> (JSM () -> JSContextRef -> IO ()
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM () -> IO ()) -> IO (JSM ()) -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSM (JSM ()) -> JSContextRef -> IO (JSM ())
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (e -> EventM e event () -> JSM (JSM ())
elementOnevent e
el (EventM e event () -> JSM (JSM ()))
-> EventM e event () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
Maybe a
mv <- EventM e event (Maybe a)
getValue
Maybe a -> (a -> EventM e event ()) -> EventM e event ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe a
mv ((a -> EventM e event ()) -> EventM e event ())
-> (a -> EventM e event ()) -> EventM e event ()
forall a b. (a -> b) -> a -> b
$ \a
v -> IO () -> EventM e event ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM e event ()) -> IO () -> EventM e event ()
forall a b. (a -> b) -> a -> b
$ a -> IO () -> IO ()
trigger a
v (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINABLE wrapDomEventsMaybe #-}
wrapDomEventsMaybe :: (MonadJSM m, MonadReflexCreateTrigger t m)
=> e
-> (forall en. IsEvent (EventType en) => EventName en -> EventM e (EventType en) (Maybe (f en)))
-> (forall en. EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ()))
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
wrapDomEventsMaybe :: e
-> (forall (en :: EventTag).
IsEvent (EventType en) =>
EventName en -> EventM e (EventType en) (Maybe (f en)))
-> (forall (en :: EventTag).
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ()))
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
wrapDomEventsMaybe e
target forall (en :: EventTag).
IsEvent (EventType en) =>
EventName en -> EventM e (EventType en) (Maybe (f en))
handlers forall (en :: EventTag).
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
onEventName = do
JSContextRef
ctx <- HydrationDomBuilderT GhcjsDomSpace t m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
Chan [DSum (EventTriggerRef t) TriggerInvocation]
eventChan <- HydrationDomBuilderT
GhcjsDomSpace
t
m
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall k (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents
EventSelector t (WrapArg f EventName)
e <- m (EventSelector t (WrapArg f EventName))
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (EventSelector t (WrapArg f EventName))
-> ImmediateDomBuilderT
t m (EventSelector t (WrapArg f EventName)))
-> m (EventSelector t (WrapArg f EventName))
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
forall a b. (a -> b) -> a -> b
$ (forall a. WrapArg f EventName a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t (WrapArg f EventName))
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger ((forall a.
WrapArg f EventName a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t (WrapArg f EventName)))
-> (forall a.
WrapArg f EventName a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t (WrapArg f EventName))
forall a b. (a -> b) -> a -> b
$ \(WrapArg en) -> EventName a1
-> (IsEvent (EventType a1) => EventTrigger t (f a1) -> IO (IO ()))
-> EventTrigger t (f a1)
-> IO (IO ())
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName a1
en
(((JSM () -> JSContextRef -> IO ()
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM () -> IO ()) -> IO (JSM ()) -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO (JSM ()) -> IO (IO ()))
-> (EventTrigger t (f a1) -> IO (JSM ()))
-> EventTrigger t (f a1)
-> IO (IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JSM (JSM ()) -> JSContextRef -> IO (JSM ())
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM (JSM ()) -> IO (JSM ()))
-> (EventTrigger t (f a1) -> JSM (JSM ()))
-> EventTrigger t (f a1)
-> IO (JSM ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventM Any (EventType a1) () -> JSM (JSM ()))
-> EventM Any (EventType a1) (Maybe (f a1))
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> EventTrigger t (f a1)
-> JSM (JSM ())
forall e event a t.
(EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> EventTrigger t a
-> JSM (JSM ())
subscribeDomEvent (EventName a1 -> e -> EventM Any (EventType a1) () -> JSM (JSM ())
forall (en :: EventTag).
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
onEventName EventName a1
en e
target) (EventName a1 -> EventM Any (EventType a1) (Maybe (f a1))
forall (en :: EventTag).
IsEvent (EventType en) =>
EventName en -> EventM e (EventType en) (Maybe (f en))
handlers EventName a1
en) Chan [DSum (EventTriggerRef t) TriggerInvocation]
eventChan)
EventSelector t (WrapArg f EventName)
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
forall (m :: * -> *) a. Monad m => a -> m a
return (EventSelector t (WrapArg f EventName)
-> ImmediateDomBuilderT
t m (EventSelector t (WrapArg f EventName)))
-> EventSelector t (WrapArg f EventName)
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
forall a b. (a -> b) -> a -> b
$! EventSelector t (WrapArg f EventName)
e
{-# INLINABLE getKeyEvent #-}
getKeyEvent :: EventM e KeyboardEvent Word
getKeyEvent :: EventM e KeyboardEvent Word
getKeyEvent = do
KeyboardEvent
e <- EventM Any KeyboardEvent KeyboardEvent
forall t e. EventM t e e
event
Word
which <- KeyboardEvent -> EventM e KeyboardEvent Word
forall (m :: * -> *). MonadDOM m => KeyboardEvent -> m Word
KeyboardEvent.getWhich KeyboardEvent
e
if Word
which Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 then Word -> EventM e KeyboardEvent Word
forall (m :: * -> *) a. Monad m => a -> m a
return Word
which else do
Word
charCode <- KeyboardEvent -> EventM e KeyboardEvent Word
forall (m :: * -> *). MonadDOM m => KeyboardEvent -> m Word
getCharCode KeyboardEvent
e
if Word
charCode Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0 then Word -> EventM e KeyboardEvent Word
forall (m :: * -> *) a. Monad m => a -> m a
return Word
charCode else
KeyboardEvent -> EventM e KeyboardEvent Word
forall (m :: * -> *). MonadDOM m => KeyboardEvent -> m Word
getKeyCode KeyboardEvent
e
{-# INLINABLE getMouseEventCoords #-}
getMouseEventCoords :: EventM e MouseEvent (Int, Int)
getMouseEventCoords :: EventM e MouseEvent (Int, Int)
getMouseEventCoords = do
MouseEvent
e <- EventM Any MouseEvent MouseEvent
forall t e. EventM t e e
event
(ReaderT MouseEvent JSM Int, ReaderT MouseEvent JSM Int)
-> EventM e MouseEvent (Int, Int)
forall (t :: * -> * -> *) (f :: * -> *) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequence (MouseEvent -> ReaderT MouseEvent JSM Int
forall (m :: * -> *) self.
(MonadDOM m, IsMouseEvent self) =>
self -> m Int
getClientX MouseEvent
e, MouseEvent -> ReaderT MouseEvent JSM Int
forall (m :: * -> *) self.
(MonadDOM m, IsMouseEvent self) =>
self -> m Int
getClientY MouseEvent
e)
{-# INLINABLE getPasteData #-}
getPasteData :: EventM e ClipboardEvent (Maybe Text)
getPasteData :: EventM e ClipboardEvent (Maybe Text)
getPasteData = do
ClipboardEvent
e <- EventM Any ClipboardEvent ClipboardEvent
forall t e. EventM t e e
event
Maybe DataTransfer
mdt <- ClipboardEvent -> ReaderT ClipboardEvent JSM (Maybe DataTransfer)
forall (m :: * -> *).
MonadDOM m =>
ClipboardEvent -> m (Maybe DataTransfer)
ClipboardEvent.getClipboardData ClipboardEvent
e
case Maybe DataTransfer
mdt of
Maybe DataTransfer
Nothing -> Maybe Text -> EventM e ClipboardEvent (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
Just DataTransfer
dt -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> ReaderT ClipboardEvent JSM Text
-> EventM e ClipboardEvent (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataTransfer -> Text -> ReaderT ClipboardEvent JSM Text
forall (m :: * -> *) format result.
(MonadDOM m, ToJSString format, FromJSString result) =>
DataTransfer -> format -> m result
DataTransfer.getData DataTransfer
dt (Text
"text" :: Text)
{-# INLINABLE getTouchEvent #-}
getTouchEvent :: EventM e TouchEvent TouchEventResult
getTouchEvent :: EventM e TouchEvent TouchEventResult
getTouchEvent = do
let touchResults :: TouchList -> m [TouchResult]
touchResults TouchList
ts = do
Word
n <- TouchList -> m Word
forall (m :: * -> *). MonadDOM m => TouchList -> m Word
TouchList.getLength TouchList
ts
[Word] -> (Word -> m TouchResult) -> m [TouchResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ((Word -> Bool) -> [Word] -> [Word]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
n) [Word
0..]) ((Word -> m TouchResult) -> m [TouchResult])
-> (Word -> m TouchResult) -> m [TouchResult]
forall a b. (a -> b) -> a -> b
$ \Word
ix -> do
Touch
t <- TouchList -> Word -> m Touch
forall (m :: * -> *). MonadDOM m => TouchList -> Word -> m Touch
TouchList.item TouchList
ts Word
ix
Word
identifier <- Touch -> m Word
forall (m :: * -> *). MonadDOM m => Touch -> m Word
Touch.getIdentifier Touch
t
Int
screenX <- Touch -> m Int
forall (m :: * -> *). MonadDOM m => Touch -> m Int
Touch.getScreenX Touch
t
Int
screenY <- Touch -> m Int
forall (m :: * -> *). MonadDOM m => Touch -> m Int
Touch.getScreenY Touch
t
Int
clientX <- Touch -> m Int
forall (m :: * -> *). MonadDOM m => Touch -> m Int
Touch.getClientX Touch
t
Int
clientY <- Touch -> m Int
forall (m :: * -> *). MonadDOM m => Touch -> m Int
Touch.getClientY Touch
t
Int
pageX <- Touch -> m Int
forall (m :: * -> *). MonadDOM m => Touch -> m Int
Touch.getPageX Touch
t
Int
pageY <- Touch -> m Int
forall (m :: * -> *). MonadDOM m => Touch -> m Int
Touch.getPageY Touch
t
TouchResult -> m TouchResult
forall (m :: * -> *) a. Monad m => a -> m a
return TouchResult :: Word -> Int -> Int -> Int -> Int -> Int -> Int -> TouchResult
TouchResult
{ _touchResult_identifier :: Word
_touchResult_identifier = Word
identifier
, _touchResult_screenX :: Int
_touchResult_screenX = Int
screenX
, _touchResult_screenY :: Int
_touchResult_screenY = Int
screenY
, _touchResult_clientX :: Int
_touchResult_clientX = Int
clientX
, _touchResult_clientY :: Int
_touchResult_clientY = Int
clientY
, _touchResult_pageX :: Int
_touchResult_pageX = Int
pageX
, _touchResult_pageY :: Int
_touchResult_pageY = Int
pageY
}
TouchEvent
e <- EventM Any TouchEvent TouchEvent
forall t e. EventM t e e
event
Bool
altKey <- TouchEvent -> ReaderT TouchEvent JSM Bool
forall (m :: * -> *). MonadDOM m => TouchEvent -> m Bool
TouchEvent.getAltKey TouchEvent
e
Bool
ctrlKey <- TouchEvent -> ReaderT TouchEvent JSM Bool
forall (m :: * -> *). MonadDOM m => TouchEvent -> m Bool
TouchEvent.getCtrlKey TouchEvent
e
Bool
shiftKey <- TouchEvent -> ReaderT TouchEvent JSM Bool
forall (m :: * -> *). MonadDOM m => TouchEvent -> m Bool
TouchEvent.getShiftKey TouchEvent
e
Bool
metaKey <- TouchEvent -> ReaderT TouchEvent JSM Bool
forall (m :: * -> *). MonadDOM m => TouchEvent -> m Bool
TouchEvent.getMetaKey TouchEvent
e
[TouchResult]
changedTouches <- TouchList -> ReaderT TouchEvent JSM [TouchResult]
forall (m :: * -> *). MonadJSM m => TouchList -> m [TouchResult]
touchResults (TouchList -> ReaderT TouchEvent JSM [TouchResult])
-> ReaderT TouchEvent JSM TouchList
-> ReaderT TouchEvent JSM [TouchResult]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TouchEvent -> ReaderT TouchEvent JSM TouchList
forall (m :: * -> *). MonadDOM m => TouchEvent -> m TouchList
TouchEvent.getChangedTouches TouchEvent
e
[TouchResult]
targetTouches <- TouchList -> ReaderT TouchEvent JSM [TouchResult]
forall (m :: * -> *). MonadJSM m => TouchList -> m [TouchResult]
touchResults (TouchList -> ReaderT TouchEvent JSM [TouchResult])
-> ReaderT TouchEvent JSM TouchList
-> ReaderT TouchEvent JSM [TouchResult]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TouchEvent -> ReaderT TouchEvent JSM TouchList
forall (m :: * -> *). MonadDOM m => TouchEvent -> m TouchList
TouchEvent.getTargetTouches TouchEvent
e
[TouchResult]
touches <- TouchList -> ReaderT TouchEvent JSM [TouchResult]
forall (m :: * -> *). MonadJSM m => TouchList -> m [TouchResult]
touchResults (TouchList -> ReaderT TouchEvent JSM [TouchResult])
-> ReaderT TouchEvent JSM TouchList
-> ReaderT TouchEvent JSM [TouchResult]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TouchEvent -> ReaderT TouchEvent JSM TouchList
forall (m :: * -> *). MonadDOM m => TouchEvent -> m TouchList
TouchEvent.getTouches TouchEvent
e
TouchEventResult -> EventM e TouchEvent TouchEventResult
forall (m :: * -> *) a. Monad m => a -> m a
return (TouchEventResult -> EventM e TouchEvent TouchEventResult)
-> TouchEventResult -> EventM e TouchEvent TouchEventResult
forall a b. (a -> b) -> a -> b
$ TouchEventResult :: Bool
-> [TouchResult]
-> Bool
-> Bool
-> Bool
-> [TouchResult]
-> [TouchResult]
-> TouchEventResult
TouchEventResult
{ _touchEventResult_altKey :: Bool
_touchEventResult_altKey = Bool
altKey
, _touchEventResult_changedTouches :: [TouchResult]
_touchEventResult_changedTouches = [TouchResult]
changedTouches
, _touchEventResult_ctrlKey :: Bool
_touchEventResult_ctrlKey = Bool
ctrlKey
, _touchEventResult_metaKey :: Bool
_touchEventResult_metaKey = Bool
metaKey
, _touchEventResult_shiftKey :: Bool
_touchEventResult_shiftKey = Bool
shiftKey
, _touchEventResult_targetTouches :: [TouchResult]
_touchEventResult_targetTouches = [TouchResult]
targetTouches
, _touchEventResult_touches :: [TouchResult]
_touchEventResult_touches = [TouchResult]
touches
}
{-# INLINABLE getWheelEvent #-}
getWheelEvent :: EventM e WheelEvent WheelEventResult
getWheelEvent :: EventM e WheelEvent WheelEventResult
getWheelEvent = do
WheelEvent
e <- EventM Any WheelEvent WheelEvent
forall t e. EventM t e e
event
Double
dx :: Double <- WheelEvent -> ReaderT WheelEvent JSM Double
forall (m :: * -> *). MonadDOM m => WheelEvent -> m Double
WheelEvent.getDeltaX WheelEvent
e
Double
dy :: Double <- WheelEvent -> ReaderT WheelEvent JSM Double
forall (m :: * -> *). MonadDOM m => WheelEvent -> m Double
WheelEvent.getDeltaY WheelEvent
e
Double
dz :: Double <- WheelEvent -> ReaderT WheelEvent JSM Double
forall (m :: * -> *). MonadDOM m => WheelEvent -> m Double
WheelEvent.getDeltaZ WheelEvent
e
Word
deltaMode :: Word <- WheelEvent -> ReaderT WheelEvent JSM Word
forall (m :: * -> *). MonadDOM m => WheelEvent -> m Word
WheelEvent.getDeltaMode WheelEvent
e
WheelEventResult -> EventM e WheelEvent WheelEventResult
forall (m :: * -> *) a. Monad m => a -> m a
return (WheelEventResult -> EventM e WheelEvent WheelEventResult)
-> WheelEventResult -> EventM e WheelEvent WheelEventResult
forall a b. (a -> b) -> a -> b
$ WheelEventResult :: Double -> Double -> Double -> DeltaMode -> WheelEventResult
WheelEventResult
{ _wheelEventResult_deltaX :: Double
_wheelEventResult_deltaX = Double
dx
, _wheelEventResult_deltaY :: Double
_wheelEventResult_deltaY = Double
dy
, _wheelEventResult_deltaZ :: Double
_wheelEventResult_deltaZ = Double
dz
, _wheelEventResult_deltaMode :: DeltaMode
_wheelEventResult_deltaMode = case Word
deltaMode of
Word
0 -> DeltaMode
DeltaPixel
Word
1 -> DeltaMode
DeltaLine
Word
2 -> DeltaMode
DeltaPage
Word
_ -> String -> DeltaMode
forall a. HasCallStack => String -> a
error String
"getWheelEvent: impossible encoding"
}
instance MonadSample t m => MonadSample t (HydrationDomBuilderT s t m) where
{-# INLINABLE sample #-}
sample :: Behavior t a -> HydrationDomBuilderT s t m a
sample = m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> (Behavior t a -> m a)
-> Behavior t a
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior t a -> m a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample
instance MonadHold t m => MonadHold t (HydrationDomBuilderT s t m) where
{-# INLINABLE hold #-}
hold :: a -> Event t a -> HydrationDomBuilderT s t m (Behavior t a)
hold a
v0 Event t a
v' = m (Behavior t a) -> HydrationDomBuilderT s t m (Behavior t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Behavior t a) -> HydrationDomBuilderT s t m (Behavior t a))
-> m (Behavior t a) -> HydrationDomBuilderT s t m (Behavior t a)
forall a b. (a -> b) -> a -> b
$ a -> Event t a -> m (Behavior t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold a
v0 Event t a
v'
{-# INLINABLE holdDyn #-}
holdDyn :: a -> Event t a -> HydrationDomBuilderT s t m (Dynamic t a)
holdDyn a
v0 Event t a
v' = m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a))
-> m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a)
forall a b. (a -> b) -> a -> b
$ a -> Event t a -> m (Dynamic t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn a
v0 Event t a
v'
{-# INLINABLE holdIncremental #-}
holdIncremental :: PatchTarget p
-> Event t p -> HydrationDomBuilderT s t m (Incremental t p)
holdIncremental PatchTarget p
v0 Event t p
v' = m (Incremental t p) -> HydrationDomBuilderT s t m (Incremental t p)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Incremental t p)
-> HydrationDomBuilderT s t m (Incremental t p))
-> m (Incremental t p)
-> HydrationDomBuilderT s t m (Incremental t p)
forall a b. (a -> b) -> a -> b
$ PatchTarget p -> Event t p -> m (Incremental t p)
forall k (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental PatchTarget p
v0 Event t p
v'
{-# INLINABLE buildDynamic #-}
buildDynamic :: PushM t a -> Event t a -> HydrationDomBuilderT s t m (Dynamic t a)
buildDynamic PushM t a
a0 = m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a))
-> (Event t a -> m (Dynamic t a))
-> Event t a
-> HydrationDomBuilderT s t m (Dynamic t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PushM t a -> Event t a -> m (Dynamic t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic PushM t a
a0
{-# INLINABLE headE #-}
headE :: Event t a -> HydrationDomBuilderT s t m (Event t a)
headE = m (Event t a) -> HydrationDomBuilderT s t m (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> HydrationDomBuilderT s t m (Event t a))
-> (Event t a -> m (Event t a))
-> Event t a
-> HydrationDomBuilderT s t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t a -> m (Event t a)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
Event t a -> m (Event t a)
headE
data WindowConfig t = WindowConfig
instance Default (WindowConfig t) where
def :: WindowConfig t
def = WindowConfig t
forall k (t :: k). WindowConfig t
WindowConfig
data Window t = Window
{ Window t -> EventSelector t (WrapArg EventResult EventName)
_window_events :: EventSelector t (WrapArg EventResult EventName)
, Window t -> Window
_window_raw :: DOM.Window
}
wrapWindow :: (MonadJSM m, MonadReflexCreateTrigger t m) => DOM.Window -> WindowConfig t -> HydrationDomBuilderT GhcjsDomSpace t m (Window t)
wrapWindow :: Window
-> WindowConfig t
-> HydrationDomBuilderT GhcjsDomSpace t m (Window t)
wrapWindow Window
wv WindowConfig t
_ = do
EventSelector t (WrapArg EventResult EventName)
events <- Window
-> (forall (en :: EventTag).
IsEvent (EventType en) =>
EventName en
-> EventM Window (EventType en) (Maybe (EventResult en)))
-> (forall (en :: EventTag).
EventName en
-> Window -> EventM e (EventType en) () -> JSM (JSM ()))
-> ImmediateDomBuilderT
t m (EventSelector t (WrapArg EventResult EventName))
forall (m :: * -> *) t e (f :: EventTag -> *).
(MonadJSM m, MonadReflexCreateTrigger t m) =>
e
-> (forall (en :: EventTag).
IsEvent (EventType en) =>
EventName en -> EventM e (EventType en) (Maybe (f en)))
-> (forall (en :: EventTag).
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ()))
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
wrapDomEventsMaybe Window
wv (Window
-> EventName en
-> EventM Window (EventType en) (Maybe (EventResult en))
forall (en :: EventTag).
Window
-> EventName en
-> EventM Window (EventType en) (Maybe (EventResult en))
defaultDomWindowEventHandler Window
wv) forall (en :: EventTag).
EventName en
-> Window -> EventM e (EventType en) () -> JSM (JSM ())
windowOnEventName
Window t -> HydrationDomBuilderT GhcjsDomSpace t m (Window t)
forall (m :: * -> *) a. Monad m => a -> m a
return (Window t -> HydrationDomBuilderT GhcjsDomSpace t m (Window t))
-> Window t -> HydrationDomBuilderT GhcjsDomSpace t m (Window t)
forall a b. (a -> b) -> a -> b
$ Window :: forall k (t :: k).
EventSelector t (WrapArg EventResult EventName)
-> Window -> Window t
Window
{ _window_events :: EventSelector t (WrapArg EventResult EventName)
_window_events = EventSelector t (WrapArg EventResult EventName)
events
, _window_raw :: Window
_window_raw = Window
wv
}
#ifdef USE_TEMPLATE_HASKELL
makeLenses ''GhcjsEventSpec
#endif