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

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

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

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.
+uncapAnnotated :: forall sz p a c h.
-     AnnotatedCornice sz p a c
+     AnnotatedCornice sz h p a c
-  -> Colonnade (Sized sz Headed) 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
+       AnnotatedCornice sz h p' a c
-    -> Vector (OneColonnade (Sized sz Headed) 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.
+headersMonoidal :: forall sz r m c p a h.
-     Monoid m
+     (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 
+     in case headednessExtract of
-          (foldMap (\(OneColonnade (Sized sz (Headed h)) _) -> 
+          Just unhead -> g $ foldMap (\(fromContent,wrap) -> wrap 
-            (fromContent sz h)) v)) fromContentList
+            (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)
+     Vector (OneCornice (AnnotatedCornice sz h) p a c)
-  -> Maybe (AnnotatedCornice sz 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)
+  -> Vector (OneCornice (AnnotatedCornice sz h) Base a c)
-  -> AnnotatedCornice sz 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)
+  -> Vector (OneCornice (AnnotatedCornice sz h) (Cap p) a c)
-  -> AnnotatedCornice sz (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 
+     OneCornice (AnnotatedCornice sz h) (Cap p) a c 
-  -> Vector (OneCornice (AnnotatedCornice sz) 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)
+    -> !(Colonnade (Sized sz h) a c)
-    -> AnnotatedCornice sz Base a c
+    -> AnnotatedCornice sz h Base a c
   AnnotatedCorniceCap :: 
        !sz
-    -> {-# UNPACK #-} !(Vector (OneCornice (AnnotatedCornice sz) p a c))
+    -> {-# UNPACK #-} !(Vector (OneCornice (AnnotatedCornice sz h) p a c))
-    -> AnnotatedCornice sz (Cap p) a c
+    -> AnnotatedCornice sz h (Cap p) a c
 
 -- data MaybeInt = JustInt {-# UNPACK #-} !Int | NothingInt
 

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

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)
+bodyResizable :: (Cellular t m c, DomBuilder t m, PostBuild t m, Foldable f, Monoid e)
-  => Map Text Text
+  => Dynamic t (Map Text Text)
-  -> (a -> Map Text Text)
+  -> (a -> Dynamic t (Map Text Text))
-  -> Colonnade (Resizable t h) a (Cell t m e)
+  -> 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) -> 
+    $ E.rowMonoidalHeader colonnade (\(Resizable dynSize _) c -> 
-        WrappedApplicative (elDynAttr "td" (zipDynWith setColspanOrHide dynSize cattr) content)) a
+        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
+        p <- page
-          v <- vecD
+        v <- vecD
-          return (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
+        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

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

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)
+     (Foldable f, E.Headedness h)
-  => Maybe Attribute -- ^ Attributes of @\<thead\>@, pass 'Nothing' to omit @\<thead\>@
+  => 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
+    for_ E.headednessExtract $ \unhead ->
-      thead_ theadAttrs $ do
+      thead_ (unhead theadAttrs) $ do
         E.headerMonadicGeneral_ colonnade (wrapContent th_)
     tbody_ tbodyAttrs $ do
       forM_ xs $ \x -> do

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