ec5d95a · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Fix listWithKey'

commitec5d95aae7957e470b43e5389bb4cdc36836a98c authorRyan Trinkle <ryan.trinkle@gmail.com> dateSat 28 Feb 2015, 19:47 (12 years ago) parentc14a15d

3 files changed+27−11

compare with develop

unifiedsplit

src/Reflex/Dom/Class.hs+4 src/Reflex/Dom/Internal.hs+7 src/Reflex/Dom/Widget/Basic.hs+16−11

src/Reflex/Dom/Class.hs+4

@@ -57,6 +57,7 @@ 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()))

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

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

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

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

9293 subWidget n w = do

9394 r <- ask

9495 lift $ subWidget n $ runReaderT w r

96+ subWidgetWithVoidActions n w = do

97+ r <- ask

98+ lift $ subWidgetWithVoidActions n $ runReaderT w r

9599 liftWidgetHost = lift . liftWidgetHost

96100 schedulePostBuild = lift . schedulePostBuild

97101 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

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

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

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

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

154161 getRunWidget = return runWidget

155162

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

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

77import Reflex

88import Reflex.Host.Class

9+import Data.Functor.Misc

910import Data.Map (Map)

1011import qualified Data.Map as Map

1112import Data.Set (Set)

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

197198 liftIO $ putStrLn "Triggering newChildren done"

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

199200

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

201202listWithKey' initialVals valsChanged mkChild = do

202203 doc <- askDocument

203204 startPlaceholder <- text' ""

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

205206 (newChildren, newChildrenTriggerRef) <- newEventWithTriggerRef

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

207208 runWidget <- getRunWidget

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

209− buildChild df k v = runWidget df $ do

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

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

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

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

213+ wrapChild k v = do

210214 childStart <- text' ""

211− result <- mkChild k v

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

212216 childEnd <- text' ""

213217 return (result, (childStart, childEnd))

214218 Just df <- liftIO $ documentCreateDocumentFragment doc

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

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

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

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

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

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

218222 Just p <- liftIO $ nodeGetParentNode endPlaceholder

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

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

221− curState <- sample children

225+ curState <- sample $ current children

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

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

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

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

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

248252 runFrameWithTriggerRef newChildrenTriggerRef newState

249253 liftIO $ putStrLn "Triggering newChildren done"

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

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

251255

252256selectViewListWithKey_ :: 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)

253257selectViewListWithKey_ selection vals mkChild = do

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

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

305309 return $ El e clicked keypress

306310

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

307312elDynAttr' elementTag attrs child = do

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

309314 e' <- wrapElement e

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

316321 return result

317322

318323{-# 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)

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

321326

322327{-# 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)

324329elAttr' elementTag attrs child = do

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

326331 e' <- wrapElement e