diff --git a/blaze-colonnade/blaze-colonnade.cabal b/blaze-colonnade/blaze-colonnade.cabal index d1844c4..2602abf 100644 --- a/blaze-colonnade/blaze-colonnade.cabal +++ b/blaze-colonnade/blaze-colonnade.cabal @@ -1,5 +1,5 @@ name: blaze-colonnade -version: 1.1.0 +version: 1.1.1 synopsis: Helper functions for using blaze-html with colonnade description: Blaze HTML and colonnade homepage: https://github.com/andrewthad/colonnade#readme @@ -18,7 +18,7 @@ library Text.Blaze.Colonnade build-depends: base >= 4.7 && < 5 - , colonnade >= 1.1 && < 1.2 + , colonnade >= 1.1 && < 1.3 , blaze-markup >= 0.7 && < 0.9 , blaze-html >= 0.8 && < 0.10 , text >= 1.0 && < 1.3 diff --git a/colonnade/colonnade.cabal b/colonnade/colonnade.cabal index 6fdf14e..2f014c2 100644 --- a/colonnade/colonnade.cabal +++ b/colonnade/colonnade.cabal @@ -1,5 +1,5 @@ name: colonnade -version: 1.1.1 +version: 1.2.0 synopsis: Generic types and functions for columnar encoding and decoding description: The `colonnade` package provides a way to to talk about diff --git a/colonnade/src/Colonnade/Encode.hs b/colonnade/src/Colonnade/Encode.hs index c8c7e10..bd85958 100644 --- a/colonnade/src/Colonnade/Encode.hs +++ b/colonnade/src/Colonnade/Encode.hs @@ -285,22 +285,22 @@ endow f x = case x of go c (CorniceBase (Colonnade v)) = V.map (mapOneColonnadeHeader (f c)) v go c (CorniceCap v) = V.concatMap (\(OneCornice h b) -> go (f c h) b) v -uncapAnnotated :: forall sz p a c. - AnnotatedCornice sz p a c - -> Colonnade (Sized sz Headed) a c +uncapAnnotated :: forall sz p a c h. + AnnotatedCornice sz h p a c + -> Colonnade (Sized sz h) a c uncapAnnotated x = case x of AnnotatedCorniceBase _ colonnade -> colonnade AnnotatedCorniceCap _ v -> Colonnade (V.concatMap (\(OneCornice _ b) -> go b) v) where go :: forall p'. - AnnotatedCornice sz p' a c - -> Vector (OneColonnade (Sized sz Headed) a c) + AnnotatedCornice sz h p' a c + -> Vector (OneColonnade (Sized sz h) a c) go (AnnotatedCorniceBase _ (Colonnade v)) = v go (AnnotatedCorniceCap _ v) = V.concatMap (\(OneCornice _ b) -> go b) v -annotate :: Cornice Headed p a c -> AnnotatedCornice (Maybe Int) p a c +annotate :: Cornice Headed p a c -> AnnotatedCornice (Maybe Int) Headed p a c annotate = go where - go :: forall p a c. Cornice Headed p a c -> AnnotatedCornice (Maybe Int) p a c + go :: forall p a c. Cornice Headed p a c -> AnnotatedCornice (Maybe Int) Headed p a c go (CorniceBase c) = let len = V.length (getColonnade c) in AnnotatedCorniceBase (if len > 0 then (Just len) else Nothing) @@ -333,7 +333,7 @@ annotateFinely :: Foldable f -> (c -> Int) -- ^ Get size from content -> f a -> Cornice Headed p a c - -> AnnotatedCornice (Maybe Int) p a c + -> AnnotatedCornice (Maybe Int) Headed p a c annotateFinely g finish toSize xs cornice = runST $ do m <- newMutableSizedCornice cornice sizeColonnades toSize xs m @@ -360,12 +360,12 @@ freezeMutableSizedCornice :: forall s p a c. (Int -> Int -> Int) -- ^ fold function -> (Int -> Int) -- ^ finalize -> MutableSizedCornice s p a c - -> ST s (AnnotatedCornice (Maybe Int) p a c) + -> ST s (AnnotatedCornice (Maybe Int) Headed p a c) freezeMutableSizedCornice step finish = go where go :: forall p' a' c'. MutableSizedCornice s p' a' c' - -> ST s (AnnotatedCornice (Maybe Int) p' a' c') + -> ST s (AnnotatedCornice (Maybe Int) Headed p' a' c') go (MutableSizedCorniceBase msc) = do szCol <- freezeMutableSizedColonnade msc let sz = @@ -400,7 +400,7 @@ mapHeadedness f (Colonnade v) = -- | This is an O(1) operation, sort of -size :: AnnotatedCornice sz p a c -> sz +size :: AnnotatedCornice sz h p a c -> sz size x = case x of AnnotatedCorniceBase m _ -> m AnnotatedCorniceCap sz _ -> sz @@ -411,23 +411,25 @@ mapOneCorniceBody f (OneCornice h b) = OneCornice h (f b) mapOneColonnadeHeader :: Functor h => (c -> c) -> OneColonnade h a c -> OneColonnade h a c mapOneColonnadeHeader f (OneColonnade h b) = OneColonnade (fmap f h) b -headersMonoidal :: forall sz r m c p a. - Monoid m +headersMonoidal :: forall sz r m c p a h. + (Monoid m, Headedness h) => Maybe (Fascia p r, r -> m -> m) -- ^ Apply the Fascia header row content -> [(sz -> c -> m, m -> m)] -- ^ Build content from cell content and size - -> AnnotatedCornice sz p a c + -> AnnotatedCornice sz h p a c -> m headersMonoidal wrapRow fromContentList = go wrapRow where - go :: forall p'. Maybe (Fascia p' r, r -> m -> m) -> AnnotatedCornice sz p' a c -> m + go :: forall p'. Maybe (Fascia p' r, r -> m -> m) -> AnnotatedCornice sz h p' a c -> m go ef (AnnotatedCorniceBase _ (Colonnade v)) = let g :: m -> m g m = case ef of Nothing -> m Just (FasciaBase r, f) -> f r m - in g $ foldMap (\(fromContent,wrap) -> wrap - (foldMap (\(OneColonnade (Sized sz (Headed h)) _) -> - (fromContent sz h)) v)) fromContentList + in case headednessExtract of + Just unhead -> g $ foldMap (\(fromContent,wrap) -> wrap + (foldMap (\(OneColonnade (Sized sz h) _) -> + (fromContent sz (unhead h))) v)) fromContentList + Nothing -> mempty go ef (AnnotatedCorniceCap _ v) = let g :: m -> m g m = case ef of @@ -444,8 +446,8 @@ headersMonoidal wrapRow fromContentList = go wrapRow Just annCoreNext -> go (Just (fn,f)) annCoreNext flattenAnnotated :: - Vector (OneCornice (AnnotatedCornice sz) p a c) - -> Maybe (AnnotatedCornice sz p a c) + Vector (OneCornice (AnnotatedCornice sz h) p a c) + -> Maybe (AnnotatedCornice sz h p a c) flattenAnnotated v = case v V.!? 0 of Nothing -> Nothing Just (OneCornice _ x) -> Just $ case x of @@ -454,8 +456,8 @@ flattenAnnotated v = case v V.!? 0 of flattenAnnotatedBase :: sz - -> Vector (OneCornice (AnnotatedCornice sz) Base a c) - -> AnnotatedCornice sz Base a c + -> Vector (OneCornice (AnnotatedCornice sz h) Base a c) + -> AnnotatedCornice sz h Base a c flattenAnnotatedBase msz = AnnotatedCorniceBase msz . Colonnade . V.concatMap @@ -463,13 +465,13 @@ flattenAnnotatedBase msz = AnnotatedCorniceBase msz flattenAnnotatedCap :: sz - -> Vector (OneCornice (AnnotatedCornice sz) (Cap p) a c) - -> AnnotatedCornice sz (Cap p) a c + -> Vector (OneCornice (AnnotatedCornice sz h) (Cap p) a c) + -> AnnotatedCornice sz h (Cap p) a c flattenAnnotatedCap m = AnnotatedCorniceCap m . V.concatMap getTheVector getTheVector :: - OneCornice (AnnotatedCornice sz) (Cap p) a c - -> Vector (OneCornice (AnnotatedCornice sz) p a c) + OneCornice (AnnotatedCornice sz h) (Cap p) a c + -> Vector (OneCornice (AnnotatedCornice sz h) p a c) getTheVector (OneCornice _ (AnnotatedCorniceCap _ v)) = v data MutableSizedCornice s (p :: Pillar) a c where @@ -594,12 +596,23 @@ data Fascia (p :: Pillar) r where data OneCornice k (p :: Pillar) a c = OneCornice { oneCorniceHead :: !c , oneCorniceBody :: !(k p a c) - } + } deriving (Functor) data Cornice h (p :: Pillar) a c where CorniceBase :: !(Colonnade h a c) -> Cornice h Base a c CorniceCap :: {-# UNPACK #-} !(Vector (OneCornice (Cornice h) p a c)) -> Cornice h (Cap p) a c +instance Functor h => Functor (Cornice h p a) where + fmap f x = case x of + CorniceBase c -> CorniceBase (fmap f c) + CorniceCap c -> CorniceCap (mapVectorCornice f c) + +instance Functor h => Profunctor (Cornice h p) where + rmap = fmap + lmap f x = case x of + CorniceBase c -> CorniceBase (lmap f c) + CorniceCap c -> CorniceCap (contramapVectorCornice f c) + instance Semigroup (Cornice h p a c) where CorniceBase a <> CorniceBase b = CorniceBase (mappend a b) CorniceCap a <> CorniceCap b = CorniceCap (a Vector.++ b) @@ -614,21 +627,30 @@ instance ToEmptyCornice p => Monoid (Cornice h p a c) where [] -> toEmptyCornice x : xs2 -> Semigroup.sconcat (x :| xs2) +mapVectorCornice :: Functor h => (c -> d) -> Vector (OneCornice (Cornice h) p a c) -> Vector (OneCornice (Cornice h) p a d) +mapVectorCornice f = V.map (fmap f) + +contramapVectorCornice :: Functor h => (b -> a) -> Vector (OneCornice (Cornice h) p a c) -> Vector (OneCornice (Cornice h) p b c) +contramapVectorCornice f = V.map (lmapOneCornice f) + +lmapOneCornice :: Functor h => (b -> a) -> OneCornice (Cornice h) p a c -> OneCornice (Cornice h) p b c +lmapOneCornice f (OneCornice theHead theBody) = OneCornice theHead (lmap f theBody) + getCorniceBase :: Cornice h Base a c -> Colonnade h a c getCorniceBase (CorniceBase c) = c getCorniceCap :: Cornice h (Cap p) a c -> Vector (OneCornice (Cornice h) p a c) getCorniceCap (CorniceCap c) = c -data AnnotatedCornice sz (p :: Pillar) a c where +data AnnotatedCornice sz h (p :: Pillar) a c where AnnotatedCorniceBase :: !sz - -> !(Colonnade (Sized sz Headed) a c) - -> AnnotatedCornice sz Base a c + -> !(Colonnade (Sized sz h) a c) + -> AnnotatedCornice sz h Base a c AnnotatedCorniceCap :: !sz - -> {-# UNPACK #-} !(Vector (OneCornice (AnnotatedCornice sz) p a c)) - -> AnnotatedCornice sz (Cap p) a c + -> {-# UNPACK #-} !(Vector (OneCornice (AnnotatedCornice sz h) p a c)) + -> AnnotatedCornice sz h (Cap p) a c -- data MaybeInt = JustInt {-# UNPACK #-} !Int | NothingInt diff --git a/reflex-dom-colonnade/reflex-dom-colonnade.cabal b/reflex-dom-colonnade/reflex-dom-colonnade.cabal index bb94fe8..92f3efe 100644 --- a/reflex-dom-colonnade/reflex-dom-colonnade.cabal +++ b/reflex-dom-colonnade/reflex-dom-colonnade.cabal @@ -18,7 +18,7 @@ library Reflex.Dom.Colonnade build-depends: base >= 4.7 && < 5.0 - , colonnade >= 1.1 && < 1.2 + , colonnade >= 1.2 && < 1.3 , contravariant >= 1.2 && < 1.5 , vector >= 0.10 && < 0.13 , text >= 1.0 && < 1.3 diff --git a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs index 5bd3ba2..e9479ba 100644 --- a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs +++ b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs @@ -21,6 +21,7 @@ module Reflex.Dom.Colonnade Cell(..) , Resizable(..) , Bureau(..) + , Chest(..) , Arrangement(..) , Pagination(..) -- * Typeclasses @@ -40,6 +41,7 @@ module Reflex.Dom.Colonnade , sectioned , paginated , paginatedExpandable + , paginatedCapped -- * Cell Functions , cell , charCell @@ -99,7 +101,14 @@ data Bureau t h a = Bureau , bureauRow :: (a -> Dynamic t (Map Text Text)) -- ^ attributes of each @\@, based on the element } - -- , bureauHeadRow :: h (Dynamic t (Map Text Text)) + +data Chest p t a = Chest + { chestTable :: Dynamic t (Map Text Text) + , chestHead :: Dynamic t (Map Text Text) + , chestFascia :: Fascia p (Map Text Text) + , chestBody :: Dynamic t (Map Text Text) + , chestRow :: (a -> Dynamic t (Map Text Text)) + } data Pagination t m = Pagination { paginationRows :: Int @@ -266,18 +275,20 @@ bodyRows trAttrs colonnade collection = unWrappedApplicative $ E.rowMonoidal colonnade (WrappedApplicative . elFromCell "td") a -bodyResizable :: (DomBuilder t m, PostBuild t m, Foldable f, Monoid e) - => Map Text Text - -> (a -> Map Text Text) - -> Colonnade (Resizable t h) a (Cell t m e) +bodyResizable :: (Cellular t m c, DomBuilder t m, PostBuild t m, Foldable f, Monoid e) + => Dynamic t (Map Text Text) + -> (a -> Dynamic t (Map Text Text)) + -> Colonnade (Resizable t h) a (c e) -> f a -> m e -bodyResizable bodyAttrs trAttrs colonnade collection = elAttr "tbody" bodyAttrs $ do +bodyResizable bodyAttrs trAttrs colonnade collection = elDynAttr "tbody" bodyAttrs $ do unWrappedApplicative . flip foldMap collection $ \a -> WrappedApplicative - $ elAttr "tr" (trAttrs a) + $ elDynAttr "tr" (trAttrs a) $ unWrappedApplicative - $ E.rowMonoidalHeader colonnade (\(Resizable dynSize _) (Cell cattr content) -> - WrappedApplicative (elDynAttr "td" (zipDynWith setColspanOrHide dynSize cattr) content)) a + $ E.rowMonoidalHeader colonnade (\(Resizable dynSize _) c -> + let cattr = cellularAttrs c + content = cellularContents c + in WrappedApplicative (elDynAttr "td" (zipDynWith setColspanOrHide dynSize cattr) content)) a setColspanOrHide :: Int -> Map Text Text -> Map Text Text setColspanOrHide i m @@ -345,7 +356,7 @@ encodeCorniceHead :: (DomBuilder t m, PostBuild t m, Monoid e) => M.Map T.Text T.Text -> Fascia p (M.Map T.Text T.Text) - -> E.AnnotatedCornice (Maybe Int) p a (Cell t m e) + -> E.AnnotatedCornice (Maybe Int) Headed p a (Cell t m e) -> m e encodeCorniceHead headAttrs fascia annCornice = elAttr "thead" headAttrs (unWrappedApplicative thead) @@ -358,7 +369,7 @@ encodeCorniceResizableHead :: forall t m e p a. (DomBuilder t m, PostBuild t m, Monoid e) => M.Map T.Text T.Text -> Fascia p (M.Map T.Text T.Text) - -> E.AnnotatedCornice (Dynamic t Int) p a (Cell t m e) + -> E.AnnotatedCornice (Dynamic t Int) Headed p a (Cell t m e) -> m e encodeCorniceResizableHead headAttrs fascia annCornice = elAttr "thead" headAttrs (unWrappedApplicative thead) @@ -370,6 +381,22 @@ encodeCorniceResizableHead headAttrs fascia annCornice = addAttr :: Map Text Text -> WrappedApplicative m b -> WrappedApplicative m b addAttr attrs = WrappedApplicative . elAttr "tr" attrs . unWrappedApplicative +encodeCorniceHeadGeneral :: forall t m e p a b c. + (DomBuilder t m, PostBuild t m, Monoid e, Headedness b, Cellular t m c) + => Dynamic t (M.Map T.Text T.Text) + -> Fascia p (M.Map T.Text T.Text) + -> E.AnnotatedCornice (Dynamic t Int) b p a (c e) + -> m e +encodeCorniceHeadGeneral headAttrs fascia annCornice = + elDynAttr "thead" headAttrs (unWrappedApplicative thead) + where + thead :: WrappedApplicative m e + thead = E.headersMonoidal (Just (fascia, addAttr)) [(th,id)] annCornice + th :: Dynamic t Int -> c e -> WrappedApplicative m e + th size c = WrappedApplicative (elDynAttr "th" (zipDynWith setColspanOrHide size (cellularAttrs c)) (cellularContents c)) + addAttr :: Map Text Text -> WrappedApplicative m r -> WrappedApplicative m r + addAttr attrs = WrappedApplicative . elAttr "tr" attrs . unWrappedApplicative + capped :: (DomBuilder t m, PostBuild t m, MonadHold t m, Foldable f, Monoid e) => M.Map T.Text T.Text -- ^ @\@ tag attributes @@ -407,7 +434,7 @@ cappedResizable tableAttrs headAttrs bodyAttrs beneathBody trAttrs fascia cornic elAttr "table" tableAttrs $ do let annCornice = dynamicAnnotate cornice h <- encodeCorniceResizableHead headAttrs fascia annCornice - b <- bodyResizable bodyAttrs trAttrs (E.discard cornice) collection + b <- bodyResizable (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection c <- beneathBody return (h `mappend` b, c, E.size annCornice) @@ -425,16 +452,36 @@ cappedResizableTableless :: cappedResizableTableless headAttrs bodyAttrs trAttrs fascia cornice collection = do let annCornice = dynamicAnnotate cornice h <- encodeCorniceResizableHead headAttrs fascia annCornice - b <- bodyResizable bodyAttrs trAttrs (E.discard cornice) collection + b <- bodyResizable (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection return (h `mappend` b, 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) + => 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) +cappedTableless headAttrs bodyAttrs trAttrs fascia cornice collection = do + let annCornice = dynamicAnnotateGeneral cornice + h <- encodeCorniceHeadGeneral headAttrs fascia annCornice + b <- bodyResizable bodyAttrs trAttrs + (C.mapHeadedness sizedToResizable (E.uncapAnnotated annCornice)) + collection + return (h `mappend` b, E.size annCornice) + +sizedToResizable :: E.Sized (Dynamic t Int) h a -> Resizable t h a +sizedToResizable (E.Sized sz h) = Resizable sz h + dynamicAnnotate :: Reflex t => Cornice (Resizable t Headed) p a c - -> E.AnnotatedCornice (Dynamic t Int) p a c + -> E.AnnotatedCornice (Dynamic t Int) Headed p a c dynamicAnnotate = go where go :: forall t p a c. Reflex t => Cornice (Resizable t Headed) p a c - -> E.AnnotatedCornice (Dynamic t Int) p a c + -> E.AnnotatedCornice (Dynamic t Int) Headed p a c go (E.CorniceBase c@(E.Colonnade cs)) = let parentSz :: Dynamic t (Sum Int) parentSz = foldMap (\(E.OneColonnade (Resizable sz _) _) -> (coerceDynamic sz :: Dynamic t (Sum Int))) cs @@ -445,6 +492,24 @@ dynamicAnnotate = go where parentSz = foldMap (\(E.OneCornice _ theBody) -> (coerceDynamic (E.size theBody) :: Dynamic t (Sum Int))) annChildren in E.AnnotatedCorniceCap (coerceDynamic parentSz) annChildren +-- | Like dynamicAnnotate but more general. +dynamicAnnotateGeneral :: (Reflex t, Sizable t b h) + => Cornice h p a c + -> E.AnnotatedCornice (Dynamic t Int) b p a c +dynamicAnnotateGeneral = go where + go :: forall t p a c b h. (Reflex t, Sizable t b h) + => Cornice h p a c + -> E.AnnotatedCornice (Dynamic t Int) b p a c + go (E.CorniceBase c@(E.Colonnade cs)) = + let parentSz :: Dynamic t (Sum Int) + parentSz = foldMap (\(E.OneColonnade h _) -> (coerceDynamic (sizableSize h) :: Dynamic t (Sum Int))) cs + in E.AnnotatedCorniceBase (coerceDynamic parentSz) (C.mapHeadedness (\h -> E.Sized (sizableSize h) (sizableCast (Proxy :: Proxy t) h)) c) + go (E.CorniceCap children) = + let annChildren = fmap (mapOneCorniceBody go) children + parentSz :: Dynamic t (Sum Int) + parentSz = foldMap (\(E.OneCornice _ theBody) -> (coerceDynamic (E.size theBody) :: Dynamic t (Sum Int))) annChildren + in E.AnnotatedCorniceCap (coerceDynamic parentSz) annChildren + mapOneCorniceBody :: (forall p' a' c'. k p' a' c' -> j p' a' c') -> E.OneCornice k p a c -> E.OneCornice j p a c mapOneCorniceBody f (E.OneCornice h b) = E.OneCornice h (f b) @@ -511,7 +576,7 @@ encodeCorniceHeadDynamic :: (DomBuilder t m, PostBuild t m, Monoid e) => Dynamic t (M.Map T.Text T.Text) -> Fascia p (Dynamic t (M.Map T.Text T.Text)) - -> E.AnnotatedCornice (Maybe Int) p a (Cell t m e) + -> E.AnnotatedCornice (Maybe Int) Headed p a (Cell t m e) -> m e encodeCorniceHeadDynamic headAttrs fascia annCornice = elDynAttr "thead" headAttrs (unWrappedApplicative thead) @@ -521,7 +586,7 @@ encodeCorniceHeadDynamic headAttrs fascia annCornice = addAttr attrs = WrappedApplicative . elDynAttr "tr" attrs . unWrappedApplicative dynamicCapped :: - (DomBuilder t m, PostBuild t m, MonadHold t m, Foldable f, Semigroup e, Monoid e) + (DomBuilder t m, PostBuild t m, MonadHold t m, Foldable f, Semigroup e, Monoid e) => Dynamic t (M.Map T.Text T.Text) -- ^ @\@ tag attributes -> Dynamic t (M.Map T.Text T.Text) -- ^ @\@ tag attributes -> Dynamic t (M.Map T.Text T.Text) -- ^ @\@ tag attributes @@ -629,6 +694,46 @@ paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination pageSize return e _ -> error "Reflex.Dom.Colonnade: paginated: 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) + => 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 +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 + 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" + + -- | 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 @@ -650,17 +755,15 @@ paginatedExpandable (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination 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 - return (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix))) + 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 :: Visible a -> Dynamic t (Map Text Text) - -- trAttrsLifted (Visible _ a) = trAttrs a trAttrsLifted :: Dynamic t (Visible a) -> Dynamic t (Map Text Text) trAttrsLifted d = do Visible isVisible a <- d diff --git a/siphon/siphon.cabal b/siphon/siphon.cabal index 68fe286..94ed8ef 100644 --- a/siphon/siphon.cabal +++ b/siphon/siphon.cabal @@ -1,5 +1,5 @@ name: siphon -version: 0.7.1 +version: 0.7.2 synopsis: Encode and decode CSV files description: Please see README.md homepage: https://github.com/andrewthad/colonnade#readme @@ -19,7 +19,7 @@ library Siphon.Types build-depends: base >= 4.9 && < 5 - , colonnade >= 1.1 && < 1.2 + , colonnade >= 1.1 && < 1.3 , text , bytestring , vector diff --git a/yesod-colonnade/src/Yesod/Colonnade.hs b/yesod-colonnade/src/Yesod/Colonnade.hs index b54ac2a..845bb22 100644 --- a/yesod-colonnade/src/Yesod/Colonnade.hs +++ b/yesod-colonnade/src/Yesod/Colonnade.hs @@ -136,7 +136,7 @@ encodeHeadedCellTable :: Foldable f -> f a -- ^ Rows of data -> WidgetT site IO () encodeHeadedCellTable = encodeTable - (Just mempty) mempty (const mempty) widgetFromCell + (E.Headed mempty) mempty (const mempty) widgetFromCell encodeHeadlessCellTable :: Foldable f => Attribute -- ^ Attributes of @table@ element @@ -144,7 +144,7 @@ encodeHeadlessCellTable :: Foldable f -> f a -- ^ Rows of data -> WidgetT site IO () encodeHeadlessCellTable = encodeTable - Nothing mempty (const mempty) widgetFromCell + E.Headless mempty (const mempty) widgetFromCell encodeHeadedWidgetTable :: Foldable f => Attribute -- ^ Attributes of @table@ element @@ -152,7 +152,7 @@ encodeHeadedWidgetTable :: Foldable f -> f a -- ^ Rows of data -> WidgetT site IO () encodeHeadedWidgetTable = encodeTable - (Just mempty) mempty (const mempty) ($ mempty) + (E.Headed mempty) mempty (const mempty) ($ mempty) encodeHeadlessWidgetTable :: Foldable f => Attribute -- ^ Attributes of @\@ element @@ -160,14 +160,14 @@ encodeHeadlessWidgetTable :: Foldable f -> f a -- ^ Rows of data -> WidgetT site IO () encodeHeadlessWidgetTable = encodeTable - Nothing mempty (const mempty) ($ mempty) + E.Headless mempty (const mempty) ($ mempty) -- | Encode a table. This handles a very general case and -- is seldom needed by users. One of the arguments provided is -- used to add attributes to the generated @\@ elements. encodeTable :: - (Foldable f, Foldable h) - => Maybe Attribute -- ^ Attributes of @\@, pass 'Nothing' to omit @\@ + (Foldable f, E.Headedness h) + => h Attribute -- ^ Attributes of @\@, pass 'Nothing' to omit @\@ -> Attribute -- ^ Attributes of @\@ element -> (a -> Attribute) -- ^ Attributes of each @\@ element -> ((Attribute -> WidgetT site IO () -> WidgetT site IO ()) -> c -> WidgetT site IO ()) -- ^ Wrap content and convert to 'Html' @@ -175,10 +175,10 @@ encodeTable :: -> Colonnade h a c -- ^ How to encode data as a row -> f a -- ^ Collection of data -> WidgetT site IO () -encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs = +encodeTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs = table_ tableAttrs $ do - for_ mtheadAttrs $ \theadAttrs -> do - thead_ theadAttrs $ do + for_ E.headednessExtract $ \unhead -> + thead_ (unhead theadAttrs) $ do E.headerMonadicGeneral_ colonnade (wrapContent th_) tbody_ tbodyAttrs $ do forM_ xs $ \x -> do diff --git a/yesod-colonnade/yesod-colonnade.cabal b/yesod-colonnade/yesod-colonnade.cabal index 8f128e6..7f15b69 100644 --- a/yesod-colonnade/yesod-colonnade.cabal +++ b/yesod-colonnade/yesod-colonnade.cabal @@ -1,5 +1,5 @@ name: yesod-colonnade -version: 1.1.0 +version: 1.2.0 synopsis: Helper functions for using yesod with colonnade description: Yesod and colonnade homepage: https://github.com/andrewthad/colonnade#readme @@ -18,7 +18,7 @@ library Yesod.Colonnade build-depends: base >= 4.7 && < 5 - , colonnade >= 1.1 && < 1.2 + , colonnade >= 1.2 && < 1.3 , yesod-core >= 1.4 && < 1.5 , text >= 1.0 && < 1.3 , blaze-markup >= 0.7 && < 0.9