2003aa8 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Make sure void actions are subscribed before running postBuild actions

commit2003aa82803d247da45ab514337ee201793da3ab authorRyan Trinkle <ryan.trinkle@gmail.com> dateWed 4 Mar 2015, 18:47 (12 years ago) parent70ebea0

3 files changed+46−22

compare with develop

unifiedsplit

src/Reflex/Dom/Class.hs+5−3 src/Reflex/Dom/Internal.hs+6−3 src/Reflex/Dom/Widget/Basic.hs+35−16

src/Reflex/Dom/Class.hs+5−3

@@ -57,11 +57,11 @@ class ( Reflex t, MonadHold t m, MonadIO m, Functor m, MonadReflexCreateTrigger

5757 type GuiAction m :: * -> *

5858 askParent :: m Node

5959 subWidget :: Node -> m a -> m a

60− subWidgetWithVoidActions :: Node -> m a -> m (a, Event t (WidgetHost m()))

60+ subWidgetWithVoidActions :: Node -> m a -> m (a, Event t (WidgetHost m ()))

6161 liftWidgetHost :: WidgetHost m a -> m a --TODO: Is this a good idea?

6262 schedulePostBuild :: WidgetHost m () -> m ()

6363 addVoidAction :: Event t (WidgetHost m ()) -> m ()

64− getRunWidget :: IsNode n => m (n -> m a -> WidgetHost m (a, Event t (WidgetHost m ())))

64+ getRunWidget :: IsNode n => m (n -> m a -> WidgetHost m (a, WidgetHost m (), Event t (WidgetHost m ())))

6565

6666class Monad m => HasDocument m where

6767 askDocument :: m HTMLDocument

@@ -102,7 +102,9 @@ instance MonadWidget t m => MonadWidget t (ReaderT r m) where

102102 getRunWidget = do

103103 r <- ask

104104 runWidget <- lift getRunWidget

105− return $ \rootElement w -> runWidget rootElement $ runReaderT w r

105+ return $ \rootElement w -> do

106+ (a, postBuild, voidActions) <- runWidget rootElement $ runReaderT w r

107+ return (a, postBuild, voidActions)

106108

107109performEvent_ = addVoidAction

108110

src/Reflex/Dom/Internal.hs+6−3

@@ -160,11 +160,11 @@ instance ( MonadRef m, Ref m ~ Ref IO, MonadRef h, Ref h ~ Ref IO --TODO: Should

160160-- runWidget :: (Monad m, IsNode n, Reflex t) => n -> Widget t m a -> m (a, Event t (m ()))

161161 getRunWidget = return runWidget

162162

163+runWidget :: (Monad m, Reflex t, IsNode n) => n -> Widget t (Gui t h m) a -> WidgetHost (Widget t (Gui t h m)) (a, WidgetHost (Widget t (Gui t h m)) (), Event t (WidgetHost (Widget t (Gui t h m)) ()))

163164runWidget rootElement w = do

164165 (result, WidgetState postBuild voidActions) <- runStateT (runReaderT (unWidget w) (WidgetEnv $ toNode rootElement)) (WidgetState (return ()) [])

165166 let voidAction = mergeWith (>>) voidActions

166− postBuild --TODO: This should be run some other way; it seems to cause strictness problems when recursion crosses parent/child boundaries

167− return (result, voidAction)

167+ return (result, postBuild, voidAction)

168168

169169holdOnStartup :: MonadWidget t m => a -> WidgetHost m a -> m (Behavior t a)

170170holdOnStartup a0 ma = do

@@ -205,7 +205,10 @@ attachWidget rootElement w = runSpiderHost $ do --TODO: It seems to re-run this

205205 sequence =<< readEvent voidAction

206206 runHostFrame $ runGui (sequence_ voidActionNeeded) guiEnv

207207 Just df <- liftIO $ documentCreateDocumentFragment doc

208− (result, voidAction) <- runHostFrame $ runGui (runWidget df w) guiEnv

208+ (result, voidAction) <- runHostFrame $ flip runGui guiEnv $ do

209+ (result, postBuild, voidAction) <- runWidget df w

210+ postBuild

211+ return (result, voidAction)

209212 liftIO $ htmlElementSetInnerHTML rootElement ""

210213 liftIO $ nodeAppendChild rootElement $ Just df

211214 subscribeEvent voidAction --TODO: Should be unnecessary

src/Reflex/Dom/Widget/Basic.hs+35−16

@@ -14,6 +14,7 @@ import qualified Data.Set as Set

1414import Data.Dependent.Sum (DSum (..))

1515import Control.Monad.Trans

1616import Control.Monad.Reader

17+import Control.Monad.State

1718import Control.Monad.Ref

1819import GHCJS.DOM.Node

1920import GHCJS.DOM.UIEvent

@@ -116,8 +117,9 @@ dyn child = do

116117 runWidget <- getRunWidget

117118 let build c = do

118119 Just df <- liftIO $ documentCreateDocumentFragment doc

119− result <- runWidget df c

120− runFrameWithTriggerRef newChildBuiltTriggerRef result

120+ (result, postBuild, voidActions) <- runWidget df c

121+ runFrameWithTriggerRef newChildBuiltTriggerRef (result, voidActions)

122+ postBuild

121123 Just p <- liftIO $ nodeGetParentNode endPlaceholder

122124 liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)

123125 return ()

@@ -142,8 +144,9 @@ widgetHold child0 newChild = do

142144 runWidget <- getRunWidget

143145 let build c = do

144146 Just df <- liftIO $ documentCreateDocumentFragment doc

145− result <- runWidget df c

146− runFrameWithTriggerRef newChildBuiltTriggerRef result

147+ (result, postBuild, voidActions) <- runWidget df c

148+ runFrameWithTriggerRef newChildBuiltTriggerRef (result, voidActions)

149+ postBuild

147150 Just p <- liftIO $ nodeGetParentNode endPlaceholder

148151 liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)

