{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Reflex.Dom.Widget.Lazy where

import Reflex.Class
import Reflex.Collection
import Reflex.Dom.Builder.Class
import Reflex.Dom.Builder.Immediate
import Reflex.Dom.Class
import Reflex.Dom.Widget.Basic
import Reflex.Dynamic
import Reflex.PerformEvent.Class
import Reflex.PostBuild.Class

import Control.Monad.Fix
import Data.Fixed
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import GHCJS.DOM.Element
import GHCJS.DOM.Types (MonadJSM)

-- |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. (DomBuilder t m, PostBuild t m, MonadHold t m, PerformEvent t m, MonadJSM (Performable m), DomBuilderSpace m ~ GhcjsDomSpace, MonadFix m, Ord k)
  => Dynamic t 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.
  -> Text -- ^ The element tag for the list
  -> Dynamic t (Map Text Text) -- ^ The attributes of the list
  -> Text -- ^ The element tag for a row
  -> Dynamic t (Map Text Text) -- ^ The attributes of each row
  -> (k -> Dynamic t (Maybe v) -> Dynamic t Bool -> m ()) -- ^ The row child element builder
  -> Dynamic t (Map k v) -- ^ The 'Map' of items
  -> (Int -> k) -- ^ Index to Key function, used to determine position of Map elements
  -> 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 :: Dynamic t Int
-> Int
-> Dynamic t Int
-> Int
-> Event t Int
-> Text
-> Dynamic t (Map Text Text)
-> Text
-> Dynamic t (Map Text Text)
-> (k -> Dynamic t (Maybe v) -> Dynamic t Bool -> m ())
-> Dynamic t (Map k v)
-> (Int -> k)
-> m (Dynamic t (Int, Int), Event t k)
virtualListWithSelection Dynamic t Int
heightPx Int
rowPx Dynamic t Int
maxIndex Int
i0 Event t Int
setI Text
listTag Dynamic t (Map Text Text)
listAttrs Text
rowTag Dynamic t (Map Text Text)
rowAttrs k -> Dynamic t (Maybe v) -> Dynamic t Bool -> m ()
itemBuilder Dynamic t (Map k v)
items Int -> k
indexToKey = do
  let totalHeightStyle :: Dynamic t (Map Text Text)
totalHeightStyle = (Int -> Map Text Text)
-> Dynamic t Int -> Dynamic t (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Map Text Text
forall m a.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Ord (IxValue m), Show a, Semigroup (IxValue m),
 IxValue m ~ Text) =>
a -> m
toHeightStyle (Int -> Map Text Text) -> (Int -> Int) -> Int -> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) Int
rowPx) Dynamic t Int
maxIndex
      containerStyle :: Dynamic t (Map Text Text)
containerStyle = (Int -> Map Text Text)
-> Dynamic t Int -> Dynamic t (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Map Text Text
forall m a.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Ord (IxValue m), Show a, Semigroup (IxValue m),
 IxValue m ~ Text) =>
a -> m
toContainer Dynamic t Int
heightPx
      viewportStyle :: Dynamic t (Map Text Text)
viewportStyle = (Int -> Map Text Text)
-> Dynamic t Int -> Dynamic t (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Map Text Text
forall m a.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Ord (IxValue m), Show a, Semigroup (IxValue m),
 IxValue m ~ Text) =>
a -> m
toViewport Dynamic t Int
heightPx
  rec (Element EventResult GhcjsDomSpace t
container, Event t k
sel) <- Text
-> Dynamic t (Map Text Text)
-> m (Element EventResult GhcjsDomSpace t, Event t k)
-> m (Element EventResult GhcjsDomSpace t, Event t k)
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text -> Dynamic t (Map Text Text) -> m a -> m a
elDynAttr Text
"div" Dynamic t (Map Text Text)
containerStyle (m (Element EventResult GhcjsDomSpace t, Event t k)
 -> m (Element EventResult GhcjsDomSpace t, Event t k))
-> m (Element EventResult GhcjsDomSpace t, Event t k)
-> m (Element EventResult GhcjsDomSpace t, Event t k)
forall a b. (a -> b) -> a -> b
$ Text
-> Dynamic t (Map Text Text)
-> m (Event t k)
-> m (Element EventResult (DomBuilderSpace m) t, Event t k)
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elDynAttr' Text
"div" Dynamic t (Map Text Text)
viewportStyle (m (Event t k)
 -> m (Element EventResult (DomBuilderSpace m) t, Event t k))
-> m (Event t k)
-> m (Element EventResult (DomBuilderSpace m) t, Event t k)
forall a b. (a -> b) -> a -> b
$ do
        let currentTop :: Dynamic t (Map Text Text)
currentTop = ((Int, (Int, Int)) -> Map Text Text)
-> Dynamic t (Int, (Int, Int)) -> Dynamic t (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Map Text Text
forall m a.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Ord (IxValue m), Show a, Semigroup (IxValue m),
 IxValue m ~ Text) =>
