on develop help sign in
Merge branch 'develop' of github.com:ryantrinkle/reflex-dom into develop

# Conflicts: # src/Reflex/Dom/Time.hs

commit00742d5b3d67b633d530c6a4f75b4c84d5f8364d authorRyan Trinkle <ryan.trinkle@gmail.com> dateThu 24 Sep 2015, 20:08 (11 years ago) parent7dce02bb630f15
2 files changed+32−20
src/Reflex/Dom/Time.hs+10−1 src/Reflex/Dom/Widget/Lazy.hs+22−19
src/Reflex/Dom/Time.hs+10−1
@@ -1,4 +1,4 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
1+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
22module Reflex.Dom.Time where
33
44import Reflex
@@ -51,3 +51,12 @@ delay :: MonadWidget t m => NominalDiffTime -> Event t a -> m (Event t a)
5151delay dt e = performEventAsync $ ffor e $ \a cb -> liftIO $ void $ forkIO $ do
5252 threadDelay $ ceiling $ dt * 1000000
5353 cb a
54+
55+-- | Block occurrences of an Event until th given number of seconds elapses without
56+-- the Event firing, at which point the last occurrence of the Event will fire.
57+debounce :: MonadWidget t m => NominalDiffTime -> Event t a -> m (Event t a)
58+debounce dt e = do
59+ n :: Dynamic t Integer <- count e
60+ let tagged = attachDynWith (,) n e
61+ delayed <- delay dt tagged
62+ return $ attachWithMaybe (\n' (t, v) -> if n' == t then Just v else Nothing) (current n) delayed
src/Reflex/Dom/Widget/Lazy.hs+22−19
@@ -15,7 +15,7 @@ import GHCJS.DOM.Element
1515
1616-- |A list view for long lists. Creates a scrollable element and only renders child row elements near the current scroll position.
1717virtualListWithSelection :: forall t m k v. (MonadWidget t m, Ord k)
18− => Int -- ^ The height of the visible region in pixels
18+ => Dynamic t Int -- ^ The height of the visible region in pixels
1919 -> Int -- ^ The height of each row in pixels
2020 -> Dynamic t Int -- ^ The total number of items
2121 -> Int -- ^ The index of the row to scroll to on initialization
@@ -24,37 +24,39 @@ virtualListWithSelection :: forall t m k v. (MonadWidget t m, Ord k)
2424 -> Dynamic t (Map String String) -- ^ The attributes of the list
2525 -> String -- ^ The element tag for a row
2626 -> Dynamic t (Map String String) -- ^ The attributes of each row
27− -> (k -> Dynamic t v -> m ()) -- ^ The row child element builder
27+ -> (k -> Dynamic t (Maybe v) -> Dynamic t Bool -> m ()) -- ^ The row child element builder
2828 -> Dynamic t (Map k v) -- ^ The 'Map' of items
29+ -> (Int -> k) -- ^ Index to Key function, used to determine position of Map elements
2930 -> m (Dynamic t (Int, Int), Event t k) -- ^ A tuple containing: a 'Dynamic' of the index (based on the current scroll position) and number of items currently being rendered, and an 'Event' of the selected key
30−virtualListWithSelection heightPx rowPx maxIndex i0 setI listTag listAttrs rowTag rowAttrs itemBuilder items = do
31+virtualListWithSelection heightPx rowPx maxIndex i0 setI listTag listAttrs rowTag rowAttrs itemBuilder items indexToKey = do
3132 totalHeightStyle <- mapDyn (toHeightStyle . (*) rowPx) maxIndex
32− rec (container, itemList) <- elAttr "div" outerStyle $ elAttr' "div" containerStyle $ do
33+ containerStyle <- mapDyn toContainer heightPx
34+ viewportStyle <- mapDyn toViewport heightPx
35+ rec (container, sel) <- elDynAttr "div" containerStyle $ elDynAttr' "div" viewportStyle $ do
3336 currentTop <- mapDyn (listWrapperStyle . fst) window
34− (_, lis) <- elDynAttr "div" totalHeightStyle $ tagWrapper listTag listAttrs currentTop $ listWithKey itemsInWindow $ \k v -> do
35− (li,_) <- tagWrapper rowTag rowAttrs (constDyn $ toHeightStyle rowPx) $ itemBuilder k v
37+ (_, lis) <- elDynAttr "div" totalHeightStyle $ tagWrapper listTag listAttrs currentTop $ selectViewListWithKey_ selected itemsInWindow $ \k v s -> do
38+ (li,_) <- tagWrapper rowTag rowAttrs (constDyn $ toHeightStyle rowPx) $ itemBuilder k v s
3639 return $ fmap (const k) (domEvent Click li)
3740 return lis
38− scrollPosition <- holdDyn 0 $ domEvent Scroll container
39− window <- mapDyn (findWindow heightPx rowPx) scrollPosition
40− itemsInWindow <- combineDyn (\(_,(idx,num)) is -> Map.fromList $ take num $ drop idx $ Map.toList is) window items
41+ selected <- holdDyn (indexToKey i0) sel
42+ pb <- getPostBuild
43+ scrollPosition <- holdDyn 0 $ leftmost [ domEvent Scroll container
44+ , fmap (const (i0 * rowPx)) pb
45+ ]
46+ window <- combineDyn (\h -> findWindow h rowPx) heightPx scrollPosition
47+ itemsInWindow <- combineDyn (\(_,(idx,num)) is -> Map.fromList $ map (\i -> let ix = indexToKey i in (ix, Map.lookup ix is)) [idx .. idx + num]) window items
4148 postBuild <- getPostBuild
4249 performEvent_ $ fmap (\i -> liftIO $ elementSetScrollTop (_el_element container) (i * rowPx)) $ leftmost [setI, fmap (const i0) postBuild]
4350 indexAndLength <- mapDyn snd window
44− sel <- mapDyn (leftmost . Map.elems) itemList
45− return (indexAndLength, switch $ current sel)
51+ return (indexAndLength, sel)
4652 where
4753 toStyleAttr m = "style" =: (Map.foldWithKey (\k v s -> k <> ":" <> v <> ";" <> s) "" m)
48− outerStyle = toStyleAttr $ "position" =: "relative" <>
49− "height" =: (show heightPx <> "px")
50− containerStyle = toStyleAttr $ "overflow" =: "auto" <>
51− "position" =: "absolute" <>
52− "left" =: "0" <>
53− "right" =: "0" <>
54− "height" =: (show heightPx <> "px")
54+ toViewport h = toStyleAttr $ "overflow" =: "auto" <> "position" =: "absolute" <>
55+ "left" =: "0" <> "right" =: "0" <> "height" =: (show h <> "px")
56+ toContainer h = toStyleAttr $ "position" =: "relative" <> "height" =: (show h <> "px")
5557 listWrapperStyle t = toStyleAttr $ "position" =: "relative" <>
5658 "top" =: (show t <> "px")
57− toHeightStyle h = toStyleAttr ("height" =: (show h <> "px"))
59+ toHeightStyle h = toStyleAttr ("height" =: (show h <> "px") <> "overflow" =: "hidden")
5860 tagWrapper elTag attrs attrsOverride c = do
5961 attrs' <- combineDyn Map.union attrsOverride attrs
6062 elDynAttr' elTag attrs' c
@@ -65,3 +67,4 @@ virtualListWithSelection heightPx rowPx maxIndex i0 setI listTag listAttrs rowTa
6567 preItems = min startingIndex numItems
6668 in (topPx - preItems * sizeIncrement, (startingIndex - preItems, preItems + numItems * 2))
6769
70+