add paginated cornice to reflex-dom-colonnade, tweak all other packages to work with Headedness

2024-09-11 06:45:41 +03:00 · 2017-11-13 22:45:00 -05:00 · 2017-11-13 22:45:00 -05:00 · add35c3fc1
commit add35c3fc1
parent c01dce8eb2
8 changed files with 196 additions and 71 deletions
--- 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
--- 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
--- 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

--- 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
--- 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 @\<tr\>@, 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 -- ^ @\<table\>@ 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) -- ^ @\<thead\>@ tag attributes
+  -> Dynamic t (Map Text Text) -- ^ @\<tbody\>@ tag attributes
+  -> (a -> Dynamic t (Map Text Text)) -- ^ @\<tr\>@ tag attributes
+  -> Fascia p (Map Text Text) -- ^ Attributes for @\<tr\>@ elements in the @\<thead\>@
+  -> 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) -- ^ @\<table\>@ tag attributes
  -> Dynamic t (M.Map T.Text T.Text) -- ^ @\<thead\>@ tag attributes
  -> Dynamic t (M.Map T.Text T.Text) -- ^ @\<tbody\>@ 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
--- 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
--- 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 @\<table\>@ 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 @\<tr\>@ elements.
 encodeTable ::
-     (Foldable f, Foldable h)
-  => Maybe Attribute -- ^ Attributes of @\<thead\>@, pass 'Nothing' to omit @\<thead\>@
+     (Foldable f, E.Headedness h)
+  => h Attribute -- ^ Attributes of @\<thead\>@, pass 'Nothing' to omit @\<thead\>@
  -> Attribute -- ^ Attributes of @\<tbody\>@ element
  -> (a -> Attribute) -- ^ Attributes of each @\<tr\>@ 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
--- 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