a -> m
listWrapperStyle (Int -> Map Text Text)
-> ((Int, (Int, Int)) -> Int) -> (Int, (Int, Int)) -> Map Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, (Int, Int)) -> Int
forall a b. (a, b) -> a
fst) Dynamic t (Int, (Int, Int))
window
        (Element EventResult GhcjsDomSpace t
_, Event t k
lis) <- Text
-> Dynamic t (Map Text Text)
-> m (Element EventResult GhcjsDomSpace t, Event t k)
-> m (Element EventResult GhcjsDomSpace t, Event t k)
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text -> Dynamic t (Map Text Text) -> m a -> m a
elDynAttr Text
"div" Dynamic t (Map Text Text)
totalHeightStyle (m (Element EventResult GhcjsDomSpace t, Event t k)
 -> m (Element EventResult GhcjsDomSpace t, Event t k))
-> m (Element EventResult GhcjsDomSpace t, Event t k)
-> m (Element EventResult GhcjsDomSpace t, Event t k)
forall a b. (a -> b) -> a -> b
$ Text
-> Dynamic t (Map Text Text)
-> Dynamic t (Map Text Text)
-> m (Event t k)
-> m (Element EventResult (DomBuilderSpace m) t, Event t k)
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text
-> Dynamic t (Map Text Text)
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
tagWrapper Text
listTag Dynamic t (Map Text Text)
listAttrs Dynamic t (Map Text Text)
currentTop (m (Event t k)
 -> m (Element EventResult (DomBuilderSpace m) t, Event t k))
-> m (Event t k)
-> m (Element EventResult (DomBuilderSpace m) t, Event t k)
forall a b. (a -> b) -> a -> b
$ Dynamic t k
-> Dynamic t (Map k (Maybe v))
-> (k -> Dynamic t (Maybe v) -> Dynamic t Bool -> m (Event t k))
-> m (Event t k)
forall t (m :: * -> *) k v a.
(Adjustable t m, Ord k, PostBuild t m, MonadHold t m,
 MonadFix m) =>
Dynamic t k
-> Dynamic t (Map k v)
-> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a))
-> m (Event t k)
selectViewListWithKey_ Dynamic t k
selected Dynamic t (Map k (Maybe v))
itemsInWindow ((k -> Dynamic t (Maybe v) -> Dynamic t Bool -> m (Event t k))
 -> m (Event t k))
-> (k -> Dynamic t (Maybe v) -> Dynamic t Bool -> m (Event t k))
-> m (Event t k)
forall a b. (a -> b) -> a -> b
$ \k
k Dynamic t (Maybe v)
v Dynamic t Bool
s -> do
            (Element EventResult GhcjsDomSpace t
li,()
_) <- Text
-> Dynamic t (Map Text Text)
-> Dynamic t (Map Text Text)
-> m ()
-> m (Element EventResult (DomBuilderSpace m) t, ())
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text
-> Dynamic t (Map Text Text)
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
tagWrapper Text
rowTag Dynamic t (Map Text Text)
rowAttrs (Map Text Text -> Dynamic t (Map Text Text)
forall k (t :: k) a. Reflex t => a -> Dynamic t a
constDyn (Map Text Text -> Dynamic t (Map Text Text))
-> Map Text Text -> Dynamic t (Map Text Text)
forall a b. (a -> b) -> a -> b
$ Int -> Map Text Text
forall m a.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Ord (IxValue m), Show a, Semigroup (IxValue m),
 IxValue m ~ Text) =>
a -> m
toHeightStyle Int
rowPx) (m () -> m (Element EventResult (DomBuilderSpace m) t, ()))
-> m () -> m (Element EventResult (DomBuilderSpace m) t, ())
forall a b. (a -> b) -> a -> b
$ k -> Dynamic t (Maybe v) -> Dynamic t Bool -> m ()
itemBuilder k
k Dynamic t (Maybe v)
v Dynamic t Bool
s
            Event t k -> m (Event t k)
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t k -> m (Event t k)) -> Event t k -> m (Event t k)
forall a b. (a -> b) -> a -> b
$ (() -> k) -> Event t () -> Event t k
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k -> () -> k
forall a b. a -> b -> a
const k
k) (EventName 'ClickTag
-> Element EventResult GhcjsDomSpace t
-> Event
     t (DomEventType (Element EventResult GhcjsDomSpace t) 'ClickTag)
forall k (t :: k) target (eventName :: EventTag).
HasDomEvent t target eventName =>
EventName eventName
-> target -> Event t (DomEventType target eventName)
domEvent EventName 'ClickTag
Click Element EventResult GhcjsDomSpace t
li)
        Event t k -> m (Event t k)
forall (m :: * -> *) a. Monad m => a -> m a
return Event t k
lis
      Dynamic t k
selected <- k -> Event t k -> m (Dynamic t k)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (Int -> k
indexToKey Int
i0) Event t k
sel
      Event t ()
pb <- m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
      Dynamic t Int
scrollPosition <- Int -> Event t Int -> m (Dynamic t Int)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Int
0 (Event t Int -> m (Dynamic t Int))
-> Event t Int -> m (Dynamic t Int)
forall a b. (a -> b) -> a -> b
$ [Event t Int] -> Event t Int
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Event t Double -> Event t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventName 'ScrollTag
-> Element EventResult GhcjsDomSpace t
-> Event
     t (DomEventType (Element EventResult GhcjsDomSpace t) 'ScrollTag)
forall k (t :: k) target (eventName :: EventTag).
HasDomEvent t target eventName =>
EventName eventName
-> target -> Event t (DomEventType target eventName)
domEvent EventName 'ScrollTag
Scroll Element EventResult GhcjsDomSpace t
container
                                             , (() -> Int) -> Event t () -> Event t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> () -> Int
forall a b. a -> b -> a
const (Int
i0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rowPx)) Event t ()
pb
                                             ]
      let window :: Dynamic t (Int, (Int, Int))
