{-# 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
import Control.Monad.Exception
import Control.Monad.Fix
import Control.Monad.Primitive
import Control.Monad.Reader
import Control.Monad.Ref
import Control.Monad.State.Strict (StateT, mapStateT, get, modify', gets, runStateT)
import Data.Bitraversable
import Data.Default
import Data.Dependent.Map (DMap)
import Data.Dependent.Sum
import Data.Foldable (for_, traverse_)
import Data.Functor.Compose
import Data.Functor.Constant
import Data.Functor.Misc
import Data.Functor.Product
import Data.GADT.Compare (GCompare)
import Data.IORef
import Data.IntMap.Strict (IntMap)
import Data.Kind (Type)
import Data.Maybe
import Data.Some (Some(..))
import Data.String (IsString)
import Data.Text (Text)
import Foreign.JavaScript.Internal.Utils
import Foreign.JavaScript.TH
import GHCJS.DOM.ClipboardEvent as ClipboardEvent
import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)
import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS, hasAttribute)
import GHCJS.DOM.EventM (EventM, event, on)
import GHCJS.DOM.KeyboardEvent as KeyboardEvent
import GHCJS.DOM.MouseEvent
import GHCJS.DOM.Node (appendChild_, getOwnerDocumentUnchecked, getParentNodeUnchecked, setNodeValue, toNode)
import GHCJS.DOM.Types (liftJSM, askJSM, runJSM, JSM, MonadJSM, FocusEvent, IsElement, IsEvent, IsNode, Node, TouchEvent, WheelEvent, uncheckedCastTo)
import GHCJS.DOM.UIEvent
#ifndef ghcjs_HOST_OS
import Language.Javascript.JSaddle (call, eval)
#endif
import Reflex.Adjustable.Class
import Reflex.Class as Reflex
import Reflex.Dom.Builder.Class
import Reflex.Dynamic
import Reflex.Host.Class
import Reflex.Patch.MapWithMove (PatchMapWithMove(..))
import Reflex.PerformEvent.Base (PerformEventT)
import Reflex.PerformEvent.Class
import Reflex.PostBuild.Base (PostBuildT)
import Reflex.PostBuild.Class
#ifdef PROFILE_REFLEX
import Reflex.Profiled
#endif
import Reflex.Requester.Base
import Reflex.Requester.Class
import Reflex.Spider (Spider, SpiderHost, Global)
import Reflex.TriggerEvent.Base hiding (askEvents)
import Reflex.TriggerEvent.Class
import qualified Data.Dependent.Map as DMap
import qualified Data.FastMutableIntMap as FastMutableIntMap
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified GHCJS.DOM as DOM
import qualified GHCJS.DOM.DataTransfer as DataTransfer
import qualified GHCJS.DOM.DocumentAndElementEventHandlers as Events
import qualified GHCJS.DOM.DocumentOrShadowRoot as Document
import qualified GHCJS.DOM.Element as Element
import qualified GHCJS.DOM.Event as Event
import qualified GHCJS.DOM.EventM as DOM
import qualified GHCJS.DOM.FileList as FileList
import qualified GHCJS.DOM.GlobalEventHandlers as Events
import qualified GHCJS.DOM.HTMLInputElement as Input
import qualified GHCJS.DOM.HTMLSelectElement as Select
import qualified GHCJS.DOM.HTMLTextAreaElement as TextArea
import qualified GHCJS.DOM.Node as Node
import qualified GHCJS.DOM.Text as DOM
import qualified GHCJS.DOM.Touch as Touch
import qualified GHCJS.DOM.TouchEvent as TouchEvent
import qualified GHCJS.DOM.TouchList as TouchList
import qualified GHCJS.DOM.Types as DOM
import qualified GHCJS.DOM.Window as Window
import qualified GHCJS.DOM.WheelEvent as WheelEvent
import qualified Reflex.Patch.DMap as PatchDMap
import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)
#ifndef USE_TEMPLATE_HASKELL
import Data.Functor.Contravariant (phantom)
import Control.Lens (Lens', Getter)
#endif
#ifndef ghcjs_HOST_OS
import GHCJS.DOM.Types (MonadJSM (..))
instance MonadJSM m => MonadJSM (HydrationRunnerT t m) where
{-# INLINABLE liftJSM' #-}
liftJSM' :: forall a. JSM a -> HydrationRunnerT t m a
liftJSM' = m a -> HydrationRunnerT t m a
forall (m :: * -> *) a. Monad m => m a -> HydrationRunnerT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationRunnerT t m a)
-> (JSM a -> m a) -> JSM a -> HydrationRunnerT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall a. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
instance MonadJSM m => MonadJSM (HydrationDomBuilderT s t m) where
{-# INLINABLE liftJSM' #-}
liftJSM' :: forall a. JSM a -> HydrationDomBuilderT s t m a
liftJSM' = m a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> (JSM a -> m a) -> JSM a -> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall a. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
instance MonadJSM m => MonadJSM (DomRenderHookT t m) where
{-# INLINABLE liftJSM' #-}
liftJSM' :: forall a. JSM a -> DomRenderHookT t m a
liftJSM' = m a -> DomRenderHookT t m a
forall (m :: * -> *) a. Monad m => m a -> DomRenderHookT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> DomRenderHookT t m a)
-> (JSM a -> m a) -> JSM a -> DomRenderHookT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSM a -> m a
forall a. JSM a -> m a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM'
#endif
data HydrationDomBuilderEnv t m = HydrationDomBuilderEnv
{ forall t (m :: * -> *). HydrationDomBuilderEnv t m -> Document
_hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document
, forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> Either Node (IORef Node)
_hydrationDomBuilderEnv_parent :: !(Either Node (IORef Node))
, forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren :: {-# UNPACK #-} !(IORef Word)
, forall t (m :: * -> *). HydrationDomBuilderEnv t m -> JSM ()
_hydrationDomBuilderEnv_commitAction :: !(JSM ())
, forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode :: {-# UNPACK #-} !(IORef HydrationMode)
, forall t (m :: * -> *). HydrationDomBuilderEnv t m -> Event t ()
_hydrationDomBuilderEnv_switchover :: !(Event t ())
, forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed :: {-# UNPACK #-} !(IORef (HydrationRunnerT t m ()))
}
newtype HydrationDomBuilderT s t m a = HydrationDomBuilderT { forall {k} (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT :: ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a }
deriving ((forall a b.
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b)
-> (forall a b.
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a)
-> Functor (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
forall a b.
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall a b.
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
fmap :: forall a b.
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
$c<$ :: forall k (s :: k) t (m :: * -> *) a b.
Functor m =>
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
<$ :: forall a b.
a -> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
Functor, Functor (HydrationDomBuilderT s t m)
Functor (HydrationDomBuilderT s t m) =>
(forall a. a -> HydrationDomBuilderT s t m a)
-> (forall a b.
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b)
-> (forall a b c.
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c)
-> (forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b)
-> (forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a)
-> Applicative (HydrationDomBuilderT s t m)
forall a. a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
Monad m =>
Functor (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
forall k (s :: k) t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall a b.
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
forall a b c.
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
pure :: forall a. a -> HydrationDomBuilderT s t m a
$c<*> :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
<*> :: forall a b.
HydrationDomBuilderT s t m (a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
$cliftA2 :: forall k (s :: k) t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
liftA2 :: forall a b c.
(a -> b -> c)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b
-> HydrationDomBuilderT s t m c
$c*> :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
*> :: forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
$c<* :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
<* :: forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
Applicative, Applicative (HydrationDomBuilderT s t m)
Applicative (HydrationDomBuilderT s t m) =>
(forall a b.
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b)
-> (forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b)
-> (forall a. a -> HydrationDomBuilderT s t m a)
-> Monad (HydrationDomBuilderT s t m)
forall a. a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
Monad m =>
Applicative (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
forall a b.
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
>>= :: forall a b.
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
$c>> :: forall k (s :: k) t (m :: * -> *) a b.
Monad m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
>> :: forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m b
$creturn :: forall k (s :: k) t (m :: * -> *) a.
Monad m =>
a -> HydrationDomBuilderT s t m a
return :: forall a. a -> HydrationDomBuilderT s t m a
Monad, Monad (HydrationDomBuilderT s t m)
Monad (HydrationDomBuilderT s t m) =>
(forall a.
(a -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a)
-> MonadFix (HydrationDomBuilderT s t m)
forall a.
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
MonadFix m =>
Monad (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall k (s :: k) t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
mfix :: forall a.
(a -> HydrationDomBuilderT s t m a) -> HydrationDomBuilderT s t m a
MonadFix, Monad (HydrationDomBuilderT s t m)
Monad (HydrationDomBuilderT s t m) =>
(forall a. IO a -> HydrationDomBuilderT s t m a)
-> MonadIO (HydrationDomBuilderT s t m)
forall a. IO a -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *).
MonadIO m =>
Monad (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationDomBuilderT s t m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall k (s :: k) t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationDomBuilderT s t m a
liftIO :: forall a. IO a -> HydrationDomBuilderT s t m a
MonadIO, Monad (HydrationDomBuilderT s t m)
Monad (HydrationDomBuilderT s t m) =>
(forall e a. Exception e => e -> HydrationDomBuilderT s t m a)
-> (forall e a.
Exception e =>
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a)
-> (forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a)
-> MonadException (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *).
MonadException m =>
Monad (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) e a.
(MonadException m, Exception e) =>
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
forall k (s :: k) t (m :: * -> *) a b.
MonadException m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall e a. Exception e => e -> HydrationDomBuilderT s t m a
forall e a.
Exception e =>
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
$cthrow :: forall k (s :: k) t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationDomBuilderT s t m a
throw :: forall e a. Exception e => e -> HydrationDomBuilderT s t m a
$ccatch :: forall k (s :: k) t (m :: * -> *) e a.
(MonadException m, Exception e) =>
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
catch :: forall e a.
Exception e =>
HydrationDomBuilderT s t m a
-> (e -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m a
$cfinally :: forall k (s :: k) t (m :: * -> *) a b.
MonadException m =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
finally :: forall a b.
HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m b -> HydrationDomBuilderT s t m a
MonadException
#if MIN_VERSION_base(4,9,1)
, MonadIO (HydrationDomBuilderT s t m)
MonadException (HydrationDomBuilderT s t m)
(MonadIO (HydrationDomBuilderT s t m),
MonadException (HydrationDomBuilderT s t m)) =>
(forall b.
((forall a.
HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b)
-> MonadAsyncException (HydrationDomBuilderT s t m)
forall b.
((forall a.
HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall k (s :: k) t (m :: * -> *).
MonadAsyncException m =>
MonadIO (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *).
MonadAsyncException m =>
MonadException (HydrationDomBuilderT s t m)
forall k (s :: k) t (m :: * -> *) b.
MonadAsyncException m =>
((forall a.
HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall (m :: * -> *).
(MonadIO m, MonadException m) =>
(forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
$cmask :: forall k (s :: k) t (m :: * -> *) b.
MonadAsyncException m =>
((forall a.
HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
mask :: forall b.
((forall a.
HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a)
-> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
MonadAsyncException
#endif
)
instance PrimMonad m => PrimMonad (HydrationDomBuilderT s t m) where
type PrimState (HydrationDomBuilderT s t m) = PrimState m
primitive :: forall a.
(State# (PrimState (HydrationDomBuilderT s t m))
-> (# State# (PrimState (HydrationDomBuilderT s t m)), a #))
-> HydrationDomBuilderT s t m a
primitive = m a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive
instance MonadTrans (HydrationDomBuilderT s t) where
lift :: forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
lift = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a)
-> (m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> m a
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> (m a -> DomRenderHookT t m a)
-> m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> DomRenderHookT t m a
forall (m :: * -> *) a. Monad m => m a -> DomRenderHookT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationDomBuilderT s t m) where
withRenderHook :: forall a.
(forall x. JSM x -> JSM x)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
withRenderHook forall x. JSM x -> JSM x
hook = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a)
-> (HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DomRenderHookT t m a -> DomRenderHookT t m a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((forall x. JSM x -> JSM x)
-> DomRenderHookT t m a -> DomRenderHookT t m a
forall a.
(forall x. JSM x -> JSM x)
-> DomRenderHookT t m a -> DomRenderHookT t m a
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
(forall x. JSM x -> JSM x) -> m a -> m a
withRenderHook JSM x -> JSM x
forall x. JSM x -> JSM x
hook) (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> (HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall {k} (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT
requestDomAction :: forall a. Event t (JSM a) -> HydrationDomBuilderT s t m (Event t a)
requestDomAction = ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
-> HydrationDomBuilderT s t m (Event t a)
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
-> HydrationDomBuilderT s t m (Event t a))
-> (Event t (JSM a)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a))
-> Event t (JSM a)
-> HydrationDomBuilderT s t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a))
-> (Event t (JSM a) -> DomRenderHookT t m (Event t a))
-> Event t (JSM a)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> DomRenderHookT t m (Event t a)
forall a. Event t (JSM a) -> DomRenderHookT t m (Event t a)
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction
requestDomAction_ :: forall a. Event t (JSM a) -> HydrationDomBuilderT s t m ()
requestDomAction_ = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ()
-> HydrationDomBuilderT s t m ()
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ()
-> HydrationDomBuilderT s t m ())
-> (Event t (JSM a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ())
-> Event t (JSM a)
-> HydrationDomBuilderT s t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m ()
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ()
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m ()
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ())
-> (Event t (JSM a) -> DomRenderHookT t m ())
-> Event t (JSM a)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> DomRenderHookT t m ()
forall a. Event t (JSM a) -> DomRenderHookT t m ()
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_
newtype HydrationRunnerT t m a = HydrationRunnerT { forall t (m :: * -> *) a.
HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
unHydrationRunnerT :: StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a }
deriving ((forall a b.
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b)
-> (forall a b.
a -> HydrationRunnerT t m b -> HydrationRunnerT t m a)
-> Functor (HydrationRunnerT t m)
forall a b. a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall a b.
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
forall t (m :: * -> *) a b.
Functor m =>
a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
fmap :: forall a b.
(a -> b) -> HydrationRunnerT t m a -> HydrationRunnerT t m b
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
<$ :: forall a b. a -> HydrationRunnerT t m b -> HydrationRunnerT t m a
Functor, Functor (HydrationRunnerT t m)
Functor (HydrationRunnerT t m) =>
(forall a. a -> HydrationRunnerT t m a)
-> (forall a b.
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b)
-> (forall a b c.
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c)
-> (forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b)
-> (forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a)
-> Applicative (HydrationRunnerT t m)
forall a. a -> HydrationRunnerT t m a
forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall a b.
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
forall a b c.
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
forall t (m :: * -> *). Monad m => Functor (HydrationRunnerT t m)
forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
pure :: forall a. a -> HydrationRunnerT t m a
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
<*> :: forall a b.
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
liftA2 :: forall a b c.
(a -> b -> c)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m b
-> HydrationRunnerT t m c
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
*> :: forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
<* :: forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
Applicative, Applicative (HydrationRunnerT t m)
Applicative (HydrationRunnerT t m) =>
(forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b)
-> (forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b)
-> (forall a. a -> HydrationRunnerT t m a)
-> Monad (HydrationRunnerT t m)
forall a. a -> HydrationRunnerT t m a
forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall t (m :: * -> *).
Monad m =>
Applicative (HydrationRunnerT t m)
forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
>>= :: forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
>> :: forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m b
$creturn :: forall t (m :: * -> *) a. Monad m => a -> HydrationRunnerT t m a
return :: forall a. a -> HydrationRunnerT t m a
Monad, Monad (HydrationRunnerT t m)
Monad (HydrationRunnerT t m) =>
(forall a. (a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a)
-> MonadFix (HydrationRunnerT t m)
forall a. (a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall t (m :: * -> *). MonadFix m => Monad (HydrationRunnerT t m)
forall t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
mfix :: forall a. (a -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
MonadFix, Monad (HydrationRunnerT t m)
Monad (HydrationRunnerT t m) =>
(forall a. IO a -> HydrationRunnerT t m a)
-> MonadIO (HydrationRunnerT t m)
forall a. IO a -> HydrationRunnerT t m a
forall t (m :: * -> *). MonadIO m => Monad (HydrationRunnerT t m)
forall t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationRunnerT t m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall t (m :: * -> *) a.
MonadIO m =>
IO a -> HydrationRunnerT t m a
liftIO :: forall a. IO a -> HydrationRunnerT t m a
MonadIO, Monad (HydrationRunnerT t m)
Monad (HydrationRunnerT t m) =>
(forall e a. Exception e => e -> HydrationRunnerT t m a)
-> (forall e a.
Exception e =>
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a)
-> (forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a)
-> MonadException (HydrationRunnerT t m)
forall e a. Exception e => e -> HydrationRunnerT t m a
forall e a.
Exception e =>
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall t (m :: * -> *).
MonadException m =>
Monad (HydrationRunnerT t m)
forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationRunnerT t m a
forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
forall t (m :: * -> *) a b.
MonadException m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
$cthrow :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> HydrationRunnerT t m a
throw :: forall e a. Exception e => e -> HydrationRunnerT t m a
$ccatch :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
catch :: forall e a.
Exception e =>
HydrationRunnerT t m a
-> (e -> HydrationRunnerT t m a) -> HydrationRunnerT t m a
$cfinally :: forall t (m :: * -> *) a b.
MonadException m =>
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
finally :: forall a b.
HydrationRunnerT t m a
-> HydrationRunnerT t m b -> HydrationRunnerT t m a
MonadException
#if MIN_VERSION_base(4,9,1)
, MonadIO (HydrationRunnerT t m)
MonadException (HydrationRunnerT t m)
(MonadIO (HydrationRunnerT t m),
MonadException (HydrationRunnerT t m)) =>
(forall b.
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
-> HydrationRunnerT t m b)
-> HydrationRunnerT t m b)
-> MonadAsyncException (HydrationRunnerT t m)
forall b.
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
-> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
forall t (m :: * -> *).
MonadAsyncException m =>
MonadIO (HydrationRunnerT t m)
forall t (m :: * -> *).
MonadAsyncException m =>
MonadException (HydrationRunnerT t m)
forall t (m :: * -> *) b.
MonadAsyncException m =>
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
-> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
forall (m :: * -> *).
(MonadIO m, MonadException m) =>
(forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
$cmask :: forall t (m :: * -> *) b.
MonadAsyncException m =>
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
-> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
mask :: forall b.
((forall a. HydrationRunnerT t m a -> HydrationRunnerT t m a)
-> HydrationRunnerT t m b)
-> HydrationRunnerT t m b
MonadAsyncException
#endif
)
data HydrationState = HydrationState
{ HydrationState -> Maybe Node
_hydrationState_previousNode :: !(Maybe Node)
, HydrationState -> Bool
_hydrationState_failed :: !Bool
}
{-# INLINABLE localRunner #-}
localRunner :: (MonadJSM m, Monad m) => HydrationRunnerT t m a -> Maybe Node -> Node -> HydrationRunnerT t m a
localRunner :: forall (m :: * -> *) t a.
(MonadJSM m, Monad m) =>
HydrationRunnerT t m a
-> Maybe Node -> Node -> HydrationRunnerT t m a
localRunner (HydrationRunnerT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
m) Maybe Node
s Node
parent = do
s0 <- StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) HydrationState
-> HydrationRunnerT t m HydrationState
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) HydrationState
forall s (m :: * -> *). MonadState s m => m s
get
(a, s') <- HydrationRunnerT $ lift $ local (\Node
_ -> Node
parent) $ runStateT m (s0 { _hydrationState_previousNode = s })
traverse_ removeSubsequentNodes $ _hydrationState_previousNode s'
HydrationRunnerT $ modify' $ \HydrationState
hs -> HydrationState
hs { _hydrationState_failed = _hydrationState_failed s' }
pure a
{-# INLINABLE runHydrationRunnerT #-}
runHydrationRunnerT
:: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))
=> HydrationRunnerT t m a -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runHydrationRunnerT :: forall (m :: * -> *) t a.
(MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m,
MonadReflexCreateTrigger t m, MonadJSM m,
MonadJSM (Performable m)) =>
HydrationRunnerT t m a
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationRunnerT HydrationRunnerT t m a
m = HydrationRunnerT t m a
-> IO ()
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
forall (m :: * -> *) t a.
(MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m,
MonadReflexCreateTrigger t m, MonadJSM m,
MonadJSM (Performable m)) =>
HydrationRunnerT t m a
-> IO ()
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationRunnerTWithFailure HydrationRunnerT t m a
m (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# INLINABLE runHydrationRunnerTWithFailure #-}
runHydrationRunnerTWithFailure
:: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))
=> HydrationRunnerT t m a -> IO () -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runHydrationRunnerTWithFailure :: forall (m :: * -> *) t a.
(MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m,
MonadReflexCreateTrigger t m, MonadJSM m,
MonadJSM (Performable m)) =>
HydrationRunnerT t m a
-> IO ()
-> Maybe Node
-> Node
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationRunnerTWithFailure (HydrationRunnerT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
m) IO ()
onFailure Maybe Node
s Node
parent Chan [DSum (EventTriggerRef t) TriggerInvocation]
events = (DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DomRenderHookT t m a
-> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
forall (m :: * -> *) t a.
(MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m,
MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef) =>
DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runDomRenderHookT Chan [DSum (EventTriggerRef t) TriggerInvocation]
events (DomRenderHookT t m a -> m a) -> DomRenderHookT t m a -> m a
forall a b. (a -> b) -> a -> b
$ (ReaderT Node (DomRenderHookT t m) a
-> Node -> DomRenderHookT t m a)
-> Node
-> ReaderT Node (DomRenderHookT t m) a
-> DomRenderHookT t m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Node (DomRenderHookT t m) a -> Node -> DomRenderHookT t m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Node
parent (ReaderT Node (DomRenderHookT t m) a -> DomRenderHookT t m a)
-> ReaderT Node (DomRenderHookT t m) a -> DomRenderHookT t m a
forall a b. (a -> b) -> a -> b
$ do
(a, s') <- StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationState
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
m (Maybe Node -> Bool -> HydrationState
HydrationState Maybe Node
s Bool
False)
traverse_ removeSubsequentNodes $ _hydrationState_previousNode s'
when (_hydrationState_failed s') $ liftIO $ putStrLn "reflex-dom warning: hydration failed: the DOM was not as expected at switchover time. This may be due to invalid HTML which the browser has altered upon parsing, some external JS altering the DOM, or the page being served from an outdated cache."
when (_hydrationState_failed s') $ liftIO onFailure
pure a
instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRunnerT t m) where
{-# INLINABLE newEventWithTrigger #-}
newEventWithTrigger :: forall a.
(EventTrigger t a -> IO (IO ()))
-> HydrationRunnerT t m (Event t a)
newEventWithTrigger = m (Event t a) -> HydrationRunnerT t m (Event t a)
forall (m :: * -> *) a. Monad m => m a -> HydrationRunnerT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> HydrationRunnerT t m (Event t a))
-> ((EventTrigger t a -> IO (IO ())) -> m (Event t a))
-> (EventTrigger t a -> IO (IO ()))
-> HydrationRunnerT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventTrigger t a -> IO (IO ())) -> m (Event t a)
forall a. (EventTrigger t a -> IO (IO ())) -> m (Event t a)
forall t (m :: * -> *) a.
MonadReflexCreateTrigger t m =>
(EventTrigger t a -> IO (IO ())) -> m (Event t a)
newEventWithTrigger
{-# INLINABLE newFanEventWithTrigger #-}
newFanEventWithTrigger :: forall (k :: * -> *).
GCompare k =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> HydrationRunnerT t m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f = m (EventSelector t k) -> HydrationRunnerT t m (EventSelector t k)
forall (m :: * -> *) a. Monad m => m a -> HydrationRunnerT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (EventSelector t k) -> HydrationRunnerT t m (EventSelector t k))
-> m (EventSelector t k)
-> HydrationRunnerT t m (EventSelector t k)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
forall (k :: * -> *).
GCompare k =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger k a -> EventTrigger t a -> IO (IO ())
forall a. k a -> EventTrigger t a -> IO (IO ())
f
instance MonadTrans (HydrationRunnerT t) where
{-# INLINABLE lift #-}
lift :: forall (m :: * -> *) a. Monad m => m a -> HydrationRunnerT t m a
lift = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a)
-> (m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> m a
-> HydrationRunnerT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Node (DomRenderHookT t m) a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall (m :: * -> *) a. Monad m => m a -> StateT HydrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Node (DomRenderHookT t m) a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> (m a -> ReaderT Node (DomRenderHookT t m) a)
-> m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m a -> ReaderT Node (DomRenderHookT t m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT Node m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m a -> ReaderT Node (DomRenderHookT t m) a)
-> (m a -> DomRenderHookT t m a)
-> m a
-> ReaderT Node (DomRenderHookT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> DomRenderHookT t m a
forall (m :: * -> *) a. Monad m => m a -> DomRenderHookT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MonadSample t m => MonadSample t (HydrationRunnerT t m) where
{-# INLINABLE sample #-}
sample :: forall a. Behavior t a -> HydrationRunnerT t m a
sample = m a -> HydrationRunnerT t m a
forall (m :: * -> *) a. Monad m => m a -> HydrationRunnerT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationRunnerT t m a)
-> (Behavior t a -> m a) -> Behavior t a -> HydrationRunnerT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior t a -> m a
forall a. Behavior t a -> m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample
instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationRunnerT t m) where
withRenderHook :: forall a.
(forall x. JSM x -> JSM x)
-> HydrationRunnerT t m a -> HydrationRunnerT t m a
withRenderHook forall x. JSM x -> JSM x
hook = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a)
-> (HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> HydrationRunnerT t m a
-> HydrationRunnerT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState))
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((DomRenderHookT t m (a, HydrationState)
-> DomRenderHookT t m (a, HydrationState))
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
-> ReaderT Node (DomRenderHookT t m) (a, HydrationState)
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((forall x. JSM x -> JSM x)
-> DomRenderHookT t m (a, HydrationState)
-> DomRenderHookT t m (a, HydrationState)
forall a.
(forall x. JSM x -> JSM x)
-> DomRenderHookT t m a -> DomRenderHookT t m a
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
(forall x. JSM x -> JSM x) -> m a -> m a
withRenderHook JSM x -> JSM x
forall x. JSM x -> JSM x
hook)) (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> (HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a)
-> HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
forall t (m :: * -> *) a.
HydrationRunnerT t m a
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
unHydrationRunnerT
requestDomAction :: forall a. Event t (JSM a) -> HydrationRunnerT t m (Event t a)
requestDomAction = StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a)
-> HydrationRunnerT t m (Event t a)
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a)
-> HydrationRunnerT t m (Event t a))
-> (Event t (JSM a)
-> StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a))
-> Event t (JSM a)
-> HydrationRunnerT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Node (DomRenderHookT t m) (Event t a)
-> StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a)
forall (m :: * -> *) a. Monad m => m a -> StateT HydrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Node (DomRenderHookT t m) (Event t a)
-> StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a))
-> (Event t (JSM a)
-> ReaderT Node (DomRenderHookT t m) (Event t a))
-> Event t (JSM a)
-> StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a)
-> ReaderT Node (DomRenderHookT t m) (Event t a)
forall (m :: * -> *) a. Monad m => m a -> ReaderT Node m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a)
-> ReaderT Node (DomRenderHookT t m) (Event t a))
-> (Event t (JSM a) -> DomRenderHookT t m (Event t a))
-> Event t (JSM a)
-> ReaderT Node (DomRenderHookT t m) (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> DomRenderHookT t m (Event t a)
forall a. Event t (JSM a) -> DomRenderHookT t m (Event t a)
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction
requestDomAction_ :: forall a. Event t (JSM a) -> HydrationRunnerT t m ()
requestDomAction_ = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ())
-> (Event t (JSM a)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> Event t (JSM a)
-> HydrationRunnerT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Node (DomRenderHookT t m) ()
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall (m :: * -> *) a. Monad m => m a -> StateT HydrationState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Node (DomRenderHookT t m) ()
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (Event t (JSM a) -> ReaderT Node (DomRenderHookT t m) ())
-> Event t (JSM a)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m () -> ReaderT Node (DomRenderHookT t m) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Node m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m () -> ReaderT Node (DomRenderHookT t m) ())
-> (Event t (JSM a) -> DomRenderHookT t m ())
-> Event t (JSM a)
-> ReaderT Node (DomRenderHookT t m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> DomRenderHookT t m ()
forall a. Event t (JSM a) -> DomRenderHookT t m ()
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_
{-# INLINABLE addHydrationStepWithSetup #-}
addHydrationStepWithSetup :: MonadIO m => m a -> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup :: forall {k} (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup m a
setup a -> HydrationRunnerT t m ()
f = HydrationDomBuilderT s t m HydrationMode
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT s t m HydrationMode
-> (HydrationMode -> HydrationDomBuilderT s t m ())
-> HydrationDomBuilderT s t m ()
forall a b.
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> () -> HydrationDomBuilderT s t m ()
forall a. a -> HydrationDomBuilderT s t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
HydrationMode
HydrationMode_Hydrating -> do
s <- m a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
setup
addHydrationStep (f s)
{-# INLINABLE addHydrationStep #-}
addHydrationStep :: MonadIO m => HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
addHydrationStep :: forall {k} (m :: * -> *) t (s :: k).
MonadIO m =>
HydrationRunnerT t m () -> HydrationDomBuilderT s t m ()
addHydrationStep HydrationRunnerT t m ()
m = do
delayedRef <- ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IORef (HydrationRunnerT t m ()))
-> HydrationDomBuilderT s t m (IORef (HydrationRunnerT t m ()))
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IORef (HydrationRunnerT t m ()))
-> HydrationDomBuilderT s t m (IORef (HydrationRunnerT t m ())))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IORef (HydrationRunnerT t m ()))
-> HydrationDomBuilderT s t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ (HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ()))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IORef (HydrationRunnerT t m ()))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed
liftIO $ modifyIORef' delayedRef (>> m)
newtype DomRenderHookT t m a = DomRenderHookT { forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT :: RequesterT t JSM Identity (TriggerEventT t m) a }
deriving ((forall a b.
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b)
-> (forall a b. a -> DomRenderHookT t m b -> DomRenderHookT t m a)
-> Functor (DomRenderHookT t m)
forall a b. a -> DomRenderHookT t m b -> DomRenderHookT t m a
forall a b.
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
forall t (m :: * -> *) a b.
Functor m =>
a -> DomRenderHookT t m b -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
fmap :: forall a b.
(a -> b) -> DomRenderHookT t m a -> DomRenderHookT t m b
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> DomRenderHookT t m b -> DomRenderHookT t m a
<$ :: forall a b. a -> DomRenderHookT t m b -> DomRenderHookT t m a
Functor, Functor (DomRenderHookT t m)
Functor (DomRenderHookT t m) =>
(forall a. a -> DomRenderHookT t m a)
-> (forall a b.
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b)
-> (forall a b c.
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c)
-> (forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b)
-> (forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a)
-> Applicative (DomRenderHookT t m)
forall a. a -> DomRenderHookT t m a
forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall a b.
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
forall a b c.
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
forall t (m :: * -> *). Monad m => Functor (DomRenderHookT t m)
forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
pure :: forall a. a -> DomRenderHookT t m a
$c<*> :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
<*> :: forall a b.
DomRenderHookT t m (a -> b)
-> DomRenderHookT t m a -> DomRenderHookT t m b
$cliftA2 :: forall t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
liftA2 :: forall a b c.
(a -> b -> c)
-> DomRenderHookT t m a
-> DomRenderHookT t m b
-> DomRenderHookT t m c
$c*> :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
*> :: forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
$c<* :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
<* :: forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
Applicative, Applicative (DomRenderHookT t m)
Applicative (DomRenderHookT t m) =>
(forall a b.
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b)
-> (forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b)
-> (forall a. a -> DomRenderHookT t m a)
-> Monad (DomRenderHookT t m)
forall a. a -> DomRenderHookT t m a
forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall a b.
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b
forall t (m :: * -> *). Monad m => Applicative (DomRenderHookT t m)
forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b
>>= :: forall a b.
DomRenderHookT t m a
-> (a -> DomRenderHookT t m b) -> DomRenderHookT t m b
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
>> :: forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m b
$creturn :: forall t (m :: * -> *) a. Monad m => a -> DomRenderHookT t m a
return :: forall a. a -> DomRenderHookT t m a
Monad, Monad (DomRenderHookT t m)
Monad (DomRenderHookT t m) =>
(forall a. (a -> DomRenderHookT t m a) -> DomRenderHookT t m a)
-> MonadFix (DomRenderHookT t m)
forall a. (a -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall t (m :: * -> *). MonadFix m => Monad (DomRenderHookT t m)
forall t (m :: * -> *) a.
MonadFix m =>
(a -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall t (m :: * -> *) a.
MonadFix m =>
(a -> DomRenderHookT t m a) -> DomRenderHookT t m a
mfix :: forall a. (a -> DomRenderHookT t m a) -> DomRenderHookT t m a
MonadFix, Monad (DomRenderHookT t m)
Monad (DomRenderHookT t m) =>
(forall a. IO a -> DomRenderHookT t m a)
-> MonadIO (DomRenderHookT t m)
forall a. IO a -> DomRenderHookT t m a
forall t (m :: * -> *). MonadIO m => Monad (DomRenderHookT t m)
forall t (m :: * -> *) a. MonadIO m => IO a -> DomRenderHookT t m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall t (m :: * -> *) a. MonadIO m => IO a -> DomRenderHookT t m a
liftIO :: forall a. IO a -> DomRenderHookT t m a
MonadIO, Monad (DomRenderHookT t m)
Monad (DomRenderHookT t m) =>
(forall e a. Exception e => e -> DomRenderHookT t m a)
-> (forall e a.
Exception e =>
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a)
-> (forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a)
-> MonadException (DomRenderHookT t m)
forall e a. Exception e => e -> DomRenderHookT t m a
forall e a.
Exception e =>
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall t (m :: * -> *).
MonadException m =>
Monad (DomRenderHookT t m)
forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> DomRenderHookT t m a
forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
forall t (m :: * -> *) a b.
MonadException m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
$cthrow :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> DomRenderHookT t m a
throw :: forall e a. Exception e => e -> DomRenderHookT t m a
$ccatch :: forall t (m :: * -> *) e a.
(MonadException m, Exception e) =>
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
catch :: forall e a.
Exception e =>
DomRenderHookT t m a
-> (e -> DomRenderHookT t m a) -> DomRenderHookT t m a
$cfinally :: forall t (m :: * -> *) a b.
MonadException m =>
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
finally :: forall a b.
DomRenderHookT t m a
-> DomRenderHookT t m b -> DomRenderHookT t m a
MonadException
#if MIN_VERSION_base(4,9,1)
, MonadIO (DomRenderHookT t m)
MonadException (DomRenderHookT t m)
(MonadIO (DomRenderHookT t m),
MonadException (DomRenderHookT t m)) =>
(forall b.
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
-> DomRenderHookT t m b)
-> DomRenderHookT t m b)
-> MonadAsyncException (DomRenderHookT t m)
forall b.
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
-> DomRenderHookT t m b)
-> DomRenderHookT t m b
forall t (m :: * -> *).
MonadAsyncException m =>
MonadIO (DomRenderHookT t m)
forall t (m :: * -> *).
MonadAsyncException m =>
MonadException (DomRenderHookT t m)
forall t (m :: * -> *) b.
MonadAsyncException m =>
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
-> DomRenderHookT t m b)
-> DomRenderHookT t m b
forall (m :: * -> *).
(MonadIO m, MonadException m) =>
(forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
$cmask :: forall t (m :: * -> *) b.
MonadAsyncException m =>
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
-> DomRenderHookT t m b)
-> DomRenderHookT t m b
mask :: forall b.
((forall a. DomRenderHookT t m a -> DomRenderHookT t m a)
-> DomRenderHookT t m b)
-> DomRenderHookT t m b
MonadAsyncException
#endif
)
{-# INLINABLE runDomRenderHookT #-}
runDomRenderHookT
:: (MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef)
=> DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runDomRenderHookT :: forall (m :: * -> *) t a.
(MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m,
MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef) =>
DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runDomRenderHookT (DomRenderHookT RequesterT t JSM Identity (TriggerEventT t m) a
a) Chan [DSum (EventTriggerRef t) TriggerInvocation]
events = do
(TriggerEventT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> TriggerEventT t m a
-> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip TriggerEventT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
forall t (m :: * -> *) a.
TriggerEventT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runTriggerEventT Chan [DSum (EventTriggerRef t) TriggerInvocation]
events (TriggerEventT t m a -> m a) -> TriggerEventT t m a -> m a
forall a b. (a -> b) -> a -> b
$ do
rec (result, req) <- runRequesterT a rsp
rsp <- performEventAsync $ ffor req $ \RequesterData JSM
rm RequesterData Identity -> IO ()
f -> JSM () -> Performable (TriggerEventT t m) ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> Performable (TriggerEventT t m) ())
-> JSM () -> Performable (TriggerEventT t m) ()
forall a b. (a -> b) -> a -> b
$ (RequesterData Identity -> IO ())
-> JSM (RequesterData Identity) -> JSM ()
forall {a} {a}. (a -> IO a) -> JSM a -> JSM ()
runInAnimationFrame RequesterData Identity -> IO ()
f (JSM (RequesterData Identity) -> JSM ())
-> JSM (RequesterData Identity) -> JSM ()
forall a b. (a -> b) -> a -> b
$
(forall a. JSM a -> JSM (Identity a))
-> RequesterData JSM -> JSM (RequesterData Identity)
forall (m :: * -> *) (request :: * -> *) (response :: * -> *).
Applicative m =>
(forall a. request a -> m (response a))
-> RequesterData request -> m (RequesterData response)
traverseRequesterData ((a -> Identity a) -> JSM a -> JSM (Identity a)
forall a b. (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity) RequesterData JSM
rm
return result
where
runInAnimationFrame :: (a -> IO a) -> JSM a -> JSM ()
runInAnimationFrame a -> IO a
f JSM a
x = JSM AnimationFrameHandle -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM AnimationFrameHandle -> JSM ())
-> ((Double -> JSM ()) -> JSM AnimationFrameHandle)
-> (Double -> JSM ())
-> JSM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> JSM ()) -> JSM AnimationFrameHandle
DOM.inAnimationFrame' ((Double -> JSM ()) -> JSM ()) -> (Double -> JSM ()) -> JSM ()
forall a b. (a -> b) -> a -> b
$ \Double
_ -> do
v <- JSM a -> JSM a
forall x. JSM x -> JSM x
synchronously JSM a
x
void . liftIO $ f v
instance MonadTrans (DomRenderHookT t) where
{-# INLINABLE lift #-}
lift :: forall (m :: * -> *) a. Monad m => m a -> DomRenderHookT t m a
lift = RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a)
-> (m a -> RequesterT t JSM Identity (TriggerEventT t m) a)
-> m a
-> DomRenderHookT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall (m :: * -> *) a.
Monad m =>
m a -> RequesterT t JSM Identity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a)
-> (m a -> TriggerEventT t m a)
-> m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> TriggerEventT t m a
forall (m :: * -> *) a. Monad m => m a -> TriggerEventT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance (Reflex t, MonadFix m) => DomRenderHook t (DomRenderHookT t m) where
withRenderHook :: forall a.
(forall x. JSM x -> JSM x)
-> DomRenderHookT t m a -> DomRenderHookT t m a
withRenderHook forall x. JSM x -> JSM x
hook (DomRenderHookT RequesterT t JSM Identity (TriggerEventT t m) a
a) = do
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a)
-> RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
forall a b. (a -> b) -> a -> b
$ (Event
t
(Response
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity))
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Event
t
(Request
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity)),
a))
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall t (m :: * -> *) a r.
(Requester t m, MonadFix m) =>
(Event t (Response m a) -> m (Event t (Request m a), r)) -> m r
withRequesting ((Event
t
(Response
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity))
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Event
t
(Request
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity)),
a))
-> RequesterT t JSM Identity (TriggerEventT t m) a)
-> (Event
t
(Response
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity))
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Event
t
(Request
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity)),
a))
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall a b. (a -> b) -> a -> b
$ \Event
t
(Response
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity))
rsp -> do
(x, req) <- TriggerEventT t m (a, Event t (RequesterData JSM))
-> RequesterT
t JSM Identity (TriggerEventT t m) (a, Event t (RequesterData JSM))
forall (m :: * -> *) a.
Monad m =>
m a -> RequesterT t JSM Identity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m (a, Event t (RequesterData JSM))
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(a, Event t (RequesterData JSM)))
-> TriggerEventT t m (a, Event t (RequesterData JSM))
-> RequesterT
t JSM Identity (TriggerEventT t m) (a, Event t (RequesterData JSM))
forall a b. (a -> b) -> a -> b
$ RequesterT t JSM Identity (TriggerEventT t m) a
-> Event t (RequesterData Identity)
-> TriggerEventT t m (a, Event t (RequesterData JSM))
forall t (m :: * -> *) (request :: * -> *) (response :: * -> *) a.
(Reflex t, Monad m) =>
RequesterT t request response m a
-> Event t (RequesterData response)
-> m (a, Event t (RequesterData request))
runRequesterT RequesterT t JSM Identity (TriggerEventT t m) a
a (Event t (RequesterData Identity)
-> TriggerEventT t m (a, Event t (RequesterData JSM)))
-> Event t (RequesterData Identity)
-> TriggerEventT t m (a, Event t (RequesterData JSM))
forall a b. (a -> b) -> a -> b
$ Identity (RequesterData Identity) -> RequesterData Identity
forall a. Identity a -> a
runIdentity (Identity (RequesterData Identity) -> RequesterData Identity)
-> Event t (Identity (RequesterData Identity))
-> Event t (RequesterData Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t (Identity (RequesterData Identity))
Event
t
(Response
(RequesterT t JSM Identity (TriggerEventT t m))
(RequesterData Identity))
rsp
return (ffor req $ \RequesterData JSM
rm -> JSM (RequesterData Identity) -> JSM (RequesterData Identity)
forall x. JSM x -> JSM x
hook (JSM (RequesterData Identity) -> JSM (RequesterData Identity))
-> JSM (RequesterData Identity) -> JSM (RequesterData Identity)
forall a b. (a -> b) -> a -> b
$ (forall a. JSM a -> JSM (Identity a))
-> RequesterData JSM -> JSM (RequesterData Identity)
forall (m :: * -> *) (request :: * -> *) (response :: * -> *).
Applicative m =>
(forall a. request a -> m (response a))
-> RequesterData request -> m (RequesterData response)
traverseRequesterData ((a -> Identity a) -> JSM a -> JSM (Identity a)
forall a b. (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity) RequesterData JSM
rm, x)
requestDomAction :: forall a. Event t (JSM a) -> DomRenderHookT t m (Event t a)
requestDomAction = RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
-> DomRenderHookT t m (Event t a)
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
-> DomRenderHookT t m (Event t a))
-> (Event t (JSM a)
-> RequesterT t JSM Identity (TriggerEventT t m) (Event t a))
-> Event t (JSM a)
-> DomRenderHookT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a)
-> RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
Event t (Request (RequesterT t JSM Identity (TriggerEventT t m)) a)
-> RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
forall t (m :: * -> *) a.
(Requester t m, Response m ~ Identity) =>
Event t (Request m a) -> m (Event t a)
requestingIdentity
requestDomAction_ :: forall a. Event t (JSM a) -> DomRenderHookT t m ()
requestDomAction_ = RequesterT t JSM Identity (TriggerEventT t m) ()
-> DomRenderHookT t m ()
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) ()
-> DomRenderHookT t m ())
-> (Event t (JSM a)
-> RequesterT t JSM Identity (TriggerEventT t m) ())
-> Event t (JSM a)
-> DomRenderHookT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (JSM a) -> RequesterT t JSM Identity (TriggerEventT t m) ()
Event t (Request (RequesterT t JSM Identity (TriggerEventT t m)) a)
-> RequesterT t JSM Identity (TriggerEventT t m) ()
forall a.
Event t (Request (RequesterT t JSM Identity (TriggerEventT t m)) a)
-> RequesterT t JSM Identity (TriggerEventT t m) ()
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m ()
requesting_
{-# INLINABLE runHydrationDomBuilderT #-}
runHydrationDomBuilderT
:: ( MonadFix m
, PerformEvent t m
, MonadReflexCreateTrigger t m
, MonadJSM m
, MonadJSM (Performable m)
, MonadRef m
, Ref m ~ IORef
)
=> HydrationDomBuilderT s t m a
-> HydrationDomBuilderEnv t m
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationDomBuilderT :: forall {k} (m :: * -> *) t (s :: k) a.
(MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m,
MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef) =>
HydrationDomBuilderT s t m a
-> HydrationDomBuilderEnv t m
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> m a
runHydrationDomBuilderT (HydrationDomBuilderT ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
a) HydrationDomBuilderEnv t m
env = DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
forall (m :: * -> *) t a.
(MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m,
MonadJSM m, MonadJSM (Performable m), MonadRef m, Ref m ~ IORef) =>
DomRenderHookT t m a
-> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runDomRenderHookT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderEnv t m -> DomRenderHookT t m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
a HydrationDomBuilderEnv t m
env)
instance (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, Monad m) => HasDocument (HydrationDomBuilderT s t m) where
{-# INLINABLE askDocument #-}
askDocument :: HydrationDomBuilderT
s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
askDocument = ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
-> HydrationDomBuilderT
s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
-> HydrationDomBuilderT
s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
-> HydrationDomBuilderT
s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
forall a b. (a -> b) -> a -> b
$ (HydrationDomBuilderEnv t m
-> RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> Document
HydrationDomBuilderEnv t m
-> RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> Document
_hydrationDomBuilderEnv_document
{-# INLINABLE askParent #-}
askParent :: Monad m => HydrationRunnerT t m DOM.Node
askParent :: forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) Node
-> HydrationRunnerT t m Node
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT StateT HydrationState (ReaderT Node (DomRenderHookT t m)) Node
forall r (m :: * -> *). MonadReader r m => m r
ask
{-# INLINABLE getParent #-}
getParent :: MonadIO m => HydrationDomBuilderT s t m DOM.Node
getParent :: forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent = (Node -> HydrationDomBuilderT s t m Node)
-> (IORef Node -> HydrationDomBuilderT s t m Node)
-> Either Node (IORef Node)
-> HydrationDomBuilderT s t m Node
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Node -> HydrationDomBuilderT s t m Node
forall a. a -> HydrationDomBuilderT s t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO Node -> HydrationDomBuilderT s t m Node
forall a. IO a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Node -> HydrationDomBuilderT s t m Node)
-> (IORef Node -> IO Node)
-> IORef Node
-> HydrationDomBuilderT s t m Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Node -> IO Node
forall a. IORef a -> IO a
readIORef) (Either Node (IORef Node) -> HydrationDomBuilderT s t m Node)
-> HydrationDomBuilderT s t m (Either Node (IORef Node))
-> HydrationDomBuilderT s t m Node
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Either Node (IORef Node))
-> HydrationDomBuilderT s t m (Either Node (IORef Node))
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT ((HydrationDomBuilderEnv t m -> Either Node (IORef Node))
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Either Node (IORef Node))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> Either Node (IORef Node)
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> Either Node (IORef Node)
_hydrationDomBuilderEnv_parent)
{-# INLINABLE askEvents #-}
askEvents :: Monad m => HydrationDomBuilderT s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents :: forall {k} (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents = ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> (TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> (TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> DomRenderHookT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> DomRenderHookT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> DomRenderHookT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> (TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> DomRenderHookT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall (m :: * -> *) a.
Monad m =>
m a -> RequesterT t JSM Identity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation]))
-> TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
-> HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall a b. (a -> b) -> a -> b
$ TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall (m :: * -> *) t.
Monad m =>
TriggerEventT
t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
TriggerEventT.askEvents
{-# INLINABLE localEnv #-}
localEnv :: Monad m => (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m) -> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
localEnv :: forall {k} (m :: * -> *) t (s :: k) a.
Monad m =>
(HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m a
localEnv HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m
f = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a)
-> (HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall a.
(HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m
f (HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m)
-> HydrationDomBuilderEnv t m -> HydrationDomBuilderEnv t m
forall a b. (a -> b) -> a -> b
$!) (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> (HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a)
-> HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
forall {k} (s :: k) t (m :: * -> *) a.
HydrationDomBuilderT s t m a
-> ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
unHydrationDomBuilderT
{-# INLINABLE append #-}
append :: MonadJSM m => DOM.Node -> HydrationDomBuilderT s t m ()
append :: forall {k} (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append Node
n = do
p <- HydrationDomBuilderT s t m Node
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
liftJSM $ appendChild_ p n
return ()
{-# SPECIALIZE append
:: DOM.Node
-> HydrationDomBuilderT s Spider HydrationM ()
#-}
data HydrationMode
= HydrationMode_Hydrating
| HydrationMode_Immediate
deriving (HydrationMode -> HydrationMode -> Bool
(HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> Bool) -> Eq HydrationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HydrationMode -> HydrationMode -> Bool
== :: HydrationMode -> HydrationMode -> Bool
$c/= :: HydrationMode -> HydrationMode -> Bool
/= :: HydrationMode -> HydrationMode -> Bool
Eq, Eq HydrationMode
Eq HydrationMode =>
(HydrationMode -> HydrationMode -> Ordering)
-> (HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> Bool)
-> (HydrationMode -> HydrationMode -> HydrationMode)
-> (HydrationMode -> HydrationMode -> HydrationMode)
-> Ord HydrationMode
HydrationMode -> HydrationMode -> Bool
HydrationMode -> HydrationMode -> Ordering
HydrationMode -> HydrationMode -> HydrationMode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HydrationMode -> HydrationMode -> Ordering
compare :: HydrationMode -> HydrationMode -> Ordering
$c< :: HydrationMode -> HydrationMode -> Bool
< :: HydrationMode -> HydrationMode -> Bool
$c<= :: HydrationMode -> HydrationMode -> Bool
<= :: HydrationMode -> HydrationMode -> Bool
$c> :: HydrationMode -> HydrationMode -> Bool
> :: HydrationMode -> HydrationMode -> Bool
$c>= :: HydrationMode -> HydrationMode -> Bool
>= :: HydrationMode -> HydrationMode -> Bool
$cmax :: HydrationMode -> HydrationMode -> HydrationMode
max :: HydrationMode -> HydrationMode -> HydrationMode
$cmin :: HydrationMode -> HydrationMode -> HydrationMode
min :: HydrationMode -> HydrationMode -> HydrationMode
Ord, Int -> HydrationMode -> ShowS
[HydrationMode] -> ShowS
HydrationMode -> String
(Int -> HydrationMode -> ShowS)
-> (HydrationMode -> String)
-> ([HydrationMode] -> ShowS)
-> Show HydrationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HydrationMode -> ShowS
showsPrec :: Int -> HydrationMode -> ShowS
$cshow :: HydrationMode -> String
show :: HydrationMode -> String
$cshowList :: [HydrationMode] -> ShowS
showList :: [HydrationMode] -> ShowS
Show)
{-# INLINABLE getPreviousNode #-}
getPreviousNode :: Monad m => HydrationRunnerT t m (Maybe DOM.Node)
getPreviousNode :: forall (m :: * -> *) t.
Monad m =>
HydrationRunnerT t m (Maybe Node)
getPreviousNode = StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Maybe Node)
-> HydrationRunnerT t m (Maybe Node)
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Maybe Node)
-> HydrationRunnerT t m (Maybe Node))
-> StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Maybe Node)
-> HydrationRunnerT t m (Maybe Node)
forall a b. (a -> b) -> a -> b
$ (HydrationState -> Maybe Node)
-> StateT
HydrationState (ReaderT Node (DomRenderHookT t m)) (Maybe Node)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets HydrationState -> Maybe Node
_hydrationState_previousNode
{-# INLINABLE setPreviousNode #-}
setPreviousNode :: Monad m => Maybe DOM.Node -> HydrationRunnerT t m ()
setPreviousNode :: forall (m :: * -> *) t.
Monad m =>
Maybe Node -> HydrationRunnerT t m ()
setPreviousNode Maybe Node
n = StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\HydrationState
hs -> HydrationState
hs { _hydrationState_previousNode = n })
{-# INLINABLE askUnreadyChildren #-}
askUnreadyChildren :: Monad m => HydrationDomBuilderT s t m (IORef Word)
askUnreadyChildren :: forall {k} (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT s t m (IORef Word)
askUnreadyChildren = ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (IORef Word)
-> HydrationDomBuilderT s t m (IORef Word)
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (IORef Word)
-> HydrationDomBuilderT s t m (IORef Word))
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (IORef Word)
-> HydrationDomBuilderT s t m (IORef Word)
forall a b. (a -> b) -> a -> b
$ (HydrationDomBuilderEnv t m -> IORef Word)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (IORef Word)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren
{-# INLINABLE askCommitAction #-}
askCommitAction :: Monad m => HydrationDomBuilderT s t m (JSM ())
askCommitAction :: forall {k} (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT s t m (JSM ())
askCommitAction = ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (JSM ())
-> HydrationDomBuilderT s t m (JSM ())
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) (JSM ())
-> HydrationDomBuilderT s t m (JSM ()))
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (JSM ())
-> HydrationDomBuilderT s t m (JSM ())
forall a b. (a -> b) -> a -> b
$ (HydrationDomBuilderEnv t m -> JSM ())
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (JSM ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> JSM ()
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> JSM ()
_hydrationDomBuilderEnv_commitAction
{-# INLINABLE getHydrationMode #-}
getHydrationMode :: MonadIO m => HydrationDomBuilderT s t m HydrationMode
getHydrationMode :: forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode = IO HydrationMode -> HydrationDomBuilderT s t m HydrationMode
forall a. IO a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HydrationMode -> HydrationDomBuilderT s t m HydrationMode)
-> (IORef HydrationMode -> IO HydrationMode)
-> IORef HydrationMode
-> HydrationDomBuilderT s t m HydrationMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef HydrationMode -> IO HydrationMode
forall a. IORef a -> IO a
readIORef (IORef HydrationMode -> HydrationDomBuilderT s t m HydrationMode)
-> HydrationDomBuilderT s t m (IORef HydrationMode)
-> HydrationDomBuilderT s t m HydrationMode
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IORef HydrationMode)
-> HydrationDomBuilderT s t m (IORef HydrationMode)
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT ((HydrationDomBuilderEnv t m -> IORef HydrationMode)
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(IORef HydrationMode)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks HydrationDomBuilderEnv t m -> IORef HydrationMode
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode)
removeSubsequentNodes :: (MonadJSM m, IsNode n) => n -> m ()
#ifdef ghcjs_HOST_OS
foreign import javascript unsafe
#if __GLASGOW_HASKELL__ < 900
"(function() { var n = $1; while (n['nextSibling']) { n['parentNode']['removeChild'](n['nextSibling']); }; })()"
#else
"(function(n) { while (n['nextSibling']) { n['parentNode']['removeChild'](n['nextSibling']); }; })"
#endif
removeSubsequentNodes_ :: DOM.Node -> IO ()
removeSubsequentNodes n = liftJSM $ removeSubsequentNodes_ (toNode n)
#else
removeSubsequentNodes :: forall (m :: * -> *) n. (MonadJSM m, IsNode n) => n -> m ()
removeSubsequentNodes n
n = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
f <- Text -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval (Text
"(function(n) { while (n.nextSibling) { (n.parentNode).removeChild(n.nextSibling); }; })" :: Text)
void $ call f f [n]
#endif
deleteBetweenExclusive :: (MonadJSM m, IsNode start, IsNode end) => start -> end -> m ()
deleteBetweenExclusive :: forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
deleteBetweenExclusive start
s end
e = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
df <- Document -> JSM DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment (Document -> JSM DocumentFragment)
-> JSM Document -> JSM DocumentFragment
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< start -> JSM Document
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Document
getOwnerDocumentUnchecked start
s
extractBetweenExclusive df s e
extractBetweenExclusive :: (MonadJSM m, IsNode start, IsNode end) => DOM.DocumentFragment -> start -> end -> m ()
#ifdef ghcjs_HOST_OS
foreign import javascript unsafe
#if __GLASGOW_HASKELL__ < 900
"(function() { var df = $1; var s = $2; var e = $3; var x; for(;;) { x = s['nextSibling']; if(e===x) { break; }; df['appendChild'](x); } })()"
#else
"(function(df, s, e) { var x; for(;;) { x = s['nextSibling']; if(e===x) { break; }; df['appendChild'](x); } })"
#endif
extractBetweenExclusive_ :: DOM.DocumentFragment -> DOM.Node -> DOM.Node -> IO ()
extractBetweenExclusive df s e = liftJSM $ extractBetweenExclusive_ df (toNode s) (toNode e)
#else
DocumentFragment
df start
s end
e = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
f <- Text -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval (Text
"(function(df,s,e) { var x; for(;;) { x = s['nextSibling']; if(e===x) { break; }; df['appendChild'](x); } })" :: Text)
void $ call f f (df, s, e)
#endif
{-# INLINABLE deleteUpTo #-}
deleteUpTo :: (MonadJSM m, IsNode start, IsNode end) => start -> end -> m ()
deleteUpTo :: forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
deleteUpTo start
s end
e = do
df <- Document -> m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment (Document -> m DocumentFragment)
-> m Document -> m DocumentFragment
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< start -> m Document
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Document
getOwnerDocumentUnchecked start
s
extractUpTo df s e
extractUpTo :: (MonadJSM m, IsNode start, IsNode end) => DOM.DocumentFragment -> start -> end -> m ()
#ifdef ghcjs_HOST_OS
foreign import javascript unsafe
#if __GLASGOW_HASKELL__ < 900
"(function() { var x = $2; while(x !== $3) { var y = x['nextSibling']; $1['appendChild'](x); x = y; } })()"
#else
"(function(_, x, $3) { while(x !== $3) { var y = x['nextSibling']; $1['appendChild'](x); x = y; } })"
#endif
extractUpTo_ :: DOM.DocumentFragment -> DOM.Node -> DOM.Node -> IO ()
extractUpTo df s e = liftJSM $ extractUpTo_ df (toNode s) (toNode e)
#else
DocumentFragment
df start
s end
e = JSM () -> m ()
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM () -> m ()) -> JSM () -> m ()
forall a b. (a -> b) -> a -> b
$ do
f <- Text -> JSM JSVal
forall script. ToJSString script => script -> JSM JSVal
eval (Text
"(function(df,s,e){ var x = s; var y; for(;;) { y = x['nextSibling']; df['appendChild'](x); if(e===y) { break; } x = y; } })" :: Text)
void $ call f f (df, s, e)
#endif
type SupportsHydrationDomBuilder t m = (Reflex t, MonadJSM m, MonadHold t m, MonadFix m, MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref JSM, Adjustable t m, PrimMonad m, PerformEvent t m, MonadJSM (Performable m))
{-# INLINABLE collectUpTo #-}
collectUpTo :: (MonadJSM m, IsNode start, IsNode end) => start -> end -> m DOM.DocumentFragment
collectUpTo :: forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
start -> end -> m DocumentFragment
collectUpTo start
s end
e = do
currentParent <- end -> m Node
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Node
getParentNodeUnchecked end
e
collectUpToGivenParent currentParent s e
{-# INLINABLE collectUpToGivenParent #-}
collectUpToGivenParent :: (MonadJSM m, IsNode parent, IsNode start, IsNode end) => parent -> start -> end -> m DOM.DocumentFragment
collectUpToGivenParent :: forall (m :: * -> *) parent start end.
(MonadJSM m, IsNode parent, IsNode start, IsNode end) =>
parent -> start -> end -> m DocumentFragment
collectUpToGivenParent parent
currentParent start
s end
e = do
doc <- parent -> m Document
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Document
getOwnerDocumentUnchecked parent
currentParent
df <- createDocumentFragment doc
extractUpTo df s e
return df
newtype EventFilterTriggerRef t er (en :: EventTag) = EventFilterTriggerRef (IORef (Maybe (EventTrigger t (er en))))
{-# INLINE wrap #-}
wrap
:: forall s m er t. (Reflex t, MonadJSM m, MonadReflexCreateTrigger t m, DomRenderHook t m, EventSpec s ~ GhcjsEventSpec)
=> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DOM.Element
-> RawElementConfig er t s
-> m (DMap EventName (EventFilterTriggerRef t er))
wrap :: forall {k1} (s :: k1) (m :: * -> *) (er :: EventTag -> *) t.
(Reflex t, MonadJSM m, MonadReflexCreateTrigger t m,
DomRenderHook t m, EventSpec s ~ GhcjsEventSpec) =>
Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> Element
-> RawElementConfig er t s
-> m (DMap EventName (EventFilterTriggerRef t er))
wrap Chan [DSum (EventTriggerRef t) TriggerInvocation]
events Element
e RawElementConfig er t s
cfg = do
Maybe (Event t (Map AttributeName (Maybe Text)))
-> (Event t (Map AttributeName (Maybe Text)) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (RawElementConfig er t s
-> Maybe (Event t (Map AttributeName (Maybe Text)))
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
RawElementConfig er t s
-> Maybe (Event t (Map AttributeName (Maybe Text)))
_rawElementConfig_modifyAttributes RawElementConfig er t s
cfg) ((Event t (Map AttributeName (Maybe Text)) -> m ()) -> m ())
-> (Event t (Map AttributeName (Maybe Text)) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Event t (Map AttributeName (Maybe Text))
modifyAttrs -> Event t (JSM ()) -> m ()
forall a. Event t (JSM a) -> m ()
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> m ()) -> Event t (JSM ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Event t (Map AttributeName (Maybe Text))
-> (Map AttributeName (Maybe Text) -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (Map AttributeName (Maybe Text))
modifyAttrs ((Map AttributeName (Maybe Text) -> JSM ()) -> Event t (JSM ()))
-> (Map AttributeName (Maybe Text) -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ (AttributeName -> Maybe Text -> JSM ())
-> Map AttributeName (Maybe Text) -> JSM ()
forall i (t :: * -> *) (m :: * -> *) a b.
(FoldableWithIndex i t, Monad m) =>
(i -> a -> m b) -> t a -> m ()
imapM_ ((AttributeName -> Maybe Text -> JSM ())
-> Map AttributeName (Maybe Text) -> JSM ())
-> (AttributeName -> Maybe Text -> JSM ())
-> Map AttributeName (Maybe Text)
-> JSM ()
forall a b. (a -> b) -> a -> b
$ \(AttributeName Maybe Text
mAttrNamespace Text
n) Maybe Text
mv -> case Maybe Text
mAttrNamespace of
Maybe Text
Nothing -> JSM () -> (Text -> JSM ()) -> Maybe Text -> JSM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Element -> Text -> JSM ()
forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsElement self, ToJSString qualifiedName) =>
self -> qualifiedName -> m ()
removeAttribute Element
e Text
n) (Element -> Text -> Text -> JSM ()
forall (m :: * -> *) self qualifiedName value.
(MonadDOM m, IsElement self, ToJSString qualifiedName,
ToJSString value) =>
self -> qualifiedName -> value -> m ()
setAttribute Element
e Text
n) Maybe Text
mv
Just Text
ns -> JSM () -> (Text -> JSM ()) -> Maybe Text -> JSM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Element -> Maybe Text -> Text -> JSM ()
forall (m :: * -> *) self namespaceURI localName.
(MonadDOM m, IsElement self, ToJSString namespaceURI,
ToJSString localName) =>
self -> Maybe namespaceURI -> localName -> m ()
removeAttributeNS Element
e (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ns) Text
n) (Element -> Maybe Text -> Text -> Text -> JSM ()
forall (m :: * -> *) self namespaceURI qualifiedName value.
(MonadDOM m, IsElement self, ToJSString namespaceURI,
ToJSString qualifiedName, ToJSString value) =>
self -> Maybe namespaceURI -> qualifiedName -> value -> m ()
setAttributeNS Element
e (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ns) Text
n) Maybe Text
mv
eventTriggerRefs :: DMap EventName (EventFilterTriggerRef t er) <- JSM (DMap EventName (EventFilterTriggerRef t er))
-> m (DMap EventName (EventFilterTriggerRef t er))
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM (JSM (DMap EventName (EventFilterTriggerRef t er))
-> m (DMap EventName (EventFilterTriggerRef t er)))
-> JSM (DMap EventName (EventFilterTriggerRef t er))
-> m (DMap EventName (EventFilterTriggerRef t er))
forall a b. (a -> b) -> a -> b
$ ([DSum EventName (EventFilterTriggerRef t er)]
-> DMap EventName (EventFilterTriggerRef t er))
-> JSM [DSum EventName (EventFilterTriggerRef t er)]
-> JSM (DMap EventName (EventFilterTriggerRef t er))
forall a b. (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [DSum EventName (EventFilterTriggerRef t er)]
-> DMap EventName (EventFilterTriggerRef t er)
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
[DSum k2 f] -> DMap k2 f
DMap.fromList (JSM [DSum EventName (EventFilterTriggerRef t er)]
-> JSM (DMap EventName (EventFilterTriggerRef t er)))
-> JSM [DSum EventName (EventFilterTriggerRef t er)]
-> JSM (DMap EventName (EventFilterTriggerRef t er))
forall a b. (a -> b) -> a -> b
$ [DSum EventName (GhcjsEventFilter er)]
-> (DSum EventName (GhcjsEventFilter er)
-> JSM (DSum EventName (EventFilterTriggerRef t er)))
-> JSM [DSum EventName (EventFilterTriggerRef t er)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (DMap EventName (GhcjsEventFilter er)
-> [DSum EventName (GhcjsEventFilter er)]
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
DMap k2 f -> [DSum k2 f]
DMap.toList (DMap EventName (GhcjsEventFilter er)
-> [DSum EventName (GhcjsEventFilter er)])
-> DMap EventName (GhcjsEventFilter er)
-> [DSum EventName (GhcjsEventFilter er)]
forall a b. (a -> b) -> a -> b
$ GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
forall (er :: EventTag -> *).
GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters (GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er))
-> GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
forall a b. (a -> b) -> a -> b
$ RawElementConfig er t s -> EventSpec s er
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
RawElementConfig er t s -> EventSpec s er
_rawElementConfig_eventSpec RawElementConfig er t s
cfg) ((DSum EventName (GhcjsEventFilter er)
-> JSM (DSum EventName (EventFilterTriggerRef t er)))
-> JSM [DSum EventName (EventFilterTriggerRef t er)])
-> (DSum EventName (GhcjsEventFilter er)
-> JSM (DSum EventName (EventFilterTriggerRef t er)))
-> JSM [DSum EventName (EventFilterTriggerRef t er)]
forall a b. (a -> b) -> a -> b
$ \(EventName a
en :=> GhcjsEventFilter GhcjsDomEvent a -> JSM (EventFlags, JSM (Maybe (er a)))
f) -> do
triggerRef <- IO (IORef (Maybe (EventTrigger t (er a))))
-> JSM (IORef (Maybe (EventTrigger t (er a))))
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe (EventTrigger t (er a))))
-> JSM (IORef (Maybe (EventTrigger t (er a)))))
-> IO (IORef (Maybe (EventTrigger t (er a))))
-> JSM (IORef (Maybe (EventTrigger t (er a))))
forall a b. (a -> b) -> a -> b
$ Maybe (EventTrigger t (er a))
-> IO (IORef (Maybe (EventTrigger t (er a))))
forall a. a -> IO (IORef a)
newIORef Maybe (EventTrigger t (er a))
forall a. Maybe a
Nothing
_ <- elementOnEventName en e $ do
evt <- DOM.event
(flags, k) <- liftJSM $ f $ GhcjsDomEvent evt
when (_eventFlags_preventDefault flags) $ withIsEvent en DOM.preventDefault
case _eventFlags_propagation flags of
Propagation
Propagation_Continue -> () -> ReaderT (EventType a) JSM ()
forall a. a -> ReaderT (EventType a) JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Propagation
Propagation_Stop -> EventName a
-> (IsEvent (EventType a) => ReaderT (EventType a) JSM ())
-> ReaderT (EventType a) JSM ()
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName a
en ReaderT (EventType a) JSM ()
IsEvent (EventType a) => ReaderT (EventType a) JSM ()
forall e t. IsEvent e => EventM t e ()
DOM.stopPropagation
Propagation
Propagation_StopImmediate -> EventName a
-> (IsEvent (EventType a) => ReaderT (EventType a) JSM ())
-> ReaderT (EventType a) JSM ()
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName a
en ReaderT (EventType a) JSM ()
IsEvent (EventType a) => ReaderT (EventType a) JSM ()
forall e t. IsEvent e => EventM t e ()
DOM.stopImmediatePropagation
mv <- liftJSM k
liftIO $ forM_ mv $ \er a
v -> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> [DSum (EventTriggerRef t) TriggerInvocation] -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan [DSum (EventTriggerRef t) TriggerInvocation]
events [IORef (Maybe (EventTrigger t (er a))) -> EventTriggerRef t (er a)
forall t a. IORef (Maybe (EventTrigger t a)) -> EventTriggerRef t a
EventTriggerRef IORef (Maybe (EventTrigger t (er a)))
triggerRef EventTriggerRef t (er a)
-> TriggerInvocation (er a)
-> DSum (EventTriggerRef t) TriggerInvocation
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> er a -> IO () -> TriggerInvocation (er a)
forall a. a -> IO () -> TriggerInvocation a
TriggerInvocation er a
v (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())]
return $ en :=> EventFilterTriggerRef triggerRef
return eventTriggerRefs
{-# SPECIALIZE wrap
:: Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
-> DOM.Element
-> RawElementConfig er DomTimeline HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (DMap EventName (EventFilterTriggerRef DomTimeline er))
#-}
{-# SPECIALIZE wrap
:: Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
-> DOM.Element
-> RawElementConfig er DomTimeline GhcjsDomSpace
-> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (DMap EventName (EventFilterTriggerRef DomTimeline er))
#-}
{-# INLINE triggerBody #-}
triggerBody
:: forall s er t x. EventSpec s ~ GhcjsEventSpec
=> DOM.JSContextRef
-> RawElementConfig er t s
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> DOM.Element
-> WrapArg er EventName x
-> EventTrigger t x
-> IO (IO ())
triggerBody :: forall {k1} (s :: k1) (er :: EventTag -> *) t x.
(EventSpec s ~ GhcjsEventSpec) =>
JSContextRef
-> RawElementConfig er t s
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef t er)
-> Element
-> WrapArg er EventName x
-> EventTrigger t x
-> IO (IO ())
triggerBody JSContextRef
ctx RawElementConfig er t s
cfg Chan [DSum (EventTriggerRef t) TriggerInvocation]
events DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs Element
e (WrapArg EventName a1
en) EventTrigger t x
t = case EventName a1
-> DMap EventName (EventFilterTriggerRef t er)
-> Maybe (EventFilterTriggerRef t er a1)
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup EventName a1
en DMap EventName (EventFilterTriggerRef t er)
eventTriggerRefs of
Just (EventFilterTriggerRef IORef (Maybe (EventTrigger t (er a1)))
r) -> do
IORef (Maybe (EventTrigger t (er a1)))
-> Maybe (EventTrigger t (er a1)) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (EventTrigger t (er a1)))
r (Maybe (EventTrigger t (er a1)) -> IO ())
-> Maybe (EventTrigger t (er a1)) -> IO ()
forall a b. (a -> b) -> a -> b
$ EventTrigger t (er a1) -> Maybe (EventTrigger t (er a1))
forall a. a -> Maybe a
Just EventTrigger t x
EventTrigger t (er a1)
t
IO () -> IO (IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> IO (IO ())) -> IO () -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ do
IORef (Maybe (EventTrigger t (er a1)))
-> Maybe (EventTrigger t (er a1)) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (EventTrigger t (er a1)))
r Maybe (EventTrigger t (er a1))
forall a. Maybe a
Nothing
Maybe (EventFilterTriggerRef t er a1)
Nothing -> (JSM () -> JSContextRef -> IO ()
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM () -> IO ()) -> IO (JSM ()) -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSM (JSM ()) -> JSContextRef -> IO (JSM ())
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (EventName a1
-> Element -> ReaderT (EventType a1) JSM () -> JSM (JSM ())
forall e (en :: EventTag).
IsElement e =>
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
elementOnEventName EventName a1
en Element
e (ReaderT (EventType a1) JSM () -> JSM (JSM ()))
-> ReaderT (EventType a1) JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
evt <- EventM (ZonkAny 31) (EventType a1) (EventType a1)
forall t e. EventM t e e
DOM.event
mv <- lift $ unGhcjsEventHandler handler (en, GhcjsDomEvent evt)
case mv of
Maybe (er a1)
Nothing -> () -> ReaderT (EventType a1) JSM ()
forall a. a -> ReaderT (EventType a1) JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just er a1
v -> IO () -> ReaderT (EventType a1) JSM ()
forall a. IO a -> ReaderT (EventType a1) JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT (EventType a1) JSM ())
-> IO () -> ReaderT (EventType a1) JSM ()
forall a b. (a -> b) -> a -> b
$ do
ref <- Maybe (EventTrigger t (er a1))
-> IO (IORef (Maybe (EventTrigger t (er a1))))
forall a. a -> IO (IORef a)
newIORef (Maybe (EventTrigger t (er a1))
-> IO (IORef (Maybe (EventTrigger t (er a1)))))
-> Maybe (EventTrigger t (er a1))
-> IO (IORef (Maybe (EventTrigger t (er a1))))
forall a b. (a -> b) -> a -> b
$ EventTrigger t (er a1) -> Maybe (EventTrigger t (er a1))
forall a. a -> Maybe a
Just EventTrigger t x
EventTrigger t (er a1)
t
writeChan events [EventTriggerRef ref :=> TriggerInvocation v (return ())])
where
handler :: GhcjsEventHandler er
!handler :: GhcjsEventHandler er
handler = GhcjsEventSpec er -> GhcjsEventHandler er
forall (er :: EventTag -> *).
GhcjsEventSpec er -> GhcjsEventHandler er
_ghcjsEventSpec_handler (GhcjsEventSpec er -> GhcjsEventHandler er)
-> GhcjsEventSpec er -> GhcjsEventHandler er
forall a b. (a -> b) -> a -> b
$ RawElementConfig er t s -> EventSpec s er
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
RawElementConfig er t s -> EventSpec s er
_rawElementConfig_eventSpec RawElementConfig er t s
cfg
{-# SPECIALIZE triggerBody
:: DOM.JSContextRef
-> RawElementConfig er DomTimeline HydrationDomSpace
-> Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef DomTimeline er)
-> DOM.Element
-> WrapArg er EventName x
-> EventTrigger DomTimeline x
-> IO (IO ())
#-}
{-# SPECIALIZE triggerBody
:: DOM.JSContextRef
-> RawElementConfig er DomTimeline GhcjsDomSpace
-> Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
-> DMap EventName (EventFilterTriggerRef DomTimeline er)
-> DOM.Element
-> WrapArg er EventName x
-> EventTrigger DomTimeline x
-> IO (IO ())
#-}
newtype GhcjsDomHandler a b = GhcjsDomHandler { forall a b. GhcjsDomHandler a b -> a -> JSM b
unGhcjsDomHandler :: a -> JSM b }
newtype GhcjsDomHandler1 a b = GhcjsDomHandler1 { forall (a :: EventTag -> *) (b :: EventTag -> *).
GhcjsDomHandler1 a b -> forall (x :: EventTag). a x -> JSM (b x)
unGhcjsDomHandler1 :: forall (x :: EventTag). a x -> JSM (b x) }
newtype GhcjsDomEvent en = GhcjsDomEvent { forall (en :: EventTag). GhcjsDomEvent en -> EventType en
unGhcjsDomEvent :: EventType en }
data GhcjsDomSpace
instance DomSpace GhcjsDomSpace where
type EventSpec GhcjsDomSpace = GhcjsEventSpec
type RawDocument GhcjsDomSpace = DOM.Document
type RawTextNode GhcjsDomSpace = DOM.Text
type GhcjsDomSpace = DOM.Comment
type RawElement GhcjsDomSpace = DOM.Element
type RawInputElement GhcjsDomSpace = DOM.HTMLInputElement
type RawTextAreaElement GhcjsDomSpace = DOM.HTMLTextAreaElement
type RawSelectElement GhcjsDomSpace = DOM.HTMLSelectElement
addEventSpecFlags :: forall (proxy :: * -> *) (en :: EventTag) (er :: EventTag -> *).
proxy GhcjsDomSpace
-> EventName en
-> (Maybe (er en) -> EventFlags)
-> EventSpec GhcjsDomSpace er
-> EventSpec GhcjsDomSpace er
addEventSpecFlags proxy GhcjsDomSpace
_ EventName en
en Maybe (er en) -> EventFlags
f EventSpec GhcjsDomSpace er
es = EventSpec GhcjsDomSpace er
es
{ _ghcjsEventSpec_filters =
let f' = GhcjsEventFilter er en -> Maybe (GhcjsEventFilter er en)
forall a. a -> Maybe a
Just (GhcjsEventFilter er en -> Maybe (GhcjsEventFilter er en))
-> (Maybe (GhcjsEventFilter er en) -> GhcjsEventFilter er en)
-> Maybe (GhcjsEventFilter er en)
-> Maybe (GhcjsEventFilter er en)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
forall (er :: EventTag -> *) (en :: EventTag).
(GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
GhcjsEventFilter ((GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en)
-> (Maybe (GhcjsEventFilter er en)
-> GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> Maybe (GhcjsEventFilter er en)
-> GhcjsEventFilter er en
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Maybe (GhcjsEventFilter er en)
Nothing -> \GhcjsDomEvent en
evt -> do
mEventResult <- GhcjsEventHandler er
-> forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
forall (er :: EventTag -> *).
GhcjsEventHandler er
-> forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
unGhcjsEventHandler (GhcjsEventSpec er -> GhcjsEventHandler er
forall (er :: EventTag -> *).
GhcjsEventSpec er -> GhcjsEventHandler er
_ghcjsEventSpec_handler EventSpec GhcjsDomSpace er
GhcjsEventSpec er
es) (EventName en
en, GhcjsDomEvent en
evt)
return (f mEventResult, return mEventResult)
Just (GhcjsEventFilter GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter) -> \GhcjsDomEvent en
evt -> do
(oldFlags, oldContinuation) <- GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter GhcjsDomEvent en
evt
mEventResult <- oldContinuation
let newFlags = EventFlags
oldFlags EventFlags -> EventFlags -> EventFlags
forall a. Semigroup a => a -> a -> a
<> Maybe (er en) -> EventFlags
f Maybe (er en)
mEventResult
return (newFlags, return mEventResult)
in DMap.alter f' en $ _ghcjsEventSpec_filters es
}
newtype GhcjsEventFilter er en = GhcjsEventFilter (GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
data Pair1 (f :: k -> Type) (g :: k -> Type) (a :: k) = Pair1 (f a) (g a)
data Maybe1 f a = Nothing1 | Just1 (f a)
data GhcjsEventSpec er = GhcjsEventSpec
{ forall (er :: EventTag -> *).
GhcjsEventSpec er -> DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters :: DMap EventName (GhcjsEventFilter er)
, forall (er :: EventTag -> *).
GhcjsEventSpec er -> GhcjsEventHandler er
_ghcjsEventSpec_handler :: GhcjsEventHandler er
}
newtype GhcjsEventHandler er = GhcjsEventHandler { forall (er :: EventTag -> *).
GhcjsEventHandler er
-> forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
unGhcjsEventHandler :: forall en. (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)) }
#ifndef USE_TEMPLATE_HASKELL
ghcjsEventSpec_filters :: forall er . Lens' (GhcjsEventSpec er) (DMap EventName (GhcjsEventFilter er))
ghcjsEventSpec_filters f (GhcjsEventSpec a b) = (\a' -> GhcjsEventSpec a' b) <$> f a
{-# INLINE ghcjsEventSpec_filters #-}
ghcjsEventSpec_handler :: forall er en . Getter (GhcjsEventSpec er) ((EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
ghcjsEventSpec_handler f (GhcjsEventSpec _ (GhcjsEventHandler b)) = phantom (f b)
{-# INLINE ghcjsEventSpec_handler #-}
#endif
instance er ~ EventResult => Default (GhcjsEventSpec er) where
def :: GhcjsEventSpec er
def = GhcjsEventSpec
{ _ghcjsEventSpec_filters :: DMap EventName (GhcjsEventFilter er)
_ghcjsEventSpec_filters = DMap EventName (GhcjsEventFilter er)
forall a. Monoid a => a
mempty
, _ghcjsEventSpec_handler :: GhcjsEventHandler er
_ghcjsEventSpec_handler = (forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
-> GhcjsEventHandler er
forall (er :: EventTag -> *).
(forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
-> GhcjsEventHandler er
GhcjsEventHandler ((forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
-> GhcjsEventHandler er)
-> (forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en)))
-> GhcjsEventHandler er
forall a b. (a -> b) -> a -> b
$ \(EventName en
en, GhcjsDomEvent EventType en
evt) -> do
t :: DOM.EventTarget <- EventName en
-> (IsEvent (EventType en) => JSM EventTarget) -> JSM EventTarget
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName en
en ((IsEvent (EventType en) => JSM EventTarget) -> JSM EventTarget)
-> (IsEvent (EventType en) => JSM EventTarget) -> JSM EventTarget
forall a b. (a -> b) -> a -> b
$ EventType en -> JSM EventTarget
forall (m :: * -> *) self.
(MonadDOM m, IsEvent self) =>
self -> m EventTarget
Event.getTargetUnchecked EventType en
evt
let e = (JSVal -> Element) -> EventTarget -> Element
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> Element
DOM.Element EventTarget
t
runReaderT (defaultDomEventHandler e en) evt
}
{-# INLINE makeElement #-}
makeElement :: MonadJSM m => Document -> Text -> ElementConfig er t s -> m DOM.Element
makeElement :: forall {k} {k1} (m :: * -> *) (er :: EventTag -> *) (t :: k)
(s :: k1).
MonadJSM m =>
Document -> Text -> ElementConfig er t s -> m Element
makeElement Document
doc Text
elementTag ElementConfig er t s
cfg = do
e <- (JSVal -> Element) -> Element -> Element
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> Element
DOM.Element (Element -> Element) -> m Element -> m Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ElementConfig er t s
cfg ElementConfig er t s
-> Getting (Maybe Text) (ElementConfig er t s) (Maybe Text)
-> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) (ElementConfig er t s) (Maybe Text)
forall a. HasNamespace a => Lens' a (Maybe Text)
Lens' (ElementConfig er t s) (Maybe Text)
namespace of
Maybe Text
Nothing -> Document -> Text -> m Element
forall (m :: * -> *) self localName.
(MonadDOM m, IsDocument self, ToJSString localName) =>
self -> localName -> m Element
createElement Document
doc Text
elementTag
Just Text
ens -> Document -> Maybe Text -> Text -> m Element
forall (m :: * -> *) self namespaceURI qualifiedName.
(MonadDOM m, IsDocument self, ToJSString namespaceURI,
ToJSString qualifiedName) =>
self -> Maybe namespaceURI -> qualifiedName -> m Element
createElementNS Document
doc (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ens) Text
elementTag
iforM_ (cfg ^. initialAttributes) $ \(AttributeName Maybe Text
mAttrNamespace Text
n) Text
v -> case Maybe Text
mAttrNamespace of
Maybe Text
Nothing -> Element -> Text -> Text -> m ()
forall (m :: * -> *) self qualifiedName value.
(MonadDOM m, IsElement self, ToJSString qualifiedName,
ToJSString value) =>
self -> qualifiedName -> value -> m ()
setAttribute Element
e Text
n Text
v
Just Text
ans -> Element -> Maybe Text -> Text -> Text -> m ()
forall (m :: * -> *) self namespaceURI qualifiedName value.
(MonadDOM m, IsElement self, ToJSString namespaceURI,
ToJSString qualifiedName, ToJSString value) =>
self -> Maybe namespaceURI -> qualifiedName -> value -> m ()
setAttributeNS Element
e (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ans) Text
n Text
v
pure e
{-# INLINE elementImmediate #-}
elementImmediate
:: ( RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, EventSpec s ~ GhcjsEventSpec
, MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m )
=> Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate :: forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
elementTag ElementConfig er t s
cfg HydrationDomBuilderT s t m a
child = do
doc <- HydrationDomBuilderT s t m Document
HydrationDomBuilderT
s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
ctx <- askJSM
events <- askEvents
parent <- getParent
e <- makeElement doc elementTag cfg
appendChild_ parent e
result <- localEnv (\HydrationDomBuilderEnv t m
env -> HydrationDomBuilderEnv t m
env { _hydrationDomBuilderEnv_parent = Left $ toNode e }) child
let rawCfg = ElementConfig er t s -> RawElementConfig er t s
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (m :: k2).
ElementConfig er t m -> RawElementConfig er t m
extractRawElementConfig ElementConfig er t s
cfg
eventTriggerRefs <- wrap events e rawCfg
es <- newFanEventWithTrigger $ triggerBody ctx rawCfg events eventTriggerRefs e
return (Element es e, result)
{-# SPECIALIZE elementImmediate
:: Text
-> ElementConfig er DomTimeline HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM a
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (Element er GhcjsDomSpace DomTimeline, a)
#-}
{-# SPECIALIZE elementImmediate
:: Text
-> ElementConfig er DomTimeline GhcjsDomSpace
-> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM a
-> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (Element er GhcjsDomSpace DomTimeline, a)
#-}
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 :: forall (m :: * -> *) t (er :: EventTag -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t, a)
elementInternal Text
elementTag ElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child = HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t, a))
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t, a)
forall a b.
HydrationDomBuilderT HydrationDomSpace t m a
-> (a -> HydrationDomBuilderT HydrationDomSpace t m b)
-> HydrationDomBuilderT HydrationDomSpace t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> do
(Element es _, result) <- Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er GhcjsDomSpace t, a)
forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
elementTag ElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child
return (Element es (), result)
HydrationMode
HydrationMode_Hydrating -> ((Element er HydrationDomSpace t, a), IORef Element)
-> (Element er HydrationDomSpace t, a)
forall a b. (a, b) -> a
fst (((Element er HydrationDomSpace t, a), IORef Element)
-> (Element er HydrationDomSpace t, a))
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
forall (er :: EventTag -> *) t (m :: * -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
elementTag ElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child
{-# SPECIALIZE elementInternal
:: Text
-> ElementConfig er DomTimeline HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM a
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (Element er HydrationDomSpace DomTimeline, a)
#-}
skipHydrationAttribute :: IsString s => s
skipHydrationAttribute :: forall s. IsString s => s
skipHydrationAttribute = s
"data-hydration-skip"
hydratableAttribute :: IsString s => s
hydratableAttribute :: forall s. IsString s => s
hydratableAttribute = s
"data-ssr"
{-# INLINE hydrateElement #-}
hydrateElement
:: forall er t m a. (MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m)
=> Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT HydrationDomSpace t m ((Element er HydrationDomSpace t, a), IORef DOM.Element)
hydrateElement :: forall (er :: EventTag -> *) t (m :: * -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
elementTag ElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child = do
ctx <- HydrationDomBuilderT HydrationDomSpace t m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
events <- askEvents
parentRef <- liftIO $ newIORef $ error "Parent not yet initialized"
e' <- liftIO $ newIORef $ error "hydrateElement: Element not yet initialized"
env <- HydrationDomBuilderT ask
childDelayedRef <- liftIO $ newIORef $ pure ()
let env' = HydrationDomBuilderEnv t m
env
{ _hydrationDomBuilderEnv_parent = Right parentRef
, _hydrationDomBuilderEnv_delayed = childDelayedRef
}
result <- HydrationDomBuilderT $ lift $ runReaderT (unHydrationDomBuilderT child) env'
wrapResult <- liftIO newEmptyMVar
let
shouldSkip :: DOM.Element -> HydrationRunnerT t m Bool
shouldSkip Element
e = do
skip <- Element -> JSString -> HydrationRunnerT t m Bool
forall (m :: * -> *) self qualifiedName.
(MonadDOM m, IsElement self, ToJSString qualifiedName) =>
self -> qualifiedName -> m Bool
hasAttribute Element
e (JSString
forall s. IsString s => s
skipHydrationAttribute :: DOM.JSString)
hydratable <- hasAttribute e (hydratableAttribute :: DOM.JSString)
pure $ skip || not hydratable
childDom <- liftIO $ readIORef childDelayedRef
let rawCfg = ElementConfig er t HydrationDomSpace
-> RawElementConfig er t HydrationDomSpace
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (m :: k2).
ElementConfig er t m -> RawElementConfig er t m
extractRawElementConfig ElementConfig er t HydrationDomSpace
cfg
doc <- askDocument
addHydrationStep $ do
parent <- askParent
lastHydrationNode <- getPreviousNode
let go Maybe Node
mLastNode = HydrationRunnerT t m (Maybe Node)
-> (Node -> HydrationRunnerT t m (Maybe Node))
-> Maybe Node
-> HydrationRunnerT t m (Maybe Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getFirstChild Node
parent) Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling Maybe Node
mLastNode HydrationRunnerT t m (Maybe Node)
-> (Maybe Node -> HydrationRunnerT t m Element)
-> HydrationRunnerT t m Element
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Node
Nothing -> do
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
s -> HydrationState
s { _hydrationState_failed = True }
e <- Document
-> Text
-> ElementConfig er t HydrationDomSpace
-> HydrationRunnerT t m Element
forall {k} {k1} (m :: * -> *) (er :: EventTag -> *) (t :: k)
(s :: k1).
MonadJSM m =>
Document -> Text -> ElementConfig er t s -> m Element
makeElement Document
doc Text
elementTag ElementConfig er t HydrationDomSpace
cfg
insertAfterPreviousNode e
pure e
Just Node
node -> (JSVal -> Element) -> Node -> HydrationRunnerT t m (Maybe Element)
forall obj obj' (m :: * -> *).
(Coercible obj JSVal, IsGObject obj', MonadJSM m) =>
(JSVal -> obj') -> obj -> m (Maybe obj')
DOM.castTo JSVal -> Element
DOM.Element Node
node HydrationRunnerT t m (Maybe Element)
-> (Maybe Element -> HydrationRunnerT t m Element)
-> HydrationRunnerT t m Element
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Element
Nothing -> Maybe Node -> HydrationRunnerT t m Element
go (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
Just Element
e -> Element -> HydrationRunnerT t m Bool
shouldSkip Element
e HydrationRunnerT t m Bool
-> (Bool -> HydrationRunnerT t m Element)
-> HydrationRunnerT t m Element
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> Maybe Node -> HydrationRunnerT t m Element
go (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
Bool
False -> do
t <- Element -> HydrationRunnerT t m Text
forall (m :: * -> *) self result.
(MonadDOM m, IsElement self, FromJSString result) =>
self -> m result
Element.getTagName Element
e
if T.toCaseFold elementTag == T.toCaseFold t
then pure e
else do
HydrationRunnerT $ modify' $ \HydrationState
s -> HydrationState
s { _hydrationState_failed = True }
n <- makeElement doc elementTag cfg
insertAfterPreviousNode n
pure n
e <- go lastHydrationNode
setPreviousNode $ Just $ toNode e
liftIO $ writeIORef parentRef $ toNode e
liftIO $ writeIORef e' e
refs <- wrap events e rawCfg
liftIO $ putMVar wrapResult (e, refs)
localRunner childDom Nothing $ toNode e
es <- newFanEventWithTrigger $ \(WrapArg EventName a1
en) EventTrigger t a
t -> do
cleanup <- IO (MVar (IO ()))
forall a. IO (MVar a)
newEmptyMVar
threadId <- forkIO $ do
(e, eventTriggerRefs) <- readMVar wrapResult
bracketOnError
(triggerBody ctx rawCfg events eventTriggerRefs e (WrapArg en) t)
id
(putMVar cleanup)
pure $ do
tryReadMVar cleanup >>= \case
Maybe (IO ())
Nothing -> ThreadId -> IO ()
killThread ThreadId
threadId
Just IO ()
c -> IO ()
c
return ((Element es (), result), e')
{-# SPECIALIZE hydrateElement
:: Text
-> ElementConfig er DomTimeline HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM a
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM ((Element er HydrationDomSpace DomTimeline, a), IORef DOM.Element)
#-}
{-# INLINE inputElementImmediate #-}
inputElementImmediate
:: ( RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, EventSpec s ~ GhcjsEventSpec
, MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
, MonadRef m, Ref m ~ IORef )
=> InputElementConfig er t s -> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
inputElementImmediate :: forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
MonadRef m, Ref m ~ IORef) =>
InputElementConfig er t s
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
inputElementImmediate InputElementConfig er t s
cfg = do
(e@(Element eventSelector domElement), ()) <- Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ())
forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
"input" (InputElementConfig er t s -> ElementConfig er t s
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> ElementConfig er t s
_inputElementConfig_elementConfig InputElementConfig er t s
cfg) (HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ()))
-> HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ())
forall a b. (a -> b) -> a -> b
$ () -> HydrationDomBuilderT s t m ()
forall a. a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
let domInputElement = (JSVal -> HTMLInputElement) -> Element -> HTMLInputElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLInputElement
DOM.HTMLInputElement Element
RawElement GhcjsDomSpace
domElement
Input.setValue domInputElement $ cfg ^. inputElementConfig_initialValue
v0 <- Input.getValue domInputElement
let getMyValue = HTMLInputElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLInputElement -> m result
Input.getValue HTMLInputElement
domInputElement
valueChangedByUI <- requestDomAction $ liftJSM getMyValue <$ Reflex.select eventSelector (WrapArg Input)
valueChangedBySetValue <- case _inputElementConfig_setValue cfg of
Maybe (Event t Text)
Nothing -> Event t Text -> HydrationDomBuilderT s t m (Event t Text)
forall a. a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Event t Text
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never
Just Event t Text
eSetValue -> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a. Event t (JSM a) -> HydrationDomBuilderT s t m (Event t a)
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM Text) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM Text) -> Event t (JSM Text))
-> (Text -> JSM Text) -> Event t (JSM Text)
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
HTMLInputElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLInputElement -> val -> m ()
Input.setValue HTMLInputElement
domInputElement Text
v'
JSM Text
getMyValue
v <- holdDyn v0 $ leftmost
[ valueChangedBySetValue
, valueChangedByUI
]
Input.setChecked domInputElement $ _inputElementConfig_initialChecked cfg
checkedChangedByUI <- wrapDomEvent domInputElement (`on` Events.click) $ do
Input.getChecked domInputElement
checkedChangedBySetChecked <- case _inputElementConfig_setChecked cfg of
Maybe (Event t Bool)
Nothing -> Event t (Maybe Bool)
-> HydrationDomBuilderT s t m (Event t (Maybe Bool))
forall a. a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Event t (Maybe Bool)
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never
Just Event t Bool
eNewchecked -> Event t (JSM (Maybe Bool))
-> HydrationDomBuilderT s t m (Event t (Maybe Bool))
forall a. Event t (JSM a) -> HydrationDomBuilderT s t m (Event t a)
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM (Maybe Bool))
-> HydrationDomBuilderT s t m (Event t (Maybe Bool)))
-> Event t (JSM (Maybe Bool))
-> HydrationDomBuilderT s t m (Event t (Maybe Bool))
forall a b. (a -> b) -> a -> b
$ Event t Bool
-> (Bool -> JSM (Maybe Bool)) -> Event t (JSM (Maybe Bool))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Bool
eNewchecked ((Bool -> JSM (Maybe Bool)) -> Event t (JSM (Maybe Bool)))
-> (Bool -> JSM (Maybe Bool)) -> Event t (JSM (Maybe Bool))
forall a b. (a -> b) -> a -> b
$ \Bool
newChecked -> do
oldChecked <- HTMLInputElement -> JSM Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement
Input.setChecked domInputElement newChecked
return $ if newChecked /= oldChecked
then Just newChecked
else Nothing
c <- holdDyn (_inputElementConfig_initialChecked cfg) $ leftmost
[ fmapMaybe id checkedChangedBySetChecked
, checkedChangedByUI
]
hasFocus <- mkHasFocus e
files <- holdDyn mempty <=< wrapDomEvent domInputElement (`on` Events.change) $ do
mfiles <- Input.getFiles domInputElement
let getMyFiles FileList
xs = ([Maybe File] -> [File]) -> m [Maybe File] -> m [File]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe File] -> [File]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe File] -> m [File])
-> (Word -> m [Maybe File]) -> Word -> m [File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> m (Maybe File)) -> [Word] -> m [Maybe File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (FileList -> Word -> m (Maybe File)
forall (m :: * -> *).
MonadDOM m =>
FileList -> Word -> m (Maybe File)
FileList.item FileList
xs) ([Word] -> m [Maybe File])
-> (Word -> [Word]) -> Word -> m [Maybe File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Word] -> [Word]) -> [Word] -> Int -> [Word]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [Word] -> [Word]
forall a. Int -> [a] -> [a]
take [Word
0..] (Int -> [Word]) -> (Word -> Int) -> Word -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> m [File]) -> m Word -> m [File]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FileList -> m Word
forall (m :: * -> *). MonadDOM m => FileList -> m Word
FileList.getLength FileList
xs
maybe (return []) getMyFiles mfiles
checked <- holdUniqDyn c
return $ InputElement
{ _inputElement_value = v
, _inputElement_checked = checked
, _inputElement_checkedChange = checkedChangedByUI
, _inputElement_input = valueChangedByUI
, _inputElement_hasFocus = hasFocus
, _inputElement_element = e
, _inputElement_raw = domInputElement
, _inputElement_files = files
}
{-# INLINE inputElementInternal #-}
inputElementInternal
:: ( MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
, MonadRef m, Ref m ~ IORef )
=> InputElementConfig er t HydrationDomSpace -> HydrationDomBuilderT HydrationDomSpace t m (InputElement er HydrationDomSpace t)
inputElementInternal :: forall (m :: * -> *) t (er :: EventTag -> *).
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m, MonadRef m, Ref m ~ IORef) =>
InputElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t)
inputElementInternal InputElementConfig er t HydrationDomSpace
cfg = HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t))
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall a b.
HydrationDomBuilderT HydrationDomSpace t m a
-> (a -> HydrationDomBuilderT HydrationDomSpace t m b)
-> HydrationDomBuilderT HydrationDomSpace t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er GhcjsDomSpace t)
-> (InputElement er GhcjsDomSpace t
-> InputElement er HydrationDomSpace t)
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (InputElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er GhcjsDomSpace t)
forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
MonadRef m, Ref m ~ IORef) =>
InputElementConfig er t s
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
inputElementImmediate InputElementConfig er t HydrationDomSpace
cfg) ((InputElement er GhcjsDomSpace t
-> InputElement er HydrationDomSpace t)
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t))
-> (InputElement er GhcjsDomSpace t
-> InputElement er HydrationDomSpace t)
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ \InputElement er GhcjsDomSpace t
result -> InputElement er GhcjsDomSpace t
result
{ _inputElement_element = Element (_element_events $ _inputElement_element result) ()
, _inputElement_raw = ()
}
HydrationMode
HydrationMode_Hydrating -> do
((e, _), domElementRef) <- Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, ()), IORef Element)
forall (er :: EventTag -> *) t (m :: * -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
"input" (InputElementConfig er t HydrationDomSpace
cfg InputElementConfig er t HydrationDomSpace
-> Getting
(ElementConfig er t HydrationDomSpace)
(InputElementConfig er t HydrationDomSpace)
(ElementConfig er t HydrationDomSpace)
-> ElementConfig er t HydrationDomSpace
forall s a. s -> Getting a s a -> a
^. Getting
(ElementConfig er t HydrationDomSpace)
(InputElementConfig er t HydrationDomSpace)
(ElementConfig er t HydrationDomSpace)
forall (er1 :: EventTag -> *) k1 (t :: k1) k2 (s1 :: k2)
(er2 :: EventTag -> *) k3 (s2 :: k3) (f :: * -> *).
Functor f =>
(ElementConfig er1 t s1 -> f (ElementConfig er2 t s2))
-> InputElementConfig er1 t s1 -> f (InputElementConfig er2 t s2)
inputElementConfig_elementConfig) (HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, ()), IORef Element))
-> HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, ()), IORef Element)
forall a b. (a -> b) -> a -> b
$ () -> HydrationDomBuilderT HydrationDomSpace t m ()
forall a. a -> HydrationDomBuilderT HydrationDomSpace t m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(valueChangedByUI, triggerChangeByUI) <- newTriggerEvent
(valueChangedBySetValue, triggerChangeBySetValue) <- newTriggerEvent
(focusChange, triggerFocusChange) <- newTriggerEvent
(checkedChangedByUI, triggerCheckedChangedByUI) <- newTriggerEvent
(checkedChangedBySetChecked, triggerCheckedChangedBySetChecked) <- newTriggerEvent
(fileChange, triggerFileChange) <- newTriggerEvent
doc <- askDocument
let v0 = InputElementConfig er t HydrationDomSpace -> Text
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> Text
_inputElementConfig_initialValue InputElementConfig er t HydrationDomSpace
cfg
c0 = InputElementConfig er t HydrationDomSpace -> Bool
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> Bool
_inputElementConfig_initialChecked InputElementConfig er t HydrationDomSpace
cfg
valuesAtSwitchover = do
v <- m (Behavior t Text)
-> (Event t Text -> m (Behavior t Text))
-> Maybe (Event t Text)
-> m (Behavior t Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Text -> m (Behavior t Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text -> m (Behavior t Text))
-> Behavior t Text -> m (Behavior t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Behavior t Text
forall a. a -> Behavior t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v0) (Text -> Event t Text -> m (Behavior t Text)
forall a. a -> Event t a -> m (Behavior t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Text
v0) (InputElementConfig er t HydrationDomSpace -> Maybe (Event t Text)
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> Maybe (Event t Text)
_inputElementConfig_setValue InputElementConfig er t HydrationDomSpace
cfg)
c <- maybe (pure $ pure c0) (hold c0) (_inputElementConfig_setChecked cfg)
pure (v, c)
addHydrationStepWithSetup valuesAtSwitchover $ \(Behavior t Text
switchoverValue', Behavior t Bool
switchoverChecked') -> do
switchoverValue <- Behavior t Text -> HydrationRunnerT t m Text
forall a. Behavior t a -> HydrationRunnerT t m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
switchoverValue'
switchoverChecked <- sample switchoverChecked'
domElement <- liftIO $ readIORef domElementRef
let domInputElement = (JSVal -> HTMLInputElement) -> Element -> HTMLInputElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLInputElement
DOM.HTMLInputElement Element
domElement
getValue = HTMLInputElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLInputElement -> m result
Input.getValue HTMLInputElement
domInputElement
when (v0 /= switchoverValue) $ liftIO $ triggerChangeBySetValue switchoverValue
liftJSM getValue >>= \Text
realValue -> Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
realValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
switchoverValue) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall a. IO a -> HydrationRunnerT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeByUI Text
realValue
requestDomAction_ $ (liftJSM getValue >>= liftIO . triggerChangeByUI) <$ Reflex.select (_element_events e) (WrapArg Input)
for_ (_inputElementConfig_setValue cfg) $ \Event t Text
eSetValue ->
Event t (JSM ()) -> HydrationRunnerT t m ()
forall a. Event t (JSM a) -> HydrationRunnerT t m ()
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM ()) -> Event t (JSM ()))
-> (Text -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
HTMLInputElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLInputElement -> val -> m ()
Input.setValue HTMLInputElement
domInputElement Text
v'
v <- JSM Text
getValue
liftIO $ triggerChangeBySetValue v
let focusChange' = [Event t Bool] -> Event t Bool
forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Bool
False Bool -> Event t (er 'BlurTag) -> Event t Bool
forall a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> forall a. WrapArg er EventName a -> Event t a
forall {k1} (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'BlurTag -> WrapArg er EventName (er 'BlurTag)
forall {k} (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'BlurTag
Blur)
, Bool
True Bool -> Event t (er 'FocusTag) -> Event t Bool
forall a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> forall a. WrapArg er EventName a -> Event t a
forall {k1} (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'FocusTag -> WrapArg er EventName (er 'FocusTag)
forall {k} (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'FocusTag
Focus)
]
liftIO . triggerFocusChange =<< Node.isSameNode (toNode domElement) . fmap toNode =<< Document.getActiveElement doc
requestDomAction_ $ liftIO . triggerFocusChange <$> focusChange'
when (c0 /= switchoverChecked) $ liftIO $ triggerCheckedChangedBySetChecked switchoverChecked
liftJSM (Input.getChecked domInputElement) >>= \Bool
realChecked -> Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
realChecked Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
switchoverChecked) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$
IO () -> HydrationRunnerT t m ()
forall a. IO a -> HydrationRunnerT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO ()
triggerCheckedChangedByUI Bool
realChecked
_ <- liftJSM $ domInputElement `on` Events.click $ do
liftIO . triggerCheckedChangedByUI =<< Input.getChecked domInputElement
for_ (_inputElementConfig_setChecked cfg) $ \Event t Bool
eNewchecked ->
Event t (JSM ()) -> HydrationRunnerT t m (Event t ())
forall a. Event t (JSM a) -> HydrationRunnerT t m (Event t a)
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM ()) -> HydrationRunnerT t m (Event t ()))
-> Event t (JSM ()) -> HydrationRunnerT t m (Event t ())
forall a b. (a -> b) -> a -> b
$ Event t Bool -> (Bool -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Bool
eNewchecked ((Bool -> JSM ()) -> Event t (JSM ()))
-> (Bool -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \Bool
newChecked -> do
oldChecked <- HTMLInputElement -> JSM Bool
forall (m :: * -> *). MonadDOM m => HTMLInputElement -> m Bool
Input.getChecked HTMLInputElement
domInputElement
Input.setChecked domInputElement newChecked
when (newChecked /= oldChecked) $ liftIO $ triggerCheckedChangedBySetChecked newChecked
_ <- liftJSM $ domInputElement `on` Events.change $ do
mfiles <- Input.getFiles domInputElement
let getMyFiles FileList
xs = ([Maybe File] -> [File]) -> m [Maybe File] -> m [File]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe File] -> [File]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe File] -> m [File])
-> (Word -> m [Maybe File]) -> Word -> m [File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> m (Maybe File)) -> [Word] -> m [Maybe File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (FileList -> Word -> m (Maybe File)
forall (m :: * -> *).
MonadDOM m =>
FileList -> Word -> m (Maybe File)
FileList.item FileList
xs) ([Word] -> m [Maybe File])
-> (Word -> [Word]) -> Word -> m [Maybe File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Word] -> [Word]) -> [Word] -> Int -> [Word]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [Word] -> [Word]
forall a. Int -> [a] -> [a]
take [Word
0..] (Int -> [Word]) -> (Word -> Int) -> Word -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> m [File]) -> m Word -> m [File]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FileList -> m Word
forall (m :: * -> *). MonadDOM m => FileList -> m Word
FileList.getLength FileList
xs
liftIO . triggerFileChange =<< maybe (return []) getMyFiles mfiles
return ()
checked' <- holdDyn c0 $ leftmost
[ checkedChangedBySetChecked
, checkedChangedByUI
]
checked <- holdUniqDyn checked'
let initialFocus = Bool
False
hasFocus <- holdUniqDyn =<< holdDyn initialFocus focusChange
v <- holdDyn v0 $ leftmost
[ valueChangedBySetValue
, valueChangedByUI
]
files <- holdDyn mempty fileChange
return $ InputElement
{ _inputElement_value = v
, _inputElement_checked = checked
, _inputElement_checkedChange = checkedChangedByUI
, _inputElement_input = valueChangedByUI
, _inputElement_hasFocus = hasFocus
, _inputElement_element = e
, _inputElement_raw = ()
, _inputElement_files = files
}
{-# INLINE textAreaElementImmediate #-}
textAreaElementImmediate
:: ( RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, EventSpec s ~ GhcjsEventSpec
, MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
, MonadRef m, Ref m ~ IORef )
=> TextAreaElementConfig er t s -> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
textAreaElementImmediate :: forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
MonadRef m, Ref m ~ IORef) =>
TextAreaElementConfig er t s
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
textAreaElementImmediate TextAreaElementConfig er t s
cfg = do
(e@(Element eventSelector domElement), _) <- Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ())
forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
"textarea" (TextAreaElementConfig er t s
cfg TextAreaElementConfig er t s
-> Getting
(ElementConfig er t s)
(TextAreaElementConfig er t s)
(ElementConfig er t s)
-> ElementConfig er t s
forall s a. s -> Getting a s a -> a
^. Getting
(ElementConfig er t s)
(TextAreaElementConfig er t s)
(ElementConfig er t s)
forall (er1 :: EventTag -> *) k1 (t :: k1) k2 (m1 :: k2)
(er2 :: EventTag -> *) k3 (m2 :: k3) (f :: * -> *).
Functor f =>
(ElementConfig er1 t m1 -> f (ElementConfig er2 t m2))
-> TextAreaElementConfig er1 t m1
-> f (TextAreaElementConfig er2 t m2)
textAreaElementConfig_elementConfig) (HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ()))
-> HydrationDomBuilderT s t m ()
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, ())
forall a b. (a -> b) -> a -> b
$ () -> HydrationDomBuilderT s t m ()
forall a. a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
let domTextAreaElement = (JSVal -> HTMLTextAreaElement) -> Element -> HTMLTextAreaElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLTextAreaElement
DOM.HTMLTextAreaElement Element
RawElement GhcjsDomSpace
domElement
TextArea.setValue domTextAreaElement $ cfg ^. textAreaElementConfig_initialValue
v0 <- TextArea.getValue domTextAreaElement
let getMyValue = HTMLTextAreaElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLTextAreaElement -> m result
TextArea.getValue HTMLTextAreaElement
domTextAreaElement
valueChangedByUI <- requestDomAction $ liftJSM getMyValue <$ Reflex.select eventSelector (WrapArg Input)
valueChangedBySetValue <- case _textAreaElementConfig_setValue cfg of
Maybe (Event t Text)
Nothing -> Event t Text -> HydrationDomBuilderT s t m (Event t Text)
forall a. a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Event t Text
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never
Just Event t Text
eSetValue -> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a. Event t (JSM a) -> HydrationDomBuilderT s t m (Event t a)
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM Text) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM Text) -> Event t (JSM Text))
-> (Text -> JSM Text) -> Event t (JSM Text)
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
HTMLTextAreaElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLTextAreaElement -> val -> m ()
TextArea.setValue HTMLTextAreaElement
domTextAreaElement Text
v'
JSM Text
getMyValue
v <- holdDyn v0 $ leftmost
[ valueChangedBySetValue
, valueChangedByUI
]
hasFocus <- mkHasFocus e
return $ TextAreaElement
{ _textAreaElement_value = v
, _textAreaElement_input = valueChangedByUI
, _textAreaElement_hasFocus = hasFocus
, _textAreaElement_element = e
, _textAreaElement_raw = domTextAreaElement
}
{-# INLINE textAreaElementInternal #-}
textAreaElementInternal
:: ( MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
, MonadRef m, Ref m ~ IORef )
=> TextAreaElementConfig er t HydrationDomSpace -> HydrationDomBuilderT HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
textAreaElementInternal :: forall (m :: * -> *) t (er :: EventTag -> *).
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m, MonadRef m, Ref m ~ IORef) =>
TextAreaElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
textAreaElementInternal TextAreaElementConfig er t HydrationDomSpace
cfg = HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t))
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall a b.
HydrationDomBuilderT HydrationDomSpace t m a
-> (a -> HydrationDomBuilderT HydrationDomSpace t m b)
-> HydrationDomBuilderT HydrationDomSpace t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er GhcjsDomSpace t)
-> (TextAreaElement er GhcjsDomSpace t
-> TextAreaElement er HydrationDomSpace t)
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (TextAreaElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er GhcjsDomSpace t)
forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
MonadRef m, Ref m ~ IORef) =>
TextAreaElementConfig er t s
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
textAreaElementImmediate TextAreaElementConfig er t HydrationDomSpace
cfg) ((TextAreaElement er GhcjsDomSpace t
-> TextAreaElement er HydrationDomSpace t)
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t))
-> (TextAreaElement er GhcjsDomSpace t
-> TextAreaElement er HydrationDomSpace t)
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall a b. (a -> b) -> a -> b
$ \TextAreaElement er GhcjsDomSpace t
result -> TextAreaElement er GhcjsDomSpace t
result
{ _textAreaElement_element = Element (_element_events $ _textAreaElement_element result) ()
, _textAreaElement_raw = ()
}
HydrationMode
HydrationMode_Hydrating -> do
((e, _), domElementRef) <- Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, ()), IORef Element)
forall (er :: EventTag -> *) t (m :: * -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
"textarea" (TextAreaElementConfig er t HydrationDomSpace
cfg TextAreaElementConfig er t HydrationDomSpace
-> Getting
(ElementConfig er t HydrationDomSpace)
(TextAreaElementConfig er t HydrationDomSpace)
(ElementConfig er t HydrationDomSpace)
-> ElementConfig er t HydrationDomSpace
forall s a. s -> Getting a s a -> a
^. Getting
(ElementConfig er t HydrationDomSpace)
(TextAreaElementConfig er t HydrationDomSpace)
(ElementConfig er t HydrationDomSpace)
forall (er1 :: EventTag -> *) k1 (t :: k1) k2 (m1 :: k2)
(er2 :: EventTag -> *) k3 (m2 :: k3) (f :: * -> *).
Functor f =>
(ElementConfig er1 t m1 -> f (ElementConfig er2 t m2))
-> TextAreaElementConfig er1 t m1
-> f (TextAreaElementConfig er2 t m2)
textAreaElementConfig_elementConfig) (HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, ()), IORef Element))
-> HydrationDomBuilderT HydrationDomSpace t m ()
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, ()), IORef Element)
forall a b. (a -> b) -> a -> b
$ () -> HydrationDomBuilderT HydrationDomSpace t m ()
forall a. a -> HydrationDomBuilderT HydrationDomSpace t m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(valueChangedByUI, triggerChangeByUI) <- newTriggerEvent
(valueChangedBySetValue, triggerChangeBySetValue) <- newTriggerEvent
(focusChange, triggerFocusChange) <- newTriggerEvent
doc <- askDocument
let v0 = TextAreaElementConfig er t HydrationDomSpace -> Text
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (m :: k2).
TextAreaElementConfig er t m -> Text
_textAreaElementConfig_initialValue TextAreaElementConfig er t HydrationDomSpace
cfg
valueAtSwitchover = m (Behavior t Text)
-> (Event t Text -> m (Behavior t Text))
-> Maybe (Event t Text)
-> m (Behavior t Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Text -> m (Behavior t Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text -> m (Behavior t Text))
-> Behavior t Text -> m (Behavior t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Behavior t Text
forall a. a -> Behavior t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v0) (Text -> Event t Text -> m (Behavior t Text)
forall a. a -> Event t a -> m (Behavior t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Text
v0) (TextAreaElementConfig er t HydrationDomSpace
-> Maybe (Event t Text)
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (m :: k2).
TextAreaElementConfig er t m -> Maybe (Event t Text)
_textAreaElementConfig_setValue TextAreaElementConfig er t HydrationDomSpace
cfg)
addHydrationStepWithSetup valueAtSwitchover $ \Behavior t Text
switchoverValue' -> do
switchoverValue <- Behavior t Text -> HydrationRunnerT t m Text
forall a. Behavior t a -> HydrationRunnerT t m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
switchoverValue'
domElement <- liftIO $ readIORef domElementRef
let domTextAreaElement = (JSVal -> HTMLTextAreaElement) -> Element -> HTMLTextAreaElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLTextAreaElement
DOM.HTMLTextAreaElement Element
domElement
getValue = HTMLTextAreaElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLTextAreaElement -> m result
TextArea.getValue HTMLTextAreaElement
domTextAreaElement
when (v0 /= switchoverValue) $ liftIO $ triggerChangeBySetValue switchoverValue
liftJSM getValue >>= \Text
realValue -> Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
realValue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
switchoverValue) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall a. IO a -> HydrationRunnerT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeByUI Text
realValue
requestDomAction_ $ (liftJSM getValue >>= liftIO . triggerChangeByUI) <$ Reflex.select (_element_events e) (WrapArg Input)
for_ (_textAreaElementConfig_setValue cfg) $ \Event t Text
eSetValue ->
Event t (JSM ()) -> HydrationRunnerT t m ()
forall a. Event t (JSM a) -> HydrationRunnerT t m ()
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM ()) -> Event t (JSM ()))
-> (Text -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
HTMLTextAreaElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLTextAreaElement -> val -> m ()
TextArea.setValue HTMLTextAreaElement
domTextAreaElement Text
v'
v <- JSM Text
getValue
liftIO $ triggerChangeBySetValue v
let focusChange' = [Event t Bool] -> Event t Bool
forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Bool
False Bool -> Event t (er 'BlurTag) -> Event t Bool
forall a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> forall a. WrapArg er EventName a -> Event t a
forall {k1} (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'BlurTag -> WrapArg er EventName (er 'BlurTag)
forall {k} (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'BlurTag
Blur)
, Bool
True Bool -> Event t (er 'FocusTag) -> Event t Bool
forall a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> forall a. WrapArg er EventName a -> Event t a
forall {k1} (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'FocusTag -> WrapArg er EventName (er 'FocusTag)
forall {k} (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'FocusTag
Focus)
]
liftIO . triggerFocusChange =<< Node.isSameNode (toNode domElement) . fmap toNode =<< Document.getActiveElement doc
requestDomAction_ $ liftIO . triggerFocusChange <$> focusChange'
let initialFocus = Bool
False
hasFocus <- holdUniqDyn =<< holdDyn initialFocus focusChange
v <- holdDyn v0 $ leftmost
[ valueChangedBySetValue
, valueChangedByUI
]
return $ TextAreaElement
{ _textAreaElement_value = v
, _textAreaElement_input = valueChangedByUI
, _textAreaElement_hasFocus = hasFocus
, _textAreaElement_element = e
, _textAreaElement_raw = ()
}
{-# INLINE selectElementImmediate #-}
selectElementImmediate
:: ( EventSpec s ~ GhcjsEventSpec, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document
, MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m )
=> SelectElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
selectElementImmediate :: forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(EventSpec s ~ GhcjsEventSpec,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m) =>
SelectElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
selectElementImmediate SelectElementConfig er t s
cfg HydrationDomBuilderT s t m a
child = do
(e@(Element eventSelector domElement), result) <- Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate Text
"select" (SelectElementConfig er t s
cfg SelectElementConfig er t s
-> Getting
(ElementConfig er t s)
(SelectElementConfig er t s)
(ElementConfig er t s)
-> ElementConfig er t s
forall s a. s -> Getting a s a -> a
^. Getting
(ElementConfig er t s)
(SelectElementConfig er t s)
(ElementConfig er t s)
forall (er1 :: EventTag -> *) k1 (t :: k1) k2 (m1 :: k2)
(er2 :: EventTag -> *) k3 (m2 :: k3) (f :: * -> *).
Functor f =>
(ElementConfig er1 t m1 -> f (ElementConfig er2 t m2))
-> SelectElementConfig er1 t m1 -> f (SelectElementConfig er2 t m2)
selectElementConfig_elementConfig) HydrationDomBuilderT s t m a
child
let domSelectElement = (JSVal -> HTMLSelectElement) -> Element -> HTMLSelectElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLSelectElement
DOM.HTMLSelectElement Element
RawElement GhcjsDomSpace
domElement
Select.setValue domSelectElement $ cfg ^. selectElementConfig_initialValue
v0 <- Select.getValue domSelectElement
let getMyValue = HTMLSelectElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLSelectElement -> m result
Select.getValue HTMLSelectElement
domSelectElement
valueChangedByUI <- requestDomAction $ liftJSM getMyValue <$ Reflex.select eventSelector (WrapArg Change)
valueChangedBySetValue <- case _selectElementConfig_setValue cfg of
Maybe (Event t Text)
Nothing -> Event t Text -> HydrationDomBuilderT s t m (Event t Text)
forall a. a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Event t Text
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never
Just Event t Text
eSetValue -> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a. Event t (JSM a) -> HydrationDomBuilderT s t m (Event t a)
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m (Event t a)
requestDomAction (Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text))
-> Event t (JSM Text) -> HydrationDomBuilderT s t m (Event t Text)
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM Text) -> Event t (JSM Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM Text) -> Event t (JSM Text))
-> (Text -> JSM Text) -> Event t (JSM Text)
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
HTMLSelectElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLSelectElement -> val -> m ()
Select.setValue HTMLSelectElement
domSelectElement Text
v'
JSM Text
getMyValue
v <- holdDyn v0 $ leftmost
[ valueChangedBySetValue
, valueChangedByUI
]
hasFocus <- mkHasFocus e
let wrapped = SelectElement
{ _selectElement_value :: Dynamic t Text
_selectElement_value = Dynamic t Text
v
, _selectElement_change :: Event t Text
_selectElement_change = Event t Text
valueChangedByUI
, _selectElement_hasFocus :: Dynamic t Bool
_selectElement_hasFocus = Dynamic t Bool
hasFocus
, _selectElement_element :: Element er GhcjsDomSpace t
_selectElement_element = Element er GhcjsDomSpace t
e
, _selectElement_raw :: RawSelectElement GhcjsDomSpace
_selectElement_raw = HTMLSelectElement
RawSelectElement GhcjsDomSpace
domSelectElement
}
return (wrapped, result)
{-# INLINE selectElementInternal #-}
selectElementInternal
:: ( MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m
, MonadRef m, Ref m ~ IORef )
=> SelectElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
selectElementInternal :: forall (m :: * -> *) t (er :: EventTag -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m, MonadRef m, Ref m ~ IORef) =>
SelectElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
selectElementInternal SelectElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child = HydrationDomBuilderT HydrationDomSpace t m HydrationMode
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT HydrationDomSpace t m HydrationMode
-> (HydrationMode
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a))
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall a b.
HydrationDomBuilderT HydrationDomSpace t m a
-> (a -> HydrationDomBuilderT HydrationDomSpace t m b)
-> HydrationDomBuilderT HydrationDomSpace t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er GhcjsDomSpace t, a)
-> ((SelectElement er GhcjsDomSpace t, a)
-> (SelectElement er HydrationDomSpace t, a))
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor (SelectElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er GhcjsDomSpace t, a)
forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(EventSpec s ~ GhcjsEventSpec,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m) =>
SelectElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
selectElementImmediate SelectElementConfig er t HydrationDomSpace
cfg HydrationDomBuilderT HydrationDomSpace t m a
child) (((SelectElement er GhcjsDomSpace t, a)
-> (SelectElement er HydrationDomSpace t, a))
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a))
-> ((SelectElement er GhcjsDomSpace t, a)
-> (SelectElement er HydrationDomSpace t, a))
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall a b. (a -> b) -> a -> b
$ \(SelectElement er GhcjsDomSpace t
e, a
result) -> (SelectElement er GhcjsDomSpace t
e
{ _selectElement_element = Element (_element_events $ _selectElement_element e) ()
, _selectElement_raw = ()
}, a
result)
HydrationMode
HydrationMode_Hydrating -> do
((e, result), domElementRef) <- Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
forall (er :: EventTag -> *) t (m :: * -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
((Element er HydrationDomSpace t, a), IORef Element)
hydrateElement Text
"select" (SelectElementConfig er t HydrationDomSpace
cfg SelectElementConfig er t HydrationDomSpace
-> Getting
(ElementConfig er t HydrationDomSpace)
(SelectElementConfig er t HydrationDomSpace)
(ElementConfig er t HydrationDomSpace)
-> ElementConfig er t HydrationDomSpace
forall s a. s -> Getting a s a -> a
^. Getting
(ElementConfig er t HydrationDomSpace)
(SelectElementConfig er t HydrationDomSpace)
(ElementConfig er t HydrationDomSpace)
forall (er1 :: EventTag -> *) k1 (t :: k1) k2 (m1 :: k2)
(er2 :: EventTag -> *) k3 (m2 :: k3) (f :: * -> *).
Functor f =>
(ElementConfig er1 t m1 -> f (ElementConfig er2 t m2))
-> SelectElementConfig er1 t m1 -> f (SelectElementConfig er2 t m2)
selectElementConfig_elementConfig) HydrationDomBuilderT HydrationDomSpace t m a
child
(valueChangedByUI, triggerChangeByUI) <- newTriggerEvent
(valueChangedBySetValue, triggerChangeBySetValue) <- newTriggerEvent
(focusChange, triggerFocusChange) <- newTriggerEvent
doc <- askDocument
let v0 = SelectElementConfig er t HydrationDomSpace -> Text
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (m :: k2).
SelectElementConfig er t m -> Text
_selectElementConfig_initialValue SelectElementConfig er t HydrationDomSpace
cfg
addHydrationStep $ do
domElement <- liftIO $ readIORef domElementRef
let domSelectElement = (JSVal -> HTMLSelectElement) -> Element -> HTMLSelectElement
forall obj obj'.
(Coercible obj JSVal, IsGObject obj') =>
(JSVal -> obj') -> obj -> obj'
uncheckedCastTo JSVal -> HTMLSelectElement
DOM.HTMLSelectElement Element
domElement
getValue = HTMLSelectElement -> JSM Text
forall (m :: * -> *) result.
(MonadDOM m, FromJSString result) =>
HTMLSelectElement -> m result
Select.getValue HTMLSelectElement
domSelectElement
liftJSM getValue >>= \Text
v0' -> do
Bool -> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
v0' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
v0) (HydrationRunnerT t m () -> HydrationRunnerT t m ())
-> HydrationRunnerT t m () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ IO () -> HydrationRunnerT t m ()
forall a. IO a -> HydrationRunnerT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> HydrationRunnerT t m ())
-> IO () -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
triggerChangeByUI Text
v0'
requestDomAction_ $ (liftJSM getValue >>= liftIO . triggerChangeByUI) <$ Reflex.select (_element_events e) (WrapArg Change)
for_ (_selectElementConfig_setValue cfg) $ \Event t Text
eSetValue ->
Event t (JSM ()) -> HydrationRunnerT t m ()
forall a. Event t (JSM a) -> HydrationRunnerT t m ()
forall {k} (t :: k) (m :: * -> *) a.
DomRenderHook t m =>
Event t (JSM a) -> m ()
requestDomAction_ (Event t (JSM ()) -> HydrationRunnerT t m ())
-> Event t (JSM ()) -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Event t Text -> (Text -> JSM ()) -> Event t (JSM ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t Text
eSetValue ((Text -> JSM ()) -> Event t (JSM ()))
-> (Text -> JSM ()) -> Event t (JSM ())
forall a b. (a -> b) -> a -> b
$ \Text
v' -> do
HTMLSelectElement -> Text -> JSM ()
forall (m :: * -> *) val.
(MonadDOM m, ToJSString val) =>
HTMLSelectElement -> val -> m ()
Select.setValue HTMLSelectElement
domSelectElement Text
v'
v <- JSM Text
getValue
liftIO $ triggerChangeBySetValue v
let focusChange' = [Event t Bool] -> Event t Bool
forall {k} (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost
[ Bool
False Bool -> Event t (er 'BlurTag) -> Event t Bool
forall a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> forall a. WrapArg er EventName a -> Event t a
forall {k1} (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'BlurTag -> WrapArg er EventName (er 'BlurTag)
forall {k} (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'BlurTag
Blur)
, Bool
True Bool -> Event t (er 'FocusTag) -> Event t Bool
forall a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ EventSelector t (WrapArg er EventName)
-> forall a. WrapArg er EventName a -> Event t a
forall {k1} (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
Reflex.select (Element er HydrationDomSpace t
-> EventSelector t (WrapArg er EventName)
forall {k1} {k2} (er :: EventTag -> *) (d :: k1) (t :: k2).
Element er d t -> EventSelector t (WrapArg er EventName)
_element_events Element er HydrationDomSpace t
e) (EventName 'FocusTag -> WrapArg er EventName (er 'FocusTag)
forall {k} (b :: k -> *) (a1 :: k) (a :: k -> *).
b a1 -> WrapArg a b (a a1)
WrapArg EventName 'FocusTag
Focus)
]
liftIO . triggerFocusChange =<< Node.isSameNode (toNode domElement) . fmap toNode =<< Document.getActiveElement doc
requestDomAction_ $ liftIO . triggerFocusChange <$> focusChange'
let initialFocus = Bool
False
hasFocus <- holdUniqDyn =<< holdDyn initialFocus focusChange
v <- holdDyn v0 $ leftmost
[ valueChangedBySetValue
, valueChangedByUI
]
return $ (,result) $ SelectElement
{ _selectElement_value = v
, _selectElement_change = valueChangedByUI
, _selectElement_hasFocus = hasFocus
, _selectElement_element = e
, _selectElement_raw = ()
}
{-# INLINE textNodeImmediate #-}
textNodeImmediate
:: (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, MonadJSM m, Reflex t, MonadFix m)
=> TextNodeConfig t -> HydrationDomBuilderT s t m DOM.Text
textNodeImmediate :: forall {k} (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate (TextNodeConfig !Text
t Maybe (Event t Text)
mSetContents) = do
p <- HydrationDomBuilderT s t m Node
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
doc <- askDocument
n <- createTextNode doc t
appendChild_ p n
mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
pure n
{-# SPECIALIZE textNodeImmediate
:: TextNodeConfig DomTimeline
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM DOM.Text
#-}
{-# SPECIALIZE textNodeImmediate
:: TextNodeConfig DomTimeline
-> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM DOM.Text
#-}
{-# INLINE textNodeInternal #-}
textNodeInternal
:: (Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m, Reflex t)
=> TextNodeConfig t -> HydrationDomBuilderT HydrationDomSpace t m (TextNode HydrationDomSpace t)
textNodeInternal :: forall t (m :: * -> *).
(Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m,
Reflex t) =>
TextNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace t m (TextNode HydrationDomSpace t)
textNodeInternal tc :: TextNodeConfig t
tc@(TextNodeConfig !Text
t Maybe (Event t Text)
mSetContents) = do
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
HydrationDomBuilderT
HydrationDomSpace
t
m
(RawDocument
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
getHydrationMode >>= \case
HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT HydrationDomSpace t m Text
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (HydrationDomBuilderT HydrationDomSpace t m Text
-> HydrationDomBuilderT HydrationDomSpace t m ())
-> HydrationDomBuilderT HydrationDomSpace t m Text
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ TextNodeConfig t -> HydrationDomBuilderT HydrationDomSpace t m Text
forall {k} (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate TextNodeConfig t
tc
HydrationMode
HydrationMode_Hydrating -> m (Behavior t Text)
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall {k} (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (m (Behavior t Text)
-> (Event t Text -> m (Behavior t Text))
-> Maybe (Event t Text)
-> m (Behavior t Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Text -> m (Behavior t Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text -> m (Behavior t Text))
-> Behavior t Text -> m (Behavior t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Behavior t Text
forall a. a -> Behavior t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t) (Text -> Event t Text -> m (Behavior t Text)
forall a. a -> Event t a -> m (Behavior t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Text
t) Maybe (Event t Text)
mSetContents) ((Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ())
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ \Behavior t Text
currentText -> do
n <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) t.
MonadJSM m =>
Document -> Text -> HydrationRunnerT t m Text
hydrateTextNode Document
doc (Text -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text -> HydrationRunnerT t m Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Behavior t Text -> HydrationRunnerT t m Text
forall a. Behavior t a -> HydrationRunnerT t m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
currentText
mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
pure $ TextNode ()
{-# SPECIALIZE textNodeInternal
:: TextNodeConfig DomTimeline
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (TextNode HydrationDomSpace DomTimeline)
#-}
{-# INLINE hydrateTextNode #-}
hydrateTextNode :: MonadJSM m => Document -> Text -> HydrationRunnerT t m DOM.Text
hydrateTextNode :: forall (m :: * -> *) t.
MonadJSM m =>
Document -> Text -> HydrationRunnerT t m Text
hydrateTextNode Document
doc t :: Text
t@Text
"" = do
tn <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc Text
t
insertAfterPreviousNode tn
pure tn
hydrateTextNode Document
doc Text
t = do
n <- HydrationRunnerT t m (HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (HydrationRunnerT t m (HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text)
-> HydrationRunnerT t m (HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node -> HydrationRunnerT t m Text
go (Node -> Maybe Node -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m Node
-> HydrationRunnerT t m (Maybe Node -> HydrationRunnerT t m Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent HydrationRunnerT t m (Maybe Node -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m (Maybe Node)
-> HydrationRunnerT t m (HydrationRunnerT t m Text)
forall a b.
HydrationRunnerT t m (a -> b)
-> HydrationRunnerT t m a -> HydrationRunnerT t m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) t.
Monad m =>
HydrationRunnerT t m (Maybe Node)
getPreviousNode
setPreviousNode $ Just $ toNode n
return n
where
go :: Node -> Maybe Node -> HydrationRunnerT t m Text
go Node
parent Maybe Node
mLastNode = HydrationRunnerT t m (Maybe Node)
-> (Node -> HydrationRunnerT t m (Maybe Node))
-> Maybe Node
-> HydrationRunnerT t m (Maybe Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getFirstChild Node
parent) Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling Maybe Node
mLastNode HydrationRunnerT t m (Maybe Node)
-> (Maybe Node -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Node
Nothing -> do
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
s -> HydrationState
s { _hydrationState_failed = True }
n <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc Text
t
insertAfterPreviousNode n
pure n
Just Node
node -> (JSVal -> Text) -> Node -> HydrationRunnerT t m (Maybe Text)
forall obj obj' (m :: * -> *).
(Coercible obj JSVal, IsGObject obj', MonadJSM m) =>
(JSVal -> obj') -> obj -> m (Maybe obj')
DOM.castTo JSVal -> Text
DOM.Text Node
node HydrationRunnerT t m (Maybe Text)
-> (Maybe Text -> HydrationRunnerT t m Text)
-> HydrationRunnerT t m Text
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Text
Nothing -> Node -> Maybe Node -> HydrationRunnerT t m Text
go Node
parent (Maybe Node -> HydrationRunnerT t m Text)
-> Maybe Node -> HydrationRunnerT t m Text
forall a b. (a -> b) -> a -> b
$ Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node
Just Text
originalNode -> do
originalText <- Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self result.
(MonadDOM m, IsNode self, FromJSString result) =>
self -> m result
Node.getTextContentUnchecked Text
originalNode
case T.stripPrefix t originalText of
Just Text
"" -> Text -> HydrationRunnerT t m Text
forall a. a -> HydrationRunnerT t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
originalNode
Just Text
_ -> do
Text -> Word -> HydrationRunnerT t m ()
forall (m :: * -> *) self.
(MonadDOM m, IsText self) =>
self -> Word -> m ()
DOM.splitText_ Text
originalNode (Word -> HydrationRunnerT t m ())
-> Word -> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
t
Text -> HydrationRunnerT t m Text
forall a. a -> HydrationRunnerT t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
originalNode
Maybe Text
Nothing -> do
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall t (m :: * -> *) a.
StateT HydrationState (ReaderT Node (DomRenderHookT t m)) a
-> HydrationRunnerT t m a
HydrationRunnerT (StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ())
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ())
-> (HydrationState -> HydrationState)
-> StateT HydrationState (ReaderT Node (DomRenderHookT t m)) ()
forall a b. (a -> b) -> a -> b
$ \HydrationState
s -> HydrationState
s { _hydrationState_failed = True }
n <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc Text
t
insertAfterPreviousNode n
pure n
{-# INLINE commentNodeImmediate #-}
commentNodeImmediate
:: (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document, MonadJSM m, Reflex t, MonadFix m)
=> CommentNodeConfig t -> HydrationDomBuilderT s t m DOM.Comment
(CommentNodeConfig !Text
t Maybe (Event t Text)
mSetContents) = do
p <- HydrationDomBuilderT s t m Node
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
doc <- askDocument
n <- createComment doc t
appendChild_ p n
mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
pure n
{-# INLINE commentNodeInternal #-}
commentNodeInternal
:: (Ref m ~ IORef, MonadRef m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadJSM m, MonadFix m, Reflex t, Adjustable t m, MonadHold t m, MonadSample t m)
=> CommentNodeConfig t -> HydrationDomBuilderT HydrationDomSpace t m (CommentNode HydrationDomSpace t)
tc :: CommentNodeConfig t
tc@(CommentNodeConfig Text
t0 Maybe (Event t Text)
mSetContents) = do
doc <- HydrationDomBuilderT HydrationDomSpace t m Document
HydrationDomBuilderT
HydrationDomSpace
t
m
(RawDocument
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
getHydrationMode >>= \case
HydrationMode
HydrationMode_Immediate -> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
-> HydrationDomBuilderT HydrationDomSpace t m ())
-> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ CommentNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
forall (m :: * -> *) t.
(Ref m ~ IORef, MonadRef m, PerformEvent t m,
MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadJSM m,
MonadFix m, Reflex t, Adjustable t m, MonadHold t m,
MonadSample t m) =>
CommentNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
commentNodeInternal CommentNodeConfig t
tc
HydrationMode
HydrationMode_Hydrating -> m (Behavior t Text)
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall {k} (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (m (Behavior t Text)
-> (Event t Text -> m (Behavior t Text))
-> Maybe (Event t Text)
-> m (Behavior t Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Behavior t Text -> m (Behavior t Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Behavior t Text -> m (Behavior t Text))
-> Behavior t Text -> m (Behavior t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Behavior t Text
forall a. a -> Behavior t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t0) (Text -> Event t Text -> m (Behavior t Text)
forall a. a -> Event t a -> m (Behavior t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold Text
t0) Maybe (Event t Text)
mSetContents) ((Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ())
-> (Behavior t Text -> HydrationRunnerT t m ())
-> HydrationDomBuilderT HydrationDomSpace t m ()
forall a b. (a -> b) -> a -> b
$ \Behavior t Text
bt -> do
t <- Behavior t Text -> HydrationRunnerT t m Text
forall a. Behavior t a -> HydrationRunnerT t m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
bt
void $ hydrateComment doc t mSetContents
pure $ CommentNode ()
{-# INLINE hydrateComment #-}
hydrateComment :: (MonadJSM m, Reflex t, MonadFix m) => Document -> Text -> Maybe (Event t Text) -> HydrationRunnerT t m DOM.Comment
Document
doc Text
t Maybe (Event t Text)
mSetContents = do
parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
let go Maybe Node
mLastNode = HydrationRunnerT t m (Maybe Node)
-> (Node -> HydrationRunnerT t m (Maybe Node))
-> Maybe Node
-> HydrationRunnerT t m (Maybe Node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getFirstChild Node
parent) Node -> HydrationRunnerT t m (Maybe Node)
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m (Maybe Node)
Node.getNextSibling Maybe Node
mLastNode HydrationRunnerT t m (Maybe Node)
-> (Maybe Node -> HydrationRunnerT t m Comment)
-> HydrationRunnerT t m Comment
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Node
Nothing -> do
c <- Document -> Text -> HydrationRunnerT t m Comment
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Comment
createComment Document
doc Text
t
insertAfterPreviousNode c
pure c
Just Node
node -> (JSVal -> Comment) -> Node -> HydrationRunnerT t m (Maybe Comment)
forall obj obj' (m :: * -> *).
(Coercible obj JSVal, IsGObject obj', MonadJSM m) =>
(JSVal -> obj') -> obj -> m (Maybe obj')
DOM.castTo JSVal -> Comment
DOM.Comment Node
node HydrationRunnerT t m (Maybe Comment)
-> (Maybe Comment -> HydrationRunnerT t m Comment)
-> HydrationRunnerT t m Comment
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Comment
Nothing -> Maybe Node -> HydrationRunnerT t m Comment
go (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
Just Comment
c -> do
t' <- Comment -> HydrationRunnerT t m Text
forall (m :: * -> *) self result.
(MonadDOM m, IsNode self, FromJSString result) =>
self -> m result
Node.getTextContentUnchecked Comment
c
if t == t'
then pure c
else do
c' <- createComment doc t
insertAfterPreviousNode c'
pure c'
n <- go =<< getPreviousNode
setPreviousNode $ Just $ toNode n
mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
pure n
{-# INLINABLE skipToAndReplaceComment #-}
skipToAndReplaceComment
:: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)
=> Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text, IORef (Maybe Text))
skipToAndReplaceComment :: forall {k} (m :: * -> *) t (s :: k).
(MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToAndReplaceComment Text
prefix IORef (Maybe Text)
key0Ref = HydrationDomBuilderT s t m HydrationMode
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m HydrationMode
getHydrationMode HydrationDomBuilderT s t m HydrationMode
-> (HydrationMode
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text)))
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall a b.
HydrationDomBuilderT s t m a
-> (a -> HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
HydrationMode
HydrationMode_Immediate -> do
t <- TextNodeConfig t -> HydrationDomBuilderT s t m Text
forall {k} (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate (TextNodeConfig t -> HydrationDomBuilderT s t m Text)
-> TextNodeConfig t -> HydrationDomBuilderT s t m Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Event t Text) -> TextNodeConfig t
forall {k} (t :: k).
Text -> Maybe (Event t Text) -> TextNodeConfig t
TextNodeConfig (Text
"" :: Text) Maybe (Event t Text)
forall a. Maybe a
Nothing
append $ toNode t
textNodeRef <- liftIO $ newIORef t
keyRef <- liftIO $ newIORef Nothing
pure (pure (), textNodeRef, keyRef)
HydrationMode
HydrationMode_Hydrating -> do
doc <- HydrationDomBuilderT s t m Document
HydrationDomBuilderT
s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
textNodeRef <- liftIO $ newIORef $ error "textNodeRef not yet initialized"
keyRef <- liftIO $ newIORef $ error "keyRef not yet initialized"
let
go Maybe Text
Nothing Maybe Node
_ = do
tn <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
insertAfterPreviousNode tn
HydrationRunnerT $ modify' $ \HydrationState
s -> HydrationState
s { _hydrationState_failed = True }
pure (tn, Nothing)
go (Just Text
key0) Maybe Node
mLastNode = do
parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
maybe (Node.getFirstChild parent) Node.getNextSibling mLastNode >>= \case
Maybe Node
Nothing -> Maybe Text -> Maybe Node -> HydrationRunnerT t m (Text, Maybe Text)
go Maybe Text
forall a. Maybe a
Nothing Maybe Node
forall a. Maybe a
Nothing
Just Node
node -> (JSVal -> Comment) -> Node -> HydrationRunnerT t m (Maybe Comment)
forall obj obj' (m :: * -> *).
(Coercible obj JSVal, IsGObject obj', MonadJSM m) =>
(JSVal -> obj') -> obj -> m (Maybe obj')
DOM.castTo JSVal -> Comment
DOM.Comment Node
node HydrationRunnerT t m (Maybe Comment)
-> (Maybe Comment -> HydrationRunnerT t m (Text, Maybe Text))
-> HydrationRunnerT t m (Text, Maybe Text)
forall a b.
HydrationRunnerT t m a
-> (a -> HydrationRunnerT t m b) -> HydrationRunnerT t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Comment
comment -> do
commentText <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
forall a. HasCallStack => String -> a
error String
"Cannot get text content of comment node") (Maybe Text -> Text)
-> HydrationRunnerT t m (Maybe Text) -> HydrationRunnerT t m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Comment -> HydrationRunnerT t m (Maybe Text)
forall (m :: * -> *) self result.
(MonadDOM m, IsNode self, FromJSString result) =>
self -> m (Maybe result)
Node.getTextContent Comment
comment
case T.stripPrefix (prefix <> key0) commentText of
Just Text
key -> do
tn <- Document -> Text -> HydrationRunnerT t m Text
forall (m :: * -> *) self data'.
(MonadDOM m, IsDocument self, ToJSString data') =>
self -> data' -> m Text
createTextNode Document
doc (Text
"" :: Text)
Node.replaceChild_ parent tn comment
pure (tn, Just key)
Maybe Text
Nothing -> do
Maybe Text -> Maybe Node -> HydrationRunnerT t m (Text, Maybe Text)
go (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key0) (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
Maybe Comment
Nothing -> do
Maybe Text -> Maybe Node -> HydrationRunnerT t m (Text, Maybe Text)
go (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key0) (Node -> Maybe Node
forall a. a -> Maybe a
Just Node
node)
switchComment = do
key0 <- IO (Maybe Text) -> HydrationRunnerT t m (Maybe Text)
forall a. IO a -> HydrationRunnerT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> HydrationRunnerT t m (Maybe Text))
-> IO (Maybe Text) -> HydrationRunnerT t m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe Text) -> IO (Maybe Text)
forall a. IORef a -> IO a
readIORef IORef (Maybe Text)
key0Ref
(tn, key) <- go key0 =<< getPreviousNode
setPreviousNode $ Just $ toNode tn
liftIO $ do
writeIORef textNodeRef tn
writeIORef keyRef key
pure (switchComment, textNodeRef, keyRef)
{-# INLINABLE skipToReplaceStart #-}
skipToReplaceStart :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text, IORef (Maybe Text))
skipToReplaceStart :: forall {k} (m :: * -> *) t (s :: k).
(MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToReplaceStart = Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall {k} (m :: * -> *) t (s :: k).
(MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToAndReplaceComment Text
"replace-start" (IORef (Maybe Text)
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text)))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (IORef (Maybe Text))
-> HydrationDomBuilderT s t m (IORef (Maybe Text))
forall a. IO a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe Text -> IO (IORef (Maybe Text))
forall a. a -> IO (IORef a)
newIORef (Maybe Text -> IO (IORef (Maybe Text)))
-> Maybe Text -> IO (IORef (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"")
{-# INLINABLE skipToReplaceEnd #-}
skipToReplaceEnd :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => IORef (Maybe Text) -> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text)
skipToReplaceEnd :: forall {k} (m :: * -> *) t (s :: k).
(MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
IORef (Maybe Text)
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef Text)
skipToReplaceEnd IORef (Maybe Text)
key = ((HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> (HydrationRunnerT t m (), IORef Text))
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef Text)
forall a b.
(a -> b)
-> HydrationDomBuilderT s t m a -> HydrationDomBuilderT s t m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(HydrationRunnerT t m ()
m,IORef Text
e,IORef (Maybe Text)
_) -> (HydrationRunnerT t m ()
m,IORef Text
e)) (HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text))
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
-> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef Text)
forall a b. (a -> b) -> a -> b
$ Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
forall {k} (m :: * -> *) t (s :: k).
(MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
Text
-> IORef (Maybe Text)
-> HydrationDomBuilderT
s t m (HydrationRunnerT t m (), IORef Text, IORef (Maybe Text))
skipToAndReplaceComment Text
"replace-end" IORef (Maybe Text)
key
instance SupportsHydrationDomBuilder t m => NotReady t (HydrationDomBuilderT s t m) where
notReadyUntil :: forall a. Event t a -> HydrationDomBuilderT s t m ()
notReadyUntil Event t a
e = do
eOnce <- Event t a -> HydrationDomBuilderT s t m (Event t a)
forall a. Event t a -> HydrationDomBuilderT s t m (Event t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
Event t a -> m (Event t a)
headE Event t a
e
unreadyChildren <- askUnreadyChildren
commitAction <- askCommitAction
liftIO $ modifyIORef' unreadyChildren succ
let ready = do
old <- IO Word -> JSM Word
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> JSM Word) -> IO Word -> JSM Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
unreadyChildren
let new = Word -> Word
forall a. Enum a => a -> a
pred Word
old
liftIO $ writeIORef unreadyChildren $! new
when (new == 0) commitAction
requestDomAction_ $ ready <$ eOnce
notReady :: HydrationDomBuilderT s t m ()
notReady = do
unreadyChildren <- HydrationDomBuilderT s t m (IORef Word)
forall {k} (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT s t m (IORef Word)
askUnreadyChildren
liftIO $ modifyIORef' unreadyChildren succ
data HydrationDomSpace
instance DomSpace HydrationDomSpace where
type EventSpec HydrationDomSpace = GhcjsEventSpec
type RawDocument HydrationDomSpace = DOM.Document
type RawTextNode HydrationDomSpace = ()
type HydrationDomSpace = ()
type RawElement HydrationDomSpace = ()
type RawInputElement HydrationDomSpace = ()
type RawTextAreaElement HydrationDomSpace = ()
type RawSelectElement HydrationDomSpace = ()
addEventSpecFlags :: forall (proxy :: * -> *) (en :: EventTag) (er :: EventTag -> *).
proxy HydrationDomSpace
-> EventName en
-> (Maybe (er en) -> EventFlags)
-> EventSpec HydrationDomSpace er
-> EventSpec HydrationDomSpace er
addEventSpecFlags proxy HydrationDomSpace
_ EventName en
en Maybe (er en) -> EventFlags
f EventSpec HydrationDomSpace er
es = EventSpec HydrationDomSpace er
es
{ _ghcjsEventSpec_filters =
let f' = GhcjsEventFilter er en -> Maybe (GhcjsEventFilter er en)
forall a. a -> Maybe a
Just (GhcjsEventFilter er en -> Maybe (GhcjsEventFilter er en))
-> (Maybe (GhcjsEventFilter er en) -> GhcjsEventFilter er en)
-> Maybe (GhcjsEventFilter er en)
-> Maybe (GhcjsEventFilter er en)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
forall (er :: EventTag -> *) (en :: EventTag).
(GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en
GhcjsEventFilter ((GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> GhcjsEventFilter er en)
-> (Maybe (GhcjsEventFilter er en)
-> GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en))))
-> Maybe (GhcjsEventFilter er en)
-> GhcjsEventFilter er en
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Maybe (GhcjsEventFilter er en)
Nothing -> \GhcjsDomEvent en
evt -> do
mEventResult <- GhcjsEventHandler er
-> forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
forall (er :: EventTag -> *).
GhcjsEventHandler er
-> forall (en :: EventTag).
(EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
unGhcjsEventHandler (GhcjsEventSpec er -> GhcjsEventHandler er
forall (er :: EventTag -> *).
GhcjsEventSpec er -> GhcjsEventHandler er
_ghcjsEventSpec_handler EventSpec HydrationDomSpace er
GhcjsEventSpec er
es) (EventName en
en, GhcjsDomEvent en
evt)
return (f mEventResult, return mEventResult)
Just (GhcjsEventFilter GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter) -> \GhcjsDomEvent en
evt -> do
(oldFlags, oldContinuation) <- GhcjsDomEvent en -> JSM (EventFlags, JSM (Maybe (er en)))
oldFilter GhcjsDomEvent en
evt
mEventResult <- oldContinuation
let newFlags = EventFlags
oldFlags EventFlags -> EventFlags -> EventFlags
forall a. Semigroup a => a -> a -> a
<> Maybe (er en) -> EventFlags
f Maybe (er en)
mEventResult
return (newFlags, return mEventResult)
in DMap.alter f' en $ _ghcjsEventSpec_filters es
}
instance SupportsHydrationDomBuilder t m => DomBuilder t (HydrationDomBuilderT HydrationDomSpace t m) where
type DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m) = HydrationDomSpace
{-# INLINABLE element #-}
element :: forall (er :: EventTag -> *) a.
Text
-> ElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(Element
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t,
a)
element = Text
-> ElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(Element
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t,
a)
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t, a)
forall (m :: * -> *) t (er :: EventTag -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (Element er HydrationDomSpace t, a)
elementInternal
{-# INLINABLE textNode #-}
textNode :: TextNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(TextNode
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t)
textNode = TextNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(TextNode
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t)
TextNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace t m (TextNode HydrationDomSpace t)
forall t (m :: * -> *).
(Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m,
Reflex t) =>
TextNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace t m (TextNode HydrationDomSpace t)
textNodeInternal
{-# INLINABLE commentNode #-}
commentNode :: CommentNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(CommentNode
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t)
commentNode = CommentNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(CommentNode
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t)
CommentNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
forall (m :: * -> *) t.
(Ref m ~ IORef, MonadRef m, PerformEvent t m,
MonadReflexCreateTrigger t m, MonadJSM (Performable m), MonadJSM m,
MonadFix m, Reflex t, Adjustable t m, MonadHold t m,
MonadSample t m) =>
CommentNodeConfig t
-> HydrationDomBuilderT
HydrationDomSpace t m (CommentNode HydrationDomSpace t)
commentNodeInternal
{-# INLINABLE inputElement #-}
inputElement :: forall (er :: EventTag -> *).
InputElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(InputElement
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t)
inputElement = InputElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(InputElement
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t)
InputElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t)
forall (m :: * -> *) t (er :: EventTag -> *).
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m, MonadRef m, Ref m ~ IORef) =>
InputElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (InputElement er HydrationDomSpace t)
inputElementInternal
{-# INLINABLE textAreaElement #-}
textAreaElement :: forall (er :: EventTag -> *).
TextAreaElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(TextAreaElement
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t)
textAreaElement = TextAreaElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(TextAreaElement
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t)
TextAreaElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
forall (m :: * -> *) t (er :: EventTag -> *).
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m, MonadRef m, Ref m ~ IORef) =>
TextAreaElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT
HydrationDomSpace t m (TextAreaElement er HydrationDomSpace t)
textAreaElementInternal
{-# INLINABLE selectElement #-}
selectElement :: forall (er :: EventTag -> *) a.
SelectElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(SelectElement
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t,
a)
selectElement = SelectElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(SelectElement
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t,
a)
SelectElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
forall (m :: * -> *) t (er :: EventTag -> *) a.
(MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m, MonadRef m, Ref m ~ IORef) =>
SelectElementConfig er t HydrationDomSpace
-> HydrationDomBuilderT HydrationDomSpace t m a
-> HydrationDomBuilderT
HydrationDomSpace t m (SelectElement er HydrationDomSpace t, a)
selectElementInternal
placeRawElement :: RawElement
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT HydrationDomSpace t m ()
placeRawElement () = () -> HydrationDomBuilderT HydrationDomSpace t m ()
forall a. a -> HydrationDomBuilderT HydrationDomSpace t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
wrapRawElement :: forall (er :: EventTag -> *).
RawElement
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> RawElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(Element
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t)
wrapRawElement () RawElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
_cfg = Element
er (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(Element
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t)
forall a. a -> HydrationDomBuilderT HydrationDomSpace t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Element
er (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(Element
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t))
-> Element
er (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t
-> HydrationDomBuilderT
HydrationDomSpace
t
m
(Element
er
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
t)
forall a b. (a -> b) -> a -> b
$ EventSelector t (WrapArg er EventName)
-> RawElement
(DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m))
-> Element
er (DomBuilderSpace (HydrationDomBuilderT HydrationDomSpace t m)) t
forall {k} {k1} (er :: EventTag -> *) (d :: k) (t :: k1).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element ((forall a. WrapArg er EventName a -> Event t a)
-> EventSelector t (WrapArg er EventName)
forall {k} (t :: k) (k1 :: * -> *).
(forall a. k1 a -> Event t a) -> EventSelector t k1
EventSelector ((forall a. WrapArg er EventName a -> Event t a)
-> EventSelector t (WrapArg er EventName))
-> (forall a. WrapArg er EventName a -> Event t a)
-> EventSelector t (WrapArg er EventName)
forall a b. (a -> b) -> a -> b
$ Event t a -> WrapArg er EventName a -> Event t a
forall a b. a -> b -> a
const Event t a
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never) ()
instance SupportsHydrationDomBuilder t m => DomBuilder t (HydrationDomBuilderT GhcjsDomSpace t m) where
type DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m) = GhcjsDomSpace
{-# INLINABLE element #-}
element :: forall (er :: EventTag -> *) a.
Text
-> ElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(Element
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t,
a)
element = Text
-> ElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(Element
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t,
a)
Text
-> ElementConfig er t GhcjsDomSpace
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
GhcjsDomSpace t m (Element er GhcjsDomSpace t, a)
forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m) =>
Text
-> ElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (Element er GhcjsDomSpace t, a)
elementImmediate
{-# INLINABLE textNode #-}
textNode :: TextNodeConfig t
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(TextNode
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
textNode = (Text -> TextNode GhcjsDomSpace t)
-> HydrationDomBuilderT GhcjsDomSpace t m Text
-> HydrationDomBuilderT
GhcjsDomSpace t m (TextNode GhcjsDomSpace t)
forall a b.
(a -> b)
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT GhcjsDomSpace t m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TextNode GhcjsDomSpace t
RawTextNode GhcjsDomSpace -> TextNode GhcjsDomSpace t
forall {k} {k1} (d :: k) (t :: k1). RawTextNode d -> TextNode d t
TextNode (HydrationDomBuilderT GhcjsDomSpace t m Text
-> HydrationDomBuilderT
GhcjsDomSpace t m (TextNode GhcjsDomSpace t))
-> (TextNodeConfig t
-> HydrationDomBuilderT GhcjsDomSpace t m Text)
-> TextNodeConfig t
-> HydrationDomBuilderT
GhcjsDomSpace t m (TextNode GhcjsDomSpace t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextNodeConfig t -> HydrationDomBuilderT GhcjsDomSpace t m Text
forall {k} (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadFix m) =>
TextNodeConfig t -> HydrationDomBuilderT s t m Text
textNodeImmediate
{-# INLINABLE commentNode #-}
commentNode :: CommentNodeConfig t
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(CommentNode
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
commentNode = (Comment -> CommentNode GhcjsDomSpace t)
-> HydrationDomBuilderT GhcjsDomSpace t m Comment
-> HydrationDomBuilderT
GhcjsDomSpace t m (CommentNode GhcjsDomSpace t)
forall a b.
(a -> b)
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT GhcjsDomSpace t m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Comment -> CommentNode GhcjsDomSpace t
RawCommentNode GhcjsDomSpace -> CommentNode GhcjsDomSpace t
forall {k} {k1} (d :: k) (t :: k1).
RawCommentNode d -> CommentNode d t
CommentNode (HydrationDomBuilderT GhcjsDomSpace t m Comment
-> HydrationDomBuilderT
GhcjsDomSpace t m (CommentNode GhcjsDomSpace t))
-> (CommentNodeConfig t
-> HydrationDomBuilderT GhcjsDomSpace t m Comment)
-> CommentNodeConfig t
-> HydrationDomBuilderT
GhcjsDomSpace t m (CommentNode GhcjsDomSpace t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentNodeConfig t
-> HydrationDomBuilderT GhcjsDomSpace t m Comment
forall {k} (s :: k) t (m :: * -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadFix m) =>
CommentNodeConfig t -> HydrationDomBuilderT s t m Comment
commentNodeImmediate
{-# INLINABLE inputElement #-}
inputElement :: forall (er :: EventTag -> *).
InputElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(InputElement
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
inputElement = InputElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(InputElement
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
InputElementConfig er t GhcjsDomSpace
-> HydrationDomBuilderT
GhcjsDomSpace t m (InputElement er GhcjsDomSpace t)
forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
MonadRef m, Ref m ~ IORef) =>
InputElementConfig er t s
-> HydrationDomBuilderT s t m (InputElement er GhcjsDomSpace t)
inputElementImmediate
{-# INLINABLE textAreaElement #-}
textAreaElement :: forall (er :: EventTag -> *).
TextAreaElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(TextAreaElement
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
textAreaElement = TextAreaElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(TextAreaElement
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
TextAreaElementConfig er t GhcjsDomSpace
-> HydrationDomBuilderT
GhcjsDomSpace t m (TextAreaElement er GhcjsDomSpace t)
forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *).
(RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
EventSpec s ~ GhcjsEventSpec, MonadJSM m, Reflex t,
MonadReflexCreateTrigger t m, MonadFix m, MonadHold t m,
MonadRef m, Ref m ~ IORef) =>
TextAreaElementConfig er t s
-> HydrationDomBuilderT s t m (TextAreaElement er GhcjsDomSpace t)
textAreaElementImmediate
{-# INLINABLE selectElement #-}
selectElement :: forall (er :: EventTag -> *) a.
SelectElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(SelectElement
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t,
a)
selectElement = SelectElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(SelectElement
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t,
a)
SelectElementConfig er t GhcjsDomSpace
-> HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
GhcjsDomSpace t m (SelectElement er GhcjsDomSpace t, a)
forall {k} (s :: k) t (m :: * -> *) (er :: EventTag -> *) a.
(EventSpec s ~ GhcjsEventSpec,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document,
MonadJSM m, Reflex t, MonadReflexCreateTrigger t m, MonadFix m,
MonadHold t m) =>
SelectElementConfig er t s
-> HydrationDomBuilderT s t m a
-> HydrationDomBuilderT s t m (SelectElement er GhcjsDomSpace t, a)
selectElementImmediate
placeRawElement :: RawElement
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m ()
placeRawElement = Node -> HydrationDomBuilderT GhcjsDomSpace t m ()
forall {k} (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT GhcjsDomSpace t m ())
-> (Element -> Node)
-> Element
-> HydrationDomBuilderT GhcjsDomSpace t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Node
forall o. IsNode o => o -> Node
toNode
wrapRawElement :: forall (er :: EventTag -> *).
RawElement
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> RawElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(Element
er (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)) t)
wrapRawElement RawElement
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
e RawElementConfig
er t (DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m))
rawCfg = do
events <- HydrationDomBuilderT
GhcjsDomSpace
t
m
(Chan [DSum (EventTriggerRef t) TriggerInvocation])
forall {k} (m :: * -> *) (s :: k) t.
Monad m =>
HydrationDomBuilderT
s t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])
askEvents
ctx <- askJSM
eventTriggerRefs <- wrap events e rawCfg
es <- newFanEventWithTrigger $ triggerBody ctx rawCfg events eventTriggerRefs e
pure $ Element es e
data FragmentState
= FragmentState_Unmounted
| FragmentState_Mounted (DOM.Text, DOM.Text)
data ImmediateDomFragment = ImmediateDomFragment
{ ImmediateDomFragment -> DocumentFragment
_immediateDomFragment_document :: DOM.DocumentFragment
, ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state :: IORef FragmentState
}
extractFragment :: MonadJSM m => ImmediateDomFragment -> m ()
ImmediateDomFragment
fragment = do
state <- IO FragmentState -> m FragmentState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FragmentState -> m FragmentState)
-> IO FragmentState -> m FragmentState
forall a b. (a -> b) -> a -> b
$ IORef FragmentState -> IO FragmentState
forall a. IORef a -> IO a
readIORef (IORef FragmentState -> IO FragmentState)
-> IORef FragmentState -> IO FragmentState
forall a b. (a -> b) -> a -> b
$ ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state ImmediateDomFragment
fragment
case state of
FragmentState
FragmentState_Unmounted -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
FragmentState_Mounted (Text
before, Text
after) -> do
DocumentFragment -> Text -> Text -> m ()
forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
DocumentFragment -> start -> end -> m ()
extractBetweenExclusive (ImmediateDomFragment -> DocumentFragment
_immediateDomFragment_document ImmediateDomFragment
fragment) Text
before Text
after
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef FragmentState -> FragmentState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state ImmediateDomFragment
fragment) FragmentState
FragmentState_Unmounted
instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomBuilderT GhcjsDomSpace t m) where
type DomFragment (HydrationDomBuilderT GhcjsDomSpace t m) = ImmediateDomFragment
buildDomFragment :: forall a.
HydrationDomBuilderT GhcjsDomSpace t m a
-> HydrationDomBuilderT
GhcjsDomSpace
t
m
(DomFragment (HydrationDomBuilderT GhcjsDomSpace t m), a)
buildDomFragment HydrationDomBuilderT GhcjsDomSpace t m a
w = do
df <- Document -> HydrationDomBuilderT GhcjsDomSpace t m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment (Document
-> HydrationDomBuilderT GhcjsDomSpace t m DocumentFragment)
-> HydrationDomBuilderT GhcjsDomSpace t m Document
-> HydrationDomBuilderT GhcjsDomSpace t m DocumentFragment
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HydrationDomBuilderT GhcjsDomSpace t m Document
HydrationDomBuilderT
GhcjsDomSpace
t
m
(RawDocument
(DomBuilderSpace (HydrationDomBuilderT GhcjsDomSpace t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
result <- flip localEnv w $ \HydrationDomBuilderEnv t m
env -> HydrationDomBuilderEnv t m
env
{ _hydrationDomBuilderEnv_parent = Left $ toNode df
}
state <- liftIO $ newIORef FragmentState_Unmounted
return (ImmediateDomFragment df state, result)
mountDomFragment :: DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
-> Event t (DomFragment (HydrationDomBuilderT GhcjsDomSpace t m))
-> HydrationDomBuilderT GhcjsDomSpace t m ()
mountDomFragment DomFragment (HydrationDomBuilderT GhcjsDomSpace t m)
fragment Event t (DomFragment (HydrationDomBuilderT GhcjsDomSpace t m))
setFragment = do
parent <- HydrationDomBuilderT GhcjsDomSpace t m Node
forall {k} (m :: * -> *) (s :: k) t.
MonadIO m =>
HydrationDomBuilderT s t m Node
getParent
extractFragment fragment
before <- textNodeImmediate $ TextNodeConfig ("" :: Text) Nothing
appendChild_ parent $ _immediateDomFragment_document fragment
after <- textNodeImmediate $ TextNodeConfig ("" :: Text) Nothing
xs <- foldDyn (\ImmediateDomFragment
new (ImmediateDomFragment
previous, Maybe ImmediateDomFragment
_) -> (ImmediateDomFragment
new, ImmediateDomFragment -> Maybe ImmediateDomFragment
forall a. a -> Maybe a
Just ImmediateDomFragment
previous)) (fragment, Nothing) setFragment
requestDomAction_ $ ffor (updated xs) $ \(ImmediateDomFragment
childFragment, Just ImmediateDomFragment
previousFragment) -> do
ImmediateDomFragment -> JSM ()
forall (m :: * -> *). MonadJSM m => ImmediateDomFragment -> m ()
extractFragment ImmediateDomFragment
previousFragment
ImmediateDomFragment -> JSM ()
forall (m :: * -> *). MonadJSM m => ImmediateDomFragment -> m ()
extractFragment ImmediateDomFragment
childFragment
DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
insertBefore (ImmediateDomFragment -> DocumentFragment
_immediateDomFragment_document ImmediateDomFragment
childFragment) Text
after
IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef FragmentState -> FragmentState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ImmediateDomFragment -> IORef FragmentState
_immediateDomFragment_state ImmediateDomFragment
childFragment) (FragmentState -> IO ()) -> FragmentState -> IO ()
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> FragmentState
FragmentState_Mounted (Text
before, Text
after)
liftIO $ writeIORef (_immediateDomFragment_state fragment) $ FragmentState_Mounted (before, after)
instance (Reflex t, Monad m, Adjustable t m, MonadHold t m, MonadFix m) => Adjustable t (DomRenderHookT t m) where
runWithReplace :: forall a b.
DomRenderHookT t m a
-> Event t (DomRenderHookT t m b)
-> DomRenderHookT t m (a, Event t b)
runWithReplace DomRenderHookT t m a
a0 Event t (DomRenderHookT t m b)
a' = RequesterT t JSM Identity (TriggerEventT t m) (a, Event t b)
-> DomRenderHookT t m (a, Event t b)
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) (a, Event t b)
-> DomRenderHookT t m (a, Event t b))
-> RequesterT t JSM Identity (TriggerEventT t m) (a, Event t b)
-> DomRenderHookT t m (a, Event t b)
forall a b. (a -> b) -> a -> b
$ RequesterT t JSM Identity (TriggerEventT t m) a
-> Event t (RequesterT t JSM Identity (TriggerEventT t m) b)
-> RequesterT t JSM Identity (TriggerEventT t m) (a, Event t b)
forall a b.
RequesterT t JSM Identity (TriggerEventT t m) a
-> Event t (RequesterT t JSM Identity (TriggerEventT t m) b)
-> RequesterT t JSM Identity (TriggerEventT t m) (a, Event t b)
forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace (DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT DomRenderHookT t m a
a0) ((DomRenderHookT t m b
-> RequesterT t JSM Identity (TriggerEventT t m) b)
-> Event t (DomRenderHookT t m b)
-> Event t (RequesterT t JSM Identity (TriggerEventT t m) b)
forall {k} (t :: k) a b.
Reflex t =>
(a -> b) -> Event t a -> Event t b
fmapCheap DomRenderHookT t m b
-> RequesterT t JSM Identity (TriggerEventT t m) b
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT Event t (DomRenderHookT t m b)
a')
traverseIntMapWithKeyWithAdjust :: forall v v'.
(Int -> v -> DomRenderHookT t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> DomRenderHookT t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust Int -> v -> DomRenderHookT t m v'
f IntMap v
m = RequesterT
t
JSM
Identity
(TriggerEventT t m)
(IntMap v', Event t (PatchIntMap v'))
-> DomRenderHookT t m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
t
JSM
Identity
(TriggerEventT t m)
(IntMap v', Event t (PatchIntMap v'))
-> DomRenderHookT t m (IntMap v', Event t (PatchIntMap v')))
-> (Event t (PatchIntMap v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(IntMap v', Event t (PatchIntMap v')))
-> Event t (PatchIntMap v)
-> DomRenderHookT t m (IntMap v', Event t (PatchIntMap v'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> v -> RequesterT t JSM Identity (TriggerEventT t m) v')
-> IntMap v
-> Event t (PatchIntMap v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(IntMap v', Event t (PatchIntMap v'))
forall v v'.
(Int -> v -> RequesterT t JSM Identity (TriggerEventT t m) v')
-> IntMap v
-> Event t (PatchIntMap v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Int -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust (\Int
k -> DomRenderHookT t m v'
-> RequesterT t JSM Identity (TriggerEventT t m) v'
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT (DomRenderHookT t m v'
-> RequesterT t JSM Identity (TriggerEventT t m) v')
-> (v -> DomRenderHookT t m v')
-> v
-> RequesterT t JSM Identity (TriggerEventT t m) v'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> v -> DomRenderHookT t m v'
f Int
k) IntMap v
m
traverseDMapWithKeyWithAdjust :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> DomRenderHookT t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust forall a. k a -> v a -> DomRenderHookT t m (v' a)
f DMap k v
m = RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMap k v'))
-> DomRenderHookT t m (DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMap k v'))
-> DomRenderHookT t m (DMap k v', Event t (PatchDMap k v')))
-> (Event t (PatchDMap k v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMap k v')))
-> Event t (PatchDMap k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMap k v'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
k a -> v a -> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMap k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a.
k a -> v a -> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust (\k a
k -> DomRenderHookT t m (v' a)
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a)
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT (DomRenderHookT t m (v' a)
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> (v a -> DomRenderHookT t m (v' a))
-> v a
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k a -> v a -> DomRenderHookT t m (v' a)
forall a. k a -> v a -> DomRenderHookT t m (v' a)
f k a
k) DMap k v
m
traverseDMapWithKeyWithAdjustWithMove :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> DomRenderHookT t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove forall a. k a -> v a -> DomRenderHookT t m (v' a)
f DMap k v
m = RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMapWithMove k v'))
-> DomRenderHookT t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMapWithMove k v'))
-> DomRenderHookT
t m (DMap k v', Event t (PatchDMapWithMove k v')))
-> (Event t (PatchDMapWithMove k v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMapWithMove k v')))
-> Event t (PatchDMapWithMove k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
k a -> v a -> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMapWithMove k v'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a.
k a -> v a -> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove (\k a
k -> DomRenderHookT t m (v' a)
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a)
forall t (m :: * -> *) a.
DomRenderHookT t m a
-> RequesterT t JSM Identity (TriggerEventT t m) a
unDomRenderHookT (DomRenderHookT t m (v' a)
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a))
-> (v a -> DomRenderHookT t m (v' a))
-> v a
-> RequesterT t JSM Identity (TriggerEventT t m) (v' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k a -> v a -> DomRenderHookT t m (v' a)
forall a. k a -> v a -> DomRenderHookT t m (v' a)
f k a
k) DMap k v
m
instance (Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => Adjustable t (HydrationDomBuilderT s t m) where
{-# INLINABLE runWithReplace #-}
runWithReplace :: forall a b.
HydrationDomBuilderT s t m a
-> Event t (HydrationDomBuilderT s t m b)
-> HydrationDomBuilderT s t m (a, Event t b)
runWithReplace HydrationDomBuilderT s t m a
a0 Event t (HydrationDomBuilderT s t m b)
a' = do
initialEnv <- ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(HydrationDomBuilderEnv t m)
-> HydrationDomBuilderT s t m (HydrationDomBuilderEnv t m)
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(HydrationDomBuilderEnv t m)
forall r (m :: * -> *). MonadReader r m => m r
ask
let hydrating = HydrationDomBuilderEnv t m -> IORef HydrationMode
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef HydrationMode
_hydrationDomBuilderEnv_hydrationMode HydrationDomBuilderEnv t m
initialEnv
(hydrateStart, before, beforeKey) <- skipToReplaceStart
let parentUnreadyChildren = HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren HydrationDomBuilderEnv t m
initialEnv
haveEverBeenReady <- liftIO $ newIORef False
currentCohort <- liftIO $ newIORef (-1 :: Int)
let myCommitAction = do
IO Bool -> JSM Bool
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
haveEverBeenReady) JSM Bool -> (Bool -> JSM ()) -> JSM ()
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> do
IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
old <- IO Word -> JSM Word
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> JSM Word) -> IO Word -> JSM Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
parentUnreadyChildren
let new = Word -> Word
forall a. Enum a => a -> a
pred Word
old
liftIO $ writeIORef parentUnreadyChildren $! new
when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
doc <- askDocument
parent <- getParent
(hydrateEnd, after) <- skipToReplaceEnd beforeKey
let drawInitialChild = do
h <- IO HydrationMode -> DomRenderHookT t m HydrationMode
forall a. IO a -> DomRenderHookT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HydrationMode -> DomRenderHookT t m HydrationMode)
-> IO HydrationMode -> DomRenderHookT t m HydrationMode
forall a b. (a -> b) -> a -> b
$ IORef HydrationMode -> IO HydrationMode
forall a. IORef a -> IO a
readIORef IORef HydrationMode
hydrating
p' <- case h of
HydrationMode
HydrationMode_Hydrating -> Node -> DomRenderHookT t m Node
forall a. a -> DomRenderHookT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
parent
HydrationMode
HydrationMode_Immediate -> DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode (DocumentFragment -> Node)
-> DomRenderHookT t m DocumentFragment -> DomRenderHookT t m Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Document -> DomRenderHookT t m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment Document
doc
unreadyChildren <- liftIO $ newIORef 0
let a0' = case HydrationMode
h of
HydrationMode
HydrationMode_Hydrating -> HydrationDomBuilderT s t m a
a0
HydrationMode
HydrationMode_Immediate -> do
a <- HydrationDomBuilderT s t m a
a0
insertBefore p' =<< liftIO (readIORef after)
pure a
delayed <- case h of
HydrationMode
HydrationMode_Hydrating -> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a. IO a -> DomRenderHookT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a. a -> IO (IORef a)
newIORef (HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ())))
-> HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall a. a -> HydrationRunnerT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
HydrationMode
HydrationMode_Immediate -> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a. a -> DomRenderHookT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed HydrationDomBuilderEnv t m
initialEnv
result <- runReaderT (unHydrationDomBuilderT a0') initialEnv
{ _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
, _hydrationDomBuilderEnv_commitAction = myCommitAction
, _hydrationDomBuilderEnv_parent = Left p'
, _hydrationDomBuilderEnv_delayed = delayed
}
dom <- case h of
HydrationMode
HydrationMode_Hydrating -> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a. IO a -> DomRenderHookT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ()))
-> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ IORef (HydrationRunnerT t m ()) -> IO (HydrationRunnerT t m ())
forall a. IORef a -> IO a
readIORef IORef (HydrationRunnerT t m ())
delayed
HydrationMode
HydrationMode_Immediate -> HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a. a -> DomRenderHookT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ()))
-> HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall a. a -> HydrationRunnerT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
liftIO $ readIORef unreadyChildren >>= \case
Word
0 -> IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
Word
_ -> IORef Word -> (Word -> Word) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Word
parentUnreadyChildren Word -> Word
forall a. Enum a => a -> a
succ
return (dom, result)
a'' <- numberOccurrences a'
((hydrate0, result0), child') <- HydrationDomBuilderT $ lift $ runWithReplace drawInitialChild $ ffor a'' $ \(Int
cohortId, HydrationDomBuilderT s t m b
child) -> do
h <- IO HydrationMode -> DomRenderHookT t m HydrationMode
forall a. IO a -> DomRenderHookT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HydrationMode -> DomRenderHookT t m HydrationMode)
-> IO HydrationMode -> DomRenderHookT t m HydrationMode
forall a b. (a -> b) -> a -> b
$ IORef HydrationMode -> IO HydrationMode
forall a. IORef a -> IO a
readIORef IORef HydrationMode
hydrating
p' <- case h of
HydrationMode
HydrationMode_Hydrating -> Node -> DomRenderHookT t m Node
forall a. a -> DomRenderHookT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
parent
HydrationMode
HydrationMode_Immediate -> DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode (DocumentFragment -> Node)
-> DomRenderHookT t m DocumentFragment -> DomRenderHookT t m Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Document -> DomRenderHookT t m DocumentFragment
forall (m :: * -> *) self.
(MonadDOM m, IsDocument self) =>
self -> m DocumentFragment
createDocumentFragment Document
doc
unreadyChildren <- liftIO $ newIORef 0
let commitAction = do
c <- IO Int -> JSM Int
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> JSM Int) -> IO Int -> JSM Int
forall a b. (a -> b) -> a -> b
$ IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
currentCohort
when (c <= cohortId) $ do
!before' <- liftIO $ readIORef before
!after' <- liftIO $ readIORef after
deleteBetweenExclusive before' after'
insertBefore p' after'
liftIO $ writeIORef currentCohort cohortId
myCommitAction
delayed <- case h of
HydrationMode
HydrationMode_Hydrating -> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a. IO a -> DomRenderHookT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a. a -> IO (IORef a)
newIORef (HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ())))
-> HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall a. a -> HydrationRunnerT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
HydrationMode
HydrationMode_Immediate -> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a. a -> DomRenderHookT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IORef (HydrationRunnerT t m ())
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
forall t (m :: * -> *).
HydrationDomBuilderEnv t m -> IORef (HydrationRunnerT t m ())
_hydrationDomBuilderEnv_delayed HydrationDomBuilderEnv t m
initialEnv
result <- runReaderT (unHydrationDomBuilderT child) $ initialEnv
{ _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
, _hydrationDomBuilderEnv_commitAction = case h of
HydrationMode
HydrationMode_Hydrating -> JSM ()
myCommitAction
HydrationMode
HydrationMode_Immediate -> JSM ()
commitAction
, _hydrationDomBuilderEnv_parent = Left p'
, _hydrationDomBuilderEnv_delayed = delayed
}
dom <- case h of
HydrationMode
HydrationMode_Hydrating -> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a. IO a -> DomRenderHookT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ()))
-> IO (HydrationRunnerT t m ())
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ IORef (HydrationRunnerT t m ()) -> IO (HydrationRunnerT t m ())
forall a. IORef a -> IO a
readIORef IORef (HydrationRunnerT t m ())
delayed
HydrationMode
HydrationMode_Immediate -> HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a. a -> DomRenderHookT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ()))
-> HydrationRunnerT t m ()
-> DomRenderHookT t m (HydrationRunnerT t m ())
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall a. a -> HydrationRunnerT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
uc <- liftIO $ readIORef unreadyChildren
let commitActionToRunNow = if Word
uc Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
then JSM () -> Maybe (JSM ())
forall a. a -> Maybe a
Just (JSM () -> Maybe (JSM ())) -> JSM () -> Maybe (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM ()
commitAction
else Maybe (JSM ())
forall a. Maybe a
Nothing
actions = case HydrationMode
h of
HydrationMode
HydrationMode_Hydrating -> HydrationRunnerT t m ()
-> Either (HydrationRunnerT t m ()) (Maybe (JSM ()))
forall a b. a -> Either a b
Left HydrationRunnerT t m ()
dom
HydrationMode
HydrationMode_Immediate -> Maybe (JSM ()) -> Either (HydrationRunnerT t m ()) (Maybe (JSM ()))
forall a b. b -> Either a b
Right Maybe (JSM ())
commitActionToRunNow
return (actions, result)
let (hydrate', commitAction) = fanEither $ fmap fst child'
addHydrationStepWithSetup (hold hydrate0 hydrate') $ \Behavior t (HydrationRunnerT t m ())
contents -> do
HydrationRunnerT t m ()
hydrateStart
HydrationRunnerT t m (HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (HydrationRunnerT t m (HydrationRunnerT t m ())
-> HydrationRunnerT t m ())
-> HydrationRunnerT t m (HydrationRunnerT t m ())
-> HydrationRunnerT t m ()
forall a b. (a -> b) -> a -> b
$ Behavior t (HydrationRunnerT t m ())
-> HydrationRunnerT t m (HydrationRunnerT t m ())
forall a. Behavior t a -> HydrationRunnerT t m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t (HydrationRunnerT t m ())
contents
HydrationRunnerT t m ()
hydrateEnd
requestDomAction_ $ fmapMaybe id commitAction
return (result0, snd <$> child')
{-# INLINABLE traverseIntMapWithKeyWithAdjust #-}
traverseIntMapWithKeyWithAdjust :: forall v v'.
(Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust = (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
forall {k} (s :: k) t (m :: * -> *) v v'.
(Adjustable t m, MonadJSM m, MonadFix m, PrimMonad m,
MonadHold t m,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
(Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust'
{-# INLINABLE traverseDMapWithKeyWithAdjust #-}
traverseDMapWithKeyWithAdjust :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust = (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
forall {k} (s :: k) t (m :: * -> *) (k :: * -> *) (v :: * -> *)
(v' :: * -> *).
(Adjustable t m, MonadHold t m, MonadFix m, MonadJSM m,
PrimMonad m, GCompare k,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
(forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust'
{-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}
traverseDMapWithKeyWithAdjustWithMove :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> HydrationDomBuilderT
s t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove = do
let updateChildUnreadiness :: PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness (PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p :: PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')) DMap k (Constant (IORef (ChildReadyState (Some k))))
old = do
let new :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseChild t m (Some k)) v') a -> IO (PatchDMapWithMove.NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
new :: forall a.
k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
new k a
k = (From k (Compose (TraverseChild t m (Some k)) v') a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
forall {k1} (f :: * -> *) (k2 :: k1 -> *) (v :: k1 -> *) (a :: k1)
(v' :: k1 -> *).
Functor f =>
(From k2 v a -> f (From k2 v' a))
-> NodeInfo k2 v a -> f (NodeInfo k2 v' a)
PatchDMapWithMove.nodeInfoMapFromM ((From k (Compose (TraverseChild t m (Some k)) v') a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a))
-> (From k (Compose (TraverseChild t m (Some k)) v') a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a b. (a -> b) -> a -> b
$ \case
PatchDMapWithMove.From_Insert (Compose (TraverseChild (Left TraverseChildHydration t m
_hydration) v' a
_)) -> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return From k (Constant (IORef (ChildReadyState (Some k)))) a
forall {a} (k :: a -> *) (v :: a -> *) (b :: a). From k v b
PatchDMapWithMove.From_Delete
PatchDMapWithMove.From_Insert (Compose (TraverseChild (Right TraverseChildImmediate (Some k)
immediate) v' a
_)) -> do
IORef (ChildReadyState (Some k)) -> IO (ChildReadyState (Some k))
forall a. IORef a -> IO a
readIORef (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate) IO (ChildReadyState (Some k))
-> (ChildReadyState (Some k)
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState (Some k)
ChildReadyState_Ready -> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return From k (Constant (IORef (ChildReadyState (Some k)))) a
forall {a} (k :: a -> *) (v :: a -> *) (b :: a). From k v b
PatchDMapWithMove.From_Delete
ChildReadyState_Unready Maybe (Some k)
_ -> do
IORef (ChildReadyState (Some k))
-> ChildReadyState (Some k) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate) (ChildReadyState (Some k) -> IO ())
-> ChildReadyState (Some k) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Some k) -> ChildReadyState (Some k)
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe (Some k) -> ChildReadyState (Some k))
-> Maybe (Some k) -> ChildReadyState (Some k)
forall a b. (a -> b) -> a -> b
$ Some k -> Maybe (Some k)
forall a. a -> Maybe a
Just (Some k -> Maybe (Some k)) -> Some k -> Maybe (Some k)
forall a b. (a -> b) -> a -> b
$ k a -> Some k
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k
From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a b. (a -> b) -> a -> b
$ Constant (IORef (ChildReadyState (Some k))) a
-> From k (Constant (IORef (ChildReadyState (Some k)))) a
forall {a} (v :: a -> *) (b :: a) (k :: a -> *). v b -> From k v b
PatchDMapWithMove.From_Insert (Constant (IORef (ChildReadyState (Some k))) a
-> From k (Constant (IORef (ChildReadyState (Some k)))) a)
-> Constant (IORef (ChildReadyState (Some k))) a
-> From k (Constant (IORef (ChildReadyState (Some k)))) a
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState (Some k))
-> Constant (IORef (ChildReadyState (Some k))) a
forall {k} a (b :: k). a -> Constant a b
Constant (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate)
From k (Compose (TraverseChild t m (Some k)) v') a
PatchDMapWithMove.From_Delete -> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return From k (Constant (IORef (ChildReadyState (Some k)))) a
forall {a} (k :: a -> *) (v :: a -> *) (b :: a). From k v b
PatchDMapWithMove.From_Delete
PatchDMapWithMove.From_Move k a
fromKey -> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a))
-> From k (Constant (IORef (ChildReadyState (Some k)))) a
-> IO (From k (Constant (IORef (ChildReadyState (Some k)))) a)
forall a b. (a -> b) -> a -> b
$ k a -> From k (Constant (IORef (ChildReadyState (Some k)))) a
forall {a} (k :: a -> *) (b :: a) (v :: a -> *). k b -> From k v b
PatchDMapWithMove.From_Move k a
fromKey
deleteOrMove :: forall a. k a -> Product (Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k) a -> IO (Constant () a)
deleteOrMove :: forall a.
k a
-> Product
(Constant (IORef (ChildReadyState (Some k)))) (ComposeMaybe k) a
-> IO (Constant () a)
deleteOrMove k a
_ (Pair (Constant IORef (ChildReadyState (Some k))
sRef) (ComposeMaybe Maybe (k a)
mToKey)) = do
IORef (ChildReadyState (Some k))
-> ChildReadyState (Some k) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState (Some k))
sRef (ChildReadyState (Some k) -> IO ())
-> ChildReadyState (Some k) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Some k) -> ChildReadyState (Some k)
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe (Some k) -> ChildReadyState (Some k))
-> Maybe (Some k) -> ChildReadyState (Some k)
forall a b. (a -> b) -> a -> b
$ k a -> Some k
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (k a -> Some k) -> Maybe (k a) -> Maybe (Some k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (k a)
mToKey
Constant () a -> IO (Constant () a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant () a -> IO (Constant () a))
-> Constant () a -> IO (Constant () a)
forall a b. (a -> b) -> a -> b
$ () -> Constant () a
forall {k} a (b :: k). a -> Constant a b
Constant ()
p' <- (DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))))
-> PatchDMapWithMove
k (Constant (IORef (ChildReadyState (Some k)))))
-> IO
(DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
(PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))))
-> PatchDMapWithMove
k (Constant (IORef (ChildReadyState (Some k))))
forall {k1} (k2 :: k1 -> *) (v :: k1 -> *).
DMap k2 (NodeInfo k2 v) -> PatchDMapWithMove k2 v
unsafePatchDMapWithMove (IO
(DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
(PatchDMapWithMove
k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
(DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
(PatchDMapWithMove k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ (forall a.
k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a))
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
forall {k1} (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
(g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey k v
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') v
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) v)
forall a.
k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> IO (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))) a)
new (DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap
k (NodeInfo k (Constant (IORef (ChildReadyState (Some k)))))))
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap k (NodeInfo k (Constant (IORef (ChildReadyState (Some k))))))
forall a b. (a -> b) -> a -> b
$ PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
forall {k1} (k2 :: k1 -> *) (v :: k1 -> *).
PatchDMapWithMove k2 v -> DMap k2 (NodeInfo k2 v)
unPatchDMapWithMove PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p
_ <- DMap.traverseWithKey deleteOrMove $ PatchDMapWithMove.getDeletionsAndMoves p old
return $ applyAlways p' old
(forall (vv :: * -> *) (vv' :: * -> *).
(forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (PatchDMapWithMove k vv)
-> DomRenderHookT
t m (DMap k vv', Event t (PatchDMapWithMove k vv')))
-> (forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a)
-> PatchDMapWithMove k vv -> PatchDMapWithMove k vv')
-> (PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
-> Text
-> PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> HydrationDomBuilderT
s t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall {k} {k} t (m :: * -> *) (k :: k -> *)
(p :: (k -> *) -> (k -> *) -> *) (v :: k -> *) (v' :: k -> *)
(s :: k).
(Adjustable t m, MonadHold t m, GCompare k, MonadIO m, MonadJSM m,
PrimMonad m, MonadFix m, Patch (p k v), Patch (p k (Constant Int)),
PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int),
Patch (p k (Compose (TraverseChild t m (Some k)) v')),
PatchTarget (p k (Compose (TraverseChild t m (Some k)) v'))
~ DMap k (Compose (TraverseChild t m (Some k)) v'),
Monoid (p k (Compose (TraverseChild t m (Some k)) v')),
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
(forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
-> (forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv')
-> (p k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
-> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> (forall (a :: k).
k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (p k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (p k v'))
hoistTraverseWithKeyWithAdjust (forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (PatchDMapWithMove k vv)
-> DomRenderHookT
t m (DMap k vv', Event t (PatchDMapWithMove k vv'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (PatchDMapWithMove k vv)
-> DomRenderHookT
t m (DMap k vv', Event t (PatchDMapWithMove k vv'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> DomRenderHookT t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove (forall a. vv a -> vv' a)
-> PatchDMapWithMove k vv -> PatchDMapWithMove k vv'
forall {k1} (k2 :: k1 -> *) (v :: k1 -> *) (v' :: k1 -> *).
(forall (a :: k1). v a -> v' a)
-> PatchDMapWithMove k2 v -> PatchDMapWithMove k2 v'
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a)
-> PatchDMapWithMove k vv -> PatchDMapWithMove k vv'
mapPatchDMapWithMove PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness ((IORef (Map (Some k) Text)
-> Text
-> PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> HydrationDomBuilderT
s t m (DMap k v', Event t (PatchDMapWithMove k v')))
-> (IORef (Map (Some k) Text)
-> Text
-> PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> HydrationDomBuilderT
s t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall a b. (a -> b) -> a -> b
$ \IORef (Map (Some k) Text)
placeholders Text
lastPlaceholder (PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p_ :: PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')) -> do
let p :: DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
p = PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (NodeInfo k (Compose (TraverseChild t m (Some k)) v'))
forall {k1} (k2 :: k1 -> *) (v :: k1 -> *).
PatchDMapWithMove k2 v -> DMap k2 (NodeInfo k2 v)
unPatchDMapWithMove PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p_
phsBefore <- IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map (Some k) Text) -> JSM (Map (Some k) Text))
-> IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> IO (Map (Some k) Text)
forall a. IORef a -> IO a
readIORef IORef (Map (Some k) Text)
placeholders
let collectIfMoved :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseChild t m (Some k)) v') a -> JSM (Constant (Maybe DOM.DocumentFragment) a)
collectIfMoved k a
k NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
e = do
let mThisPlaceholder :: Maybe Text
mThisPlaceholder = Some k -> Map (Some k) Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (k a -> Some k
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k) Map (Some k) Text
phsBefore
nextPlaceholder :: Text
nextPlaceholder = Text -> ((Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
lastPlaceholder (Some k, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Some k -> Map (Some k) Text -> Maybe (Some k, Text)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGT (k a -> Some k
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k) Map (Some k) Text
phsBefore
case Maybe (k a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (k a) -> Bool) -> Maybe (k a) -> Bool
forall a b. (a -> b) -> a -> b
$ ComposeMaybe k a -> Maybe (k a)
forall {k} (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe (ComposeMaybe k a -> Maybe (k a))
-> ComposeMaybe k a -> Maybe (k a)
forall a b. (a -> b) -> a -> b
$ NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> ComposeMaybe k a
forall {k1} (k2 :: k1 -> *) (v :: k1 -> *) (a :: k1).
NodeInfo k2 v a -> To k2 a
PatchDMapWithMove._nodeInfo_to NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
e of
Bool
False -> do
(Text -> JSM ()) -> Maybe Text -> JSM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`deleteUpTo` Text
nextPlaceholder) Maybe Text
mThisPlaceholder
Constant (Maybe DocumentFragment) a
-> JSM (Constant (Maybe DocumentFragment) a)
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant (Maybe DocumentFragment) a
-> JSM (Constant (Maybe DocumentFragment) a))
-> Constant (Maybe DocumentFragment) a
-> JSM (Constant (Maybe DocumentFragment) a)
forall a b. (a -> b) -> a -> b
$ Maybe DocumentFragment -> Constant (Maybe DocumentFragment) a
forall {k} a (b :: k). a -> Constant a b
Constant Maybe DocumentFragment
forall a. Maybe a
Nothing
Bool
True -> do
Maybe DocumentFragment -> Constant (Maybe DocumentFragment) a
forall {k} a (b :: k). a -> Constant a b
Constant (Maybe DocumentFragment -> Constant (Maybe DocumentFragment) a)
-> JSM (Maybe DocumentFragment)
-> JSM (Constant (Maybe DocumentFragment) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> JSM DocumentFragment)
-> Maybe Text -> JSM (Maybe DocumentFragment)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Text -> Text -> JSM DocumentFragment
forall (m :: * -> *) start end.
(MonadJSM m, IsNode start, IsNode end) =>
start -> end -> m DocumentFragment
`collectUpTo` Text
nextPlaceholder) Maybe Text
mThisPlaceholder
collected <- DMap.traverseWithKey collectIfMoved p
let !phsAfter = Map (Some k) Text -> Maybe (Map (Some k) Text) -> Map (Some k) Text
forall a. a -> Maybe a -> a
fromMaybe Map (Some k) Text
phsBefore (Maybe (Map (Some k) Text) -> Map (Some k) Text)
-> Maybe (Map (Some k) Text) -> Map (Some k) Text
forall a b. (a -> b) -> a -> b
$ PatchMapWithMove (Some k) Text
-> PatchTarget (PatchMapWithMove (Some k) Text)
-> Maybe (PatchTarget (PatchMapWithMove (Some k) Text))
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply PatchMapWithMove (Some k) Text
filtered Map (Some k) Text
PatchTarget (PatchMapWithMove (Some k) Text)
phsBefore
weakened :: PatchMapWithMove (Some k) (Either (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened = (forall a.
Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
-> PatchMapWithMove
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
forall {k1} (k2 :: k1 -> *) (v :: k1 -> *) v'.
(forall (a :: k1). v a -> v')
-> PatchDMapWithMove k2 v -> PatchMapWithMove (Some k2) v'
weakenPatchDMapWithMoveWith (TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode (TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> (Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) PatchDMapWithMove k (Compose (TraverseChild t m (Some k)) v')
p_
filtered :: PatchMapWithMove (Some k) DOM.Text
filtered = Map (Some k) (NodeInfo (Some k) Text)
-> PatchMapWithMove (Some k) Text
forall k v. Map k (NodeInfo k v) -> PatchMapWithMove k v
PatchMapWithMove (Map (Some k) (NodeInfo (Some k) Text)
-> PatchMapWithMove (Some k) Text)
-> Map (Some k) (NodeInfo (Some k) Text)
-> PatchMapWithMove (Some k) Text
forall a b. (a -> b) -> a -> b
$ ((NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (NodeInfo (Some k) Text))
-> Map
(Some k)
(NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> Map (Some k) (NodeInfo (Some k) Text))
-> Map
(Some k)
(NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> (NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (NodeInfo (Some k) Text))
-> Map (Some k) (NodeInfo (Some k) Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (NodeInfo (Some k) Text))
-> Map
(Some k)
(NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> Map (Some k) (NodeInfo (Some k) Text)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (PatchMapWithMove
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Map
(Some k)
(NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
forall k v. PatchMapWithMove k v -> Map k (NodeInfo k v)
unPatchMapWithMove PatchMapWithMove
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened) ((NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (NodeInfo (Some k) Text))
-> Map (Some k) (NodeInfo (Some k) Text))
-> (NodeInfo
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (NodeInfo (Some k) Text))
-> Map (Some k) (NodeInfo (Some k) Text)
forall a b. (a -> b) -> a -> b
$ \(PatchMapWithMove.NodeInfo From
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
from Maybe (Some k)
to) -> (From (Some k) Text -> Maybe (Some k) -> NodeInfo (Some k) Text)
-> Maybe (Some k) -> From (Some k) Text -> NodeInfo (Some k) Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip From (Some k) Text -> Maybe (Some k) -> NodeInfo (Some k) Text
forall k v. From k v -> To k -> NodeInfo k v
PatchMapWithMove.NodeInfo Maybe (Some k)
to (From (Some k) Text -> NodeInfo (Some k) Text)
-> Maybe (From (Some k) Text) -> Maybe (NodeInfo (Some k) Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case From
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
from of
PatchMapWithMove.From_Insert (Left TraverseChildHydration t m
_hydration) -> Maybe (From (Some k) Text)
forall a. Maybe a
Nothing
PatchMapWithMove.From_Insert (Right TraverseChildImmediate (Some k)
immediate) -> From (Some k) Text -> Maybe (From (Some k) Text)
forall a. a -> Maybe a
Just (From (Some k) Text -> Maybe (From (Some k) Text))
-> From (Some k) Text -> Maybe (From (Some k) Text)
forall a b. (a -> b) -> a -> b
$ Text -> From (Some k) Text
forall v k. v -> From k v
PatchMapWithMove.From_Insert (Text -> From (Some k) Text) -> Text -> From (Some k) Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate (Some k) -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate (Some k)
immediate
From
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
PatchMapWithMove.From_Delete -> From (Some k) Text -> Maybe (From (Some k) Text)
forall a. a -> Maybe a
Just (From (Some k) Text -> Maybe (From (Some k) Text))
-> From (Some k) Text -> Maybe (From (Some k) Text)
forall a b. (a -> b) -> a -> b
$ From (Some k) Text
forall k v. From k v
PatchMapWithMove.From_Delete
PatchMapWithMove.From_Move Some k
k -> From (Some k) Text -> Maybe (From (Some k) Text)
forall a. a -> Maybe a
Just (From (Some k) Text -> Maybe (From (Some k) Text))
-> From (Some k) Text -> Maybe (From (Some k) Text)
forall a b. (a -> b) -> a -> b
$ Some k -> From (Some k) Text
forall k v. k -> From k v
PatchMapWithMove.From_Move Some k
k
let placeFragment :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Compose (TraverseChild t m (Some k)) v') a -> JSM (Constant () a)
placeFragment k a
k NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
e = do
let nextPlaceholder :: Text
nextPlaceholder = Text -> ((Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
lastPlaceholder (Some k, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Some k -> Map (Some k) Text -> Maybe (Some k, Text)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGT (k a -> Some k
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k) Map (Some k) Text
phsAfter
case NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> From k (Compose (TraverseChild t m (Some k)) v') a
forall {k1} (k2 :: k1 -> *) (v :: k1 -> *) (a :: k1).
NodeInfo k2 v a -> From k2 v a
PatchDMapWithMove._nodeInfo_from NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
e of
PatchDMapWithMove.From_Insert (Compose (TraverseChild Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
x v' a
_)) -> case Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
x of
Left TraverseChildHydration t m
_ -> () -> JSM ()
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Right TraverseChildImmediate (Some k)
immediate -> TraverseChildImmediate (Some k) -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate (Some k)
immediate DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`insertBefore` Text
nextPlaceholder
From k (Compose (TraverseChild t m (Some k)) v') a
PatchDMapWithMove.From_Delete -> do
() -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
PatchDMapWithMove.From_Move k a
fromKey -> do
Just (Constant mdf) <- Maybe (Constant (Maybe DocumentFragment) a)
-> JSM (Maybe (Constant (Maybe DocumentFragment) a))
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Constant (Maybe DocumentFragment) a)
-> JSM (Maybe (Constant (Maybe DocumentFragment) a)))
-> Maybe (Constant (Maybe DocumentFragment) a)
-> JSM (Maybe (Constant (Maybe DocumentFragment) a))
forall a b. (a -> b) -> a -> b
$ k a
-> DMap k (Constant (Maybe DocumentFragment))
-> Maybe (Constant (Maybe DocumentFragment) a)
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup k a
fromKey DMap k (Constant (Maybe DocumentFragment))
collected
mapM_ (`insertBefore` nextPlaceholder) mdf
Constant () a -> JSM (Constant () a)
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant () a -> JSM (Constant () a))
-> Constant () a -> JSM (Constant () a)
forall a b. (a -> b) -> a -> b
$ () -> Constant () a
forall {k} a (b :: k). a -> Constant a b
Constant ()
mapM_ (\(k a
k :=> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
v) -> JSM (Constant () a) -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM (Constant () a) -> JSM ()) -> JSM (Constant () a) -> JSM ()
forall a b. (a -> b) -> a -> b
$ k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> JSM (Constant () a)
forall a.
k a
-> NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
-> JSM (Constant () a)
placeFragment k a
k NodeInfo k (Compose (TraverseChild t m (Some k)) v') a
v) $ DMap.toDescList p
liftIO $ writeIORef placeholders $! phsAfter
{-# INLINABLE traverseDMapWithKeyWithAdjust' #-}
traverseDMapWithKeyWithAdjust'
:: forall s t m (k :: Type -> Type) v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadJSM m, PrimMonad m, GCompare k, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)
=> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust' :: forall {k} (s :: k) t (m :: * -> *) (k :: * -> *) (v :: * -> *)
(v' :: * -> *).
(Adjustable t m, MonadHold t m, MonadFix m, MonadJSM m,
PrimMonad m, GCompare k,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
(forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust' = do
let updateChildUnreadiness :: PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness (PatchDMap k (Compose (TraverseChild t m (Some k)) v')
p :: PatchDMap k (Compose (TraverseChild t m (Some k)) v')) DMap k (Constant (IORef (ChildReadyState (Some k))))
old = do
let new :: forall a. k a -> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') a -> IO (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
new :: forall a.
k a
-> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') a
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
new k a
k (ComposeMaybe Maybe (Compose (TraverseChild t m (Some k)) v' a)
m) = Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a
forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe (Compose (TraverseChild t m (Some k)) v' a)
m of
Maybe (Compose (TraverseChild t m (Some k)) v' a)
Nothing -> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a. Maybe a
Nothing
Just (Compose (TraverseChild (Left TraverseChildHydration t m
_hydration) v' a
_)) -> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a. Maybe a
Nothing
Just (Compose (TraverseChild (Right TraverseChildImmediate (Some k)
immediate) v' a
_)) -> do
IORef (ChildReadyState (Some k)) -> IO (ChildReadyState (Some k))
forall a. IORef a -> IO a
readIORef (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate) IO (ChildReadyState (Some k))
-> (ChildReadyState (Some k)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a)))
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState (Some k)
ChildReadyState_Ready -> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a. Maybe a
Nothing
ChildReadyState_Unready Maybe (Some k)
_ -> do
IORef (ChildReadyState (Some k))
-> ChildReadyState (Some k) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate) (ChildReadyState (Some k) -> IO ())
-> ChildReadyState (Some k) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Some k) -> ChildReadyState (Some k)
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe (Some k) -> ChildReadyState (Some k))
-> Maybe (Some k) -> ChildReadyState (Some k)
forall a b. (a -> b) -> a -> b
$ Some k -> Maybe (Some k)
forall a. a -> Maybe a
Just (Some k -> Maybe (Some k)) -> Some k -> Maybe (Some k)
forall a b. (a -> b) -> a -> b
$ k a -> Some k
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k
Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a)))
-> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some k))) a))
forall a b. (a -> b) -> a -> b
$ Constant (IORef (ChildReadyState (Some k))) a
-> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a. a -> Maybe a
Just (Constant (IORef (ChildReadyState (Some k))) a
-> Maybe (Constant (IORef (ChildReadyState (Some k))) a))
-> Constant (IORef (ChildReadyState (Some k))) a
-> Maybe (Constant (IORef (ChildReadyState (Some k))) a)
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState (Some k))
-> Constant (IORef (ChildReadyState (Some k))) a
forall {k} a (b :: k). a -> Constant a b
Constant (TraverseChildImmediate (Some k) -> IORef (ChildReadyState (Some k))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some k)
immediate)
delete :: p -> Constant (IORef (ChildReadyState a)) b -> IO (Constant () b)
delete p
_ (Constant IORef (ChildReadyState a)
sRef) = do
IORef (ChildReadyState a) -> ChildReadyState a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState a)
sRef (ChildReadyState a -> IO ()) -> ChildReadyState a -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe a -> ChildReadyState a
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready Maybe a
forall a. Maybe a
Nothing
Constant () b -> IO (Constant () b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant () b -> IO (Constant () b))
-> Constant () b -> IO (Constant () b)
forall a b. (a -> b) -> a -> b
$ () -> Constant () b
forall {k} a (b :: k). a -> Constant a b
Constant ()
p' <- (DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))))
-> PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
-> IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
-> IO (PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DMap k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))))
-> PatchDMap k (Constant (IORef (ChildReadyState (Some k))))
forall {k} (k1 :: k -> *) (v :: k -> *).
DMap k1 (ComposeMaybe v) -> PatchDMap k1 v
PatchDMap (IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
-> IO (PatchDMap k (Constant (IORef (ChildReadyState (Some k))))))
-> IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
-> IO (PatchDMap k (Constant (IORef (ChildReadyState (Some k)))))
forall a b. (a -> b) -> a -> b
$ (forall a.
k a
-> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') a
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a))
-> DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
forall {k1} (t :: * -> *) (k2 :: k1 -> *) (f :: k1 -> *)
(g :: k1 -> *).
Applicative t =>
(forall (v :: k1). k2 v -> f v -> t (g v))
-> DMap k2 f -> t (DMap k2 g)
DMap.traverseWithKey k v
-> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') v
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v)
forall a.
k a
-> ComposeMaybe (Compose (TraverseChild t m (Some k)) v') a
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) a)
new (DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))))))
-> DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap
k (ComposeMaybe (Constant (IORef (ChildReadyState (Some k))))))
forall a b. (a -> b) -> a -> b
$ PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
forall {k1} (k2 :: k1 -> *) (v :: k1 -> *).
PatchDMap k2 v -> DMap k2 (ComposeMaybe v)
unPatchDMap PatchDMap k (Compose (TraverseChild t m (Some k)) v')
p
_ <- DMap.traverseWithKey delete $ PatchDMap.getDeletions p old
return $ applyAlways p' old
(forall (vv :: * -> *) (vv' :: * -> *).
(forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (PatchDMap k vv)
-> DomRenderHookT t m (DMap k vv', Event t (PatchDMap k vv')))
-> (forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a) -> PatchDMap k vv -> PatchDMap k vv')
-> (PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
-> Text
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
forall {k} {k} t (m :: * -> *) (k :: k -> *)
(p :: (k -> *) -> (k -> *) -> *) (v :: k -> *) (v' :: k -> *)
(s :: k).
(Adjustable t m, MonadHold t m, GCompare k, MonadIO m, MonadJSM m,
PrimMonad m, MonadFix m, Patch (p k v), Patch (p k (Constant Int)),
PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int),
Patch (p k (Compose (TraverseChild t m (Some k)) v')),
PatchTarget (p k (Compose (TraverseChild t m (Some k)) v'))
~ DMap k (Compose (TraverseChild t m (Some k)) v'),
Monoid (p k (Compose (TraverseChild t m (Some k)) v')),
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
(forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
-> (forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv')
-> (p k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
-> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> (forall (a :: k).
k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (p k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (p k v'))
hoistTraverseWithKeyWithAdjust (forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (PatchDMap k vv)
-> DomRenderHookT t m (DMap k vv', Event t (PatchDMap k vv'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (PatchDMap k vv)
-> DomRenderHookT t m (DMap k vv', Event t (PatchDMap k vv'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> DomRenderHookT t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> DomRenderHookT t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust (forall a. vv a -> vv' a) -> PatchDMap k vv -> PatchDMap k vv'
forall {k1} (v :: k1 -> *) (v' :: k1 -> *) (k2 :: k1 -> *).
(forall (a :: k1). v a -> v' a)
-> PatchDMap k2 v -> PatchDMap k2 v'
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a) -> PatchDMap k vv -> PatchDMap k vv'
mapPatchDMap PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness ((IORef (Map (Some k) Text)
-> Text
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT
s t m (DMap k v', Event t (PatchDMap k v')))
-> (IORef (Map (Some k) Text)
-> Text
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> JSM ())
-> (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (PatchDMap k v'))
forall a b. (a -> b) -> a -> b
$ \IORef (Map (Some k) Text)
placeholders Text
lastPlaceholder (PatchDMap DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
patch) -> do
phs <- IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map (Some k) Text) -> JSM (Map (Some k) Text))
-> IO (Map (Some k) Text) -> JSM (Map (Some k) Text)
forall a b. (a -> b) -> a -> b
$ IORef (Map (Some k) Text) -> IO (Map (Some k) Text)
forall a. IORef a -> IO a
readIORef IORef (Map (Some k) Text)
placeholders
forM_ (DMap.toList patch) $ \(k a
k :=> ComposeMaybe Maybe (Compose (TraverseChild t m (Some k)) v' a)
mv) -> do
let nextPlaceholder :: Text
nextPlaceholder = Text -> ((Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
lastPlaceholder (Some k, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Some k, Text) -> Text) -> Maybe (Some k, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Some k -> Map (Some k) Text -> Maybe (Some k, Text)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGT (k a -> Some k
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k) Map (Some k) Text
phs
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 a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Right TraverseChildImmediate (Some k)
immediate -> do
TraverseChildImmediate (Some k) -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate (Some k)
immediate DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`insertBefore` Text
nextPlaceholder
let weakened :: PatchMap (Some k) (Either (TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened = (forall a.
Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> PatchMap
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
forall {k1} (v :: k1 -> *) v' (k2 :: k1 -> *).
(forall (a :: k1). v a -> v')
-> PatchDMap k2 v -> PatchMap (Some k2) v'
weakenPatchDMapWith (TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode (TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> (Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) (PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> PatchMap
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
-> PatchMap
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
forall a b. (a -> b) -> a -> b
$ DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
-> PatchDMap k (Compose (TraverseChild t m (Some k)) v')
forall {k} (k1 :: k -> *) (v :: k -> *).
DMap k1 (ComposeMaybe v) -> PatchDMap k1 v
PatchDMap DMap k (ComposeMaybe (Compose (TraverseChild t m (Some k)) v'))
patch
filtered :: PatchMap (Some k) DOM.Text
filtered = Map (Some k) (Maybe Text) -> PatchMap (Some k) Text
forall k v. Map k (Maybe v) -> PatchMap k v
PatchMap (Map (Some k) (Maybe Text) -> PatchMap (Some k) Text)
-> Map (Some k) (Maybe Text) -> PatchMap (Some k) Text
forall a b. (a -> b) -> a -> b
$ ((Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (Maybe Text))
-> Map
(Some k)
(Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> Map (Some k) (Maybe Text))
-> Map
(Some k)
(Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> (Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (Maybe Text))
-> Map (Some k) (Maybe Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (Maybe Text))
-> Map
(Some k)
(Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
-> Map (Some k) (Maybe Text)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (PatchMap
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Map
(Some k)
(Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))))
forall k v. PatchMap k v -> Map k (Maybe v)
unPatchMap PatchMap
(Some k)
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
weakened) ((Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (Maybe Text))
-> Map (Some k) (Maybe Text))
-> (Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Maybe (Maybe Text))
-> Map (Some k) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \case
Maybe
(Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
Nothing -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
forall a. Maybe a
Nothing
Just (Left TraverseChildHydration t m
_) -> Maybe (Maybe Text)
forall a. Maybe a
Nothing
Just (Right TraverseChildImmediate (Some k)
immediate) -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Maybe Text -> Maybe (Maybe Text))
-> Maybe Text -> Maybe (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate (Some k) -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate (Some k)
immediate
liftIO $ writeIORef placeholders $! fromMaybe phs $ apply filtered phs
{-# INLINABLE traverseIntMapWithKeyWithAdjust' #-}
traverseIntMapWithKeyWithAdjust'
:: forall s t m v v'. (Adjustable t m, MonadJSM m, MonadFix m, PrimMonad m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)
=> (IntMap.Key -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust' :: forall {k} (s :: k) t (m :: * -> *) v v'.
(Adjustable t m, MonadJSM m, MonadFix m, PrimMonad m,
MonadHold t m,
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
(Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust' = do
let updateChildUnreadiness :: PatchIntMap (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
updateChildUnreadiness (p :: PatchIntMap (TraverseChild t m Int v')
p@(PatchIntMap IntMap (Maybe (TraverseChild t m Int v'))
pInner) :: PatchIntMap (TraverseChild t m Int v')) IntMap (IORef (ChildReadyState Int))
old = do
let new :: IntMap.Key -> Maybe (TraverseChild t m Int v') -> IO (Maybe (IORef (ChildReadyState Int)))
new :: Int
-> Maybe (TraverseChild t m Int v')
-> IO (Maybe (IORef (ChildReadyState Int)))
new Int
k Maybe (TraverseChild t m Int v')
m = case Maybe (TraverseChild t m Int v')
m of
Maybe (TraverseChild t m Int v')
Nothing -> Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IORef (ChildReadyState Int))
forall a. Maybe a
Nothing
Just (TraverseChild (Left TraverseChildHydration t m
_hydration) v'
_) -> Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (IORef (ChildReadyState Int))
forall a. Maybe a
Nothing
Just (TraverseChild (Right TraverseChildImmediate Int
immediate) v'
_) -> do
let sRef :: IORef (ChildReadyState Int)
sRef = TraverseChildImmediate Int -> IORef (ChildReadyState Int)
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate Int
immediate
IORef (ChildReadyState Int) -> IO (ChildReadyState Int)
forall a. IORef a -> IO a
readIORef IORef (ChildReadyState Int)
sRef IO (ChildReadyState Int)
-> (ChildReadyState Int
-> IO (Maybe (IORef (ChildReadyState Int))))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState Int
ChildReadyState_Ready -> Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IORef (ChildReadyState Int))
forall a. Maybe a
Nothing
ChildReadyState_Unready Maybe Int
_ -> do
IORef (ChildReadyState Int) -> ChildReadyState Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState Int)
sRef (ChildReadyState Int -> IO ()) -> ChildReadyState Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Int -> ChildReadyState Int
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe Int -> ChildReadyState Int)
-> Maybe Int -> ChildReadyState Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
k
Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int))))
-> Maybe (IORef (ChildReadyState Int))
-> IO (Maybe (IORef (ChildReadyState Int)))
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState Int) -> Maybe (IORef (ChildReadyState Int))
forall a. a -> Maybe a
Just IORef (ChildReadyState Int)
sRef
delete :: p -> IORef (ChildReadyState a) -> IO ()
delete p
_ IORef (ChildReadyState a)
sRef = do
IORef (ChildReadyState a) -> ChildReadyState a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState a)
sRef (ChildReadyState a -> IO ()) -> ChildReadyState a -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe a -> ChildReadyState a
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready Maybe a
forall a. Maybe a
Nothing
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
p' <- IntMap (Maybe (IORef (ChildReadyState Int)))
-> PatchIntMap (IORef (ChildReadyState Int))
forall a. IntMap (Maybe a) -> PatchIntMap a
PatchIntMap (IntMap (Maybe (IORef (ChildReadyState Int)))
-> PatchIntMap (IORef (ChildReadyState Int)))
-> IO (IntMap (Maybe (IORef (ChildReadyState Int))))
-> IO (PatchIntMap (IORef (ChildReadyState Int)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int
-> Maybe (TraverseChild t m Int v')
-> IO (Maybe (IORef (ChildReadyState Int))))
-> IntMap (Maybe (TraverseChild t m Int v'))
-> IO (IntMap (Maybe (IORef (ChildReadyState Int))))
forall (t :: * -> *) a b.
Applicative t =>
(Int -> a -> t b) -> IntMap a -> t (IntMap b)
IntMap.traverseWithKey Int
-> Maybe (TraverseChild t m Int v')
-> IO (Maybe (IORef (ChildReadyState Int)))
new IntMap (Maybe (TraverseChild t m Int v'))
pInner
_ <- IntMap.traverseWithKey delete $ FastMutableIntMap.getDeletions p old
return $ applyAlways p' old
((Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (PatchIntMap v)
-> DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (PatchIntMap (TraverseChild t m Int v'))))
-> (PatchIntMap (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap Text)
-> Text -> PatchIntMap (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
forall {k} t (m :: * -> *) (p :: * -> *) v' (s :: k) v.
(Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m,
PrimMonad m, Monoid (p (TraverseChild t m Int v')), Functor p,
PatchTarget (p (HydrationRunnerT t m ()))
~ IntMap (HydrationRunnerT t m ()),
PatchTarget (p (TraverseChild t m Int v'))
~ IntMap (TraverseChild t m Int v'),
Patch (p (HydrationRunnerT t m ())),
Patch (p (TraverseChild t m Int v')),
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
((Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (p v)
-> DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v'))))
-> (p (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap Text)
-> Text -> p (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (p v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (p v'))
hoistTraverseIntMapWithKeyWithAdjust (Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (PatchIntMap v)
-> DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (PatchIntMap (TraverseChild t m Int v')))
forall v v'.
(Int -> v -> DomRenderHookT t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> DomRenderHookT t m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Int -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust PatchIntMap (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
updateChildUnreadiness ((IORef (IntMap Text)
-> Text -> PatchIntMap (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT
s t m (IntMap v', Event t (PatchIntMap v')))
-> (IORef (IntMap Text)
-> Text -> PatchIntMap (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (PatchIntMap v'))
forall a b. (a -> b) -> a -> b
$ \IORef (IntMap Text)
placeholders Text
lastPlaceholder (PatchIntMap IntMap (Maybe (TraverseChild t m Int v'))
p) -> do
phs <- IO (IntMap Text) -> JSM (IntMap Text)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IntMap Text) -> JSM (IntMap Text))
-> IO (IntMap Text) -> JSM (IntMap Text)
forall a b. (a -> b) -> a -> b
$ IORef (IntMap Text) -> IO (IntMap Text)
forall a. IORef a -> IO a
readIORef IORef (IntMap Text)
placeholders
forM_ (IntMap.toList p) $ \(Int
k, Maybe (TraverseChild t m Int v')
mv) -> do
let nextPlaceholder :: Text
nextPlaceholder = Text -> ((Int, Text) -> Text) -> Maybe (Int, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
lastPlaceholder (Int, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Int, Text) -> Text) -> Maybe (Int, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Int -> IntMap Text -> Maybe (Int, Text)
forall a. Int -> IntMap a -> Maybe (Int, a)
IntMap.lookupGT Int
k IntMap Text
phs
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 a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Right TraverseChildImmediate Int
immediate -> do
TraverseChildImmediate Int -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate Int
immediate DocumentFragment -> Text -> JSM ()
forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
`insertBefore` Text
nextPlaceholder
let filtered :: PatchIntMap DOM.Text
filtered = IntMap (Maybe Text) -> PatchIntMap Text
forall a. IntMap (Maybe a) -> PatchIntMap a
PatchIntMap (IntMap (Maybe Text) -> PatchIntMap Text)
-> IntMap (Maybe Text) -> PatchIntMap Text
forall a b. (a -> b) -> a -> b
$ ((Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
-> IntMap (Maybe (TraverseChild t m Int v'))
-> IntMap (Maybe Text))
-> IntMap (Maybe (TraverseChild t m Int v'))
-> (Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
-> IntMap (Maybe Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
-> IntMap (Maybe (TraverseChild t m Int v')) -> IntMap (Maybe Text)
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe IntMap (Maybe (TraverseChild t m Int v'))
p ((Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
-> IntMap (Maybe Text))
-> (Maybe (TraverseChild t m Int v') -> Maybe (Maybe Text))
-> IntMap (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \case
Maybe (TraverseChild t m Int v')
Nothing -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just Maybe Text
forall a. Maybe a
Nothing
Just TraverseChild t m Int v'
tc
| Right TraverseChildImmediate Int
immediate <- TraverseChild t m Int v'
-> Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode TraverseChild t m Int v'
tc -> Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Maybe Text -> Maybe (Maybe Text))
-> Maybe Text -> Maybe (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate Int -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate Int
immediate
| Bool
otherwise -> Maybe (Maybe Text)
forall a. Maybe a
Nothing
liftIO $ writeIORef placeholders $! fromMaybe phs $ apply filtered phs
{-# SPECIALIZE traverseIntMapWithKeyWithAdjust'
:: (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM v')
-> IntMap v
-> Event DomTimeline (PatchIntMap v)
-> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
#-}
{-# SPECIALIZE traverseIntMapWithKeyWithAdjust'
:: (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM v')
-> IntMap v
-> Event DomTimeline (PatchIntMap v)
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
#-}
data ChildReadyState a
= ChildReadyState_Ready
| ChildReadyState_Unready !(Maybe a)
deriving (Int -> ChildReadyState a -> ShowS
[ChildReadyState a] -> ShowS
ChildReadyState a -> String
(Int -> ChildReadyState a -> ShowS)
-> (ChildReadyState a -> String)
-> ([ChildReadyState a] -> ShowS)
-> Show (ChildReadyState a)
forall a. Show a => Int -> ChildReadyState a -> ShowS
forall a. Show a => [ChildReadyState a] -> ShowS
forall a. Show a => ChildReadyState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ChildReadyState a -> ShowS
showsPrec :: Int -> ChildReadyState a -> ShowS
$cshow :: forall a. Show a => ChildReadyState a -> String
show :: ChildReadyState a -> String
$cshowList :: forall a. Show a => [ChildReadyState a] -> ShowS
showList :: [ChildReadyState a] -> ShowS
Show, ReadPrec [ChildReadyState a]
ReadPrec (ChildReadyState a)
Int -> ReadS (ChildReadyState a)
ReadS [ChildReadyState a]
(Int -> ReadS (ChildReadyState a))
-> ReadS [ChildReadyState a]
-> ReadPrec (ChildReadyState a)
-> ReadPrec [ChildReadyState a]
-> Read (ChildReadyState a)
forall a. Read a => ReadPrec [ChildReadyState a]
forall a. Read a => ReadPrec (ChildReadyState a)
forall a. Read a => Int -> ReadS (ChildReadyState a)
forall a. Read a => ReadS [ChildReadyState a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (ChildReadyState a)
readsPrec :: Int -> ReadS (ChildReadyState a)
$creadList :: forall a. Read a => ReadS [ChildReadyState a]
readList :: ReadS [ChildReadyState a]
$creadPrec :: forall a. Read a => ReadPrec (ChildReadyState a)
readPrec :: ReadPrec (ChildReadyState a)
$creadListPrec :: forall a. Read a => ReadPrec [ChildReadyState a]
readListPrec :: ReadPrec [ChildReadyState a]
Read, ChildReadyState a -> ChildReadyState a -> Bool
(ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> Eq (ChildReadyState a)
forall a. Eq a => ChildReadyState a -> ChildReadyState a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ChildReadyState a -> ChildReadyState a -> Bool
== :: ChildReadyState a -> ChildReadyState a -> Bool
$c/= :: forall a. Eq a => ChildReadyState a -> ChildReadyState a -> Bool
/= :: ChildReadyState a -> ChildReadyState a -> Bool
Eq, Eq (ChildReadyState a)
Eq (ChildReadyState a) =>
(ChildReadyState a -> ChildReadyState a -> Ordering)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> Bool)
-> (ChildReadyState a -> ChildReadyState a -> ChildReadyState a)
-> (ChildReadyState a -> ChildReadyState a -> ChildReadyState a)
-> Ord (ChildReadyState a)
ChildReadyState a -> ChildReadyState a -> Bool
ChildReadyState a -> ChildReadyState a -> Ordering
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ChildReadyState a)
forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> Ordering
forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
$ccompare :: forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> Ordering
compare :: ChildReadyState a -> ChildReadyState a -> Ordering
$c< :: forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
< :: ChildReadyState a -> ChildReadyState a -> Bool
$c<= :: forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
<= :: ChildReadyState a -> ChildReadyState a -> Bool
$c> :: forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
> :: ChildReadyState a -> ChildReadyState a -> Bool
$c>= :: forall a. Ord a => ChildReadyState a -> ChildReadyState a -> Bool
>= :: ChildReadyState a -> ChildReadyState a -> Bool
$cmax :: forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
max :: ChildReadyState a -> ChildReadyState a -> ChildReadyState a
$cmin :: forall a.
Ord a =>
ChildReadyState a -> ChildReadyState a -> ChildReadyState a
min :: ChildReadyState a -> ChildReadyState a -> ChildReadyState a
Ord)
insertAfterPreviousNode :: (Monad m, MonadJSM m) => DOM.IsNode node => node -> HydrationRunnerT t m ()
insertAfterPreviousNode :: forall (m :: * -> *) node t.
(Monad m, MonadJSM m, IsNode node) =>
node -> HydrationRunnerT t m ()
insertAfterPreviousNode node
node = do
parent <- HydrationRunnerT t m Node
forall (m :: * -> *) t. Monad m => HydrationRunnerT t m Node
askParent
nextNode <- maybe (Node.getFirstChild parent) Node.getNextSibling =<< getPreviousNode
Node.insertBefore_ parent node nextNode
setPreviousNode $ Just $ toNode node
{-# INLINABLE hoistTraverseWithKeyWithAdjust #-}
hoistTraverseWithKeyWithAdjust
::
( Adjustable t m
, MonadHold t m
, GCompare k
, MonadIO m
, MonadJSM m
, PrimMonad m
, MonadFix m
, Patch (p k v)
, Patch (p k (Constant Int))
, PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int)
, Patch (p k (Compose (TraverseChild t m (Some k)) v'))
, PatchTarget (p k (Compose (TraverseChild t m (Some k)) v')) ~ DMap k (Compose (TraverseChild t m (Some k)) v')
, Monoid (p k (Compose (TraverseChild t m (Some k)) v'))
, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document
)
=> (forall vv vv'.
(forall a. k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
-> (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 {k} {k} t (m :: * -> *) (k :: k -> *)
(p :: (k -> *) -> (k -> *) -> *) (v :: k -> *) (v' :: k -> *)
(s :: k).
(Adjustable t m, MonadHold t m, GCompare k, MonadIO m, MonadJSM m,
PrimMonad m, MonadFix m, Patch (p k v), Patch (p k (Constant Int)),
PatchTarget (p k (Constant Int)) ~ DMap k (Constant Int),
Patch (p k (Compose (TraverseChild t m (Some k)) v')),
PatchTarget (p k (Compose (TraverseChild t m (Some k)) v'))
~ DMap k (Compose (TraverseChild t m (Some k)) v'),
Monoid (p k (Compose (TraverseChild t m (Some k)) v')),
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
(forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> DomRenderHookT t m (DMap k vv', Event t (p k vv')))
-> (forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv')
-> (p k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k))))))
-> (IORef (Map (Some k) Text)
-> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ())
-> (forall (a :: k).
k a -> v a -> HydrationDomBuilderT s t m (v' a))
-> DMap k v
-> Event t (p k v)
-> HydrationDomBuilderT s t m (DMap k v', Event t (p k v'))
hoistTraverseWithKeyWithAdjust forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). k a -> vv a -> DomRenderHookT t m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> DomRenderHookT t m (DMap k vv', Event t (p k vv'))
base forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv'
mapPatch p k (Compose (TraverseChild t m (Some k)) v')
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> IO (DMap k (Constant (IORef (ChildReadyState (Some k)))))
updateChildUnreadiness IORef (Map (Some k) Text)
-> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ()
applyDomUpdate_ forall (a :: k). k a -> v a -> HydrationDomBuilderT s t m (v' a)
f DMap k v
dm0 Event t (p k v)
dm' = do
doc <- HydrationDomBuilderT s t m Document
HydrationDomBuilderT
s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
initialEnv <- HydrationDomBuilderT ask
let parentUnreadyChildren = HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren HydrationDomBuilderEnv t m
initialEnv
pendingChange :: IORef (DMap k (Constant (IORef (ChildReadyState (Some k)))), p k (Compose (TraverseChild t m (Some k)) v')) <- liftIO $ newIORef mempty
haveEverBeenReady <- liftIO $ newIORef False
placeholders <- liftIO $ newIORef Map.empty
lastPlaceholder <- createTextNode doc ("" :: Text)
let applyDomUpdate p k (Compose (TraverseChild t m (Some k)) v')
p = do
IORef (Map (Some k) Text)
-> Text -> p k (Compose (TraverseChild t m (Some k)) v') -> JSM ()
applyDomUpdate_ IORef (Map (Some k) Text)
placeholders Text
lastPlaceholder p k (Compose (TraverseChild t m (Some k)) v')
p
JSM ()
markSelfReady
IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> (DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange ((DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ())
-> (DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO ()
forall a b. (a -> b) -> a -> b
$! (DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall a. Monoid a => a
mempty
markSelfReady = do
IO Bool -> JSM Bool
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
haveEverBeenReady) JSM Bool -> (Bool -> JSM ()) -> JSM ()
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> do
IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
old <- IO Word -> JSM Word
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> JSM Word) -> IO Word -> JSM Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
parentUnreadyChildren
let new = Word -> Word
forall a. Enum a => a -> a
pred Word
old
liftIO $ writeIORef parentUnreadyChildren $! new
when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
markChildReady :: IORef (ChildReadyState (Some k)) -> JSM ()
markChildReady IORef (ChildReadyState (Some k))
childReadyState = do
IO (ChildReadyState (Some k)) -> JSM (ChildReadyState (Some k))
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (ChildReadyState (Some k)) -> IO (ChildReadyState (Some k))
forall a. IORef a -> IO a
readIORef IORef (ChildReadyState (Some k))
childReadyState) JSM (ChildReadyState (Some k))
-> (ChildReadyState (Some k) -> JSM ()) -> JSM ()
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState (Some k)
ChildReadyState_Ready -> () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ChildReadyState_Unready Maybe (Some k)
countedAt -> do
IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState (Some k))
-> ChildReadyState (Some k) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState (Some k))
childReadyState ChildReadyState (Some k)
forall a. ChildReadyState a
ChildReadyState_Ready
case Maybe (Some k)
countedAt of
Maybe (Some k)
Nothing -> () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Some k a
k) -> do
(oldUnready, p) <- IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v')))
-> IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall a b. (a -> b) -> a -> b
$ IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall a. IORef a -> IO a
readIORef IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange
when (not $ DMap.null oldUnready) $ do
let newUnready = k a
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
-> DMap k (Constant (IORef (ChildReadyState (Some k))))
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> DMap k2 f
DMap.delete k a
k DMap k (Constant (IORef (ChildReadyState (Some k))))
oldUnready
liftIO $ writeIORef pendingChange (newUnready, p)
when (DMap.null newUnready) $ do
applyDomUpdate p
(children0 :: DMap k (Compose (TraverseChild t m (Some k)) v'), children' :: Event t (p k (Compose (TraverseChild t m (Some k)) v')))
<- HydrationDomBuilderT $ lift $ base (\k a
k v a
v -> HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState (Some k)) -> JSM ())
-> HydrationDomBuilderT s t m (v' a)
-> DomRenderHookT t m (Compose (TraverseChild t m (Some k)) v' a)
forall {k} {k1} (m :: * -> *) t k (s :: k) (f :: k1 -> *)
(a :: k1).
(MonadJSM m, Reflex t) =>
HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (f a)
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
drawChildUpdate HydrationDomBuilderEnv t m
initialEnv IORef (ChildReadyState (Some k)) -> JSM ()
markChildReady (HydrationDomBuilderT s t m (v' a)
-> DomRenderHookT t m (Compose (TraverseChild t m (Some k)) v' a))
-> HydrationDomBuilderT s t m (v' a)
-> DomRenderHookT t m (Compose (TraverseChild t m (Some k)) v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> HydrationDomBuilderT s t m (v' a)
forall (a :: k). k a -> v a -> HydrationDomBuilderT s t m (v' a)
f k a
k v a
v) dm0 dm'
let processChild tag a
k (Compose (TraverseChild Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some tag))
e g a
_)) = case Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some tag))
e of
Left TraverseChildHydration t m
_ -> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a))
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
forall a b. (a -> b) -> a -> b
$ Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
forall a. Maybe a
Nothing
Right TraverseChildImmediate (Some tag)
immediate -> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a
forall {k} (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe (Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
-> IO
(ComposeMaybe (Constant (IORef (ChildReadyState (Some tag)))) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
IORef (ChildReadyState (Some tag))
-> IO (ChildReadyState (Some tag))
forall a. IORef a -> IO a
readIORef (TraverseChildImmediate (Some tag)
-> IORef (ChildReadyState (Some tag))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some tag)
immediate) IO (ChildReadyState (Some tag))
-> (ChildReadyState (Some tag)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a)))
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState (Some tag)
ChildReadyState_Ready -> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
forall a. Maybe a
Nothing
ChildReadyState_Unready Maybe (Some tag)
_ -> do
IORef (ChildReadyState (Some tag))
-> ChildReadyState (Some tag) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TraverseChildImmediate (Some tag)
-> IORef (ChildReadyState (Some tag))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some tag)
immediate) (ChildReadyState (Some tag) -> IO ())
-> ChildReadyState (Some tag) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Some tag) -> ChildReadyState (Some tag)
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe (Some tag) -> ChildReadyState (Some tag))
-> Maybe (Some tag) -> ChildReadyState (Some tag)
forall a b. (a -> b) -> a -> b
$ Some tag -> Maybe (Some tag)
forall a. a -> Maybe a
Just (Some tag -> Maybe (Some tag)) -> Some tag -> Maybe (Some tag)
forall a b. (a -> b) -> a -> b
$ tag a -> Some tag
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some tag a
k
Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a)))
-> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
-> IO (Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
forall a b. (a -> b) -> a -> b
$ Constant (IORef (ChildReadyState (Some tag))) a
-> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
forall a. a -> Maybe a
Just (Constant (IORef (ChildReadyState (Some tag))) a
-> Maybe (Constant (IORef (ChildReadyState (Some tag))) a))
-> Constant (IORef (ChildReadyState (Some tag))) a
-> Maybe (Constant (IORef (ChildReadyState (Some tag))) a)
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState (Some tag))
-> Constant (IORef (ChildReadyState (Some tag))) a
forall {k} a (b :: k). a -> Constant a b
Constant (TraverseChildImmediate (Some tag)
-> IORef (ChildReadyState (Some tag))
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate (Some tag)
immediate)
initialUnready <- liftIO $ DMap.mapMaybeWithKey (\k v
_ -> ComposeMaybe (Constant (IORef (ChildReadyState (Some k)))) v
-> Maybe (Constant (IORef (ChildReadyState (Some k))) v)
forall {k} (f :: k -> *) (a :: k). ComposeMaybe f a -> Maybe (f a)
getComposeMaybe) <$> DMap.traverseWithKey processChild children0
liftIO $ if DMap.null initialUnready
then writeIORef haveEverBeenReady True
else do
modifyIORef' parentUnreadyChildren succ
writeIORef pendingChange (initialUnready, mempty)
getHydrationMode >>= \case
HydrationMode
HydrationMode_Hydrating -> m (Incremental t (p k (Compose (TraverseChild t m (Some k)) v')))
-> (Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall {k} (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (PatchTarget (p k (Compose (TraverseChild t m (Some k)) v'))
-> Event t (p k (Compose (TraverseChild t m (Some k)) v'))
-> m (Incremental
t (p k (Compose (TraverseChild t m (Some k)) v')))
forall p.
Patch p =>
PatchTarget p -> Event t p -> m (Incremental t p)
forall {k} (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental DMap k (Compose (TraverseChild t m (Some k)) v')
PatchTarget (p k (Compose (TraverseChild t m (Some k)) v'))
children0 Event t (p k (Compose (TraverseChild t m (Some k)) v'))
children') ((Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ())
-> (Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ \Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
children -> do
dm :: DMap k (Compose (TraverseChild t m (Some k)) v') <- Behavior t (DMap k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT
t m (DMap k (Compose (TraverseChild t m (Some k)) v'))
forall a. Behavior t a -> HydrationRunnerT t m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t (DMap k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT
t m (DMap k (Compose (TraverseChild t m (Some k)) v')))
-> Behavior t (DMap k (Compose (TraverseChild t m (Some k)) v'))
-> HydrationRunnerT
t m (DMap k (Compose (TraverseChild t m (Some k)) v'))
forall a b. (a -> b) -> a -> b
$ Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
-> Behavior
t (PatchTarget (p k (Compose (TraverseChild t m (Some k)) v')))
forall p. Patch p => Incremental t p -> Behavior t (PatchTarget p)
forall {k} (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Behavior t (PatchTarget p)
currentIncremental Incremental t (p k (Compose (TraverseChild t m (Some k)) v'))
children
phs <- sequenceA $ weakenDMapWith (either _traverseChildHydration_delayed (pure . _traverseChildImmediate_placeholder) . _traverseChild_mode . getCompose) dm
liftIO $ writeIORef placeholders $! phs
insertAfterPreviousNode lastPlaceholder
HydrationMode
HydrationMode_Immediate -> do
let activate :: TraverseChildImmediate k -> HydrationDomBuilderT s t m Text
activate TraverseChildImmediate k
i = do
Node -> HydrationDomBuilderT s t m ()
forall {k} (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT s t m ())
-> Node -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode (DocumentFragment -> Node) -> DocumentFragment -> Node
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate k -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate k
i
Text -> HydrationDomBuilderT s t m Text
forall a. a -> HydrationDomBuilderT s t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HydrationDomBuilderT s t m Text)
-> Text -> HydrationDomBuilderT s t m Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate k -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate k
i
phs <- Map (Some k) (HydrationDomBuilderT s t m Text)
-> HydrationDomBuilderT s t m (Map (Some k) Text)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
Map (Some k) (f a) -> f (Map (Some k) a)
sequenceA (Map (Some k) (HydrationDomBuilderT s t m Text)
-> HydrationDomBuilderT s t m (Map (Some k) Text))
-> Map (Some k) (HydrationDomBuilderT s t m Text)
-> HydrationDomBuilderT s t m (Map (Some k) Text)
forall a b. (a -> b) -> a -> b
$ (forall (a :: k).
Compose (TraverseChild t m (Some k)) v' a
-> HydrationDomBuilderT s t m Text)
-> DMap k (Compose (TraverseChild t m (Some k)) v')
-> Map (Some k) (HydrationDomBuilderT s t m Text)
forall {k1} (v :: k1 -> *) v' (k2 :: k1 -> *).
(forall (a :: k1). v a -> v') -> DMap k2 v -> Map (Some k2) v'
weakenDMapWith ((TraverseChildHydration t m -> HydrationDomBuilderT s t m Text)
-> (TraverseChildImmediate (Some k)
-> HydrationDomBuilderT s t m Text)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
-> HydrationDomBuilderT s t m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String
-> TraverseChildHydration t m -> HydrationDomBuilderT s t m Text
forall a. HasCallStack => String -> a
error String
"impossible") TraverseChildImmediate (Some k) -> HydrationDomBuilderT s t m Text
forall {k} {m :: * -> *} {k} {s :: k} {t}.
MonadJSM m =>
TraverseChildImmediate k -> HydrationDomBuilderT s t m Text
activate (Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
-> HydrationDomBuilderT s t m Text)
-> (Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> Compose (TraverseChild t m (Some k)) v' a
-> HydrationDomBuilderT s t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode (TraverseChild t m (Some k) (v' a)
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k)))
-> (Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate (Some k))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) DMap k (Compose (TraverseChild t m (Some k)) v')
children0
liftIO $ writeIORef placeholders $! phs
append $ toNode lastPlaceholder
requestDomAction_ $ ffor children' $ \p k (Compose (TraverseChild t m (Some k)) v')
p -> do
(oldUnready, oldP) <- IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v')))
-> IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> JSM
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall a b. (a -> b) -> a -> b
$ IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
-> IO
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
forall a. IORef a -> IO a
readIORef IORef
(DMap k (Constant (IORef (ChildReadyState (Some k)))),
p k (Compose (TraverseChild t m (Some k)) v'))
pendingChange
newUnready <- liftIO $ updateChildUnreadiness p oldUnready
let !newP = p k (Compose (TraverseChild t m (Some k)) v')
p p k (Compose (TraverseChild t m (Some k)) v')
-> p k (Compose (TraverseChild t m (Some k)) v')
-> p k (Compose (TraverseChild t m (Some k)) v')
forall a. Semigroup a => a -> a -> a
<> p k (Compose (TraverseChild t m (Some k)) v')
oldP
liftIO $ writeIORef pendingChange (newUnready, newP)
when (DMap.null newUnready) $ do
applyDomUpdate newP
let result0 = (forall (v :: k).
Compose (TraverseChild t m (Some k)) v' v -> v' v)
-> DMap k (Compose (TraverseChild t m (Some k)) v') -> DMap k v'
forall {k1} (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v) -> DMap k2 f -> DMap k2 g
DMap.map (TraverseChild t m (Some k) (v' v) -> v' v
forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result (TraverseChild t m (Some k) (v' v) -> v' v)
-> (Compose (TraverseChild t m (Some k)) v' v
-> TraverseChild t m (Some k) (v' v))
-> Compose (TraverseChild t m (Some k)) v' v
-> v' v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' v
-> TraverseChild t m (Some k) (v' v)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) DMap k (Compose (TraverseChild t m (Some k)) v')
children0
result' = Event t (p k (Compose (TraverseChild t m (Some k)) v'))
-> (p k (Compose (TraverseChild t m (Some k)) v') -> p k v')
-> Event t (p k v')
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p k (Compose (TraverseChild t m (Some k)) v'))
children' ((p k (Compose (TraverseChild t m (Some k)) v') -> p k v')
-> Event t (p k v'))
-> (p k (Compose (TraverseChild t m (Some k)) v') -> p k v')
-> Event t (p k v')
forall a b. (a -> b) -> a -> b
$ (forall (v :: k).
Compose (TraverseChild t m (Some k)) v' v -> v' v)
-> p k (Compose (TraverseChild t m (Some k)) v') -> p k v'
forall (vv :: k -> *) (vv' :: k -> *).
(forall (a :: k). vv a -> vv' a) -> p k vv -> p k vv'
mapPatch ((forall (v :: k).
Compose (TraverseChild t m (Some k)) v' v -> v' v)
-> p k (Compose (TraverseChild t m (Some k)) v') -> p k v')
-> (forall (v :: k).
Compose (TraverseChild t m (Some k)) v' v -> v' v)
-> p k (Compose (TraverseChild t m (Some k)) v')
-> p k v'
forall a b. (a -> b) -> a -> b
$ TraverseChild t m (Some k) (v' a) -> v' a
forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result (TraverseChild t m (Some k) (v' a) -> v' a)
-> (Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a))
-> Compose (TraverseChild t m (Some k)) v' a
-> v' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m (Some k)) v' a
-> TraverseChild t m (Some k) (v' a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
return (result0, result')
{-# INLINE hoistTraverseIntMapWithKeyWithAdjust #-}
hoistTraverseIntMapWithKeyWithAdjust ::
( Adjustable t m
, MonadHold t m
, MonadJSM m
, MonadFix m
, PrimMonad m
, Monoid (p (TraverseChild t m Int v'))
, Functor p
, PatchTarget (p (HydrationRunnerT t m ())) ~ IntMap (HydrationRunnerT t m ())
, PatchTarget (p (TraverseChild t m Int v')) ~ IntMap (TraverseChild t m Int v')
, Patch (p (HydrationRunnerT t m ()))
, Patch (p (TraverseChild t m Int v'))
, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document
)
=> ((IntMap.Key -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (p v)
-> DomRenderHookT t m (IntMap (TraverseChild t m Int v'), Event t (p (TraverseChild t m Int v'))))
-> (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 :: forall {k} t (m :: * -> *) (p :: * -> *) v' (s :: k) v.
(Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m,
PrimMonad m, Monoid (p (TraverseChild t m Int v')), Functor p,
PatchTarget (p (HydrationRunnerT t m ()))
~ IntMap (HydrationRunnerT t m ()),
PatchTarget (p (TraverseChild t m Int v'))
~ IntMap (TraverseChild t m Int v'),
Patch (p (HydrationRunnerT t m ())),
Patch (p (TraverseChild t m Int v')),
RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m))
~ Document) =>
((Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (p v)
-> DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v'))))
-> (p (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap Text)
-> Text -> p (TraverseChild t m Int v') -> JSM ())
-> (Int -> v -> HydrationDomBuilderT s t m v')
-> IntMap v
-> Event t (p v)
-> HydrationDomBuilderT s t m (IntMap v', Event t (p v'))
hoistTraverseIntMapWithKeyWithAdjust (Int -> v -> DomRenderHookT t m (TraverseChild t m Int v'))
-> IntMap v
-> Event t (p v)
-> DomRenderHookT
t
m
(IntMap (TraverseChild t m Int v'),
Event t (p (TraverseChild t m Int v')))
base p (TraverseChild t m Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int)))
updateChildUnreadiness IORef (IntMap Text)
-> Text -> p (TraverseChild t m Int v') -> JSM ()
applyDomUpdate_ Int -> v -> HydrationDomBuilderT s t m v'
f IntMap v
dm0 Event t (p v)
dm' = do
doc <- HydrationDomBuilderT s t m Document
HydrationDomBuilderT
s t m (RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
initialEnv <- HydrationDomBuilderT ask
let parentUnreadyChildren = HydrationDomBuilderEnv t m -> IORef Word
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> IORef Word
_hydrationDomBuilderEnv_unreadyChildren HydrationDomBuilderEnv t m
initialEnv
pendingChange :: IORef (IntMap (IORef (ChildReadyState Int)), p (TraverseChild t m Int v')) <- liftIO $ newIORef mempty
haveEverBeenReady <- liftIO $ newIORef False
placeholders <- liftIO $ newIORef IntMap.empty
lastPlaceholder <- createTextNode doc ("" :: Text)
let applyDomUpdate p (TraverseChild t m Int v')
p = do
IORef (IntMap Text)
-> Text -> p (TraverseChild t m Int v') -> JSM ()
applyDomUpdate_ IORef (IntMap Text)
placeholders Text
lastPlaceholder p (TraverseChild t m Int v')
p
JSM ()
markSelfReady
IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> (IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
pendingChange ((IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO ())
-> (IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO ()
forall a b. (a -> b) -> a -> b
$! (IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall a. Monoid a => a
mempty
markSelfReady = do
IO Bool -> JSM Bool
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
haveEverBeenReady) JSM Bool -> (Bool -> JSM ()) -> JSM ()
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> do
IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
haveEverBeenReady Bool
True
old <- IO Word -> JSM Word
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word -> JSM Word) -> IO Word -> JSM Word
forall a b. (a -> b) -> a -> b
$ IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
parentUnreadyChildren
let new = Word -> Word
forall a. Enum a => a -> a
pred Word
old
liftIO $ writeIORef parentUnreadyChildren $! new
when (new == 0) $ _hydrationDomBuilderEnv_commitAction initialEnv
markChildReady :: IORef (ChildReadyState Int) -> JSM ()
markChildReady IORef (ChildReadyState Int)
childReadyState = do
IO (ChildReadyState Int) -> JSM (ChildReadyState Int)
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (ChildReadyState Int) -> IO (ChildReadyState Int)
forall a. IORef a -> IO a
readIORef IORef (ChildReadyState Int)
childReadyState) JSM (ChildReadyState Int)
-> (ChildReadyState Int -> JSM ()) -> JSM ()
forall a b. JSM a -> (a -> JSM b) -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState Int
ChildReadyState_Ready -> () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ChildReadyState_Unready Maybe Int
countedAt -> do
IO () -> JSM ()
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> JSM ()) -> IO () -> JSM ()
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState Int) -> ChildReadyState Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ChildReadyState Int)
childReadyState ChildReadyState Int
forall a. ChildReadyState a
ChildReadyState_Ready
case Maybe Int
countedAt of
Maybe Int
Nothing -> () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Int
k -> do
(oldUnready, p) <- IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> JSM
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> JSM
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v')))
-> IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> JSM
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall a b. (a -> b) -> a -> b
$ IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall a. IORef a -> IO a
readIORef IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
pendingChange
when (not $ IntMap.null oldUnready) $ do
let newUnready = Int
-> IntMap (IORef (ChildReadyState Int))
-> IntMap (IORef (ChildReadyState Int))
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
k IntMap (IORef (ChildReadyState Int))
oldUnready
liftIO $ writeIORef pendingChange (newUnready, p)
when (IntMap.null newUnready) $ do
applyDomUpdate p
(children0 :: IntMap (TraverseChild t m Int v'), children' :: Event t (p (TraverseChild t m Int v')))
<- HydrationDomBuilderT $ lift $ base (\Int
k v
v -> HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState Int) -> JSM ())
-> HydrationDomBuilderT s t m v'
-> DomRenderHookT t m (TraverseChild t m Int v')
forall {k} (m :: * -> *) t k (s :: k) v.
(MonadIO m, MonadJSM m, Reflex t) =>
HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m v
-> DomRenderHookT t m (TraverseChild t m k v)
drawChildUpdateInt HydrationDomBuilderEnv t m
initialEnv IORef (ChildReadyState Int) -> JSM ()
markChildReady (HydrationDomBuilderT s t m v'
-> DomRenderHookT t m (TraverseChild t m Int v'))
-> HydrationDomBuilderT s t m v'
-> DomRenderHookT t m (TraverseChild t m Int v')
forall a b. (a -> b) -> a -> b
$ Int -> v -> HydrationDomBuilderT s t m v'
f Int
k v
v) dm0 dm'
let processChild k
k (TraverseChild Either (TraverseChildHydration t m) (TraverseChildImmediate k)
e a
_) = case Either (TraverseChildHydration t m) (TraverseChildImmediate k)
e of
Left TraverseChildHydration t m
_ -> Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k)))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (IORef (ChildReadyState k))
forall a. Maybe a
Nothing
Right TraverseChildImmediate k
immediate -> do
IORef (ChildReadyState k) -> IO (ChildReadyState k)
forall a. IORef a -> IO a
readIORef (TraverseChildImmediate k -> IORef (ChildReadyState k)
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate k
immediate) IO (ChildReadyState k)
-> (ChildReadyState k -> IO (Maybe (IORef (ChildReadyState k))))
-> IO (Maybe (IORef (ChildReadyState k)))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ChildReadyState k
ChildReadyState_Ready -> Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IORef (ChildReadyState k))
forall a. Maybe a
Nothing
ChildReadyState_Unready Maybe k
_ -> do
IORef (ChildReadyState k) -> ChildReadyState k -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (TraverseChildImmediate k -> IORef (ChildReadyState k)
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate k
immediate) (ChildReadyState k -> IO ()) -> ChildReadyState k -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe k -> ChildReadyState k
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready (Maybe k -> ChildReadyState k) -> Maybe k -> ChildReadyState k
forall a b. (a -> b) -> a -> b
$ k -> Maybe k
forall a. a -> Maybe a
Just k
k
Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k))))
-> Maybe (IORef (ChildReadyState k))
-> IO (Maybe (IORef (ChildReadyState k)))
forall a b. (a -> b) -> a -> b
$ IORef (ChildReadyState k) -> Maybe (IORef (ChildReadyState k))
forall a. a -> Maybe a
Just (TraverseChildImmediate k -> IORef (ChildReadyState k)
forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState TraverseChildImmediate k
immediate)
initialUnready <- liftIO $ IntMap.mapMaybe id <$> IntMap.traverseWithKey processChild children0
liftIO $ if IntMap.null initialUnready
then writeIORef haveEverBeenReady True
else do
modifyIORef' parentUnreadyChildren succ
writeIORef pendingChange (initialUnready, mempty)
getHydrationMode >>= \case
HydrationMode
HydrationMode_Hydrating -> m (Incremental t (p (TraverseChild t m Int v')))
-> (Incremental t (p (TraverseChild t m Int v'))
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall {k} (m :: * -> *) a t (s :: k).
MonadIO m =>
m a
-> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()
addHydrationStepWithSetup (PatchTarget (p (TraverseChild t m Int v'))
-> Event t (p (TraverseChild t m Int v'))
-> m (Incremental t (p (TraverseChild t m Int v')))
forall p.
Patch p =>
PatchTarget p -> Event t p -> m (Incremental t p)
forall {k} (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental IntMap (TraverseChild t m Int v')
PatchTarget (p (TraverseChild t m Int v'))
children0 Event t (p (TraverseChild t m Int v'))
children') ((Incremental t (p (TraverseChild t m Int v'))
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ())
-> (Incremental t (p (TraverseChild t m Int v'))
-> HydrationRunnerT t m ())
-> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ \Incremental t (p (TraverseChild t m Int v'))
children -> do
dm :: IntMap (TraverseChild t m Int v') <- Behavior t (IntMap (TraverseChild t m Int v'))
-> HydrationRunnerT t m (IntMap (TraverseChild t m Int v'))
forall a. Behavior t a -> HydrationRunnerT t m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t (IntMap (TraverseChild t m Int v'))
-> HydrationRunnerT t m (IntMap (TraverseChild t m Int v')))
-> Behavior t (IntMap (TraverseChild t m Int v'))
-> HydrationRunnerT t m (IntMap (TraverseChild t m Int v'))
forall a b. (a -> b) -> a -> b
$ Incremental t (p (TraverseChild t m Int v'))
-> Behavior t (PatchTarget (p (TraverseChild t m Int v')))
forall p. Patch p => Incremental t p -> Behavior t (PatchTarget p)
forall {k} (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Behavior t (PatchTarget p)
currentIncremental Incremental t (p (TraverseChild t m Int v'))
children
phs <- traverse (either _traverseChildHydration_delayed (pure . _traverseChildImmediate_placeholder) . _traverseChild_mode) dm
liftIO $ writeIORef placeholders $! phs
insertAfterPreviousNode lastPlaceholder
HydrationMode
HydrationMode_Immediate -> do
let activate :: TraverseChildImmediate k -> HydrationDomBuilderT s t m Text
activate TraverseChildImmediate k
i = do
Node -> HydrationDomBuilderT s t m ()
forall {k} (m :: * -> *) (s :: k) t.
MonadJSM m =>
Node -> HydrationDomBuilderT s t m ()
append (Node -> HydrationDomBuilderT s t m ())
-> Node -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ DocumentFragment -> Node
forall o. IsNode o => o -> Node
toNode (DocumentFragment -> Node) -> DocumentFragment -> Node
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate k -> DocumentFragment
forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment TraverseChildImmediate k
i
Text -> HydrationDomBuilderT s t m Text
forall a. a -> HydrationDomBuilderT s t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HydrationDomBuilderT s t m Text)
-> Text -> HydrationDomBuilderT s t m Text
forall a b. (a -> b) -> a -> b
$ TraverseChildImmediate k -> Text
forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder TraverseChildImmediate k
i
phs <- (TraverseChild t m Int v' -> HydrationDomBuilderT s t m Text)
-> IntMap (TraverseChild t m Int v')
-> HydrationDomBuilderT s t m (IntMap Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntMap a -> f (IntMap b)
traverse ((TraverseChildHydration t m -> HydrationDomBuilderT s t m Text)
-> (TraverseChildImmediate Int -> HydrationDomBuilderT s t m Text)
-> Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
-> HydrationDomBuilderT s t m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String
-> TraverseChildHydration t m -> HydrationDomBuilderT s t m Text
forall a. HasCallStack => String -> a
error String
"impossible") TraverseChildImmediate Int -> HydrationDomBuilderT s t m Text
forall {k} {m :: * -> *} {k} {s :: k} {t}.
MonadJSM m =>
TraverseChildImmediate k -> HydrationDomBuilderT s t m Text
activate (Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
-> HydrationDomBuilderT s t m Text)
-> (TraverseChild t m Int v'
-> Either
(TraverseChildHydration t m) (TraverseChildImmediate Int))
-> TraverseChild t m Int v'
-> HydrationDomBuilderT s t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraverseChild t m Int v'
-> Either (TraverseChildHydration t m) (TraverseChildImmediate Int)
forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode) IntMap (TraverseChild t m Int v')
children0
liftIO $ writeIORef placeholders $! phs
append $ toNode lastPlaceholder
requestDomAction_ $ ffor children' $ \p (TraverseChild t m Int v')
p -> do
(oldUnready, oldP) <- IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> JSM
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall a. IO a -> JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> JSM
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v')))
-> IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> JSM
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall a b. (a -> b) -> a -> b
$ IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
-> IO
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
forall a. IORef a -> IO a
readIORef IORef
(IntMap (IORef (ChildReadyState Int)),
p (TraverseChild t m Int v'))
pendingChange
newUnready <- liftIO $ updateChildUnreadiness p oldUnready
let !newP = p (TraverseChild t m Int v')
p p (TraverseChild t m Int v')
-> p (TraverseChild t m Int v') -> p (TraverseChild t m Int v')
forall a. Semigroup a => a -> a -> a
<> p (TraverseChild t m Int v')
oldP
liftIO $ writeIORef pendingChange (newUnready, newP)
when (IntMap.null newUnready) $ do
applyDomUpdate newP
let result0 = (TraverseChild t m Int v' -> v')
-> IntMap (TraverseChild t m Int v') -> IntMap v'
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map TraverseChild t m Int v' -> v'
forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result IntMap (TraverseChild t m Int v')
children0
result' = Event t (p (TraverseChild t m Int v'))
-> (p (TraverseChild t m Int v') -> p v') -> Event t (p v')
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p (TraverseChild t m Int v'))
children' ((p (TraverseChild t m Int v') -> p v') -> Event t (p v'))
-> (p (TraverseChild t m Int v') -> p v') -> Event t (p v')
forall a b. (a -> b) -> a -> b
$ (TraverseChild t m Int v' -> v')
-> p (TraverseChild t m Int v') -> p v'
forall a b. (a -> b) -> p a -> p b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TraverseChild t m Int v' -> v')
-> p (TraverseChild t m Int v') -> p v')
-> (TraverseChild t m Int v' -> v')
-> p (TraverseChild t m Int v')
-> p v'
forall a b. (a -> b) -> a -> b
$ TraverseChild t m Int v' -> v'
forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result
return (result0, result')
{-# SPECIALIZE hoistTraverseIntMapWithKeyWithAdjust
:: ((IntMap.Key -> v -> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM Int v'))
-> IntMap v
-> Event DomTimeline (PatchIntMap v)
-> DomRenderHookT DomTimeline HydrationM (IntMap (TraverseChild DomTimeline HydrationM Int v'), Event DomTimeline (PatchIntMap (TraverseChild DomTimeline HydrationM Int v'))))
-> (PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap DOM.Text)
-> DOM.Text
-> PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
-> JSM ())
-> (IntMap.Key -> v -> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM v')
-> IntMap v
-> Event DomTimeline (PatchIntMap v)
-> HydrationDomBuilderT HydrationDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
#-}
{-# SPECIALIZE hoistTraverseIntMapWithKeyWithAdjust
:: ((IntMap.Key -> v -> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM Int v'))
-> IntMap v
-> Event DomTimeline (PatchIntMap v)
-> DomRenderHookT DomTimeline HydrationM (IntMap (TraverseChild DomTimeline HydrationM Int v'), Event DomTimeline (PatchIntMap (TraverseChild DomTimeline HydrationM Int v'))))
-> (PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
-> IntMap (IORef (ChildReadyState Int))
-> IO (IntMap (IORef (ChildReadyState Int))))
-> (IORef (IntMap DOM.Text)
-> DOM.Text
-> PatchIntMap (TraverseChild DomTimeline HydrationM Int v')
-> JSM ())
-> (IntMap.Key -> v -> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM v')
-> IntMap v
-> Event DomTimeline (PatchIntMap v)
-> HydrationDomBuilderT GhcjsDomSpace DomTimeline HydrationM (IntMap v', Event DomTimeline (PatchIntMap v'))
#-}
data TraverseChildImmediate k = TraverseChildImmediate
{ forall k. TraverseChildImmediate k -> DocumentFragment
_traverseChildImmediate_fragment :: {-# UNPACK #-} !DOM.DocumentFragment
, forall k. TraverseChildImmediate k -> Text
_traverseChildImmediate_placeholder :: {-# UNPACK #-} !DOM.Text
, forall k. TraverseChildImmediate k -> IORef (ChildReadyState k)
_traverseChildImmediate_childReadyState :: {-# UNPACK #-} !(IORef (ChildReadyState k))
}
newtype TraverseChildHydration t m = TraverseChildHydration
{ forall t (m :: * -> *).
TraverseChildHydration t m -> HydrationRunnerT t m Text
_traverseChildHydration_delayed :: HydrationRunnerT t m DOM.Text
}
data TraverseChild t m k a = TraverseChild
{ forall t (m :: * -> *) k a.
TraverseChild t m k a
-> Either (TraverseChildHydration t m) (TraverseChildImmediate k)
_traverseChild_mode :: !(Either (TraverseChildHydration t m) (TraverseChildImmediate k))
, forall t (m :: * -> *) k a. TraverseChild t m k a -> a
_traverseChild_result :: !a
} deriving (forall a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b)
-> (forall a b.
a -> TraverseChild t m k b -> TraverseChild t m k a)
-> Functor (TraverseChild t m k)
forall a b. a -> TraverseChild t m k b -> TraverseChild t m k a
forall a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
forall t (m :: * -> *) k a b.
a -> TraverseChild t m k b -> TraverseChild t m k a
forall t (m :: * -> *) k a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall t (m :: * -> *) k a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
fmap :: forall a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
$c<$ :: forall t (m :: * -> *) k a b.
a -> TraverseChild t m k b -> TraverseChild t m k a
<$ :: forall a b. a -> TraverseChild t m k b -> TraverseChild t m k a
Functor
{-# INLINABLE drawChildUpdate #-}
drawChildUpdate :: (MonadJSM m, Reflex t)
=> HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (f a)
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
drawChildUpdate :: forall {k} {k1} (m :: * -> *) t k (s :: k) (f :: k1 -> *)
(a :: k1).
(MonadJSM m, Reflex t) =>
HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (f a)
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
drawChildUpdate HydrationDomBuilderEnv t m
initialEnv IORef (ChildReadyState k) -> JSM ()
markReady HydrationDomBuilderT s t m (f a)
child = do
let doc :: Document
doc = HydrationDomBuilderEnv t m -> Document
forall t (m :: * -> *). HydrationDomBuilderEnv t m -> Document
_hydrationDomBuilderEnv_document HydrationDomBuilderEnv t m
initialEnv
unreadyChildren <- IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall a. IO a -> DomRenderHookT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef Word) -> DomRenderHookT t m (IORef Word))
-> IO (IORef Word) -> DomRenderHookT t m (IORef Word)
forall a b. (a -> b) -> a -> b
$ Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef Word
0
liftIO (readIORef $ _hydrationDomBuilderEnv_hydrationMode initialEnv) >>= \case
HydrationMode
HydrationMode_Hydrating -> do
childDelayedRef <- IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a. IO a -> DomRenderHookT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ())))
-> IO (IORef (HydrationRunnerT t m ()))
-> DomRenderHookT t m (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a. a -> IO (IORef a)
newIORef (HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ())))
-> HydrationRunnerT t m () -> IO (IORef (HydrationRunnerT t m ()))
forall a b. (a -> b) -> a -> b
$ () -> HydrationRunnerT t m ()
forall a. a -> HydrationRunnerT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
result <- runReaderT (unHydrationDomBuilderT child) initialEnv
{ _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
, _hydrationDomBuilderEnv_delayed = childDelayedRef
}
childDelayed <- liftIO $ readIORef childDelayedRef
return $ Compose $ TraverseChild
{ _traverseChild_result = result
, _traverseChild_mode = Left TraverseChildHydration
{ _traverseChildHydration_delayed = do
placeholder <- createTextNode doc ("" :: Text)
insertAfterPreviousNode placeholder
childDelayed
pure placeholder
}
}
HydrationMode
HydrationMode_Immediate -> do
childReadyState <- IO (IORef (ChildReadyState k))
-> DomRenderHookT t m (IORef (ChildReadyState k))
forall a. IO a -> DomRenderHookT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (ChildReadyState k))
-> DomRenderHookT t m (IORef (ChildReadyState k)))
-> IO (IORef (ChildReadyState k))
-> DomRenderHookT t m (IORef (ChildReadyState k))
forall a b. (a -> b) -> a -> b
$ ChildReadyState k -> IO (IORef (ChildReadyState k))
forall a. a -> IO (IORef a)
newIORef (ChildReadyState k -> IO (IORef (ChildReadyState k)))
-> ChildReadyState k -> IO (IORef (ChildReadyState k))
forall a b. (a -> b) -> a -> b
$ Maybe k -> ChildReadyState k
forall a. Maybe a -> ChildReadyState a
ChildReadyState_Unready Maybe k
forall a. Maybe a
Nothing
df <- createDocumentFragment doc
placeholder <- createTextNode doc ("" :: Text)
Node.appendChild_ df placeholder
result <- runReaderT (unHydrationDomBuilderT child) initialEnv
{ _hydrationDomBuilderEnv_parent = Left $ toNode df
, _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
, _hydrationDomBuilderEnv_commitAction = markReady childReadyState
}
u <- liftIO $ readIORef unreadyChildren
when (u == 0) $ liftIO $ writeIORef childReadyState ChildReadyState_Ready
return $ Compose $ TraverseChild
{ _traverseChild_result = result
, _traverseChild_mode = Right TraverseChildImmediate
{ _traverseChildImmediate_fragment = df
, _traverseChildImmediate_placeholder = placeholder
, _traverseChildImmediate_childReadyState = childReadyState
}
}
{-# SPECIALIZE drawChildUpdate
:: HydrationDomBuilderEnv DomTimeline HydrationM
-> (IORef (ChildReadyState Int) -> JSM ())
-> HydrationDomBuilderT s DomTimeline HydrationM (Identity a)
-> DomRenderHookT DomTimeline HydrationM (Compose (TraverseChild DomTimeline HydrationM Int) Identity a)
#-}
{-# SPECIALIZE drawChildUpdate
:: HydrationDomBuilderEnv DomTimeline HydrationM
-> (IORef (ChildReadyState (Some k)) -> JSM ())
-> HydrationDomBuilderT s DomTimeline HydrationM (f a)
-> DomRenderHookT DomTimeline HydrationM (Compose (TraverseChild DomTimeline HydrationM (Some k)) f a)
#-}
{-# INLINABLE drawChildUpdateInt #-}
drawChildUpdateInt :: (MonadIO m, MonadJSM m, Reflex t)
=> HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m v
-> DomRenderHookT t m (TraverseChild t m k v)
drawChildUpdateInt :: forall {k} (m :: * -> *) t k (s :: k) v.
(MonadIO m, MonadJSM m, Reflex t) =>
HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m v
-> DomRenderHookT t m (TraverseChild t m k v)
drawChildUpdateInt HydrationDomBuilderEnv t m
env IORef (ChildReadyState k) -> JSM ()
mark HydrationDomBuilderT s t m v
m = (Identity v -> v)
-> TraverseChild t m k (Identity v) -> TraverseChild t m k v
forall a b.
(a -> b) -> TraverseChild t m k a -> TraverseChild t m k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity v -> v
forall a. Identity a -> a
runIdentity (TraverseChild t m k (Identity v) -> TraverseChild t m k v)
-> (Compose (TraverseChild t m k) Identity v
-> TraverseChild t m k (Identity v))
-> Compose (TraverseChild t m k) Identity v
-> TraverseChild t m k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (TraverseChild t m k) Identity v
-> TraverseChild t m k (Identity v)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (TraverseChild t m k) Identity v -> TraverseChild t m k v)
-> DomRenderHookT t m (Compose (TraverseChild t m k) Identity v)
-> DomRenderHookT t m (TraverseChild t m k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (Identity v)
-> DomRenderHookT t m (Compose (TraverseChild t m k) Identity v)
forall {k} {k1} (m :: * -> *) t k (s :: k) (f :: k1 -> *)
(a :: k1).
(MonadJSM m, Reflex t) =>
HydrationDomBuilderEnv t m
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s t m (f a)
-> DomRenderHookT t m (Compose (TraverseChild t m k) f a)
drawChildUpdate HydrationDomBuilderEnv t m
env IORef (ChildReadyState k) -> JSM ()
mark (v -> Identity v
forall a. a -> Identity a
Identity (v -> Identity v)
-> HydrationDomBuilderT s t m v
-> HydrationDomBuilderT s t m (Identity v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HydrationDomBuilderT s t m v
m)
{-# SPECIALIZE drawChildUpdateInt
:: HydrationDomBuilderEnv DomTimeline HydrationM
-> (IORef (ChildReadyState k) -> JSM ())
-> HydrationDomBuilderT s DomTimeline HydrationM v
-> DomRenderHookT DomTimeline HydrationM (TraverseChild DomTimeline HydrationM k v)
#-}
{-# INLINE mkHasFocus #-}
mkHasFocus
:: (HasDocument m, MonadJSM m, IsNode (RawElement d), MonadHold t m, Reflex t, DOM.IsDocumentOrShadowRoot (RawDocument (DomBuilderSpace m)))
=> Element er d t -> m (Dynamic t Bool)
mkHasFocus :: forall {k} {k} (m :: * -> *) (d :: k) (t :: k)
(er :: EventTag -> *).
(HasDocument m, MonadJSM m, IsNode (RawElement d), MonadHold t m,
Reflex t,
IsDocumentOrShadowRoot (RawDocument (DomBuilderSpace m))) =>
Element er d t -> m (Dynamic t Bool)
mkHasFocus Element er d t
e = do
doc <- m (RawDocument (DomBuilderSpace m))
forall (m :: * -> *).
HasDocument m =>
m (RawDocument (DomBuilderSpace m))
askDocument
initialFocus <- Node.isSameNode (toNode $ _element_raw e) . fmap toNode =<< Document.getActiveElement doc
holdDyn initialFocus $ leftmost
[ False <$ Reflex.select (_element_events e) (WrapArg Blur)
, True <$ Reflex.select (_element_events e) (WrapArg Focus)
]
insertBefore :: (MonadJSM m, IsNode new, IsNode existing) => new -> existing -> m ()
insertBefore :: forall (m :: * -> *) self node.
(MonadDOM m, IsNode self, IsNode node) =>
self -> node -> m ()
insertBefore new
new existing
existing = do
p <- existing -> m Node
forall (m :: * -> *) self.
(MonadDOM m, IsNode self) =>
self -> m Node
getParentNodeUnchecked existing
existing
Node.insertBefore_ p new (Just existing)
type ImmediateDomBuilderT = HydrationDomBuilderT GhcjsDomSpace
instance PerformEvent t m => PerformEvent t (HydrationDomBuilderT s t m) where
type Performable (HydrationDomBuilderT s t m) = Performable m
{-# INLINABLE performEvent_ #-}
performEvent_ :: Event t (Performable (HydrationDomBuilderT s t m) ())
-> HydrationDomBuilderT s t m ()
performEvent_ Event t (Performable (HydrationDomBuilderT s t m) ())
e = m () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> HydrationDomBuilderT s t m ())
-> m () -> HydrationDomBuilderT s t m ()
forall a b. (a -> b) -> a -> b
$ Event t (Performable m ()) -> m ()
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_ Event t (Performable m ())
Event t (Performable (HydrationDomBuilderT s t m) ())
e
{-# INLINABLE performEvent #-}
performEvent :: forall a.
Event t (Performable (HydrationDomBuilderT s t m) a)
-> HydrationDomBuilderT s t m (Event t a)
performEvent Event t (Performable (HydrationDomBuilderT s t m) a)
e = m (Event t a) -> HydrationDomBuilderT s t m (Event t a)
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> HydrationDomBuilderT s t m (Event t a))
-> m (Event t a) -> HydrationDomBuilderT s t m (Event t a)
forall a b. (a -> b) -> a -> b
$ Event t (Performable m a) -> m (Event t a)
forall a. Event t (Performable m a) -> m (Event t a)
forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent Event t (Performable m a)
Event t (Performable (HydrationDomBuilderT s t m) a)
e
instance PostBuild t m => PostBuild t (HydrationDomBuilderT s t m) where
{-# INLINABLE getPostBuild #-}
getPostBuild :: HydrationDomBuilderT s t m (Event t ())
getPostBuild = m (Event t ()) -> HydrationDomBuilderT s t m (Event t ())
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationDomBuilderT s t m) where
{-# INLINABLE newEventWithTrigger #-}
newEventWithTrigger :: forall a.
(EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT s t m (Event t a)
newEventWithTrigger = m (Event t a) -> HydrationDomBuilderT s t m (Event t a)
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> HydrationDomBuilderT s t m (Event t a))
-> ((EventTrigger t a -> IO (IO ())) -> m (Event t a))
-> (EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT s t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventTrigger t a -> IO (IO ())) -> m (Event t a)
forall a. (EventTrigger t a -> IO (IO ())) -> m (Event t a)
forall t (m :: * -> *) a.
MonadReflexCreateTrigger t m =>
(EventTrigger t a -> IO (IO ())) -> m (Event t a)
newEventWithTrigger
{-# INLINABLE newFanEventWithTrigger #-}
newFanEventWithTrigger :: forall (k :: * -> *).
GCompare k =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> HydrationDomBuilderT s t m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f = m (EventSelector t k)
-> HydrationDomBuilderT s t m (EventSelector t k)
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (EventSelector t k)
-> HydrationDomBuilderT s t m (EventSelector t k))
-> m (EventSelector t k)
-> HydrationDomBuilderT s t m (EventSelector t k)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
forall (k :: * -> *).
GCompare k =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger k a -> EventTrigger t a -> IO (IO ())
forall a. k a -> EventTrigger t a -> IO (IO ())
f
instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (HydrationDomBuilderT s t m) where
{-# INLINABLE newTriggerEvent #-}
newTriggerEvent :: forall a. HydrationDomBuilderT s t m (Event t a, a -> IO ())
newTriggerEvent = ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO ())
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO ()))
-> (DomRenderHookT t m (Event t a, a -> IO ())
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO ()))
-> DomRenderHookT t m (Event t a, a -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a, a -> IO ())
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO ())
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a, a -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO ()))
-> DomRenderHookT t m (Event t a, a -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO ())
forall a b. (a -> b) -> a -> b
$ DomRenderHookT t m (Event t a, a -> IO ())
forall a. DomRenderHookT t m (Event t a, a -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
{-# INLINABLE newTriggerEventWithOnComplete #-}
newTriggerEventWithOnComplete :: forall a.
HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete = ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO () -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ())
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO () -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ()))
-> (DomRenderHookT t m (Event t a, a -> IO () -> IO ())
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO () -> IO ()))
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a, a -> IO () -> IO ())
-> ReaderT
(HydrationDomBuilderEnv t m)
(DomRenderHookT t m)
(Event t a, a -> IO () -> IO ())
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a, a -> IO () -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ()))
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
-> HydrationDomBuilderT s t m (Event t a, a -> IO () -> IO ())
forall a b. (a -> b) -> a -> b
$ DomRenderHookT t m (Event t a, a -> IO () -> IO ())
forall a. DomRenderHookT t m (Event t a, a -> IO () -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete
{-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
newEventWithLazyTriggerWithOnComplete :: forall a.
((a -> IO () -> IO ()) -> IO (IO ()))
-> HydrationDomBuilderT s t m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
f = ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
-> HydrationDomBuilderT s t m (Event t a)
forall {k} (s :: k) t (m :: * -> *) a.
ReaderT (HydrationDomBuilderEnv t m) (DomRenderHookT t m) a
-> HydrationDomBuilderT s t m a
HydrationDomBuilderT (ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
-> HydrationDomBuilderT s t m (Event t a))
-> (DomRenderHookT t m (Event t a)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a))
-> DomRenderHookT t m (Event t a)
-> HydrationDomBuilderT s t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DomRenderHookT t m (Event t a)
-> ReaderT
(HydrationDomBuilderEnv t m) (DomRenderHookT t m) (Event t a)
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (HydrationDomBuilderEnv t m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (DomRenderHookT t m (Event t a)
-> HydrationDomBuilderT s t m (Event t a))
-> DomRenderHookT t m (Event t a)
-> HydrationDomBuilderT s t m (Event t a)
forall a b. (a -> b) -> a -> b
$ ((a -> IO () -> IO ()) -> IO (IO ()))
-> DomRenderHookT t m (Event t a)
forall a.
((a -> IO () -> IO ()) -> IO (IO ()))
-> DomRenderHookT t m (Event t a)
forall t (m :: * -> *) a.
TriggerEvent t m =>
((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
f
instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) => TriggerEvent t (DomRenderHookT t m) where
{-# INLINABLE newTriggerEvent #-}
newTriggerEvent :: forall a. DomRenderHookT t m (Event t a, a -> IO ())
newTriggerEvent = RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO ())
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO ()))
-> (TriggerEventT t m (Event t a, a -> IO ())
-> RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO ()))
-> TriggerEventT t m (Event t a, a -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT t m (Event t a, a -> IO ())
-> RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO ())
forall (m :: * -> *) a.
Monad m =>
m a -> RequesterT t JSM Identity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m (Event t a, a -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO ()))
-> TriggerEventT t m (Event t a, a -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO ())
forall a b. (a -> b) -> a -> b
$ TriggerEventT t m (Event t a, a -> IO ())
forall a. TriggerEventT t m (Event t a, a -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
{-# INLINABLE newTriggerEventWithOnComplete #-}
newTriggerEventWithOnComplete :: forall a. DomRenderHookT t m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete = RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO () -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO () -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ()))
-> (TriggerEventT t m (Event t a, a -> IO () -> IO ())
-> RequesterT
t
JSM
Identity
(TriggerEventT t m)
(Event t a, a -> IO () -> IO ()))
-> TriggerEventT t m (Event t a, a -> IO () -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT t m (Event t a, a -> IO () -> IO ())
-> RequesterT
t JSM Identity (TriggerEventT t m) (Event t a, a -> IO () -> IO ())
forall (m :: * -> *) a.
Monad m =>
m a -> RequesterT t JSM Identity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m (Event t a, a -> IO () -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ()))
-> TriggerEventT t m (Event t a, a -> IO () -> IO ())
-> DomRenderHookT t m (Event t a, a -> IO () -> IO ())
forall a b. (a -> b) -> a -> b
$ TriggerEventT t m (Event t a, a -> IO () -> IO ())
forall a. TriggerEventT t m (Event t a, a -> IO () -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete
{-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
newEventWithLazyTriggerWithOnComplete :: forall a.
((a -> IO () -> IO ()) -> IO (IO ()))
-> DomRenderHookT t m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
f = RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
-> DomRenderHookT t m (Event t a)
forall t (m :: * -> *) a.
RequesterT t JSM Identity (TriggerEventT t m) a
-> DomRenderHookT t m a
DomRenderHookT (RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
-> DomRenderHookT t m (Event t a))
-> (TriggerEventT t m (Event t a)
-> RequesterT t JSM Identity (TriggerEventT t m) (Event t a))
-> TriggerEventT t m (Event t a)
-> DomRenderHookT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TriggerEventT t m (Event t a)
-> RequesterT t JSM Identity (TriggerEventT t m) (Event t a)
forall (m :: * -> *) a.
Monad m =>
m a -> RequesterT t JSM Identity m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TriggerEventT t m (Event t a) -> DomRenderHookT t m (Event t a))
-> TriggerEventT t m (Event t a) -> DomRenderHookT t m (Event t a)
forall a b. (a -> b) -> a -> b
$ ((a -> IO () -> IO ()) -> IO (IO ()))
-> TriggerEventT t m (Event t a)
forall a.
((a -> IO () -> IO ()) -> IO (IO ()))
-> TriggerEventT t m (Event t a)
forall t (m :: * -> *) a.
TriggerEvent t m =>
((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
f
instance MonadRef m => MonadRef (HydrationDomBuilderT s t m) where
type Ref (HydrationDomBuilderT s t m) = Ref m
{-# INLINABLE newRef #-}
newRef :: forall a.
a
-> HydrationDomBuilderT s t m (Ref (HydrationDomBuilderT s t m) a)
newRef = m (Ref m a) -> HydrationDomBuilderT s t m (Ref m a)
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Ref m a) -> HydrationDomBuilderT s t m (Ref m a))
-> (a -> m (Ref m a)) -> a -> HydrationDomBuilderT s t m (Ref m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Ref m a)
forall a. a -> m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
{-# INLINABLE readRef #-}
readRef :: forall a.
Ref (HydrationDomBuilderT s t m) a -> HydrationDomBuilderT s t m a
readRef = m a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> (Ref m a -> m a) -> Ref m a -> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> m a
forall a. Ref m a -> m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
{-# INLINABLE writeRef #-}
writeRef :: forall a.
Ref (HydrationDomBuilderT s t m) a
-> a -> HydrationDomBuilderT s t m ()
writeRef Ref (HydrationDomBuilderT s t m) a
r = m () -> HydrationDomBuilderT s t m ()
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> HydrationDomBuilderT s t m ())
-> (a -> m ()) -> a -> HydrationDomBuilderT s t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> a -> m ()
forall a. Ref m a -> a -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef Ref m a
Ref (HydrationDomBuilderT s t m) a
r
instance MonadAtomicRef m => MonadAtomicRef (HydrationDomBuilderT s t m) where
{-# INLINABLE atomicModifyRef #-}
atomicModifyRef :: forall a b.
Ref (HydrationDomBuilderT s t m) a
-> (a -> (a, b)) -> HydrationDomBuilderT s t m b
atomicModifyRef Ref (HydrationDomBuilderT s t m) a
r = m b -> HydrationDomBuilderT s t m b
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> HydrationDomBuilderT s t m b)
-> ((a -> (a, b)) -> m b)
-> (a -> (a, b))
-> HydrationDomBuilderT s t m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> (a -> (a, b)) -> m b
forall a b. Ref m a -> (a -> (a, b)) -> m b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef Ref m a
Ref (HydrationDomBuilderT s t m) a
r
type family EventType en where
EventType 'AbortTag = UIEvent
EventType 'BlurTag = FocusEvent
EventType 'ChangeTag = DOM.Event
EventType 'ClickTag = MouseEvent
EventType 'ContextmenuTag = MouseEvent
EventType 'DblclickTag = MouseEvent
EventType 'DragTag = MouseEvent
EventType 'DragendTag = MouseEvent
EventType 'DragenterTag = MouseEvent
EventType 'DragleaveTag = MouseEvent
EventType 'DragoverTag = MouseEvent
EventType 'DragstartTag = MouseEvent
EventType 'DropTag = MouseEvent
EventType 'ErrorTag = UIEvent
EventType 'FocusTag = FocusEvent
EventType 'InputTag = DOM.Event
EventType 'InvalidTag = DOM.Event
EventType 'KeydownTag = KeyboardEvent
EventType 'KeypressTag = KeyboardEvent
EventType 'KeyupTag = KeyboardEvent
EventType 'LoadTag = UIEvent
EventType 'MousedownTag = MouseEvent
EventType 'MouseenterTag = MouseEvent
EventType 'MouseleaveTag = MouseEvent
EventType 'MousemoveTag = MouseEvent
EventType 'MouseoutTag = MouseEvent
EventType 'MouseoverTag = MouseEvent
EventType 'MouseupTag = MouseEvent
EventType 'MousewheelTag = MouseEvent
EventType 'ScrollTag = UIEvent
EventType 'SelectTag = UIEvent
EventType 'SubmitTag = DOM.Event
EventType 'WheelTag = WheelEvent
EventType 'BeforecutTag = ClipboardEvent
EventType 'CutTag = ClipboardEvent
EventType 'BeforecopyTag = ClipboardEvent
EventType 'CopyTag = ClipboardEvent
EventType 'BeforepasteTag = ClipboardEvent
EventType 'PasteTag = ClipboardEvent
EventType 'ResetTag = DOM.Event
EventType 'SearchTag = DOM.Event
EventType 'SelectstartTag = DOM.Event
EventType 'TouchstartTag = TouchEvent
EventType 'TouchmoveTag = TouchEvent
EventType 'TouchendTag = TouchEvent
EventType 'TouchcancelTag = TouchEvent
{-# INLINABLE defaultDomEventHandler #-}
defaultDomEventHandler :: IsElement e => e -> EventName en -> EventM e (EventType en) (Maybe (EventResult en))
defaultDomEventHandler :: forall e (en :: EventTag).
IsElement e =>
e
-> EventName en -> EventM e (EventType en) (Maybe (EventResult en))
defaultDomEventHandler e
e EventName en
evt = (EventResultType en -> Maybe (EventResult en))
-> ReaderT (EventType en) JSM (EventResultType en)
-> ReaderT (EventType en) JSM (Maybe (EventResult en))
forall a b.
(a -> b)
-> ReaderT (EventType en) JSM a -> ReaderT (EventType en) JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EventResult en -> Maybe (EventResult en)
forall a. a -> Maybe a
Just (EventResult en -> Maybe (EventResult en))
-> (EventResultType en -> EventResult en)
-> EventResultType en
-> Maybe (EventResult en)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventResultType en -> EventResult en
forall (en :: EventTag). EventResultType en -> EventResult en
EventResult) (ReaderT (EventType en) JSM (EventResultType en)
-> ReaderT (EventType en) JSM (Maybe (EventResult en)))
-> ReaderT (EventType en) JSM (EventResultType en)
-> ReaderT (EventType en) JSM (Maybe (EventResult en))
forall a b. (a -> b) -> a -> b
$ case EventName en
evt of
EventName en
Click -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dblclick -> EventM (ZonkAny 18) MouseEvent (Int, Int)
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 18) MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Keypress -> EventM (ZonkAny 19) KeyboardEvent Word
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 19) KeyboardEvent Word
getKeyEvent
EventName en
Scroll -> Int -> EventResultType en
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> EventResultType en)
-> ReaderT UIEvent JSM Int
-> ReaderT UIEvent JSM (EventResultType en)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> ReaderT UIEvent JSM Int
forall (m :: * -> *) self.
(MonadDOM m, IsElement self) =>
self -> m Int
getScrollTop e
e
EventName en
Keydown -> EventM (ZonkAny 19) KeyboardEvent Word
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 19) KeyboardEvent Word
getKeyEvent
EventName en
Keyup -> EventM (ZonkAny 19) KeyboardEvent Word
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 19) KeyboardEvent Word
getKeyEvent
EventName en
Mousemove -> EventM (ZonkAny 18) MouseEvent (Int, Int)
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 18) MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Mouseup -> EventM (ZonkAny 18) MouseEvent (Int, Int)
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 18) MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Mousedown -> EventM (ZonkAny 18) MouseEvent (Int, Int)
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 18) MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Mouseenter -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Mouseleave -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Focus -> EventResultType en -> ReaderT FocusEvent JSM (EventResultType en)
forall a. a -> ReaderT FocusEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Blur -> EventResultType en -> ReaderT FocusEvent JSM (EventResultType en)
forall a. a -> ReaderT FocusEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Change -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Drag -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragend -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragenter -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragleave -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragover -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragstart -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Drop -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Abort -> EventResultType en -> ReaderT UIEvent JSM (EventResultType en)
forall a. a -> ReaderT UIEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Contextmenu -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Error -> EventResultType en -> ReaderT UIEvent JSM (EventResultType en)
forall a. a -> ReaderT UIEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Input -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Invalid -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Load -> EventResultType en -> ReaderT UIEvent JSM (EventResultType en)
forall a. a -> ReaderT UIEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Mouseout -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Mouseover -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Select -> EventResultType en -> ReaderT UIEvent JSM (EventResultType en)
forall a. a -> ReaderT UIEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Submit -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforecut -> EventResultType en
-> ReaderT ClipboardEvent JSM (EventResultType en)
forall a. a -> ReaderT ClipboardEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Cut -> EventResultType en
-> ReaderT ClipboardEvent JSM (EventResultType en)
forall a. a -> ReaderT ClipboardEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforecopy -> EventResultType en
-> ReaderT ClipboardEvent JSM (EventResultType en)
forall a. a -> ReaderT ClipboardEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Copy -> EventResultType en
-> ReaderT ClipboardEvent JSM (EventResultType en)
forall a. a -> ReaderT ClipboardEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforepaste -> EventResultType en
-> ReaderT ClipboardEvent JSM (EventResultType en)
forall a. a -> ReaderT ClipboardEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Paste -> EventM (ZonkAny 25) ClipboardEvent (Maybe Text)
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 25) ClipboardEvent (Maybe Text)
getPasteData
EventName en
Reset -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Search -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Selectstart -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Touchstart -> EventM (ZonkAny 26) TouchEvent TouchEventResult
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 26) TouchEvent TouchEventResult
getTouchEvent
EventName en
Touchmove -> EventM (ZonkAny 26) TouchEvent TouchEventResult
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 26) TouchEvent TouchEventResult
getTouchEvent
EventName en
Touchend -> EventM (ZonkAny 26) TouchEvent TouchEventResult
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 26) TouchEvent TouchEventResult
getTouchEvent
EventName en
Touchcancel -> EventM (ZonkAny 26) TouchEvent TouchEventResult
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 26) TouchEvent TouchEventResult
getTouchEvent
EventName en
Mousewheel -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Wheel -> EventM (ZonkAny 30) WheelEvent WheelEventResult
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 30) WheelEvent WheelEventResult
getWheelEvent
{-# INLINABLE defaultDomWindowEventHandler #-}
defaultDomWindowEventHandler :: DOM.Window -> EventName en -> EventM DOM.Window (EventType en) (Maybe (EventResult en))
defaultDomWindowEventHandler :: forall (en :: EventTag).
Window
-> EventName en
-> EventM Window (EventType en) (Maybe (EventResult en))
defaultDomWindowEventHandler Window
w EventName en
evt = (EventResultType en -> Maybe (EventResult en))
-> ReaderT (EventType en) JSM (EventResultType en)
-> ReaderT (EventType en) JSM (Maybe (EventResult en))
forall a b.
(a -> b)
-> ReaderT (EventType en) JSM a -> ReaderT (EventType en) JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EventResult en -> Maybe (EventResult en)
forall a. a -> Maybe a
Just (EventResult en -> Maybe (EventResult en))
-> (EventResultType en -> EventResult en)
-> EventResultType en
-> Maybe (EventResult en)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventResultType en -> EventResult en
forall (en :: EventTag). EventResultType en -> EventResult en
EventResult) (ReaderT (EventType en) JSM (EventResultType en)
-> ReaderT (EventType en) JSM (Maybe (EventResult en)))
-> ReaderT (EventType en) JSM (EventResultType en)
-> ReaderT (EventType en) JSM (Maybe (EventResult en))
forall a b. (a -> b) -> a -> b
$ case EventName en
evt of
EventName en
Click -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dblclick -> EventM (ZonkAny 18) MouseEvent (Int, Int)
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 18) MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Keypress -> EventM (ZonkAny 19) KeyboardEvent Word
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 19) KeyboardEvent Word
getKeyEvent
EventName en
Scroll -> Window -> ReaderT UIEvent JSM Double
forall (m :: * -> *). MonadDOM m => Window -> m Double
Window.getScrollY Window
w
EventName en
Keydown -> EventM (ZonkAny 19) KeyboardEvent Word
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 19) KeyboardEvent Word
getKeyEvent
EventName en
Keyup -> EventM (ZonkAny 19) KeyboardEvent Word
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 19) KeyboardEvent Word
getKeyEvent
EventName en
Mousemove -> EventM (ZonkAny 18) MouseEvent (Int, Int)
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 18) MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Mouseup -> EventM (ZonkAny 18) MouseEvent (Int, Int)
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 18) MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Mousedown -> EventM (ZonkAny 18) MouseEvent (Int, Int)
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 18) MouseEvent (Int, Int)
getMouseEventCoords
EventName en
Mouseenter -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Mouseleave -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Focus -> EventResultType en -> ReaderT FocusEvent JSM (EventResultType en)
forall a. a -> ReaderT FocusEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Blur -> EventResultType en -> ReaderT FocusEvent JSM (EventResultType en)
forall a. a -> ReaderT FocusEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Change -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Drag -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragend -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragenter -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragleave -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragover -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Dragstart -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Drop -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Abort -> EventResultType en -> ReaderT UIEvent JSM (EventResultType en)
forall a. a -> ReaderT UIEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Contextmenu -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Error -> EventResultType en -> ReaderT UIEvent JSM (EventResultType en)
forall a. a -> ReaderT UIEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Input -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Invalid -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Load -> EventResultType en -> ReaderT UIEvent JSM (EventResultType en)
forall a. a -> ReaderT UIEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Mouseout -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Mouseover -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Select -> EventResultType en -> ReaderT UIEvent JSM (EventResultType en)
forall a. a -> ReaderT UIEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Submit -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforecut -> EventResultType en
-> ReaderT ClipboardEvent JSM (EventResultType en)
forall a. a -> ReaderT ClipboardEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Cut -> EventResultType en
-> ReaderT ClipboardEvent JSM (EventResultType en)
forall a. a -> ReaderT ClipboardEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforecopy -> EventResultType en
-> ReaderT ClipboardEvent JSM (EventResultType en)
forall a. a -> ReaderT ClipboardEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Copy -> EventResultType en
-> ReaderT ClipboardEvent JSM (EventResultType en)
forall a. a -> ReaderT ClipboardEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforepaste -> EventResultType en
-> ReaderT ClipboardEvent JSM (EventResultType en)
forall a. a -> ReaderT ClipboardEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Paste -> EventM (ZonkAny 25) ClipboardEvent (Maybe Text)
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 25) ClipboardEvent (Maybe Text)
getPasteData
EventName en
Reset -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Search -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Selectstart -> EventResultType en -> ReaderT Event JSM (EventResultType en)
forall a. a -> ReaderT Event JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Touchstart -> EventM (ZonkAny 26) TouchEvent TouchEventResult
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 26) TouchEvent TouchEventResult
getTouchEvent
EventName en
Touchmove -> EventM (ZonkAny 26) TouchEvent TouchEventResult
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 26) TouchEvent TouchEventResult
getTouchEvent
EventName en
Touchend -> EventM (ZonkAny 26) TouchEvent TouchEventResult
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 26) TouchEvent TouchEventResult
getTouchEvent
EventName en
Touchcancel -> EventM (ZonkAny 26) TouchEvent TouchEventResult
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 26) TouchEvent TouchEventResult
getTouchEvent
EventName en
Mousewheel -> EventResultType en -> ReaderT MouseEvent JSM (EventResultType en)
forall a. a -> ReaderT MouseEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Wheel -> EventM (ZonkAny 30) WheelEvent WheelEventResult
ReaderT (EventType en) JSM (EventResultType en)
forall e. EventM (ZonkAny 30) WheelEvent WheelEventResult
getWheelEvent
{-# INLINABLE withIsEvent #-}
withIsEvent :: EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent :: forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName en
en IsEvent (EventType en) => r
r = case EventName en
en of
EventName en
Click -> r
IsEvent (EventType en) => r
r
EventName en
Dblclick -> r
IsEvent (EventType en) => r
r
EventName en
Keypress -> r
IsEvent (EventType en) => r
r
EventName en
Scroll -> r
IsEvent (EventType en) => r
r
EventName en
Keydown -> r
IsEvent (EventType en) => r
r
EventName en
Keyup -> r
IsEvent (EventType en) => r
r
EventName en
Mousemove -> r
IsEvent (EventType en) => r
r
EventName en
Mouseup -> r
IsEvent (EventType en) => r
r
EventName en
Mousedown -> r
IsEvent (EventType en) => r
r
EventName en
Mouseenter -> r
IsEvent (EventType en) => r
r
EventName en
Mouseleave -> r
IsEvent (EventType en) => r
r
EventName en
Focus -> r
IsEvent (EventType en) => r
r
EventName en
Blur -> r
IsEvent (EventType en) => r
r
EventName en
Change -> r
IsEvent (EventType en) => r
r
EventName en
Drag -> r
IsEvent (EventType en) => r
r
EventName en
Dragend -> r
IsEvent (EventType en) => r
r
EventName en
Dragenter -> r
IsEvent (EventType en) => r
r
EventName en
Dragleave -> r
IsEvent (EventType en) => r
r
EventName en
Dragover -> r
IsEvent (EventType en) => r
r
EventName en
Dragstart -> r
IsEvent (EventType en) => r
r
EventName en
Drop -> r
IsEvent (EventType en) => r
r
EventName en
Abort -> r
IsEvent (EventType en) => r
r
EventName en
Contextmenu -> r
IsEvent (EventType en) => r
r
EventName en
Error -> r
IsEvent (EventType en) => r
r
EventName en
Input -> r
IsEvent (EventType en) => r
r
EventName en
Invalid -> r
IsEvent (EventType en) => r
r
EventName en
Load -> r
IsEvent (EventType en) => r
r
EventName en
Mouseout -> r
IsEvent (EventType en) => r
r
EventName en
Mouseover -> r
IsEvent (EventType en) => r
r
EventName en
Select -> r
IsEvent (EventType en) => r
r
EventName en
Submit -> r
IsEvent (EventType en) => r
r
EventName en
Beforecut -> r
IsEvent (EventType en) => r
r
EventName en
Cut -> r
IsEvent (EventType en) => r
r
EventName en
Beforecopy -> r
IsEvent (EventType en) => r
r
EventName en
Copy -> r
IsEvent (EventType en) => r
r
EventName en
Beforepaste -> r
IsEvent (EventType en) => r
r
EventName en
Paste -> r
IsEvent (EventType en) => r
r
EventName en
Reset -> r
IsEvent (EventType en) => r
r
EventName en
Search -> r
IsEvent (EventType en) => r
r
EventName en
Selectstart -> r
IsEvent (EventType en) => r
r
EventName en
Touchstart -> r
IsEvent (EventType en) => r
r
EventName en
Touchmove -> r
IsEvent (EventType en) => r
r
EventName en
Touchend -> r
IsEvent (EventType en) => r
r
EventName en
Touchcancel -> r
IsEvent (EventType en) => r
r
EventName en
Mousewheel -> r
IsEvent (EventType en) => r
r
EventName en
Wheel -> r
IsEvent (EventType en) => r
r
showEventName :: EventName en -> String
showEventName :: forall (en :: EventTag). EventName en -> String
showEventName EventName en
en = case EventName en
en of
EventName en
Abort -> String
"Abort"
EventName en
Blur -> String
"Blur"
EventName en
Change -> String
"Change"
EventName en
Click -> String
"Click"
EventName en
Contextmenu -> String
"Contextmenu"
EventName en
Dblclick -> String
"Dblclick"
EventName en
Drag -> String
"Drag"
EventName en
Dragend -> String
"Dragend"
EventName en
Dragenter -> String
"Dragenter"
EventName en
Dragleave -> String
"Dragleave"
EventName en
Dragover -> String
"Dragover"
EventName en
Dragstart -> String
"Dragstart"
EventName en
Drop -> String
"Drop"
EventName en
Error -> String
"Error"
EventName en
Focus -> String
"Focus"
EventName en
Input -> String
"Input"
EventName en
Invalid -> String
"Invalid"
EventName en
Keydown -> String
"Keydown"
EventName en
Keypress -> String
"Keypress"
EventName en
Keyup -> String
"Keyup"
EventName en
Load -> String
"Load"
EventName en
Mousedown -> String
"Mousedown"
EventName en
Mouseenter -> String
"Mouseenter"
EventName en
Mouseleave -> String
"Mouseleave"
EventName en
Mousemove -> String
"Mousemove"
EventName en
Mouseout -> String
"Mouseout"
EventName en
Mouseover -> String
"Mouseover"
EventName en
Mouseup -> String
"Mouseup"
EventName en
Mousewheel -> String
"Mousewheel"
EventName en
Scroll -> String
"Scroll"
EventName en
Select -> String
"Select"
EventName en
Submit -> String
"Submit"
EventName en
Wheel -> String
"Wheel"
EventName en
Beforecut -> String
"Beforecut"
EventName en
Cut -> String
"Cut"
EventName en
Beforecopy -> String
"Beforecopy"
EventName en
Copy -> String
"Copy"
EventName en
Beforepaste -> String
"Beforepaste"
EventName en
Paste -> String
"Paste"
EventName en
Reset -> String
"Reset"
EventName en
Search -> String
"Search"
EventName en
Selectstart -> String
"Selectstart"
EventName en
Touchstart -> String
"Touchstart"
EventName en
Touchmove -> String
"Touchmove"
EventName en
Touchend -> String
"Touchend"
EventName en
Touchcancel -> String
"Touchcancel"
newtype ElementEventTarget = ElementEventTarget DOM.Element deriving (Coercible ElementEventTarget JSVal
FromJSVal ElementEventTarget
ToJSVal ElementEventTarget
(ToJSVal ElementEventTarget, FromJSVal ElementEventTarget,
Coercible ElementEventTarget JSVal) =>
(ElementEventTarget -> JSM GType) -> IsGObject ElementEventTarget
ElementEventTarget -> JSM GType
forall o.
(ToJSVal o, FromJSVal o, Coercible o JSVal) =>
(o -> JSM GType) -> IsGObject o
$ctypeGType :: ElementEventTarget -> JSM GType
typeGType :: ElementEventTarget -> JSM GType
DOM.IsGObject, [ElementEventTarget] -> JSM JSVal
ElementEventTarget -> JSM JSVal
(ElementEventTarget -> JSM JSVal)
-> ([ElementEventTarget] -> JSM JSVal)
-> ToJSVal ElementEventTarget
forall a. (a -> JSM JSVal) -> ([a] -> JSM JSVal) -> ToJSVal a
$ctoJSVal :: ElementEventTarget -> JSM JSVal
toJSVal :: ElementEventTarget -> JSM JSVal
$ctoJSValListOf :: [ElementEventTarget] -> JSM JSVal
toJSValListOf :: [ElementEventTarget] -> JSM JSVal
DOM.ToJSVal, IsGObject ElementEventTarget
IsGObject ElementEventTarget => IsSlotable ElementEventTarget
forall o. IsGObject o => IsSlotable o
DOM.IsSlotable, IsGObject ElementEventTarget
IsGObject ElementEventTarget => IsParentNode ElementEventTarget
forall o. IsGObject o => IsParentNode o
DOM.IsParentNode, IsGObject ElementEventTarget
IsGObject ElementEventTarget =>
IsNonDocumentTypeChildNode ElementEventTarget
forall o. IsGObject o => IsNonDocumentTypeChildNode o
DOM.IsNonDocumentTypeChildNode, IsGObject ElementEventTarget
IsGObject ElementEventTarget => IsChildNode ElementEventTarget
forall o. IsGObject o => IsChildNode o
DOM.IsChildNode, IsGObject ElementEventTarget
IsGObject ElementEventTarget => IsAnimatable ElementEventTarget
forall o. IsGObject o => IsAnimatable o
DOM.IsAnimatable, IsEventTarget ElementEventTarget
IsGObject ElementEventTarget
(IsEventTarget ElementEventTarget, IsGObject ElementEventTarget) =>
IsNode ElementEventTarget
forall o. (IsEventTarget o, IsGObject o) => IsNode o
IsNode, IsSlotable ElementEventTarget
IsParentNode ElementEventTarget
IsNonDocumentTypeChildNode ElementEventTarget
IsNode ElementEventTarget
IsEventTarget ElementEventTarget
IsDocumentAndElementEventHandlers ElementEventTarget
IsChildNode ElementEventTarget
IsAnimatable ElementEventTarget
IsGObject ElementEventTarget
(IsNode ElementEventTarget, IsEventTarget ElementEventTarget,
IsSlotable ElementEventTarget, IsParentNode ElementEventTarget,
IsNonDocumentTypeChildNode ElementEventTarget,
IsDocumentAndElementEventHandlers ElementEventTarget,
IsChildNode ElementEventTarget, IsAnimatable ElementEventTarget,
IsGObject ElementEventTarget) =>
IsElement ElementEventTarget
forall o.
(IsNode o, IsEventTarget o, IsSlotable o, IsParentNode o,
IsNonDocumentTypeChildNode o, IsDocumentAndElementEventHandlers o,
IsChildNode o, IsAnimatable o, IsGObject o) =>
IsElement o
IsElement)
instance DOM.FromJSVal ElementEventTarget where
fromJSVal :: JSVal -> JSM (Maybe ElementEventTarget)
fromJSVal = (Maybe Element -> Maybe ElementEventTarget)
-> JSM (Maybe Element) -> JSM (Maybe ElementEventTarget)
forall a b. (a -> b) -> JSM a -> JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Element -> ElementEventTarget)
-> Maybe Element -> Maybe ElementEventTarget
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> ElementEventTarget
ElementEventTarget) (JSM (Maybe Element) -> JSM (Maybe ElementEventTarget))
-> (JSVal -> JSM (Maybe Element))
-> JSVal
-> JSM (Maybe ElementEventTarget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSVal -> JSM (Maybe Element)
forall a. FromJSVal a => JSVal -> JSM (Maybe a)
DOM.fromJSVal
instance DOM.IsEventTarget ElementEventTarget
instance DOM.IsGlobalEventHandlers ElementEventTarget
instance DOM.IsDocumentAndElementEventHandlers ElementEventTarget
{-# INLINABLE elementOnEventName #-}
elementOnEventName :: IsElement e => EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
elementOnEventName :: forall e (en :: EventTag).
IsElement e =>
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
elementOnEventName EventName en
en e
e_ = let e :: ElementEventTarget
e = Element -> ElementEventTarget
ElementEventTarget (e -> Element
forall o. IsElement o => o -> Element
DOM.toElement e
e_) in case EventName en
en of
EventName en
Abort -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.abort
EventName en
Blur -> ElementEventTarget
-> EventName ElementEventTarget FocusEvent
-> EventM ElementEventTarget FocusEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget FocusEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self FocusEvent
Events.blur
EventName en
Change -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.change
EventName en
Click -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.click
EventName en
Contextmenu -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.contextMenu
EventName en
Dblclick -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dblClick
EventName en
Drag -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.drag
EventName en
Dragend -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragEnd
EventName en
Dragenter -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragEnter
EventName en
Dragleave -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragLeave
EventName en
Dragover -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragOver
EventName en
Dragstart -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragStart
EventName en
Drop -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.drop
EventName en
Error -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.error
EventName en
Focus -> ElementEventTarget
-> EventName ElementEventTarget FocusEvent
-> EventM ElementEventTarget FocusEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget FocusEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self FocusEvent
Events.focus
EventName en
Input -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.input
EventName en
Invalid -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.invalid
EventName en
Keydown -> ElementEventTarget
-> EventName ElementEventTarget KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyDown
EventName en
Keypress -> ElementEventTarget
-> EventName ElementEventTarget KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyPress
EventName en
Keyup -> ElementEventTarget
-> EventName ElementEventTarget KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyUp
EventName en
Load -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.load
EventName en
Mousedown -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseDown
EventName en
Mouseenter -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseEnter
EventName en
Mouseleave -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseLeave
EventName en
Mousemove -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseMove
EventName en
Mouseout -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseOut
EventName en
Mouseover -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseOver
EventName en
Mouseup -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseUp
EventName en
Mousewheel -> ElementEventTarget
-> EventName ElementEventTarget MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseWheel
EventName en
Scroll -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.scroll
EventName en
Select -> ElementEventTarget
-> EventName ElementEventTarget UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.select
EventName en
Submit -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.submit
EventName en
Wheel -> ElementEventTarget
-> EventName ElementEventTarget WheelEvent
-> EventM ElementEventTarget WheelEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget WheelEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self WheelEvent
Events.wheel
EventName en
Beforecut -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.beforeCut
EventName en
Cut -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.cut
EventName en
Beforecopy -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.beforeCopy
EventName en
Copy -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.copy
EventName en
Beforepaste -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.beforePaste
EventName en
Paste -> ElementEventTarget
-> EventName ElementEventTarget ClipboardEvent
-> EventM ElementEventTarget ClipboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget ClipboardEvent
forall self.
(IsDocumentAndElementEventHandlers self, IsEventTarget self) =>
EventName self ClipboardEvent
Events.paste
EventName en
Reset -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.reset
EventName en
Search -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.search
EventName en
Selectstart -> ElementEventTarget
-> EventName ElementEventTarget Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget Event
forall self.
(IsElement self, IsEventTarget self) =>
EventName self Event
Element.selectStart
EventName en
Touchstart -> ElementEventTarget
-> EventName ElementEventTarget TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchStart
EventName en
Touchmove -> ElementEventTarget
-> EventName ElementEventTarget TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchMove
EventName en
Touchend -> ElementEventTarget
-> EventName ElementEventTarget TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchEnd
EventName en
Touchcancel -> ElementEventTarget
-> EventName ElementEventTarget TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on ElementEventTarget
e EventName ElementEventTarget TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchCancel
{-# INLINABLE windowOnEventName #-}
windowOnEventName :: EventName en -> DOM.Window -> EventM DOM.Window (EventType en) () -> JSM (JSM ())
windowOnEventName :: forall (en :: EventTag).
EventName en
-> Window -> EventM Window (EventType en) () -> JSM (JSM ())
windowOnEventName EventName en
en Window
e = case EventName en
en of
EventName en
Abort -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.abort
EventName en
Blur -> Window
-> EventName Window FocusEvent
-> EventM ElementEventTarget FocusEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window FocusEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self FocusEvent
Events.blur
EventName en
Change -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.change
EventName en
Click -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.click
EventName en
Contextmenu -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.contextMenu
EventName en
Dblclick -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dblClick
EventName en
Drag -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.drag
EventName en
Dragend -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragEnd
EventName en
Dragenter -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragEnter
EventName en
Dragleave -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragLeave
EventName en
Dragover -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragOver
EventName en
Dragstart -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.dragStart
EventName en
Drop -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.drop
EventName en
Error -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.error
EventName en
Focus -> Window
-> EventName Window FocusEvent
-> EventM ElementEventTarget FocusEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window FocusEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self FocusEvent
Events.focus
EventName en
Input -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.input
EventName en
Invalid -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.invalid
EventName en
Keydown -> Window
-> EventName Window KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyDown
EventName en
Keypress -> Window
-> EventName Window KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyPress
EventName en
Keyup -> Window
-> EventName Window KeyboardEvent
-> EventM ElementEventTarget KeyboardEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window KeyboardEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self KeyboardEvent
Events.keyUp
EventName en
Load -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.load
EventName en
Mousedown -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseDown
EventName en
Mouseenter -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseEnter
EventName en
Mouseleave -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseLeave
EventName en
Mousemove -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseMove
EventName en
Mouseout -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseOut
EventName en
Mouseover -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseOver
EventName en
Mouseup -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseUp
EventName en
Mousewheel -> Window
-> EventName Window MouseEvent
-> EventM HTMLInputElement MouseEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window MouseEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self MouseEvent
Events.mouseWheel
EventName en
Scroll -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.scroll
EventName en
Select -> Window
-> EventName Window UIEvent
-> EventM ElementEventTarget UIEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window UIEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self UIEvent
Events.select
EventName en
Submit -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.submit
EventName en
Wheel -> Window
-> EventName Window WheelEvent
-> EventM ElementEventTarget WheelEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window WheelEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self WheelEvent
Events.wheel
EventName en
Beforecut -> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Cut -> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforecopy -> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Copy -> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Beforepaste -> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Paste -> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Reset -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.reset
EventName en
Search -> Window
-> EventName Window Event
-> EventM HTMLInputElement Event ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window Event
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self Event
Events.search
EventName en
Selectstart -> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. a -> b -> a
const (JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ()))
-> JSM (JSM ()) -> EventM Window (EventType en) () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ JSM () -> JSM (JSM ())
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return (JSM () -> JSM (JSM ())) -> JSM () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ () -> JSM ()
forall a. a -> JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
EventName en
Touchstart -> Window
-> EventName Window TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchStart
EventName en
Touchmove -> Window
-> EventName Window TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchMove
EventName en
Touchend -> Window
-> EventName Window TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchEnd
EventName en
Touchcancel -> Window
-> EventName Window TouchEvent
-> EventM ElementEventTarget TouchEvent ()
-> JSM (JSM ())
forall t e.
(IsEventTarget t, IsEvent e) =>
t -> EventName t e -> EventM t e () -> JSM (JSM ())
on Window
e EventName Window TouchEvent
forall self.
(IsGlobalEventHandlers self, IsEventTarget self) =>
EventName self TouchEvent
Events.touchCancel
{-# INLINABLE wrapDomEvent #-}
wrapDomEvent :: (TriggerEvent t m, MonadJSM m) => e -> (e -> EventM e event () -> JSM (JSM ())) -> EventM e event a -> m (Event t a)
wrapDomEvent :: forall t (m :: * -> *) e event a.
(TriggerEvent t m, MonadJSM m) =>
e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event a
-> m (Event t a)
wrapDomEvent e
el e -> EventM e event () -> JSM (JSM ())
elementOnevent EventM e event a
getValue = e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> m (Event t a)
forall t (m :: * -> *) e event a.
(TriggerEvent t m, MonadJSM m) =>
e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> m (Event t a)
wrapDomEventMaybe e
el e -> EventM e event () -> JSM (JSM ())
elementOnevent (EventM e event (Maybe a) -> m (Event t a))
-> EventM e event (Maybe a) -> m (Event t a)
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a) -> EventM e event a -> EventM e event (Maybe a)
forall a b. (a -> b) -> ReaderT event JSM a -> ReaderT event JSM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just EventM e event a
getValue
{-# INLINABLE subscribeDomEvent #-}
subscribeDomEvent :: (EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> EventTrigger t a
-> JSM (JSM ())
subscribeDomEvent :: forall e event a t.
(EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> EventTrigger t a
-> JSM (JSM ())
subscribeDomEvent EventM e event () -> JSM (JSM ())
elementOnevent EventM e event (Maybe a)
getValue Chan [DSum (EventTriggerRef t) TriggerInvocation]
eventChan EventTrigger t a
et = EventM e event () -> JSM (JSM ())
elementOnevent (EventM e event () -> JSM (JSM ()))
-> EventM e event () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
mv <- EventM e event (Maybe a)
getValue
forM_ mv $ \a
v -> IO () -> EventM e event ()
forall a. IO a -> ReaderT event JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM e event ()) -> IO () -> EventM e event ()
forall a b. (a -> b) -> a -> b
$ do
etr <- Maybe (EventTrigger t a) -> IO (IORef (Maybe (EventTrigger t a)))
forall a. a -> IO (IORef a)
newIORef (Maybe (EventTrigger t a) -> IO (IORef (Maybe (EventTrigger t a))))
-> Maybe (EventTrigger t a)
-> IO (IORef (Maybe (EventTrigger t a)))
forall a b. (a -> b) -> a -> b
$ EventTrigger t a -> Maybe (EventTrigger t a)
forall a. a -> Maybe a
Just EventTrigger t a
et
writeChan eventChan [EventTriggerRef etr :=> TriggerInvocation v (return ())]
{-# INLINABLE wrapDomEventMaybe #-}
wrapDomEventMaybe :: (TriggerEvent t m, MonadJSM m)
=> e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> m (Event t a)
wrapDomEventMaybe :: forall t (m :: * -> *) e event a.
(TriggerEvent t m, MonadJSM m) =>
e
-> (e -> EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> m (Event t a)
wrapDomEventMaybe e
el e -> EventM e event () -> JSM (JSM ())
elementOnevent EventM e event (Maybe a)
getValue = do
ctx <- m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
newEventWithLazyTriggerWithOnComplete $ \a -> IO () -> IO ()
trigger -> (JSM () -> JSContextRef -> IO ()
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM () -> IO ()) -> IO (JSM ()) -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JSM (JSM ()) -> JSContextRef -> IO (JSM ())
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (e -> EventM e event () -> JSM (JSM ())
elementOnevent e
el (EventM e event () -> JSM (JSM ()))
-> EventM e event () -> JSM (JSM ())
forall a b. (a -> b) -> a -> b
$ do
mv <- EventM e event (Maybe a)
getValue
forM_ mv $ \a
v -> IO () -> EventM e event ()
forall a. IO a -> ReaderT event JSM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM e event ()) -> IO () -> EventM e event ()
forall a b. (a -> b) -> a -> b
$ a -> IO () -> IO ()
trigger a
v (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINABLE wrapDomEventsMaybe #-}
wrapDomEventsMaybe :: (MonadJSM m, MonadReflexCreateTrigger t m)
=> e
-> (forall en. IsEvent (EventType en) => EventName en -> EventM e (EventType en) (Maybe (f en)))
-> (forall en. EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ()))
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
wrapDomEventsMaybe :: forall (m :: * -> *) t e (f :: EventTag -> *).
(MonadJSM m, MonadReflexCreateTrigger t m) =>
e
-> (forall (en :: EventTag).
IsEvent (EventType en) =>
EventName en -> EventM e (EventType en) (Maybe (f en)))
-> (forall (en :: EventTag).
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ()))
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
wrapDomEventsMaybe e
target forall (en :: EventTag).
IsEvent (EventType en) =>
EventName en -> EventM e (EventType en) (Maybe (f en))
handlers forall (en :: EventTag).
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
onEventName = do
ctx <- HydrationDomBuilderT GhcjsDomSpace t m JSContextRef
forall (m :: * -> *). MonadJSM m => m JSContextRef
askJSM
eventChan <- askEvents
e <- lift $ newFanEventWithTrigger $ \(WrapArg EventName a1
en) -> EventName a1
-> (IsEvent (EventType a1) => EventTrigger t (f a1) -> IO (IO ()))
-> EventTrigger t (f a1)
-> IO (IO ())
forall (en :: EventTag) r.
EventName en -> (IsEvent (EventType en) => r) -> r
withIsEvent EventName a1
en
(((JSM () -> JSContextRef -> IO ()
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM () -> IO ()) -> IO (JSM ()) -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO (JSM ()) -> IO (IO ()))
-> (EventTrigger t (f a1) -> IO (JSM ()))
-> EventTrigger t (f a1)
-> IO (IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JSM (JSM ()) -> JSContextRef -> IO (JSM ())
forall (m :: * -> *) a. MonadIO m => JSM a -> JSContextRef -> m a
`runJSM` JSContextRef
ctx) (JSM (JSM ()) -> IO (JSM ()))
-> (EventTrigger t (f a1) -> JSM (JSM ()))
-> EventTrigger t (f a1)
-> IO (JSM ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventM (ZonkAny 36) (EventType a1) () -> JSM (JSM ()))
-> EventM (ZonkAny 36) (EventType a1) (Maybe (f a1))
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> EventTrigger t (f a1)
-> JSM (JSM ())
forall e event a t.
(EventM e event () -> JSM (JSM ()))
-> EventM e event (Maybe a)
-> Chan [DSum (EventTriggerRef t) TriggerInvocation]
-> EventTrigger t a
-> JSM (JSM ())
subscribeDomEvent (EventName a1
-> e -> EventM (ZonkAny 36) (EventType a1) () -> JSM (JSM ())
forall (en :: EventTag).
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
onEventName EventName a1
en e
target) (EventName a1 -> EventM (ZonkAny 36) (EventType a1) (Maybe (f a1))
forall (en :: EventTag).
IsEvent (EventType en) =>
EventName en -> EventM e (EventType en) (Maybe (f en))
handlers EventName a1
en) Chan [DSum (EventTriggerRef t) TriggerInvocation]
eventChan)
return $! e
{-# INLINABLE getKeyEvent #-}
getKeyEvent :: EventM e KeyboardEvent Word
getKeyEvent :: forall e. EventM (ZonkAny 19) KeyboardEvent Word
getKeyEvent = do
e <- EventM (ZonkAny 4) KeyboardEvent KeyboardEvent
forall t e. EventM t e e
event
which <- KeyboardEvent.getWhich e
if which /= 0 then return which else do
charCode <- getCharCode e
if charCode /= 0 then return charCode else
getKeyCode e
{-# INLINABLE getMouseEventCoords #-}
getMouseEventCoords :: EventM e MouseEvent (Int, Int)
getMouseEventCoords :: forall e. EventM (ZonkAny 18) MouseEvent (Int, Int)
getMouseEventCoords = do
e <- EventM (ZonkAny 3) MouseEvent MouseEvent
forall t e. EventM t e e
event
bisequence (getClientX e, getClientY e)
{-# INLINABLE getPasteData #-}
getPasteData :: EventM e ClipboardEvent (Maybe Text)
getPasteData :: forall e. EventM (ZonkAny 25) ClipboardEvent (Maybe Text)
getPasteData = do
e <- EventM (ZonkAny 2) ClipboardEvent ClipboardEvent
forall t e. EventM t e e
event
mdt <- ClipboardEvent.getClipboardData e
case mdt of
Maybe DataTransfer
Nothing -> Maybe Text -> EventM (ZonkAny 25) ClipboardEvent (Maybe Text)
forall a. a -> ReaderT ClipboardEvent JSM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
Just DataTransfer
dt -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> ReaderT ClipboardEvent JSM Text
-> EventM (ZonkAny 25) ClipboardEvent (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DataTransfer -> Text -> ReaderT ClipboardEvent JSM Text
forall (m :: * -> *) format result.
(MonadDOM m, ToJSString format, FromJSString result) =>
DataTransfer -> format -> m result
DataTransfer.getData DataTransfer
dt (Text
"text" :: Text)
{-# INLINABLE getTouchEvent #-}
getTouchEvent :: EventM e TouchEvent TouchEventResult
getTouchEvent :: forall e. EventM (ZonkAny 26) TouchEvent TouchEventResult
getTouchEvent = do
let touchResults :: TouchList -> m [TouchResult]
touchResults TouchList
ts = do
n <- TouchList -> m Word
forall (m :: * -> *). MonadDOM m => TouchList -> m Word
TouchList.getLength TouchList
ts
forM (takeWhile (< n) [0..]) $ \Word
ix -> do
t <- TouchList -> Word -> m Touch
forall (m :: * -> *). MonadDOM m => TouchList -> Word -> m Touch
TouchList.item TouchList
ts Word
ix
identifier <- Touch.getIdentifier t
screenX <- Touch.getScreenX t
screenY <- Touch.getScreenY t
clientX <- Touch.getClientX t
clientY <- Touch.getClientY t
pageX <- Touch.getPageX t
pageY <- Touch.getPageY t
return TouchResult
{ _touchResult_identifier = identifier
, _touchResult_screenX = screenX
, _touchResult_screenY = screenY
, _touchResult_clientX = clientX
, _touchResult_clientY = clientY
, _touchResult_pageX = pageX
, _touchResult_pageY = pageY
}
e <- EventM (ZonkAny 1) TouchEvent TouchEvent
forall t e. EventM t e e
event
altKey <- TouchEvent.getAltKey e
ctrlKey <- TouchEvent.getCtrlKey e
shiftKey <- TouchEvent.getShiftKey e
metaKey <- TouchEvent.getMetaKey e
changedTouches <- touchResults =<< TouchEvent.getChangedTouches e
targetTouches <- touchResults =<< TouchEvent.getTargetTouches e
touches <- touchResults =<< TouchEvent.getTouches e
return $ TouchEventResult
{ _touchEventResult_altKey = altKey
, _touchEventResult_changedTouches = changedTouches
, _touchEventResult_ctrlKey = ctrlKey
, _touchEventResult_metaKey = metaKey
, _touchEventResult_shiftKey = shiftKey
, _touchEventResult_targetTouches = targetTouches
, _touchEventResult_touches = touches
}
{-# INLINABLE getWheelEvent #-}
getWheelEvent :: EventM e WheelEvent WheelEventResult
getWheelEvent :: forall e. EventM (ZonkAny 30) WheelEvent WheelEventResult
getWheelEvent = do
e <- EventM (ZonkAny 0) WheelEvent WheelEvent
forall t e. EventM t e e
event
dx :: Double <- WheelEvent.getDeltaX e
dy :: Double <- WheelEvent.getDeltaY e
dz :: Double <- WheelEvent.getDeltaZ e
deltaMode :: Word <- WheelEvent.getDeltaMode e
return $ WheelEventResult
{ _wheelEventResult_deltaX = dx
, _wheelEventResult_deltaY = dy
, _wheelEventResult_deltaZ = dz
, _wheelEventResult_deltaMode = case deltaMode of
Word
0 -> DeltaMode
DeltaPixel
Word
1 -> DeltaMode
DeltaLine
Word
2 -> DeltaMode
DeltaPage
Word
_ -> String -> DeltaMode
forall a. HasCallStack => String -> a
error String
"getWheelEvent: impossible encoding"
}
instance MonadSample t m => MonadSample t (HydrationDomBuilderT s t m) where
{-# INLINABLE sample #-}
sample :: forall a. Behavior t a -> HydrationDomBuilderT s t m a
sample = m a -> HydrationDomBuilderT s t m a
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HydrationDomBuilderT s t m a)
-> (Behavior t a -> m a)
-> Behavior t a
-> HydrationDomBuilderT s t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior t a -> m a
forall a. Behavior t a -> m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample
instance MonadHold t m => MonadHold t (HydrationDomBuilderT s t m) where
{-# INLINABLE hold #-}
hold :: forall a.
a -> Event t a -> HydrationDomBuilderT s t m (Behavior t a)
hold a
v0 Event t a
v' = m (Behavior t a) -> HydrationDomBuilderT s t m (Behavior t a)
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Behavior t a) -> HydrationDomBuilderT s t m (Behavior t a))
-> m (Behavior t a) -> HydrationDomBuilderT s t m (Behavior t a)
forall a b. (a -> b) -> a -> b
$ a -> Event t a -> m (Behavior t a)
forall a. a -> Event t a -> m (Behavior t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold a
v0 Event t a
v'
{-# INLINABLE holdDyn #-}
holdDyn :: forall a.
a -> Event t a -> HydrationDomBuilderT s t m (Dynamic t a)
holdDyn a
v0 Event t a
v' = m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a)
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a))
-> m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a)
forall a b. (a -> b) -> a -> b
$ a -> Event t a -> m (Dynamic t a)
forall a. a -> Event t a -> m (Dynamic t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn a
v0 Event t a
v'
{-# INLINABLE holdIncremental #-}
holdIncremental :: forall p.
Patch p =>
PatchTarget p
-> Event t p -> HydrationDomBuilderT s t m (Incremental t p)
holdIncremental PatchTarget p
v0 Event t p
v' = m (Incremental t p) -> HydrationDomBuilderT s t m (Incremental t p)
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Incremental t p)
-> HydrationDomBuilderT s t m (Incremental t p))
-> m (Incremental t p)
-> HydrationDomBuilderT s t m (Incremental t p)
forall a b. (a -> b) -> a -> b
$ PatchTarget p -> Event t p -> m (Incremental t p)
forall p.
Patch p =>
PatchTarget p -> Event t p -> m (Incremental t p)
forall {k} (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental PatchTarget p
v0 Event t p
v'
{-# INLINABLE buildDynamic #-}
buildDynamic :: forall a.
PushM t a -> Event t a -> HydrationDomBuilderT s t m (Dynamic t a)
buildDynamic PushM t a
a0 = m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a)
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t a) -> HydrationDomBuilderT s t m (Dynamic t a))
-> (Event t a -> m (Dynamic t a))
-> Event t a
-> HydrationDomBuilderT s t m (Dynamic t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PushM t a -> Event t a -> m (Dynamic t a)
forall a. PushM t a -> Event t a -> m (Dynamic t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic PushM t a
a0
{-# INLINABLE headE #-}
headE :: forall a. Event t a -> HydrationDomBuilderT s t m (Event t a)
headE = m (Event t a) -> HydrationDomBuilderT s t m (Event t a)
forall (m :: * -> *) a.
Monad m =>
m a -> HydrationDomBuilderT s t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> HydrationDomBuilderT s t m (Event t a))
-> (Event t a -> m (Event t a))
-> Event t a
-> HydrationDomBuilderT s t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t a -> m (Event t a)
forall a. Event t a -> m (Event t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
Event t a -> m (Event t a)
headE
data WindowConfig t = WindowConfig
instance Default (WindowConfig t) where
def :: WindowConfig t
def = WindowConfig t
forall k (t :: k). WindowConfig t
WindowConfig
data Window t = Window
{ forall {k} (t :: k).
Window t -> EventSelector t (WrapArg EventResult EventName)
_window_events :: EventSelector t (WrapArg EventResult EventName)
, forall {k} (t :: k). Window t -> Window
_window_raw :: DOM.Window
}
wrapWindow :: (MonadJSM m, MonadReflexCreateTrigger t m) => DOM.Window -> WindowConfig t -> HydrationDomBuilderT GhcjsDomSpace t m (Window t)
wrapWindow :: forall (m :: * -> *) t.
(MonadJSM m, MonadReflexCreateTrigger t m) =>
Window
-> WindowConfig t
-> HydrationDomBuilderT GhcjsDomSpace t m (Window t)
wrapWindow Window
wv WindowConfig t
_ = do
events <- Window
-> (forall (en :: EventTag).
IsEvent (EventType en) =>
EventName en
-> EventM Window (EventType en) (Maybe (EventResult en)))
-> (forall (en :: EventTag).
EventName en
-> Window -> EventM Window (EventType en) () -> JSM (JSM ()))
-> ImmediateDomBuilderT
t m (EventSelector t (WrapArg EventResult EventName))
forall (m :: * -> *) t e (f :: EventTag -> *).
(MonadJSM m, MonadReflexCreateTrigger t m) =>
e
-> (forall (en :: EventTag).
IsEvent (EventType en) =>
EventName en -> EventM e (EventType en) (Maybe (f en)))
-> (forall (en :: EventTag).
EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ()))
-> ImmediateDomBuilderT t m (EventSelector t (WrapArg f EventName))
wrapDomEventsMaybe Window
wv (Window
-> EventName en
-> ReaderT (EventType en) JSM (Maybe (EventResult en))
forall (en :: EventTag).
Window
-> EventName en
-> EventM Window (EventType en) (Maybe (EventResult en))
defaultDomWindowEventHandler Window
wv) EventName en
-> Window -> EventM Window (EventType en) () -> JSM (JSM ())
forall (en :: EventTag).
EventName en
-> Window -> EventM Window (EventType en) () -> JSM (JSM ())
windowOnEventName
return $ Window
{ _window_events = events
, _window_raw = wv
}
#ifdef USE_TEMPLATE_HASKELL
makeLenses ''GhcjsEventSpec
#endif