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

git.iko.soy/reflex-dom

on develop help sign in

Make sure void actions are subscribed before running postBuild actions

2003aa8Ryan Trinkle12 years ago

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

compare with develop

unifiedsplit

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

57 type GuiAction m :: * -> *

58 askParent :: m Node

59 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 ()))

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

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

63 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 ())))

66class Monad m => HasDocument m where

67 askDocument :: m HTMLDocument

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

102 getRunWidget = do

103 r <- ask

104 runWidget <- lift getRunWidget

105+ return $ \rootElement w -> do

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

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

107+ return (a, postBuild, voidActions)

106

108

107performEvent_ = addVoidAction

109performEvent_ = addVoidAction

108

110

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

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

161 getRunWidget = return runWidget

162

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)) ()))

163runWidget rootElement w = do

164runWidget rootElement w = do

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

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

165 let voidAction = mergeWith (>>) voidActions

166 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)

168

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

170holdOnStartup a0 ma = do

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

205 sequence =<< readEvent voidAction

206 runHostFrame $ runGui (sequence_ voidActionNeeded) guiEnv

207 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)

209 liftIO $ htmlElementSetInnerHTML rootElement ""

212 liftIO $ htmlElementSetInnerHTML rootElement ""

210 liftIO $ nodeAppendChild rootElement $ Just df

213 liftIO $ nodeAppendChild rootElement $ Just df

211 subscribeEvent voidAction --TODO: Should be unnecessary

214 subscribeEvent voidAction --TODO: Should be unnecessary

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

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

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

15import Control.Monad.Trans

16import Control.Monad.Reader

17+import Control.Monad.State

17import Control.Monad.Ref

18import Control.Monad.Ref

18import GHCJS.DOM.Node

19import GHCJS.DOM.Node

19import GHCJS.DOM.UIEvent

20import GHCJS.DOM.UIEvent

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

116 runWidget <- getRunWidget

117 runWidget <- getRunWidget

117 let build c = do

118 let build c = do

118 Just df <- liftIO $ documentCreateDocumentFragment doc

119 Just df <- liftIO $ documentCreateDocumentFragment doc

119− result <- runWidget df c

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

120− runFrameWithTriggerRef newChildBuiltTriggerRef result

121+ runFrameWithTriggerRef newChildBuiltTriggerRef (result, voidActions)

122+ postBuild

121 Just p <- liftIO $ nodeGetParentNode endPlaceholder

123 Just p <- liftIO $ nodeGetParentNode endPlaceholder

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

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

123 return ()

125 return ()

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

142 runWidget <- getRunWidget

144 runWidget <- getRunWidget

143 let build c = do

145 let build c = do

144 Just df <- liftIO $ documentCreateDocumentFragment doc

146 Just df <- liftIO $ documentCreateDocumentFragment doc

145− result <- runWidget df c

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

146− runFrameWithTriggerRef newChildBuiltTriggerRef result

148+ runFrameWithTriggerRef newChildBuiltTriggerRef (result, voidActions)

149+ postBuild

147 Just p <- liftIO $ nodeGetParentNode endPlaceholder

150 Just p <- liftIO $ nodeGetParentNode endPlaceholder

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

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

149 return ()

152 return ()

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

171 schedulePostBuild $ do

174 schedulePostBuild $ do

172 Just df <- liftIO $ documentCreateDocumentFragment doc

175 Just df <- liftIO $ documentCreateDocumentFragment doc

173 curVals <- sample $ current vals

176 curVals <- sample $ current vals

174− initialState <- iforM curVals $ buildChild df

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

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

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

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

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

181+ sequence $ fmap snd initialState

176 Just p <- liftIO $ nodeGetParentNode endPlaceholder

182 Just p <- liftIO $ nodeGetParentNode endPlaceholder

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

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

178 return ()

184 return ()

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

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

180 curState <- sample children

186 curState <- sample children

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

187 --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

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

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

184 liftIO $ putStrLn "Deleting item"

190 liftIO $ putStrLn "Deleting item"

185 liftIO $ deleteBetweenInclusive start end

191 liftIO $ deleteBetweenInclusive start end

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

187 That v -> do

193 That v -> do

188 liftIO $ putStrLn "Creating item"

194 liftIO $ putStrLn "Creating item"