window = (Int -> Int -> (Int, (Int, Int)))
-> Dynamic t Int -> Dynamic t Int -> Dynamic t (Int, (Int, Int))
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
zipDynWith (Int -> Int -> Int -> (Int, (Int, Int))
forall b. Integral b => b -> b -> b -> (b, (b, b))
findWindow Int
rowPx) Dynamic t Int
heightPx Dynamic t Int
scrollPosition
          itemsInWindow :: Dynamic t (Map k (Maybe v))
itemsInWindow = ((Int, (Int, Int)) -> Map k v -> Map k (Maybe v))
-> Dynamic t (Int, (Int, Int))
-> Dynamic t (Map k v)
-> Dynamic t (Map k (Maybe v))
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
zipDynWith (\(Int
_,(Int
idx,Int
num)) Map k v
is -> [(k, Maybe v)] -> Map k (Maybe v)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, Maybe v)] -> Map k (Maybe v))
-> [(k, Maybe v)] -> Map k (Maybe v)
forall a b. (a -> b) -> a -> b
$ (Int -> (k, Maybe v)) -> [Int] -> [(k, Maybe v)]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> let ix :: k
ix = Int -> k
indexToKey Int
i in (k
ix, k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
ix Map k v
is)) [Int
idx .. Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
num]) Dynamic t (Int, (Int, Int))
window Dynamic t (Map k v)
items
  Event t ()
postBuild <- m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
  Event t (Performable m ()) -> m ()
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_ (Event t (Performable m ()) -> m ())
-> Event t (Performable m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Event t Int
-> (Int -> Performable m ()) -> Event t (Performable m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor ([Event t Int] -> Event t Int
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t Int
setI, Int
i0 Int -> Event t () -> Event t Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t ()
postBuild]) ((Int -> Performable m ()) -> Event t (Performable m ()))
-> (Int -> Performable m ()) -> Event t (Performable m ())
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Element -> Int -> Performable m ()
forall (m :: * -> *) self.
(MonadDOM m, IsElement self) =>
self -> Int -> m ()
setScrollTop (Element EventResult GhcjsDomSpace t -> RawElement GhcjsDomSpace
forall (er :: EventTag -> *) k1 (d :: k1) k2 (t :: k2).
Element er d t -> RawElement d
_element_raw Element EventResult GhcjsDomSpace t
container) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rowPx)
  let indexAndLength :: Dynamic t (Int, Int)
indexAndLength = ((Int, (Int, Int)) -> (Int, Int))
-> Dynamic t (Int, (Int, Int)) -> Dynamic t (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, (Int, Int)) -> (Int, Int)
forall a b. (a, b) -> b
snd Dynamic t (Int, (Int, Int))
window
  (Dynamic t (Int, Int), Event t k)
-> m (Dynamic t (Int, Int), Event t k)
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic t (Int, Int)
indexAndLength, Event t k
sel)
  where
    toStyleAttr :: Map (IxValue m) (IxValue m) -> m
toStyleAttr Map (IxValue m) (IxValue m)
m = Index m
"style" Index m -> IxValue m -> m
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (IxValue m -> IxValue m -> IxValue m -> IxValue m)
-> IxValue m -> Map (IxValue m) (IxValue m) -> IxValue m
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\IxValue m
k IxValue m
v IxValue m
s -> IxValue m
k IxValue m -> IxValue m -> IxValue m
forall a. Semigroup a => a -> a -> a
<> IxValue m
":" IxValue m -> IxValue m -> IxValue m
forall a. Semigroup a => a -> a -> a
<> IxValue m
v IxValue m -> IxValue m -> IxValue m
forall a. Semigroup a => a -> a -> a
<> IxValue m
";" IxValue m -> IxValue m -> IxValue m
forall a. Semigroup a => a -> a -> a
<> IxValue m
s) IxValue m
"" Map (IxValue m) (IxValue m)
m
    toViewport :: a -> m
