ec5d95a · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Fix listWithKey'

ec5d95aRyan Trinkle12 years ago

src/Reflex/Dom/Class.hs+4

compare with develop

unifiedsplit

@@ -57,6 +57,7 @@ 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 liftWidgetHost :: WidgetHost m a -> m a --TODO: Is this a good idea?

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

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

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

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

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

@@ -92,6 +93,9 @@ instance MonadWidget t m => MonadWidget t (ReaderT r m) where

92 subWidget n w = do

93 subWidget n w = do

93 r <- ask

94 r <- ask

94 lift $ subWidget n $ runReaderT w r

95 lift $ subWidget n $ runReaderT w r

96+ subWidgetWithVoidActions n w = do

97+ r <- ask

98+ lift $ subWidgetWithVoidActions n $ runReaderT w r

95 liftWidgetHost = lift . liftWidgetHost

99 liftWidgetHost = lift . liftWidgetHost

96 schedulePostBuild = lift . schedulePostBuild

100 schedulePostBuild = lift . schedulePostBuild

97 addVoidAction = lift . addVoidAction

101 addVoidAction = lift . addVoidAction

src/Reflex/Dom/Internal.hs+7

@@ -150,6 +150,13 @@ instance ( MonadRef m, Ref m ~ Ref IO, MonadRef h, Ref h ~ Ref IO --TODO: Should

150 --addVoidAction :: Monad m => Event t (m ()) -> WidgetInternal t m ()

151 addVoidAction a = Widget $ widgetStateVoidActions %= (a:)

152 subWidget n child = Widget $ local (widgetEnvParent .~ toNode n) $ unWidget child

153+ subWidgetWithVoidActions n child = Widget $ do

154+ oldActions <- use widgetStateVoidActions

155+ widgetStateVoidActions .= []

156+ result <- local (widgetEnvParent .~ toNode n) $ unWidget child

157+ actions <- use widgetStateVoidActions

158+ widgetStateVoidActions .= oldActions

159+ return (result, mergeWith (>>) actions)

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

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

154 getRunWidget = return runWidget

161 getRunWidget = return runWidget

155

162

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

@@ -6,6 +6,7 @@ import Reflex.Dom.Class

7import Reflex

8import Reflex.Host.Class

9+import Data.Functor.Misc

9import Data.Map (Map)

10import Data.Map (Map)

10import qualified Data.Map as Map

11import qualified Data.Map as Map

11import Data.Set (Set)

12import Data.Set (Set)

@@ -197,7 +198,7 @@ listWithKey vals mkChild = do

197 liftIO $ putStrLn "Triggering newChildren done"

198 liftIO $ putStrLn "Triggering newChildren done"

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

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

199

200

200−listWithKey' :: forall t m k v a. (Ord k, MonadWidget t m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> m a) -> m (Dynamic t (Map k a))

201+listWithKey' :: forall t m k v a. (Ord k, MonadWidget t m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> Event t v -> m a) -> m (Dynamic t (Map k a))

201listWithKey' initialVals valsChanged mkChild = do

202listWithKey' initialVals valsChanged mkChild = do

202 doc <- askDocument

203 doc <- askDocument

203 startPlaceholder <- text' ""

204 startPlaceholder <- text' ""

@@ -205,20 +206,23 @@ listWithKey' initialVals valsChanged mkChild = do

205 (newChildren, newChildrenTriggerRef) <- newEventWithTriggerRef

206 (newChildren, newChildrenTriggerRef) <- newEventWithTriggerRef

206-- performEvent_ $ fmap (const $ return ()) newChildren --TODO: Get rid of this hack

207-- performEvent_ $ fmap (const $ return ()) newChildren --TODO: Get rid of this hack

207 runWidget <- getRunWidget

208 runWidget <- getRunWidget

209+ let childValChangedSelector :: EventSelector t (Const2 k v)

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

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

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

209− buildChild df k v = runWidget df $ do

212+ buildChild df k v = runWidget df $ wrapChild k v

213+ wrapChild k v = do

210 childStart <- text' ""

214 childStart <- text' ""

211− result <- mkChild k v

215+ result <- mkChild k v $ select childValChangedSelector $ Const2 k

212 childEnd <- text' ""

216 childEnd <- text' ""

213 return (result, (childStart, childEnd))

217 return (result, (childStart, childEnd))

214 Just df <- liftIO $ documentCreateDocumentFragment doc

218 Just df <- liftIO $ documentCreateDocumentFragment doc

215− initialState <- liftWidgetHost $ iforM initialVals $ buildChild df

219+ initialState <- iforM initialVals $ \k v -> subWidgetWithVoidActions (toNode df) $ wrapChild k v --Note: we have to use subWidgetWithVoidActions rather than runWidget here, because running post-build actions during build can cause not-yet-constructed values to be read

216− children <- hold initialState $ traceEventWith (\x -> "newChildren: " <> show (Map.size x)) newChildren

220+ children <- holdDyn initialState $ traceEventWith (\x -> "newChildren: " <> show (Map.size x)) newChildren

217− addVoidAction $ switch $ fmap (mergeWith (>>) . map snd . Map.elems) children

221+ addVoidAction $ switch $ fmap (mergeWith (>>) . map snd . Map.elems) $ current children

218 Just p <- liftIO $ nodeGetParentNode endPlaceholder

222 Just p <- liftIO $ nodeGetParentNode endPlaceholder

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

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

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

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

221− curState <- sample children

225+ curState <- sample $ current children

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

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

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

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

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

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

@@ -247,7 +251,7 @@ listWithKey' initialVals valsChanged mkChild = do

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

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

248 runFrameWithTriggerRef newChildrenTriggerRef newState

252 runFrameWithTriggerRef newChildrenTriggerRef newState

249 liftIO $ putStrLn "Triggering newChildren done"

253 liftIO $ putStrLn "Triggering newChildren done"

250− holdDyn Map.empty $ fmap (fmap (fst . fst)) newChildren

254+ mapDyn (fmap (fst . fst)) children

251

255

252selectViewListWithKey_ :: forall t m k v a. (MonadWidget t m, Ord k) => Dynamic t k -> Dynamic t (Map k v) -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a)) -> m (Event t k)

