From 4aa89dcdaa15bb0d0549e674fbe38a4145bf1c5a Mon Sep 17 00:00:00 2001 From: goolord Date: Mon, 1 Oct 2018 10:11:47 -0400 Subject: [PATCH] adds paginatedExpandableLazy function --- .../src/Reflex/Dom/Colonnade.hs | 135 ++++++++++++++---- 1 file changed, 105 insertions(+), 30 deletions(-) diff --git a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs index 60b2052..549fd3a 100644 --- a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs +++ b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs @@ -41,6 +41,7 @@ module Reflex.Dom.Colonnade , sectioned , paginated , paginatedExpandable + , paginatedExpandableLazy , paginatedCapped -- * Cell Functions , cell @@ -56,29 +57,29 @@ module Reflex.Dom.Colonnade , semUiFixedPagination ) where +import Colonnade (Colonnade,Headed,Headless,Fascia,Cornice,Headedness(..)) +import Control.Applicative (liftA2) +import Control.Monad (forM) +import Control.Monad.Fix (MonadFix) +import Control.Monad.Trans.Reader (ReaderT) +import Data.Foldable (Foldable(..),for_,forM_,foldlM) +import Data.Map.Strict (Map) +import Data.Monoid (Sum(..)) +import Data.Proxy +import Data.Semigroup (Semigroup(..)) import Data.String (IsString(..)) +import Data.Text (Text) +import Data.Traversable (for) +import Data.Vector (Vector) +import Reflex.Dom +import qualified Colonnade as C +import qualified Colonnade.Encode as E +import qualified Data.Map.Strict as M +import qualified Data.Profunctor as PF import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as LT -import qualified Data.Map.Strict as M import qualified Data.Vector as V -import qualified Data.Profunctor as PF -import Data.Map.Strict (Map) -import Data.Vector (Vector) -import Data.Text (Text) -import Data.Foldable (Foldable(..),for_,forM_,foldlM) -import Data.Traversable (for) -import Data.Semigroup (Semigroup(..)) -import Control.Applicative (liftA2) -import Reflex.Dom -import Colonnade (Colonnade,Headed,Headless,Fascia,Cornice,Headedness(..)) -import Data.Monoid (Sum(..)) -import Data.Proxy -import Control.Monad.Fix (MonadFix) -import Control.Monad (forM) -import Control.Monad.Trans.Reader (ReaderT) -import qualified Colonnade as C -import qualified Colonnade.Encode as E data Cell t m b = Cell { cellAttrs :: !(Dynamic t (M.Map T.Text T.Text)) @@ -171,11 +172,13 @@ class Sizable t b h | h -> b where sizableSize :: h a -> Dynamic t Int sizableCast :: Proxy t -> h a -> b a --- instance (Headedness h, Reflex t) => Headedness (Resizable t h) where --- headednessPure = Resizable (pure 1) . headednessPure --- headednessContents = do --- f <- headednessContents --- Just (\(Resizable _ a) -> f a) +instance (Headedness h, Reflex t) => Headedness (Resizable t h) where + headednessPure = Resizable (pure 1) . headednessPure + headednessExtract = do + f <- headednessExtract + Just (\(Resizable _ a) -> f a) + headednessExtractForall = headednessExtractForall + instance (Headedness h, Reflex t) => Sizable t h (Resizable t h) where sizableSize = resizableSize @@ -475,7 +478,7 @@ cappedResizableTableless headAttrs bodyAttrs trAttrs fascia cornice collection = bodyResizableLazy (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection return (E.size annCornice) -cappedTableless :: +cappedTableless :: forall t b h m f e c p a. (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 @@ -485,13 +488,14 @@ cappedTableless :: -> f a -- ^ Collection of data -> m (Dynamic t Int) cappedTableless headAttrs bodyAttrs trAttrs fascia cornice collection = do - let annCornice = dynamicAnnotateGeneral cornice + let annCornice :: E.AnnotatedCornice (Dynamic t Int) b p a (c e) + annCornice = dynamicAnnotateGeneral cornice _ <- encodeCorniceHeadGeneral headAttrs fascia annCornice bodyResizableLazy bodyAttrs trAttrs (C.mapHeadedness sizedToResizable (E.uncapAnnotated annCornice)) collection return (E.size annCornice) - + sizedToResizable :: E.Sized (Dynamic t Int) h a -> Resizable t h a sizedToResizable (E.Sized sz h) = Resizable sz h @@ -803,7 +807,6 @@ paginatedCapped (Chest tableAttrs theadAttrs fascia bodyAttrs trAttrs) (Paginati makePagination totalPages return () _ -> error "Reflex.Dom.Colonnade: paginatedCapped: write this code" - -- | A paginated table with a fixed number of rows. Each row can -- expand a section beneath it, represented as an additional @@ -853,13 +856,62 @@ paginatedExpandable (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination elDynAttr "th" attrs $ do makePagination totalPages return () - _ -> error "Reflex.Dom.Colonnade: paginated: write this code" + _ -> error "Reflex.Dom.Colonnade: paginatedExpandable: write this code" +-- | A paginated table with a fixed number of rows. Each row can +-- expand a section beneath it, represented as an additional +-- table row. CSS rules that give the table a striped appearance +-- are unlikely to work since there are hidden rows. +paginatedExpandableLazy :: forall t b h m a c. + (Sizable t b h, Cellular t m c, Headedness b, MonadFix m, Functor h, Functor c, MonadHold t m, MonadWidget t m, Headedness h, h ~ b) + => Bureau t b a -- ^ table class settings + -> Pagination t m -- ^ pagination settings + -> a -- ^ An inhabitant of type @a@ only used for the cells in hidden rows. + -> (Dynamic t a -> m ()) -- expandable extra content + -> Colonnade (Resizable t h) (Dynamic t a) (c (Dynamic t Bool)) + -- ^ Column blueprint. The boolean event enables and disables the expansion. + -> Dynamic t (Vector a) -- ^ table row data + -> m () +paginatedExpandableLazy (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination pageSize arrange makePagination) aDef expansion col vecD = do + let colLifted :: Colonnade (Resizable t h) (Dynamic t (Visible a)) (c (Dynamic t Bool)) + colLifted = PF.lmap (fmap (\(Visible _ a) -> a)) col + expansionLifted :: Dynamic t (Visible a) -> m () + expansionLifted = expansion . fmap (\(Visible _ a) -> a) + makeVals :: Dynamic t Int -> Vector (Dynamic t (Visible a)) + makeVals page = V.generate pageSize $ \ix -> do + p <- page + v <- vecD + pure (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) + size :: Dynamic t Int + size = coerceDynamic (foldMap (\x -> coerceDynamic (sizableSize (E.oneColonnadeHead x)) :: Dynamic t (Sum Int)) (E.getColonnade col)) + elDynAttr "table" tableAttrs $ case arrange of + ArrangementFooter tfootAttrs tfootTrAttrs tfootThAttrs -> mdo + tableHeader theadAttrs colLifted + let vals = makeVals page + tableBodyExpandableLazy size expansionLifted bodyAttrs trAttrsLifted colLifted vals (Visible True aDef) + page <- elDynAttr "tfoot" (hideWhenUnipage tfootAttrs) $ do + elDynAttr "tr" tfootTrAttrs $ do + let attrs = zipDynWith insertSizeAttr size tfootThAttrs + elDynAttr "th" attrs $ do + makePagination totalPages + return () + _ -> error "Reflex.Dom.Colonnade: paginatedExpandableLazy: write this code" divRoundUp :: Int -> Int -> Int divRoundUp a b = case divMod a b of (x,y) -> if y == 0 then x else x + 1 - + tableHeader :: forall t b h c a m x. (Reflex t, Sizable t b h, Cellular t m c, Headedness b) => b (Dynamic t (Map Text Text), Dynamic t (Map Text Text)) @@ -875,7 +927,7 @@ tableHeader theadAttrsWrap col = case headednessExtractForall of where extract :: forall y. b y -> y extract = E.runExtractForall extractForall - + tableBody :: (DomBuilder t m, PostBuild t m, Foldable f, Monoid e, Cellular t m c, Sizable t b h) => Dynamic t (M.Map T.Text T.Text) -> (a -> Dynamic t (M.Map T.Text T.Text)) @@ -888,6 +940,29 @@ tableBody bodyAttrs trAttrs col collection = return (mappend m e) ) mempty collection +tableBodyExpandableLazy :: forall t m c b a h. (Headedness h, MonadFix m, DomBuilder t m, MonadHold t m, PostBuild t m, Cellular t m c, Sizable t b h) + => Dynamic t Int -- ^ number of visible columns in the table + -> (Dynamic t a -> m ()) + -> Dynamic t (Map Text Text) + -> (Dynamic t a -> Dynamic t (Map Text Text)) + -> Colonnade (Resizable t h) (Dynamic t a) (c (Dynamic t Bool)) + -> Vector (Dynamic t a) + -> a -- ^ initial value, a hack + -> m () +tableBodyExpandableLazy colCount renderExpansion bodyAttrs trAttrs colonnade collection a0 = 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)))) + tableBodyExpandable colCount renderExpansion bodyAttrs trAttrs colonnade' collection a0 + return () + -- | This function has a implementation that is careful to only -- redraw the expansion rows, which are usually hidden, when -- it is necessary to do so.