toViewport a
h = Map (IxValue m) (IxValue m) -> m
forall m.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Semigroup (IxValue m)) =>
Map (IxValue m) (IxValue m) -> m
toStyleAttr (Map (IxValue m) (IxValue m) -> m)
-> Map (IxValue m) (IxValue m) -> m
forall a b. (a -> b) -> a -> b
$ Index (Map (IxValue m) (IxValue m))
"overflow" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map (IxValue m) (IxValue m))
"auto" Map (IxValue m) (IxValue m)
-> Map (IxValue m) (IxValue m) -> Map (IxValue m) (IxValue m)
forall a. Semigroup a => a -> a -> a
<> Index (Map (IxValue m) (IxValue m))
"position" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map (IxValue m) (IxValue m))
"absolute" Map (IxValue m) (IxValue m)
-> Map (IxValue m) (IxValue m) -> Map (IxValue m) (IxValue m)
forall a. Semigroup a => a -> a -> a
<>
                                 Index (Map (IxValue m) (IxValue m))
"left" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map (IxValue m) (IxValue m))
"0" Map (IxValue m) (IxValue m)
-> Map (IxValue m) (IxValue m) -> Map (IxValue m) (IxValue m)
forall a. Semigroup a => a -> a -> a
<> Index (Map (IxValue m) (IxValue m))
"right" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map (IxValue m) (IxValue m))
"0" Map (IxValue m) (IxValue m)
-> Map (IxValue m) (IxValue m) -> Map (IxValue m) (IxValue m)
forall a. Semigroup a => a -> a -> a
<> Index (Map (IxValue m) (IxValue m))
"height" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
h) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"px")
    toContainer :: a -> m
toContainer a
h = Map (IxValue m) (IxValue m) -> m
forall m.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Semigroup (IxValue m)) =>
Map (IxValue m) (IxValue m) -> m
toStyleAttr (Map (IxValue m) (IxValue m) -> m)
-> Map (IxValue m) (IxValue m) -> m
forall a b. (a -> b) -> a -> b
$ Index (Map (IxValue m) (IxValue m))
"position" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map (IxValue m) (IxValue m))
"relative" Map (IxValue m) (IxValue m)
-> Map (IxValue m) (IxValue m) -> Map (IxValue m) (IxValue m)
forall a. Semigroup a => a -> a -> a
<> Index (Map (IxValue m) (IxValue m))
"height" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
h) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"px")
    listWrapperStyle :: a -> m
listWrapperStyle a
t = Map (IxValue m) (IxValue m) -> m
forall m.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Semigroup (IxValue m)) =>
Map (IxValue m) (IxValue m) -> m
toStyleAttr (Map (IxValue m) (IxValue m) -> m)
-> Map (IxValue m) (IxValue m) -> m
forall a b. (a -> b) -> a -> b
$ Index (Map (IxValue m) (IxValue m))
"position" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map (IxValue m) (IxValue m))
"relative" Map (IxValue m) (IxValue m)
-> Map (IxValue m) (IxValue m) -> Map (IxValue m) (IxValue m)
forall a. Semigroup a => a -> a -> a
<>
                                       Index (Map (IxValue m) (IxValue m))
"top" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"px")
    toHeightStyle :: a -> m
toHeightStyle a
h = Map (IxValue m) (IxValue m) -> m
forall m.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Semigroup (IxValue m)) =>
Map (IxValue m) (IxValue m) -> m
toStyleAttr (Index (Map (IxValue m) (IxValue m))
"height" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
h) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"px") Map (IxValue m) (IxValue m)
-> Map (IxValue m) (IxValue m) -> Map (IxValue m) (IxValue m)
forall a. Semigroup a => a -> a -> a
<> Index (Map (IxValue m) (IxValue m))
"overflow" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map (IxValue m) (IxValue m))
"hidden")
    tagWrapper :: Text
-> Dynamic t (Map Text Text)
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
tagWrapper Text
elTag Dynamic t (Map Text Text)
attrs Dynamic t (Map Text Text)
attrsOverride m a
c = do
      let attrs' :: Dynamic t (Map Text Text)
attrs' = (Map Text Text -> Map Text Text -> Map Text Text)
-> Dynamic t (Map Text Text)
-> Dynamic t (Map Text Text)
-> Dynamic t (Map Text Text)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
zipDynWith Map Text Text -> Map Text Text -> Map Text Text
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Dynamic t (Map Text Text)
attrsOverride Dynamic t (Map Text Text)
attrs
      Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elDynAttr' Text
elTag Dynamic t (Map Text Text)
attrs' m a
c
    findWindow :: b -> b -> b -> (b, (b, b))
findWindow b
sizeIncrement b
windowSize b
startingPosition =
      let (b
startingIndex, b
topOffsetPx) = b
startingPosition b -> b -> (b, b)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
`divMod'` b
sizeIncrement
          topPx :: b
topPx = b
startingPosition b -> b -> b
forall a. Num a => a -> a -> a
- b
topOffsetPx
          numItems :: b