256selectViewListWithKey_ :: forall t m k v a. (MonadWidget t m, Ord k) => Dynamic t k -> Dynamic t (Map k v) -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a)) -> m (Event t k)

253selectViewListWithKey_ selection vals mkChild = do

257selectViewListWithKey_ selection vals mkChild = do

@@ -304,6 +308,7 @@ wrapElement e = do

304 keypress <- wrapDomEvent e elementOnkeypress $ liftIO . uiEventGetKeyCode =<< event

308 keypress <- wrapDomEvent e elementOnkeypress $ liftIO . uiEventGetKeyCode =<< event

305 return $ El e clicked keypress

309 return $ El e clicked keypress

306

310

311+elDynAttr' :: forall t m a. MonadWidget t m => String -> Dynamic t (Map String String) -> m a -> m (El t, a)

307elDynAttr' elementTag attrs child = do

312elDynAttr' elementTag attrs child = do

308 (e, result) <- buildElement elementTag attrs child

313 (e, result) <- buildElement elementTag attrs child

309 e' <- wrapElement e

314 e' <- wrapElement e

@@ -316,11 +321,11 @@ elAttr elementTag attrs child = do

316 return result

321 return result

317

322

318{-# INLINABLE el' #-}

323{-# INLINABLE el' #-}

319−--el' :: forall t m a. MonadWidget t m => String -> m a -> m (El t, a)

324+el' :: forall t m a. MonadWidget t m => String -> m a -> m (El t, a)

320el' tag child = elAttr' tag (Map.empty :: AttributeMap) child

325el' tag child = elAttr' tag (Map.empty :: AttributeMap) child

321

326

322{-# INLINABLE elAttr' #-}

327{-# INLINABLE elAttr' #-}

323−--elAttr' :: forall t m a. MonadWidget t m => String -> Map String String -> m a -> m (El t, a)

328+elAttr' :: forall t m a. MonadWidget t m => String -> Map String String -> m a -> m (El t, a)

324elAttr' elementTag attrs child = do

329elAttr' elementTag attrs child = do

325 (e, result) <- buildElement elementTag attrs child

330 (e, result) <- buildElement elementTag attrs child

326 e' <- wrapElement e

331 e' <- wrapElement e