{-# LANGUAGE RecursiveDo, ScopedTypeVariables #-} module Reflex.Dom.Widget.Lazy where import Reflex import Reflex.Dom.Class import Reflex.Dom.Widget.Basic import Control.Monad.IO.Class import Data.Fixed import Data.Monoid import qualified Data.Map as Map import Data.Map (Map) import GHCJS.DOM.Element -- |A list view for long lists. Creates a scrollable element and only renders child row elements near the current scroll position. virtualListWithSelection :: forall t m k v. (MonadWidget t m, Ord k) => Int -- ^ The height of the visible region in pixels -> Int -- ^ The height of each row in pixels -> Dynamic t Int -- ^ The total number of items -> Int -- ^ The index of the row to scroll to on initialization -> Event t Int -- ^ An 'Event' containing a row index. Used to scroll to the given index. -> String -- ^ The element tag for the list -> Dynamic t (Map String String) -- ^ The attributes of the list -> String -- ^ The element tag for a row -> Dynamic t (Map String String) -- ^ The attributes of each row -> (k -> Dynamic t v -> m ()) -- ^ The row child element builder -> Dynamic t (Map k v) -- ^ The 'Map' of items -> 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 virtualListWithSelection heightPx rowPx maxIndex i0 setI listTag listAttrs rowTag rowAttrs itemBuilder items = do totalHeightStyle <- mapDyn (toHeightStyle . (*) rowPx) maxIndex rec (container, itemList) <- elAttr "div" outerStyle $ elAttr' "div" containerStyle $ do currentTop <- mapDyn (listWrapperStyle . fst) window (_, lis) <- elDynAttr "div" totalHeightStyle $ tagWrapper listTag listAttrs currentTop $ listWithKey itemsInWindow $ \k v -> do (li,_) <- tagWrapper rowTag rowAttrs (constDyn $ toHeightStyle rowPx) $ itemBuilder k v return $ fmap (const k) (_el_clicked li) return lis scrollPosition <- holdDyn 0 $ _el_scrolled container window <- mapDyn (findWindow heightPx rowPx) scrollPosition itemsInWindow <- combineDyn (\(_,(idx,num)) is -> Map.fromList $ take num $ drop idx $ Map.toList is) window items postBuild <- getPostBuild performEvent_ $ fmap (\i -> liftIO $ elementSetScrollTop (_el_element container) (i * rowPx)) $ leftmost [setI, fmap (const i0) postBuild] indexAndLength <- mapDyn snd window sel <- mapDyn (leftmost . Map.elems) itemList return (indexAndLength, switch $ current sel) where toStyleAttr m = "style" =: (Map.foldWithKey (\k v s -> k <> ":" <> v <> ";" <> s) "" m) outerStyle = toStyleAttr $ "position" =: "relative" <> "height" =: (show heightPx <> "px") containerStyle = toStyleAttr $ "overflow" =: "auto" <> "position" =: "absolute" <> "left" =: "0" <> "right" =: "0" <> "height" =: (show heightPx <> "px") listWrapperStyle t = toStyleAttr $ "position" =: "relative" <> "top" =: (show t <> "px") toHeightStyle h = toStyleAttr ("height" =: (show h <> "px")) tagWrapper elTag attrs attrsOverride c = do attrs' <- combineDyn Map.union attrsOverride attrs elDynAttr' elTag attrs' c findWindow windowSize sizeIncrement startingPosition = let (startingIndex, topOffsetPx) = startingPosition `divMod'` sizeIncrement topPx = startingPosition - topOffsetPx numItems = windowSize `div` sizeIncrement + 1 preItems = min startingIndex numItems in (topPx - preItems * sizeIncrement, (startingIndex - preItems, preItems + numItems * 2))