149152 return ()

@@ -171,15 +174,18 @@ listWithKey vals mkChild = do

171174 schedulePostBuild $ do

172175 Just df <- liftIO $ documentCreateDocumentFragment doc

173176 curVals <- sample $ current vals

174− initialState <- iforM curVals $ buildChild df

175− runFrameWithTriggerRef newChildrenTriggerRef initialState --TODO: Do all these in a single runFrame

177+ initialState <- iforM curVals $ \k v -> do

178+ (result, postBuild, voidAction) <- buildChild df k v

179+ return ((result, voidAction), postBuild)

180+ runFrameWithTriggerRef newChildrenTriggerRef $ fmap fst initialState --TODO: Do all these in a single runFrame

181+ sequence $ fmap snd initialState

176182 Just p <- liftIO $ nodeGetParentNode endPlaceholder

177183 liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)

178184 return ()

179185 addVoidAction $ flip fmap (updated vals) $ \newVals -> do

180186 curState <- sample children

181187 --TODO: Should we remove the parent from the DOM first to avoid reflows?

182− newState <- liftM (Map.mapMaybe id) $ iforM (align curState newVals) $ \k -> \case

188+ (newState, postBuild) <- flip runStateT (return ()) $ liftM (Map.mapMaybe id) $ iforM (align curState newVals) $ \k -> \case

183189 This ((_, (start, end)), _) -> do

184190 liftIO $ putStrLn "Deleting item"

185191 liftIO $ deleteBetweenInclusive start end

@@ -187,7 +193,9 @@ listWithKey vals mkChild = do

187193 That v -> do

188194 liftIO $ putStrLn "Creating item"

189195 Just df <- liftIO $ documentCreateDocumentFragment doc

190− s <- buildChild df k v

196+ (childResult, childPostBuild, childVoidAction) <- lift $ buildChild df k v

197+ let s = (childResult, childVoidAction)

198+ modify (>>childPostBuild)

191199 let placeholder = case Map.lookupGT k curState of

192200 Nothing -> endPlaceholder

193201 Just (_, ((_, (start, _)), _)) -> start

@@ -200,6 +208,7 @@ listWithKey vals mkChild = do

200208 liftIO $ putStrLn "Triggering newChildren"

201209 liftIO $ putStrLn . ("newChildrenTriggerRef is Just? " <>) . show . isJust =<< readRef newChildrenTriggerRef

202210 runFrameWithTriggerRef newChildrenTriggerRef newState

211+ postBuild

203212 liftIO $ putStrLn "Triggering newChildren done"

204213 holdDyn Map.empty $ fmap (fmap (fst . fst)) newChildren

205214

@@ -213,7 +222,6 @@ listWithKey' initialVals valsChanged mkChild = do

213222 runWidget <- getRunWidget

214223 let childValChangedSelector :: EventSelector t (Const2 k v)

215224 childValChangedSelector = fanMap $ fmap (Map.mapMaybe id) valsChanged

216− buildChild :: DocumentFragment -> k -> v -> WidgetHost m ((a, (Text, Text)), Event t (WidgetHost m ()))

217225 buildChild df k v = runWidget df $ wrapChild k v

218226 wrapChild k v = do

219227 childStart <- text' ""

@@ -229,21 +237,25 @@ listWithKey' initialVals valsChanged mkChild = do

229237 addVoidAction $ flip fmap valsChanged $ \newVals -> do

230238 curState <- sample $ current children

231239 --TODO: Should we remove the parent from the DOM first to avoid reflows?

