@@ -0,0 +1,67 @@
1+{-# LANGUAGE RecursiveDo, ScopedTypeVariables #-}
2+
3+module Reflex.Dom.Widget.Lazy where
4+
5+import Reflex
6+import Reflex.Dom.Class
7+import Reflex.Dom.Widget.Basic
8+
9+import Control.Monad.IO.Class
10+import Data.Fixed
11+import Data.Monoid
12+import qualified Data.Map as Map
13+import Data.Map (Map)
14+import GHCJS.DOM.Element
15+
16+-- |A list view for long lists. Creates a scrollable element and only renders child row elements near the current scroll position.
17+virtualListWithSelection :: forall t m k v. (MonadWidget t m, Ord k)
18+ => Int -- ^ The height of the visible region in pixels
19+ -> Int -- ^ The height of each row in pixels
20+ -> Int -- ^ The total number of items
21+ -> Int -- ^ The index of the row to scroll to on initialization
22+ -> Event t Int -- ^ An 'Event' containing a row index. Used to scroll to the given index.
23+ -> String -- ^ The element tag for the list
24+ -> Dynamic t (Map String String) -- ^ The attributes of the list
25+ -> String -- ^ The element tag for a row
26+ -> Dynamic t (Map String String) -- ^ The attributes of each row
27+ -> (k -> Dynamic t v -> m ()) -- ^ The row child element builder
28+ -> Dynamic t (Map k v) -- ^ The 'Map' of items
29+ -> 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+ let totalHeightStyle = toHeightStyle $ rowPx * maxIndex
32+ rec (container, itemList) <- elAttr "div" outerStyle $ elAttr' "div" containerStyle $ do
33+ currentTop <- mapDyn (listWrapperStyle . fst) window
34+ (_, lis) <- elAttr "div" totalHeightStyle $ tagWrapper listTag listAttrs currentTop $ listWithKey itemsInWindow $ \k v -> do
35+ (li,_) <- tagWrapper rowTag rowAttrs (constDyn $ toHeightStyle rowPx) $ itemBuilder k v
36+ return $ fmap (const k) (_el_clicked li)
37+ return lis
38+ scrollPosition <- holdDyn 0 $ _el_scrolled 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+ postBuild <- getPostBuild
42+ performEvent_ $ fmap (\i -> liftIO $ elementSetScrollTop (_el_element container) (i * rowPx)) $ leftmost [setI, fmap (const i0) postBuild]
43+ indexAndLength <- mapDyn snd window
44+ sel <- mapDyn (leftmost . Map.elems) itemList
45+ return (indexAndLength, switch $ current sel)
46+ where
47+ 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")
55+ listWrapperStyle t = toStyleAttr $ "position" =: "relative" <>
56+ "top" =: (show t <> "px")
57+ toHeightStyle h = toStyleAttr ("height" =: (show h <> "px"))
58+ tagWrapper elTag attrs attrsOverride c = do
59+ attrs' <- combineDyn Map.union attrsOverride attrs
60+ elDynAttr' elTag attrs' c
61+ findWindow windowSize sizeIncrement startingPosition =
62+ let (startingIndex, topOffsetPx) = startingPosition `divMod'` sizeIncrement
63+ topPx = startingPosition - topOffsetPx
64+ numItems = windowSize `div` sizeIncrement + 1
65+ preItems = min startingIndex numItems
66+ in (topPx - preItems * sizeIncrement, (startingIndex - preItems, preItems + numItems * 2))
67+