byteverse/colonnade
1
1
Fork 0
mirror of https://github.com/byteverse/colonnade.git synced 2024-09-11 06:45:41 +03:00
Code Issues Packages Projects Releases Wiki Activity

make expandablePreloaded return an extra event

Browse Source
This commit is contained in:
Andrew Martin 2018-11-20 16:57:53 -05:00
parent 12b9f0e4a0
commit 518423ef9e
No known key found for this signature in database
GPG Key ID: 4FEE56C538F773B4
1 changed files with 13 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs
View File

@ -631,33 +631,33 @@ dynamicCapped tableAttrs headAttrs bodyAttrs trAttrs fascia cornice collection =
-- | Start displaying the widget after the first time the event -- | Start displaying the widget after the first time the event
-- fires. Subsequent fires of the event do not reconstruct the -- fires. Subsequent fires of the event do not reconstruct the
-- widget. They update it in whatever way the lambda normally does. -- widget. They update it in whatever way the lambda normally does.
dynAfter :: MonadWidget t m => Event t a -> (Dynamic t a -> m ()) -> m () dynAfter :: MonadWidget t m => Event t a -> (Dynamic t a -> m (Event t e)) -> m (Event t e)
dynAfter e f = do dynAfter e f = do
e1 <- headE e e1 <- headE e
let em1 = fmap (\a1 -> holdDyn a1 e >>= f) e1 let em1 = fmap (\a1 -> holdDyn a1 e >>= f) e1
_ <- widgetHold blank em1 -- This use of switchPromptlyDyn might be dubious. Rethink this.
return () fmap switchPromptlyDyn (widgetHold (pure never) em1)
-- | Table with cells that can create expanded content between the rows. -- | Table with cells that can create expanded content between the rows.
-- The content between the rows is built when the vector changed. -- The content between the rows is built when the vector changed.
expandablePreloaded :: forall t m a. MonadWidget t m expandablePreloaded :: forall t m e a. (MonadWidget t m, Semigroup e)
=> Bureau t Headed (M.Map T.Text T.Text) => Bureau t Headed (M.Map T.Text T.Text)
-- ^ Table class settings -- ^ Table class settings
-> (Dynamic t a -> m ()) -> (Dynamic t a -> m ())
-- ^ Function to render the content under the row. -- ^ Function to render the content under the row.
-> Int -> Int
-- ^ Number of rows -- ^ Number of rows
-> Colonnade Headed (Dynamic t a) (m (Event t Bool)) -> Colonnade Headed (Dynamic t a) (m (Event t Bool, Event t e))
-- ^ Encoding into cells with events that can fire to display additional -- ^ Encoding into cells with events that can fire to display additional
-- content under the row. -- content under the row.
-> Dynamic t (Vector a) -> Dynamic t (Vector a)
-- ^ Values -- ^ Values
-> m () -> m (Event t e)
expandablePreloaded (Bureau tableAttrs (E.Headed (theadAttrs,theadRowAttrs)) bodyAttrs _trBuildAttrs) f n colonnade@(E.Colonnade v) xs = do expandablePreloaded (Bureau tableAttrs (E.Headed (theadAttrs,theadRowAttrs)) bodyAttrs _trBuildAttrs) f n colonnade@(E.Colonnade v) xs = do
elDynAttr "table" tableAttrs $ do elDynAttr "table" tableAttrs $ do
_ <- elDynAttr "thead" theadAttrs $ elDynAttr "tr" theadRowAttrs $ E.headerMonadicGeneral_ colonnade (el "th") _ <- elDynAttr "thead" theadAttrs $ elDynAttr "tr" theadRowAttrs $ E.headerMonadicGeneral_ colonnade (el "th")
ys <- sample (current xs) ys <- sample (current xs)
elDynAttr "tbody" bodyAttrs $ forM_ (enumFromTo 0 (n - 1)) $ \ix -> do es <- elDynAttr "tbody" bodyAttrs $ forM (enumFromTo 0 (n - 1)) $ \ix -> do
let stream = fmapMaybe (V.!? ix) (updated xs) let stream = fmapMaybe (V.!? ix) (updated xs)
let visible = fmap (\x -> V.length x > ix) xs let visible = fmap (\x -> V.length x > ix) xs
case ys V.!? ix of case ys V.!? ix of
@ -665,13 +665,15 @@ expandablePreloaded (Bureau tableAttrs (E.Headed (theadAttrs,theadRowAttrs)) bod
Just y -> do Just y -> do
a <- holdDyn y stream a <- holdDyn y stream
buildRow a visible buildRow a visible
pure (mconcat es)
where where
vlen = V.length v vlen = V.length v
buildRow :: Dynamic t a -> Dynamic t Bool -> m () buildRow :: Dynamic t a -> Dynamic t Bool -> m (Event t e)
buildRow a visible = do buildRow a visible = do
elist <- el "tr" $ E.rowMonadicWith [] (++) colonnade (fmap (\k -> [k]) . el "td") a elist <- el "tr" $ E.rowMonadicWith [] (++) colonnade (fmap (\k -> [k]) . el "td") a
let e = leftmost elist let b = leftmost (map fst elist)
shouldDisplay1 <- foldDyn const False e let e = map snd elist
shouldDisplay1 <- foldDyn const False b
let shouldDisplay2 = zipDynWith (&&) shouldDisplay1 visible let shouldDisplay2 = zipDynWith (&&) shouldDisplay1 visible
el "tr" $ do el "tr" $ do
let attrs = fmap let attrs = fmap
@ -680,6 +682,7 @@ expandablePreloaded (Bureau tableAttrs (E.Headed (theadAttrs,theadRowAttrs)) bod
(M.fromList [("colspan",T.pack (show vlen))]) (M.fromList [("colspan",T.pack (show vlen))])
) shouldDisplay2 ) shouldDisplay2
elDynAttr "td" attrs (f a) elDynAttr "td" attrs (f a)
pure (mconcat e)
-- | Table with cells that can create expanded content -- | Table with cells that can create expanded content