From 06b5ffcd4096d5675d7dbe494de503e533bdfd59 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Mon, 18 Jun 2018 16:01:56 -0400 Subject: [PATCH] try to be more clever with rebuilding capped tables --- .../src/Reflex/Dom/Colonnade.hs | 109 +++++++++++++++--- 1 file changed, 90 insertions(+), 19 deletions(-) diff --git a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs index afe7a4d..60b2052 100644 --- a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs +++ b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs @@ -290,6 +290,26 @@ bodyResizable bodyAttrs trAttrs colonnade collection = elDynAttr "tbody" bodyAtt content = cellularContents c in WrappedApplicative (elDynAttr "td" (zipDynWith setColspanOrHide dynSize cattr) content)) a +bodyResizableLazy :: forall m t c e a f h. (Cellular t m c, DomBuilder t m, PostBuild t m, Foldable f, MonadHold t m, MonadSample t m, MonadFix m, Monoid e) + => Dynamic t (Map Text Text) + -> (a -> Dynamic t (Map Text Text)) + -> Colonnade (Resizable t h) a (c e) + -> f a + -> m () +bodyResizableLazy bodyAttrs trAttrs colonnade collection = do + let sizeVec = V.map (resizableSize . E.oneColonnadeHead) (E.getColonnade colonnade) + let sizeVecD = fmap V.fromList (distributeListOverDynPure (V.toList sizeVec)) + sizeVec0 <- sample (current sizeVecD) + largestSizes <- foldDynMaybe + ( \incoming largest -> + let v = V.zipWith max incoming largest + in if v == largest then Nothing else Just v + ) sizeVec0 (updated sizeVecD) + _ <- dyn $ flip fmap largestSizes $ \s -> do + let colonnade' = E.Colonnade (V.map snd (V.filter (\(sz,_) -> sz > 0) (V.zip s (E.getColonnade colonnade)))) + bodyResizable bodyAttrs trAttrs colonnade' collection + return () + setColspanOrHide :: Int -> Map Text Text -> Map Text Text setColspanOrHide i m | i < 1 = M.insertWith T.append "style" "display:none;" m @@ -420,7 +440,7 @@ capped tableAttrs headAttrs bodyAttrs trAttrs fascia cornice collection = -- useful, but it can be helpful if the table footer needs to be -- given a @colspan@ that matches the number of visible columns. cappedResizable :: - (DomBuilder t m, PostBuild t m, MonadHold t m, Foldable f, Monoid e) + (MonadWidget t m, Foldable f, Monoid e) => Map Text Text -- ^ @\@ tag attributes -> Map Text Text -- ^ @\@ tag attributes -> Map Text Text -- ^ @\@ tag attributes @@ -429,48 +449,48 @@ cappedResizable :: -> Fascia p (Map Text Text) -- ^ Attributes for @\@ elements in the @\@ -> Cornice (Resizable t Headed) p a (Cell t m e) -- ^ Data encoding strategy -> f a -- ^ Collection of data - -> m (e, c, Dynamic t Int) + -> m (c, Dynamic t Int) cappedResizable tableAttrs headAttrs bodyAttrs beneathBody trAttrs fascia cornice collection = do elAttr "table" tableAttrs $ do let annCornice = dynamicAnnotate cornice - h <- encodeCorniceResizableHead headAttrs fascia annCornice - b <- bodyResizable (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection + _ <- encodeCorniceResizableHead headAttrs fascia annCornice + bodyResizableLazy (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection c <- beneathBody - return (h `mappend` b, c, E.size annCornice) + return (c, E.size annCornice) -- | Same as 'cappedResizable' but without the @\@ wrapping it. -- Also, it does not take extra content to go beneath the @\@. cappedResizableTableless :: - (DomBuilder t m, PostBuild t m, MonadHold t m, Foldable f, Monoid e) + (MonadWidget t m, Foldable f, Monoid e) => Map Text Text -- ^ @\@ tag attributes -> Map Text Text -- ^ @\@ tag attributes -> (a -> Map Text Text) -- ^ @\@ tag attributes -> Fascia p (Map Text Text) -- ^ Attributes for @\@ elements in the @\@ -> Cornice (Resizable t Headed) p a (Cell t m e) -- ^ Data encoding strategy -> f a -- ^ Collection of data - -> m (e, Dynamic t Int) + -> m (Dynamic t Int) cappedResizableTableless headAttrs bodyAttrs trAttrs fascia cornice collection = do let annCornice = dynamicAnnotate cornice - h <- encodeCorniceResizableHead headAttrs fascia annCornice - b <- bodyResizable (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection - return (h `mappend` b, E.size annCornice) + _ <- encodeCorniceResizableHead headAttrs fascia annCornice + bodyResizableLazy (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection + return (E.size annCornice) cappedTableless :: - (Headedness b, Sizable t b h, DomBuilder t m, PostBuild t m, MonadHold t m, Foldable f, Monoid e, Cellular t m c) + (Headedness b, Sizable t b h, MonadWidget t m, Foldable f, Monoid e, Cellular t m c) => Dynamic t (Map Text Text) -- ^ @\@ tag attributes -> Dynamic t (Map Text Text) -- ^ @\@ tag attributes -> (a -> Dynamic t (Map Text Text)) -- ^ @\@ tag attributes -> Fascia p (Map Text Text) -- ^ Attributes for @\@ elements in the @\@ -> Cornice h p a (c e) -- ^ Data encoding strategy -> f a -- ^ Collection of data - -> m (e, Dynamic t Int) + -> m (Dynamic t Int) cappedTableless headAttrs bodyAttrs trAttrs fascia cornice collection = do let annCornice = dynamicAnnotateGeneral cornice - h <- encodeCorniceHeadGeneral headAttrs fascia annCornice - b <- bodyResizable bodyAttrs trAttrs + _ <- encodeCorniceHeadGeneral headAttrs fascia annCornice + bodyResizableLazy bodyAttrs trAttrs (C.mapHeadedness sizedToResizable (E.uncapAnnotated annCornice)) collection - return (h `mappend` b, E.size annCornice) + return (E.size annCornice) sizedToResizable :: E.Sized (Dynamic t Int) h a -> Resizable t h a sizedToResizable (E.Sized sz h) = Resizable sz h @@ -694,14 +714,65 @@ paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination pageSize return e _ -> error "Reflex.Dom.Colonnade: paginated: write this code" +-- dynAfter :: forall t m a b. MonadWidget t m => Event t a -> (Dynamic t a -> m (Event t b)) -> m (Event t b) +-- dynAfter e f = do +-- e1 <- headE e +-- let em1 = fmap (\a1 -> holdDyn a1 e >>= f) e1 +-- de <- widgetHold (return never) em1 +-- return (switch (current de)) + +-- paginatedCappedLazy :: forall t b h m a c p e. +-- (Sizable t b h, Cellular t m c, Headedness b, MonadFix m, Functor h, MonadHold t m, Monoid e) +-- => Chest p t a +-- -> Pagination t m -- ^ pagination settings +-- -> Cornice h p (Dynamic t a) (c e) -- ^ Data encoding strategy +-- -> Event t (Vector a) -- ^ table row data +-- -> m e +-- paginatedCappedLazy (Chest tableAttrs theadAttrs fascia bodyAttrs trAttrs) (Pagination pageSize arrange makePagination) col vecE = do +-- let vecE' = fmapMaybe (not . V.null) vecE +-- dynAfter vecE' $ \vecD -> do +-- -- note: vec0 is guaranteed to be non-empty +-- vec0 <- sample (current vecD) +-- let aDef = vec0 V.! aDef +-- colLifted :: Cornice h p (Dynamic t (Visible a)) (c e) +-- colLifted = PF.lmap (fmap (\(Visible _ a) -> a)) col +-- makeVals :: Dynamic t Int -> Vector (Dynamic t (Visible a)) +-- makeVals page = V.generate pageSize $ \ix -> do +-- p <- page +-- v <- vecD +-- return (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix))) +-- totalPages :: Dynamic t Int +-- totalPages = fmap ((`divRoundUp` pageSize) . V.length) vecD +-- hideWhenUnipage :: Dynamic t (Map Text Text) -> Dynamic t (Map Text Text) +-- hideWhenUnipage = zipDynWith +-- ( \ct attrs -> if ct > 1 then attrs else M.insert "style" "display:none;" attrs +-- ) totalPages +-- trAttrsLifted :: Dynamic t (Visible a) -> Dynamic t (Map Text Text) +-- trAttrsLifted d = do +-- Visible isVisible a <- d +-- attrs <- trAttrs a +-- return (if isVisible then attrs else M.insertWith T.append "style" "display:none;" attrs) +-- elDynAttr "table" tableAttrs $ case arrange of +-- ArrangementFooter tfootAttrs tfootTrAttrs tfootThAttrs -> mdo +-- let vals = makeVals page +-- (e, size) <- cappedTableless theadAttrs bodyAttrs trAttrsLifted fascia colLifted vals +-- page <- elDynAttr "tfoot" (hideWhenUnipage tfootAttrs) $ do +-- elDynAttr "tr" tfootTrAttrs $ do +-- let attrs = zipDynWith insertSizeAttr size tfootThAttrs +-- elDynAttr "th" attrs $ do +-- makePagination totalPages +-- return e +-- _ -> error "Reflex.Dom.Colonnade: paginatedCapped: write this code" + + paginatedCapped :: forall t b h m a c p e. - (Sizable t b h, Cellular t m c, Headedness b, MonadFix m, Functor h, MonadHold t m, Monoid e) + (Sizable t b h, Cellular t m c, Headedness b, Functor h, Monoid e, MonadWidget t m) => Chest p t a -> Pagination t m -- ^ pagination settings -> a -- ^ An inhabitant of type @a@ only used for the cells in hidden rows. -> Cornice h p (Dynamic t a) (c e) -- ^ Data encoding strategy -> Dynamic t (Vector a) -- ^ table row data - -> m e + -> m () paginatedCapped (Chest tableAttrs theadAttrs fascia bodyAttrs trAttrs) (Pagination pageSize arrange makePagination) aDef col vecD = do let colLifted :: Cornice h p (Dynamic t (Visible a)) (c e) colLifted = PF.lmap (fmap (\(Visible _ a) -> a)) col @@ -724,13 +795,13 @@ paginatedCapped (Chest tableAttrs theadAttrs fascia bodyAttrs trAttrs) (Paginati elDynAttr "table" tableAttrs $ case arrange of ArrangementFooter tfootAttrs tfootTrAttrs tfootThAttrs -> mdo let vals = makeVals page - (e, size) <- cappedTableless theadAttrs bodyAttrs trAttrsLifted fascia colLifted vals + size <- cappedTableless theadAttrs bodyAttrs trAttrsLifted fascia colLifted vals page <- elDynAttr "tfoot" (hideWhenUnipage tfootAttrs) $ do elDynAttr "tr" tfootTrAttrs $ do let attrs = zipDynWith insertSizeAttr size tfootThAttrs elDynAttr "th" attrs $ do makePagination totalPages - return e + return () _ -> error "Reflex.Dom.Colonnade: paginatedCapped: write this code"