189 Just df <- liftIO $ documentCreateDocumentFragment doc

195 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)

191 let placeholder = case Map.lookupGT k curState of

199 let placeholder = case Map.lookupGT k curState of

192 Nothing -> endPlaceholder

200 Nothing -> endPlaceholder

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

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

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

200 liftIO $ putStrLn "Triggering newChildren"

208 liftIO $ putStrLn "Triggering newChildren"

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

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

202 runFrameWithTriggerRef newChildrenTriggerRef newState

210 runFrameWithTriggerRef newChildrenTriggerRef newState

211+ postBuild

203 liftIO $ putStrLn "Triggering newChildren done"

212 liftIO $ putStrLn "Triggering newChildren done"

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

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

205

214

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

213 runWidget <- getRunWidget

222 runWidget <- getRunWidget

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

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

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

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

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

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

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

218 wrapChild k v = do

226 wrapChild k v = do

219 childStart <- text' ""

227 childStart <- text' ""

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

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

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

230 curState <- sample $ current children

238 curState <- sample $ current children

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

239 --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

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

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

234 liftIO $ deleteBetweenInclusive start end

242 liftIO $ deleteBetweenInclusive start end

235 return Nothing

243 return Nothing

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

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

237 liftIO $ deleteBetweenExclusive start end

245 liftIO $ deleteBetweenExclusive start end

238 Just df <- liftIO $ documentCreateDocumentFragment doc

246 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)

240 Just p <- liftIO $ nodeGetParentNode end

250 Just p <- liftIO $ nodeGetParentNode end

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

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

242 return $ Just s

252 return $ Just s

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

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

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

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

245 Just df <- liftIO $ documentCreateDocumentFragment doc

255 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)

247 let placeholder = case Map.lookupGT k curState of

259 let placeholder = case Map.lookupGT k curState of

248 Nothing -> endPlaceholder

260 Nothing -> endPlaceholder

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

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

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

255 liftIO $ putStrLn "Triggering newChildren"

267 liftIO $ putStrLn "Triggering newChildren"

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

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

257 runFrameWithTriggerRef newChildrenTriggerRef newState

269 runFrameWithTriggerRef newChildrenTriggerRef newState

270+ postBuild

258 liftIO $ putStrLn "Triggering newChildren done"

271 liftIO $ putStrLn "Triggering newChildren done"

259 mapDyn (fmap (fst . fst)) children

272 mapDyn (fmap (fst . fst)) children

260

273

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

280 schedulePostBuild $ do

293 schedulePostBuild $ do

281 Just df <- liftIO $ documentCreateDocumentFragment doc

294 Just df <- liftIO $ documentCreateDocumentFragment doc

282 curVals <- sample $ current vals

295 curVals <- sample $ current vals

283− initialState <- iforM curVals $ buildChild df

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

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

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

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

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

300+ sequence $ fmap snd initialState

285 Just p <- liftIO $ nodeGetParentNode endPlaceholder

301 Just p <- liftIO $ nodeGetParentNode endPlaceholder

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

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

287 return ()

303 return ()

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

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

289 curState <- sample children

305 curState <- sample children

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

306 --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

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

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

293 liftIO $ putStrLn "Deleting item"

309 liftIO $ putStrLn "Deleting item"

294 liftIO $ deleteBetweenInclusive start end

310 liftIO $ deleteBetweenInclusive start end

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

296 That v -> do

312 That v -> do

297 liftIO $ putStrLn "Creating item"

313 liftIO $ putStrLn "Creating item"

298 Just df <- liftIO $ documentCreateDocumentFragment doc

314 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)

300 let placeholder = case Map.lookupGT k curState of

318 let placeholder = case Map.lookupGT k curState of

301 Nothing -> endPlaceholder

319 Nothing -> endPlaceholder

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

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

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

309 liftIO $ putStrLn "Triggering newChildren"

327 liftIO $ putStrLn "Triggering newChildren"

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

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

311 runFrameWithTriggerRef newChildrenTriggerRef newState

329 runFrameWithTriggerRef newChildrenTriggerRef newState

330+ postBuild

312 liftIO $ putStrLn "Triggering newChildren done"

331 liftIO $ putStrLn "Triggering newChildren done"

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

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

314

333