numItems = b
windowSize b -> b -> b
forall a. Integral a => a -> a -> a
`div` b
sizeIncrement b -> b -> b
forall a. Num a => a -> a -> a
+ b
1
          preItems :: b
preItems = b -> b -> b
forall a. Ord a => a -> a -> a
min b
startingIndex b
numItems
      in (b
topPx b -> b -> b
forall a. Num a => a -> a -> a
- b
preItems b -> b -> b
forall a. Num a => a -> a -> a
* b
sizeIncrement, (b
startingIndex b -> b -> b
forall a. Num a => a -> a -> a
- b
preItems, b
preItems b -> b -> b
forall a. Num a => a -> a -> a
+ b
numItems b -> b -> b
forall a. Num a => a -> a -> a
* b
2))

virtualList :: forall t m k v a. (DomBuilder t m, PostBuild t m, MonadHold t m, PerformEvent t m, MonadJSM (Performable m), DomBuilderSpace m ~ GhcjsDomSpace, MonadFix m, Ord k)
  => Dynamic t Int -- ^ A 'Dynamic' of the visible region's height in pixels
  -> Int -- ^ The fixed height of each row in pixels
  -> Dynamic t Int -- ^ A 'Dynamic' of 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.
  -> (k -> Int) -- ^ Key to Index function, used to position items.
  -> Map k v -- ^ The initial 'Map' of items
  -> Event t (Map k (Maybe v)) -- ^ The update 'Event'. Nothing values are removed from the list and Just values are added or updated.
  -> (k -> v -> Event t v -> m a) -- ^ The row child element builder.
  -> 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
virtualList :: Dynamic t Int
-> Int
-> Dynamic t Int
-> Int
-> Event t Int
-> (k -> Int)
-> Map k v
-> Event t (Map k (Maybe v))
-> (k -> v -> Event t v -> m a)
-> m (Dynamic t (Int, Int), Dynamic t (Map k a))
virtualList Dynamic t Int
heightPx Int
rowPx Dynamic t Int
maxIndex Int
i0 Event t Int
setI k -> Int
keyToIndex Map k v
items0 Event t (Map k (Maybe v))
itemsUpdate k -> v -> Event t v -> m a
itemBuilder = do
  let virtualH :: Dynamic t (Map Text Text)
