@@ -254,6 +254,59 @@ listWithKey' initialVals valsChanged mkChild = do
254 liftIO $ putStrLn "Triggering newChildren done"
254 liftIO $ putStrLn "Triggering newChildren done"
255 mapDyn (fmap (fst . fst)) children
255 mapDyn (fmap (fst . fst)) children
257+--TODO: Something better than Dynamic t (Map k v) - we want something where the Events carry diffs, not the whole value
258+listViewWithKey :: (Ord k, MonadWidget t m) => Dynamic t (Map k v) -> (k -> Dynamic t v -> m (Event t a)) -> m (Event t (Map k a))
259+listViewWithKey vals mkChild = do
261+ startPlaceholder <- text' ""
262+ endPlaceholder <- text' ""
263+ (newChildren, newChildrenTriggerRef) <- newEventWithTriggerRef
264+ performEvent_ $ fmap (const $ return ()) newChildren --TODO: Get rid of this hack
265+ children <- hold Map.empty $ traceEventWith (\x -> "newChildren: " <> show (Map.size x)) newChildren
266+ addVoidAction $ switch $ fmap (mergeWith (>>) . map snd . Map.elems) children
267+ runWidget <- getRunWidget
268+ let buildChild df k v = runWidget df $ do
269+ childStart <- text' ""
270+ result <- mkChild k =<< holdDyn v (fmapMaybe (Map.lookup k) (updated vals))
271+ childEnd <- text' ""
272+ return (result, (childStart, childEnd))
273+ schedulePostBuild $ do
274+ Just df <- liftIO $ documentCreateDocumentFragment doc
275+ curVals <- sample $ current vals
276+ initialState <- iforM curVals $ buildChild df
277+ runFrameWithTriggerRef newChildrenTriggerRef initialState --TODO: Do all these in a single runFrame
278+ Just p <- liftIO $ nodeGetParentNode endPlaceholder
279+ liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)
281+ addVoidAction $ flip fmap (updated vals) $ \newVals -> do
282+ curState <- sample children
283+ --TODO: Should we remove the parent from the DOM first to avoid reflows?
284+ newState <- liftM (Map.mapMaybe id) $ iforM (align curState newVals) $ \k -> \case
285+ This ((_, (start, end)), _) -> do
286+ liftIO $ putStrLn "Deleting item"
287+ liftIO $ deleteBetweenInclusive start end
290+ liftIO $ putStrLn "Creating item"
291+ Just df <- liftIO $ documentCreateDocumentFragment doc
292+ s <- buildChild df k v
293+ let placeholder = case Map.lookupGT k curState of
294+ Nothing -> endPlaceholder
295+ Just (_, ((_, (start, _)), _)) -> start
296+ Just p <- liftIO $ nodeGetParentNode placeholder
297+ liftIO $ nodeInsertBefore p (Just df) (Just placeholder)
300+ liftIO $ putStrLn "Leaving item unchanged"
302+ liftIO $ putStrLn "Triggering newChildren"
303+ liftIO $ putStrLn . ("newChildrenTriggerRef is Just? " <>) . show . isJust =<< readRef newChildrenTriggerRef
304+ runFrameWithTriggerRef newChildrenTriggerRef newState
305+ liftIO $ putStrLn "Triggering newChildren done"
306+ return $ switch $ fmap (mergeMap . fmap (fst . fst)) children
308+--TODO: Deduplicate the various list*WithKey* implementations
257selectViewListWithKey_ :: 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)
310selectViewListWithKey_ :: 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)
258selectViewListWithKey_ selection vals mkChild = do
311selectViewListWithKey_ selection vals mkChild = do
259 let selectionDemux = demux selection -- For good performance, this value must be shared across all children
312 let selectionDemux = demux selection -- For good performance, this value must be shared across all children