@@ -6,12 +6,15 @@ import Reflex
66import Reflex.Dom.Class
77import Reflex.Dom.Widget.Basic
88
9+import Control.Monad
910import Control.Monad.IO.Class
1011import Data.Fixed
1112import Data.Monoid
1213import qualified Data.Map as Map
1314import Data.Map (Map)
1415import GHCJS.DOM.Element
16+import Data.Maybe
17+import Data.Int
1518
1619-- |A list view for long lists. Creates a scrollable element and only renders child row elements near the current scroll position.
1720virtualListWithSelection :: forall t m k v. (MonadWidget t m, Ord k)
@@ -67,4 +70,39 @@ virtualListWithSelection heightPx rowPx maxIndex i0 setI listTag listAttrs rowTa
6770 preItems = min startingIndex numItems
6871 in (topPx - preItems * sizeIncrement, (startingIndex - preItems, preItems + numItems * 2))
6972
70−
73+{-# NOINLINE virtualList #-}
74+virtualList :: forall t m k v a. (MonadWidget t m, Ord k)
75+ => Dynamic t Int -- ^ The height of the visible region in pixels
76+ -> Int -- ^ The height of each row in pixels
77+ -> Dynamic t Int -- ^ The total number of items
78+ -> Int -- ^ The index of the row to scroll to on initialization
79+ -> Event t Int -- ^ An 'Event' containing a row index. Used to scroll to the given index.
80+ -> (k -> Int) -- ^ Index to Key function, used to determine position of Map elements
81+ -> Map k v -- ^ The initial 'Map' of items
82+ -> Event t (Map k (Maybe v)) -- ^ The update 'Event'
83+ -> (k -> v -> Event t v -> m a) -- ^ The row child element builder
84+ -> m (Dynamic t (Int, Int), Dynamic t (Map k a)) -- ^ A tuple containing: a 'Dynamic' of the index (based on the current scroll position) and number of items currently being rendered, and the Dynamic list result
85+virtualList heightPx rowPx maxIndex i0 setI keyToIndex items0 itemUpdate itemBuilder = do
86+ totalHeightStyle <- mapDyn (toHeightStyle . (*) rowPx) maxIndex
87+ containerStyle <- mapDyn toContainer heightPx
88+ viewportStyle <- mapDyn toViewport heightPx
89+ pb <- getPostBuild
90+ rec (viewport, result) <- elDynAttr "div" containerStyle $ elDynAttr' "div" viewportStyle $ do
91+ elDynAttr "div" totalHeightStyle $ listWithKeyShallowDiff items0 itemUpdate $ \k v e -> do
92+ elAttr "div" (toStyleAttr $ ("height" =: (show rowPx <> "px") <> "top" =: ((<>"px") $ show $ keyToIndex k * rowPx) <> "position" =: "absolute" <> "width" =: "100%")) $ itemBuilder k v e
93+ scrollPosition <- holdDyn 0 $ leftmost [ domEvent Scroll viewport
94+ , fmap (const (i0 * rowPx)) pb
95+ ]
96+ window <- combineDyn (\h -> findWindow h rowPx) heightPx scrollPosition
97+ performEvent_ $ fmap (\i -> liftIO $ elementSetScrollTop (_el_element viewport) (i * rowPx)) $ leftmost [setI, fmap (const i0) pb]
98+ return (nubDyn window, result)
99+ where
100+ toStyleAttr m = "style" =: (Map.foldWithKey (\k v s -> k <> ":" <> v <> ";" <> s) "" m)
101+ toViewport h = toStyleAttr $ "overflow" =: "auto" <> "position" =: "absolute" <>
102+ "left" =: "0" <> "right" =: "0" <> "height" =: (show h <> "px")
103+ toContainer h = toStyleAttr $ "position" =: "relative" <> "height" =: (show h <> "px")
104+ toHeightStyle h = toStyleAttr ("height" =: (show h <> "px") <> "overflow" =: "hidden" <> "position" =: "relative")
105+ findWindow windowSize sizeIncrement startingPosition =
106+ let (startingIndex, topOffsetPx) = startingPosition `divMod'` sizeIncrement
107+ numItems = (windowSize + sizeIncrement - 1) `div` sizeIncrement
108+ in (startingIndex, numItems)