virtualH = Int -> Map Text Text
mkVirtualHeight (Int -> Map Text Text)
-> Dynamic t Int -> Dynamic t (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Int
maxIndex
      containerStyle :: Dynamic t (Map Text Text)
containerStyle = (Int -> Map Text Text)
-> Dynamic t Int -> Dynamic t (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Map Text Text
forall m a.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Ord (IxValue m), Show a, Semigroup (IxValue m),
 IxValue m ~ Text) =>
a -> m
mkContainer Dynamic t Int
heightPx
      viewportStyle :: Dynamic t (Map Text Text)
viewportStyle = (Int -> Map Text Text)
-> Dynamic t Int -> Dynamic t (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Map Text Text
forall m a.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Ord (IxValue m), Show a, Semigroup (IxValue m),
 IxValue m ~ Text) =>
a -> m
mkViewport Dynamic t Int
heightPx
  Event t ()
pb <- m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
  rec (Element EventResult GhcjsDomSpace t
viewport, Dynamic t (Map k a)
result) <- Text
-> Dynamic t (Map Text Text)
-> m (Element EventResult GhcjsDomSpace t, Dynamic t (Map k a))
-> m (Element EventResult GhcjsDomSpace t, Dynamic t (Map k a))
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text -> Dynamic t (Map Text Text) -> m a -> m a
elDynAttr Text
"div" Dynamic t (Map Text Text)
containerStyle (m (Element EventResult GhcjsDomSpace t, Dynamic t (Map k a))
 -> m (Element EventResult GhcjsDomSpace t, Dynamic t (Map k a)))
-> m (Element EventResult GhcjsDomSpace t, Dynamic t (Map k a))
-> m (Element EventResult GhcjsDomSpace t, Dynamic t (Map k a))
forall a b. (a -> b) -> a -> b
$ Text
-> Dynamic t (Map Text Text)
-> m (Dynamic t (Map k a))
-> m (Element EventResult (DomBuilderSpace m) t,
      Dynamic t (Map k a))
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elDynAttr' Text
"div" Dynamic t (Map Text Text)
viewportStyle (m (Dynamic t (Map k a))
 -> m (Element EventResult (DomBuilderSpace m) t,
       Dynamic t (Map k a)))
-> m (Dynamic t (Map k a))
-> m (Element EventResult (DomBuilderSpace m) t,
      Dynamic t (Map k a))
forall a b. (a -> b) -> a -> b
$ Text
-> Dynamic t (Map Text Text)
-> m (Dynamic t (Map k a))
-> m (Dynamic t (Map k a))
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text -> Dynamic t (Map Text Text) -> m a -> m a
elDynAttr Text
"div" Dynamic t (Map Text Text)
virtualH (m (Dynamic t (Map k a)) -> m (Dynamic t (Map k a)))
-> m (Dynamic t (Map k a)) -> m (Dynamic t (Map k a))
forall a b. (a -> b) -> a -> b
$
        Map k v
-> Event t (Map k (Maybe v))
-> (k -> v -> Event t v -> m a)
-> m (Dynamic t (Map k a))
forall k t (m :: * -> *) v a.
(Ord k, Adjustable t m, MonadFix m, MonadHold t m) =>
Map k v
-> Event t (Map k (Maybe v))
-> (k -> v -> Event t v -> m a)
-> m (Dynamic t (Map k a))
listWithKeyShallowDiff Map k v
items0 Event t (Map k (Maybe v))
itemsUpdate ((k -> v -> Event t v -> m a) -> m (Dynamic t (Map k a)))
-> (k -> v -> Event t v -> m a) -> m (Dynamic t (Map k a))
forall a b. (a -> b) -> a -> b
$ \k
k v
v Event t v
e -> Text -> Map Text Text -> m a -> m a
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Map Text Text -> m a -> m a
elAttr Text
"div" (k -> Map Text Text
mkRow k
k) (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ k -> v -> Event t v -> m a
itemBuilder k
k v
v Event t v
e
      Dynamic t Int
scrollPosition <- Int -> Event t Int -> m (Dynamic t Int)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn Int
0 (Event t Int -> m (Dynamic t Int))
-> Event t Int -> m (Dynamic t Int)
forall a b. (a -> b) -> a -> b
$ [Event t Int] -> Event t Int
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Event t Double -> Event t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EventName 'ScrollTag
-> Element EventResult GhcjsDomSpace t
-> Event
     t (DomEventType (Element EventResult GhcjsDomSpace t) 'ScrollTag)
forall k (t :: k) target (eventName :: EventTag).
HasDomEvent t target eventName =>
EventName eventName
-> target -> Event t (DomEventType target eventName)
domEvent EventName 'ScrollTag
Scroll Element EventResult GhcjsDomSpace t
viewport
                                             , (() -> Int) -> Event t () -> Event t Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> () -> Int
forall a b. a -> b -> a
const (Int
i0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rowPx)) Event t ()
pb
                                             ]
      let window :: Dynamic t (Int, Int)
window = (Int -> Int -> (Int, Int))
-> Dynamic t Int -> Dynamic t Int -> Dynamic t (Int, Int)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
zipDynWith (Int -> Int -> Int -> (Int, Int)
forall b a. (Integral b, Integral a) => b -> b -> b -> (a, b)
findWindow Int
rowPx) Dynamic t Int
heightPx Dynamic t Int
scrollPosition
  Event t (Performable m ()) -> m ()
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_ (Event t (Performable m ()) -> m ())
-> Event t (Performable m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Event t Int
-> (Int -> Performable m ()) -> Event t (Performable m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor ([Event t Int] -> Event t Int
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t Int
setI, Int
i0 Int -> Event t () -> Event t Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t ()
pb]) ((Int -> Performable m ()) -> Event t (Performable m ()))
-> (Int -> Performable m ()) -> Event t (Performable m ())
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Element -> Int -> Performable m ()
forall (m :: * -> *) self.
(MonadDOM m, IsElement self) =>
self -> Int -> m ()
setScrollTop (Element EventResult GhcjsDomSpace t -> RawElement GhcjsDomSpace
forall (er :: EventTag -> *) k1 (d :: k1) k2 (t :: k2).
Element er d t -> RawElement d
_element_raw Element EventResult GhcjsDomSpace t
viewport) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rowPx)
  Dynamic t (Int, Int)
uniqWindow <- Dynamic t (Int, Int) -> m (Dynamic t (Int, Int))
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m, Eq a) =>
Dynamic t a -> m (Dynamic t a)
holdUniqDyn Dynamic t (Int, Int)
window
  (Dynamic t (Int, Int), Dynamic t (Map k a))
-> m (Dynamic t (Int, Int), Dynamic t (Map k a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic t (Int, Int)
uniqWindow, Dynamic t (Map k a)
result)
  where
    toStyleAttr :: Map (IxValue m) (IxValue m) -> m
toStyleAttr Map (IxValue m) (IxValue m)
m = Index m
"style" Index m -> IxValue m -> m
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (IxValue m -> IxValue m -> IxValue m -> IxValue m)
-> IxValue m -> Map (IxValue m) (IxValue m) -> IxValue m
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\IxValue m
k IxValue m
v IxValue m
s -> IxValue m
k IxValue m -> IxValue m -> IxValue m
forall a. Semigroup a => a -> a -> a
<> IxValue m
":" IxValue m -> IxValue m -> IxValue m
forall a. Semigroup a => a -> a -> a
<> IxValue m
v IxValue m -> IxValue m -> IxValue m
forall a. Semigroup a => a -> a -> a
<> IxValue m
";" IxValue m -> IxValue m -> IxValue m
forall a. Semigroup a => a -> a -> a
<> IxValue m
s) IxValue m
"" Map (IxValue m) (IxValue m)
m
    mkViewport :: a -> m
