on develop help sign in
Don't use PerformEvent anywhere in ImmediateDomBuilderT except runImmediateDomBuilderT

This may fix withRenderHook

commitb3d612e28e51a70da776874dfa7548b22b51ed46 authorRyan Trinkle <ryan.trinkle@gmail.com> dateTue 25 Apr 2017, 16:36 (10 years ago) parent173ee15
1 file changed+21−20
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+21−20
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+21−20
@@ -167,7 +167,7 @@ instance PrimMonad m => PrimMonad (ImmediateDomBuilderT x m) where
167167instance MonadTrans (ImmediateDomBuilderT t) where
168168 lift = ImmediateDomBuilderT . lift . lift
169169
170−instance (PerformEvent t m, PrimMonad m) => DomRenderHook t (ImmediateDomBuilderT t m) where
170+instance (Reflex t, PrimMonad m) => DomRenderHook t (ImmediateDomBuilderT t m) where
171171 withRenderHook hook (ImmediateDomBuilderT a) = do
172172 e <- ImmediateDomBuilderT ask
173173 ImmediateDomBuilderT $ lift $ withRequesting $ \rsp -> do
@@ -195,6 +195,9 @@ askParent = ImmediateDomBuilderT $ asks _immediateDomBuilderEnv_parent
195195askEvents :: Monad m => ImmediateDomBuilderT t m (Chan [DSum (TriggerRef t) TriggerInvocation])
196196askEvents = ImmediateDomBuilderT $ asks _immediateDomBuilderEnv_events
197197
198+localEnv :: Monad m => (ImmediateDomBuilderEnv t -> ImmediateDomBuilderEnv t) -> ImmediateDomBuilderT t m a -> ImmediateDomBuilderT t m a
199+localEnv f = ImmediateDomBuilderT . local f . unImmediateDomBuilderT
200+
198201{-# INLINABLE append #-}
199202append :: (IsNode n, MonadJSM m) => n -> ImmediateDomBuilderT t m ()
200203append n = do
@@ -258,7 +261,7 @@ extractUpTo df s e = liftJSM $ do
258261 ]
259262 void $ call f f (df, s, e)
260263
261−type SupportsImmediateDomBuilder t m = (Reflex t, MonadJSM m, MonadJSM (Performable m), MonadHold t m, MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref JSM, MonadAdjust t m, PrimMonad m)
264+type SupportsImmediateDomBuilder t m = (Reflex t, MonadJSM m, MonadJSM (Performable m), MonadHold t m, MonadFix m, MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref JSM, MonadAdjust t m, PrimMonad m)
262265
263266{-# INLINABLE collectUpTo #-}
264267collectUpTo :: (MonadJSM m, IsNode start, IsNode end) => start -> end -> m DOM.DocumentFragment
@@ -322,15 +325,14 @@ wrap e cfg = do
322325{-# INLINABLE makeElement #-}
323326makeElement :: forall er t m a. SupportsImmediateDomBuilder t m => Text -> ElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m a -> ImmediateDomBuilderT t m ((Element er GhcjsDomSpace t, a), DOM.Element)
324327makeElement elementTag cfg child = do
325− env <- ImmediateDomBuilderT ask
326− let doc = _immediateDomBuilderEnv_document env
328+ doc <- askDocument
327329 e <- liftJSM $ case cfg ^. namespace of
328330 Nothing -> createElementUnchecked doc (Just elementTag)
329331 Just ens -> createElementNSUnchecked doc (Just ens) (Just elementTag)
330332 ImmediateDomBuilderT $ iforM_ (cfg ^. initialAttributes) $ \(AttributeName mAttrNamespace n) v -> case mAttrNamespace of
331333 Nothing -> lift $ setAttribute e n v
332334 Just ans -> lift $ setAttributeNS e (Just ans) n v
333− result <- ImmediateDomBuilderT $ lift $ runReaderT (unImmediateDomBuilderT child) $ env
335+ result <- flip localEnv child $ \env -> env
334336 { _immediateDomBuilderEnv_parent = toNode e
335337 }
336338 append e
@@ -418,7 +420,7 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t
418420 Input.setValue domInputElement $ Just (cfg ^. inputElementConfig_initialValue)
419421 v0 <- Input.getValueUnchecked domInputElement
420422 let getMyValue = fromMaybe "" <$> Input.getValue domInputElement
421− valueChangedByUI <- performEvent $ liftJSM getMyValue <$ Reflex.select (_element_events e) (WrapArg Input)
423+ valueChangedByUI <- requestDomAction $ liftJSM getMyValue <$ Reflex.select (_element_events e) (WrapArg Input)
422424 valueChangedBySetValue <- case _inputElementConfig_setValue cfg of
423425 Nothing -> return never
424426 Just eSetValue -> requestDomAction $ ffor eSetValue $ \v' -> do
@@ -469,7 +471,7 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t
469471 TextArea.setValue domTextAreaElement $ Just (cfg ^. textAreaElementConfig_initialValue)
470472 v0 <- TextArea.getValueUnchecked domTextAreaElement
471473 let getMyValue = fromMaybe "" <$> TextArea.getValue domTextAreaElement
472− valueChangedByUI <- performEvent $ liftJSM getMyValue <$ Reflex.select (_element_events e) (WrapArg Input)
474+ valueChangedByUI <- requestDomAction $ liftJSM getMyValue <$ Reflex.select (_element_events e) (WrapArg Input)
473475 valueChangedBySetValue <- case _textAreaElementConfig_setValue cfg of
474476 Nothing -> return never
475477 Just eSetValue -> requestDomAction $ ffor eSetValue $ \v' -> do
@@ -494,7 +496,7 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t
494496 Select.setValue domSelectElement $ Just (cfg ^. selectElementConfig_initialValue)
495497 Just v0 <- Select.getValue domSelectElement
496498 let getMyValue = fromMaybe "" <$> Select.getValue domSelectElement
497− valueChangedByUI <- performEvent $ liftJSM getMyValue <$ Reflex.select (_element_events e) (WrapArg Change)
499+ valueChangedByUI <- requestDomAction $ liftJSM getMyValue <$ Reflex.select (_element_events e) (WrapArg Change)
498500 valueChangedBySetValue <- case _selectElementConfig_setValue cfg of
499501 Nothing -> return never
500502 Just eSetValue -> requestDomAction $ ffor eSetValue $ \v' -> do
@@ -552,9 +554,8 @@ extractFragment fragment = do
552554instance SupportsImmediateDomBuilder t m => MountableDomBuilder t (ImmediateDomBuilderT t m) where
553555 type DomFragment (ImmediateDomBuilderT t m) = ImmediateDomFragment
554556 buildDomFragment w = do
555− initialEnv <- ImmediateDomBuilderT ask
556− df <- createDocumentFragmentUnchecked $ _immediateDomBuilderEnv_document initialEnv
557− result <- lift $ runImmediateDomBuilderT w $ initialEnv
557+ df <- createDocumentFragmentUnchecked =<< askDocument
558+ result <- flip localEnv w $ \env -> env
558559 { _immediateDomBuilderEnv_parent = toNode df
559560 }
560561 state <- liftIO $ newIORef FragmentState_Unmounted
@@ -566,14 +567,14 @@ instance SupportsImmediateDomBuilder t m => MountableDomBuilder t (ImmediateDomB
566567 appendChild_ parent $ Just $ _immediateDomFragment_document fragment
567568 after <- textNodeInternal ("" :: Text)
568569 xs <- foldDyn (\new (previous, _) -> (new, Just previous)) (fragment, Nothing) setFragment
569− performEvent_ $ ffor (updated xs) $ \(childFragment, Just previousFragment) -> do
570+ requestDomAction_ $ ffor (updated xs) $ \(childFragment, Just previousFragment) -> do
570571 extractFragment previousFragment
571572 extractFragment childFragment
572573 insertBefore (_immediateDomFragment_document childFragment) after
573574 liftIO $ writeIORef (_immediateDomFragment_state childFragment) $ FragmentState_Mounted (before, after)
574575 liftIO $ writeIORef (_immediateDomFragment_state fragment) $ FragmentState_Mounted (before, after)
575576
576−instance (Reflex t, MonadAdjust t m, MonadJSM m, MonadHold t m, PerformEvent t m, MonadJSM (Performable m), MonadFix m, PrimMonad m) => MonadAdjust t (ImmediateDomBuilderT t m) where
577+instance (Reflex t, MonadAdjust t m, MonadJSM m, MonadHold t m, MonadJSM (Performable m), MonadFix m, PrimMonad m) => MonadAdjust t (ImmediateDomBuilderT t m) where
577578 runWithReplace a0 a' = do
578579 initialEnv <- ImmediateDomBuilderT ask
579580 before <- textNodeInternal ("" :: Text)
@@ -590,14 +591,15 @@ instance (Reflex t, MonadAdjust t m, MonadJSM m, MonadHold t m, PerformEvent t m
590591 liftIO $ writeIORef parentUnreadyChildren $! new
591592 when (new == 0) $ _immediateDomBuilderEnv_commitAction initialEnv
592593 -- We draw 'after' in this roundabout way to avoid using MonadFix
593− after <- createTextNodeUnchecked (_immediateDomBuilderEnv_document initialEnv) ("" :: Text)
594+ doc <- askDocument
595+ after <- createTextNodeUnchecked doc ("" :: Text)
594596 let drawInitialChild = do
595597 unreadyChildren <- liftIO $ newIORef 0
596598 let f = do
597599 result <- a0
598600 append after
599601 return result
600− result <- runImmediateDomBuilderT f $ initialEnv
602+ result <- runReaderT (unImmediateDomBuilderT f) $ initialEnv
601603 { _immediateDomBuilderEnv_unreadyChildren = unreadyChildren
602604 , _immediateDomBuilderEnv_commitAction = myCommitAction
603605 }
@@ -606,8 +608,8 @@ instance (Reflex t, MonadAdjust t m, MonadJSM m, MonadHold t m, PerformEvent t m
606608 _ -> modifyIORef' parentUnreadyChildren succ
607609 return result
608610 a'' <- numberOccurrences a'
609− (result0, result') <- lift $ runWithReplace drawInitialChild $ ffor a'' $ \(cohortId, child) -> do
610− df <- createDocumentFragmentUnchecked $ _immediateDomBuilderEnv_document initialEnv
611+ (result0, result') <- ImmediateDomBuilderT $ lift $ runWithReplace drawInitialChild $ ffor a'' $ \(cohortId, child) -> do
612+ df <- createDocumentFragmentUnchecked doc
611613 unreadyChildren <- liftIO $ newIORef 0
612614 let commitAction = do
613615 c <- liftIO $ readIORef currentCohort
@@ -616,7 +618,7 @@ instance (Reflex t, MonadAdjust t m, MonadJSM m, MonadHold t m, PerformEvent t m
616618 insertBefore df after
617619 liftIO $ writeIORef currentCohort cohortId
618620 myCommitAction
619− result <- runImmediateDomBuilderT child $ initialEnv
621+ result <- runReaderT (unImmediateDomBuilderT child) $ initialEnv
620622 { _immediateDomBuilderEnv_parent = toNode df
621623 , _immediateDomBuilderEnv_unreadyChildren = unreadyChildren
622624 , _immediateDomBuilderEnv_commitAction = commitAction
@@ -707,8 +709,7 @@ data ChildReadyState k
707709 deriving (Show, Read, Eq, Ord)
708710
709711hoistTraverseWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
710− ( PerformEvent t m
711− , MonadAdjust t m
712+ ( MonadAdjust t m
712713 , MonadHold t m
713714 , DMap.GCompare k
714715 , MonadIO (Performable m)