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
virtualListWithSelection :: forall t m k v. (MonadWidget t m, Ord k)
=> Int
-> Int
-> Dynamic t Int
-> Int
-> Event t Int
-> String
-> Dynamic t (Map String String)
-> String
-> Dynamic t (Map String String)
-> (k -> Dynamic t v -> m ())
-> Dynamic t (Map k v)
-> m (Dynamic t (Int, Int), Event t k)
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) (domEvent Click li)
return lis
scrollPosition <- holdDyn 0 $ domEvent Scroll 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))