mkViewport a
h = Map (IxValue m) (IxValue m) -> m
forall m.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Semigroup (IxValue m)) =>
Map (IxValue m) (IxValue m) -> m
toStyleAttr (Map (IxValue m) (IxValue m) -> m)
-> Map (IxValue m) (IxValue m) -> m
forall a b. (a -> b) -> a -> b
$ Index (Map (IxValue m) (IxValue m))
"overflow" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map (IxValue m) (IxValue m))
"auto" Map (IxValue m) (IxValue m)
-> Map (IxValue m) (IxValue m) -> Map (IxValue m) (IxValue m)
forall a. Semigroup a => a -> a -> a
<> Index (Map (IxValue m) (IxValue m))
"position" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map (IxValue m) (IxValue m))
"absolute" Map (IxValue m) (IxValue m)
-> Map (IxValue m) (IxValue m) -> Map (IxValue m) (IxValue m)
forall a. Semigroup a => a -> a -> a
<>
                                 Index (Map (IxValue m) (IxValue m))
"left" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map (IxValue m) (IxValue m))
"0" Map (IxValue m) (IxValue m)
-> Map (IxValue m) (IxValue m) -> Map (IxValue m) (IxValue m)
forall a. Semigroup a => a -> a -> a
<> Index (Map (IxValue m) (IxValue m))
"right" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map (IxValue m) (IxValue m))
"0" Map (IxValue m) (IxValue m)
-> Map (IxValue m) (IxValue m) -> Map (IxValue m) (IxValue m)
forall a. Semigroup a => a -> a -> a
<> Index (Map (IxValue m) (IxValue m))
"height" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
h) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"px")
    mkContainer :: a -> m
mkContainer a
h = Map (IxValue m) (IxValue m) -> m
forall m.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Semigroup (IxValue m)) =>
Map (IxValue m) (IxValue m) -> m
toStyleAttr (Map (IxValue m) (IxValue m) -> m)
-> Map (IxValue m) (IxValue m) -> m
forall a b. (a -> b) -> a -> b
$ Index (Map (IxValue m) (IxValue m))
"position" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map (IxValue m) (IxValue m))
"relative" Map (IxValue m) (IxValue m)
-> Map (IxValue m) (IxValue m) -> Map (IxValue m) (IxValue m)
forall a. Semigroup a => a -> a -> a
<> Index (Map (IxValue m) (IxValue m))
"height" Index (Map (IxValue m) (IxValue m))
-> IxValue (Map (IxValue m) (IxValue m))
-> Map (IxValue m) (IxValue m)
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
h) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"px")
    mkVirtualHeight :: Int -> Map Text Text
mkVirtualHeight Int
h = let h' :: Int
h' = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rowPx --TODO: test the use of this
                        in Map (IxValue (Map Text Text)) (IxValue (Map Text Text))
-> Map Text Text
forall m.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Semigroup (IxValue m)) =>
Map (IxValue m) (IxValue m) -> m
toStyleAttr (Map (IxValue (Map Text Text)) (IxValue (Map Text Text))
 -> Map Text Text)
-> Map (IxValue (Map Text Text)) (IxValue (Map Text Text))
-> Map Text Text
forall a b. (a -> b) -> a -> b
$ Index (Map Text Text)
"height" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
h') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"px") Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<>
                                         Index (Map Text Text)
"overflow" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map Text Text)
"hidden" Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<>
                                         Index (Map Text Text)
"position" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map Text Text)
"relative"
    mkRow :: k -> Map Text Text
mkRow k
k = Map (IxValue (Map Text Text)) (IxValue (Map Text Text))
-> Map Text Text
forall m.
(At m, Monoid m, IsString (Index m), IsString (IxValue m),
 Semigroup (IxValue m)) =>
Map (IxValue m) (IxValue m) -> m
toStyleAttr (Map (IxValue (Map Text Text)) (IxValue (Map Text Text))
 -> Map Text Text)
-> Map (IxValue (Map Text Text)) (IxValue (Map Text Text))
-> Map Text Text
forall a b. (a -> b) -> a -> b
$ Index (Map Text Text)
"height" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
rowPx) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"px") Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<>
                            Index (Map Text Text)
"top" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"px") (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ k -> Int
keyToIndex k
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rowPx) Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<>
                            Index (Map Text Text)
"position" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map Text Text)
"absolute" Map Text Text -> Map Text Text -> Map Text Text
forall a. Semigroup a => a -> a -> a
<>
                            Index (Map Text Text)
"width" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: IxValue (Map Text Text)
"100%"
    findWindow :: b -> b -> b -> (a, b)
findWindow b
sizeIncrement b
windowSize b
startingPosition =
      let (a
startingIndex, b
_) = b
startingPosition b -> b -> (a, b)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
`divMod'` b
sizeIncrement
          numItems :: b