232− newState <- liftM (Map.mapMaybe id) $ iforM (align curState newVals) $ \k -> \case

240+ (newState, postBuild) <- flip runStateT (return ()) $ liftM (Map.mapMaybe id) $ iforM (align curState newVals) $ \k -> \case

233241 These ((_, (start, end)), _) Nothing -> do -- Deleting child

234242 liftIO $ deleteBetweenInclusive start end

235243 return Nothing

236244 These ((_, (start, end)), _) (Just v) -> do -- Replacing existing child

237245 liftIO $ deleteBetweenExclusive start end

238246 Just df <- liftIO $ documentCreateDocumentFragment doc

239− s <- buildChild df k v

247+ (childResult, childPostBuild, childVoidAction) <- lift $ buildChild df k v

248+ let s = (childResult, childVoidAction)

249+ modify (>>childPostBuild)

240250 Just p <- liftIO $ nodeGetParentNode end

241251 liftIO $ nodeInsertBefore p (Just df) (Just end)

242252 return $ Just s

243253 That Nothing -> return Nothing -- Deleting non-existent child

244254 That (Just v) -> do -- Creating new child

245255 Just df <- liftIO $ documentCreateDocumentFragment doc

246− s <- buildChild df k v

256+ (childResult, childPostBuild, childVoidAction) <- lift $ buildChild df k v

257+ let s = (childResult, childVoidAction)

258+ modify (>>childPostBuild)

247259 let placeholder = case Map.lookupGT k curState of

248260 Nothing -> endPlaceholder

249261 Just (_, ((_, (start, _)), _)) -> start

@@ -255,6 +267,7 @@ listWithKey' initialVals valsChanged mkChild = do

255267 liftIO $ putStrLn "Triggering newChildren"

256268 liftIO $ putStrLn . ("newChildrenTriggerRef is Just? " <>) . show . isJust =<< readRef newChildrenTriggerRef

257269 runFrameWithTriggerRef newChildrenTriggerRef newState

270+ postBuild

258271 liftIO $ putStrLn "Triggering newChildren done"

259272 mapDyn (fmap (fst . fst)) children

260273

@@ -280,15 +293,18 @@ listViewWithKey' vals mkChild = do

280293 schedulePostBuild $ do

281294 Just df <- liftIO $ documentCreateDocumentFragment doc

282295 curVals <- sample $ current vals

283− initialState <- iforM curVals $ buildChild df

284− runFrameWithTriggerRef newChildrenTriggerRef initialState --TODO: Do all these in a single runFrame

296+ initialState <- iforM curVals $ \k v -> do

297+ (result, postBuild, voidAction) <- buildChild df k v

298+ return ((result, voidAction), postBuild)

299+ runFrameWithTriggerRef newChildrenTriggerRef $ fmap fst initialState --TODO: Do all these in a single runFrame

300+ sequence $ fmap snd initialState

285301 Just p <- liftIO $ nodeGetParentNode endPlaceholder

286302 liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)

287303 return ()

288304 addVoidAction $ flip fmap (updated vals) $ \newVals -> do

289305 curState <- sample children

290306 --TODO: Should we remove the parent from the DOM first to avoid reflows?

291− newState <- liftM (Map.mapMaybe id) $ iforM (align curState newVals) $ \k -> \case

307+ (newState, postBuild) <- flip runStateT (return ()) $ liftM (Map.mapMaybe id) $ iforM (align curState newVals) $ \k -> \case

292308 This ((_, (start, end)), _) -> do

293309 liftIO $ putStrLn "Deleting item"

294310 liftIO $ deleteBetweenInclusive start end

@@ -296,7 +312,9 @@ listViewWithKey' vals mkChild = do

296312 That v -> do

297313 liftIO $ putStrLn "Creating item"

298314 Just df <- liftIO $ documentCreateDocumentFragment doc

299− s <- buildChild df k v

315+ (childResult, childPostBuild, childVoidAction) <- lift $ buildChild df k v

316+ let s = (childResult, childVoidAction)

317+ modify (>>childPostBuild)

300318 let placeholder = case Map.lookupGT k curState of

301319 Nothing -> endPlaceholder

302320 Just (_, ((_, (start, _)), _)) -> start

@@ -309,6 +327,7 @@ listViewWithKey' vals mkChild = do

309327 liftIO $ putStrLn "Triggering newChildren"

310328 liftIO $ putStrLn . ("newChildrenTriggerRef is Just? " <>) . show . isJust =<< readRef newChildrenTriggerRef

311329 runFrameWithTriggerRef newChildrenTriggerRef newState

330+ postBuild

312331 liftIO $ putStrLn "Triggering newChildren done"

313332 return $ fmap (fmap (fst . fst)) children

314333