numItems = (b
windowSize b -> b -> b
forall a. Num a => a -> a -> a
+ b
sizeIncrement b -> b -> b
forall a. Num a => a -> a -> a
- b
1) b -> b -> b
forall a. Integral a => a -> a -> a
`div` b
sizeIncrement
      in (a
startingIndex, b
numItems)

virtualListBuffered
  :: (DomBuilder t m, PostBuild t m, MonadHold t m, PerformEvent t m, MonadJSM (Performable m), DomBuilderSpace m ~ GhcjsDomSpace, MonadFix m, Ord k)
  => Int
  -> Dynamic t Int
  -> Int
  -> Dynamic t Int
  -> Int
  -> Event t Int
  -> (k -> Int)
  -> Map k v
  -> Event t (Map k (Maybe v))
  -> (k -> v -> Event t v -> m a)
  -> m (Event t (Int, Int), Dynamic t (Map k a))
virtualListBuffered :: Int
-> Dynamic t Int
-> Int
-> Dynamic t Int
-> Int
-> Event t Int
-> (k -> Int)
-> Map k v
-> Event t (Map k (Maybe v))
-> (k -> v -> Event t v -> m a)
-> m (Event t (Int, Int), Dynamic t (Map k a))
virtualListBuffered Int
buffer Dynamic t Int
heightPx Int
rowPx Dynamic t Int
maxIndex Int
i0 Event t Int
setI k -> Int
keyToIndex Map k v
items0 Event t (Map k (Maybe v))
itemsUpdate k -> v -> Event t v -> m a
itemBuilder = do
    (Dynamic t (Int, Int)
win, Dynamic t (Map k a)
m) <- Dynamic t Int
-> Int
-> Dynamic t Int
-> Int
-> Event t Int
-> (k -> Int)
-> Map k v
-> Event t (Map k (Maybe v))
-> (k -> v -> Event t v -> m a)
-> m (Dynamic t (Int, Int), Dynamic t (Map k a))
forall t (m :: * -> *) k v a.
(DomBuilder t m, PostBuild t m, MonadHold t m, PerformEvent t m,
 MonadJSM (Performable m), DomBuilderSpace m ~ GhcjsDomSpace,
 MonadFix m, Ord k) =>
Dynamic t Int
-> Int
-> Dynamic t Int
-> Int
-> Event t Int
-> (k -> Int)
-> Map k v
-> Event t (Map k (Maybe v))
-> (k -> v -> Event t v -> m a)
-> m (Dynamic t (Int, Int), Dynamic t (Map k a))
virtualList Dynamic t Int
heightPx Int
rowPx Dynamic t Int
maxIndex Int
i0 Event t Int
setI k -> Int
keyToIndex Map k v
items0 Event t (Map k (Maybe v))
itemsUpdate k -> v -> Event t v -> m a
itemBuilder
    Event t ()
pb <- m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
    let extendWin :: Int -> Int -> (Int, Int)
extendWin Int
o Int
l = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
bufferInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2), Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
buffer)
    rec let winHitEdge :: Event t (Int, Int)
winHitEdge = ((Int, Int) -> (Int, Int) -> Maybe (Int, Int))
-> Behavior t (Int, Int)
-> Event t (Int, Int)
-> Event t (Int, Int)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
attachWithMaybe (\(Int
oldOffset, Int
oldLimit) (Int
winOffset, Int
winLimit) ->
              if Int
winOffset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
oldOffset Bool -> Bool -> Bool
&& Int
winOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
winLimit Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
oldOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oldLimit
                 then Maybe (Int, Int)
forall a. Maybe a
Nothing
                 else (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int -> Int -> (Int, Int)
extendWin Int
winOffset Int
winLimit)) (Dynamic t (Int, Int) -> Behavior t (Int, Int)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Int, Int)
winBuffered) (Dynamic t (Int, Int) -> Event t (Int, Int)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Int, Int)
win)
        Dynamic t (Int, Int)
winBuffered <- (Int, Int) -> Event t (Int, Int) -> m (Dynamic t (Int, Int))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (Int
0, Int
0) (Event t (Int, Int) -> m (Dynamic t (Int, Int)))
-> Event t (Int, Int) -> m (Dynamic t (Int, Int))
forall a b. (a -> b) -> a -> b
$ [Event t (Int, Int)] -> Event t (Int, Int)
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [ Event t (Int, Int)
winHitEdge
                                                 , ((Int, Int) -> () -> (Int, Int))
-> Dynamic t (Int, Int) -> Event t () -> Event t (Int, Int)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWith (\(Int
x, Int
y) ()
_ -> Int -> Int -> (Int, Int)
extendWin Int
x Int
y) Dynamic t (Int, Int)
win Event t ()
pb
                                                 ]
    (Event t (Int, Int), Dynamic t (Map k a))
-> m (Event t (Int, Int), Dynamic t (Map k a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic t (Int, Int) -> Event t (Int, Int)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Int, Int)
winBuffered, Dynamic t (Map k a)
m)