start using typeclass to make headed vs headless more convenient. add paginated for reflex-dom

2024-10-26 08:03:25 +03:00 · 2017-09-24 22:02:57 -04:00 · 2017-09-24 22:02:57 -04:00 · 24a2c1d142
commit 24a2c1d142
parent 11f9a10268
4 changed files with 294 additions and 47 deletions
--- a/colonnade/src/Colonnade.hs
+++ b/colonnade/src/Colonnade.hs
@ -12,6 +12,8 @@ module Colonnade
    Colonnade
  , Headed(..)
  , Headless(..)
+    -- * Typeclasses
+  , E.Headedness(..)
    -- * Create
  , headed
  , headless
--- a/colonnade/src/Colonnade/Encode.hs
+++ b/colonnade/src/Colonnade/Encode.hs
@ -44,6 +44,9 @@ module Colonnade.Encode
  , Headed(..)
  , Headless(..)
  , Sized(..)
+  , ExtractForall(..)
+    -- ** Typeclasses
+  , Headedness(..)
    -- ** Row
  , row
  , rowMonadic
@ -234,12 +237,13 @@ headerMonadic (Colonnade v) g =
  fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneColonnadeHead) v

 headerMonadicGeneral_ :: 
-     (Monad m, Foldable h)
+     (Monad m, Headedness h)
  => Colonnade h a c
  -> (c -> m b)
  -> m ()
-headerMonadicGeneral_ (Colonnade v) g =
-  Vector.mapM_ (mapM_ g . oneColonnadeHead) v
+headerMonadicGeneral_ (Colonnade v) g = case headednessExtract of
+  Nothing -> return ()
+  Just f -> Vector.mapM_ (g . f . oneColonnadeHead) v

 headerMonoidalGeneral ::
     (Monoid m, Foldable h)
@ -493,6 +497,10 @@ data MutableSizedColonnade s h a c = MutableSizedColonnade
 newtype Headed a = Headed { getHeaded :: a }
  deriving (Eq,Ord,Functor,Show,Read,Foldable)

+instance Applicative Headed where
+  pure = Headed
+  Headed f <*> Headed a = Headed (f a)
+
 -- | As the first argument to the 'Colonnade' type 
 --   constructor, this indictates that the columnar encoding does not have 
 --   a header. This type is isomorphic to 'Proxy' but is 
@ -505,6 +513,10 @@ newtype Headed a = Headed { getHeaded :: a }
 data Headless a = Headless
  deriving (Eq,Ord,Functor,Show,Read,Foldable)

+instance Applicative Headless where
+  pure _ = Headless
+  Headless <*> Headless = Headless
+
 data Sized sz f a = Sized
  { sizedSize :: !sz
  , sizedContent :: !(f a)
@ -620,8 +632,38 @@ data AnnotatedCornice sz (p :: Pillar) a c where

 -- data MaybeInt = JustInt {-# UNPACK #-} !Int | NothingInt

-- | This is provided with vector-0.12, but we include a copy here 
+-- | This is provided with @vector-0.12@, but we include a copy here 
 --   for compatibility.
 vectorConcatNE :: NonEmpty (Vector a) -> Vector a
 vectorConcatNE = Vector.concat . toList

+-- | This class communicates that a container holds either zero
+--   elements or one element. Furthermore, all inhabitants of
+--   the type must hold the same number of elements. Both
+--   'Headed' and 'Headless' have instances. The following
+--   law accompanies any instances:
+--
+--   > maybe x (\f -> f (headednessPure x)) headednessContents == x
+--   > todo: come up with another law that relates to Traversable
+--
+--   Consequently, there is no instance for 'Maybe', which cannot
+--   satisfy the laws since it has inhabitants which hold different
+--   numbers of elements. 'Nothing' holds 0 elements and 'Just' holds
+--   1 element.
+class Headedness h where
+  headednessPure :: a -> h a
+  headednessExtract :: Maybe (h a -> a)
+  headednessExtractForall :: Maybe (ExtractForall h)
+
+instance Headedness Headed where
+  headednessPure = Headed
+  headednessExtract = Just getHeaded 
+  headednessExtractForall = Just (ExtractForall getHeaded)
+
+instance Headedness Headless where
+  headednessPure _ = Headless
+  headednessExtract = Nothing
+  headednessExtractForall = Nothing
+
+newtype ExtractForall h = ExtractForall { runExtractForall :: forall a. h a -> a }
+
--- a/reflex-dom-colonnade/reflex-dom-colonnade.cabal
+++ b/reflex-dom-colonnade/reflex-dom-colonnade.cabal
@ -1,16 +1,16 @@
-name:                reflex-dom-colonnade
-version:             0.5.0
-synopsis:            Use colonnade with reflex-dom
-description:         Please see README.md
-homepage:            https://github.com/andrewthad/colonnade#readme
-license:             BSD3
-license-file:        LICENSE
-author:              Andrew Martin
-maintainer:          andrew.thaddeus@gmail.com
-copyright:           2016 Andrew Martin
-category:            web
-build-type:          Simple
-cabal-version:       >=1.10
+name: reflex-dom-colonnade
+version: 0.6.0
+synopsis: Use colonnade with reflex-dom
+description: Please see README.md
+homepage: https://github.com/andrewthad/colonnade#readme
+license: BSD3
+license-file: LICENSE
+author: Andrew Martin
+maintainer: andrew.thaddeus@gmail.com
+copyright: 2016 Andrew Martin
+category: web
+build-type: Simple
+cabal-version: >=1.10

 library
  hs-source-dirs:      src
@ -25,6 +25,7 @@ library
    , reflex == 0.5.*
    , reflex-dom == 0.4.*
    , containers >= 0.5 && < 0.6
+    , profunctors >= 5.2 && < 5.3
  default-language: Haskell2010

 source-repository head
--- a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs
+++ b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs
@ -3,8 +3,12 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
@ -16,6 +20,9 @@ module Reflex.Dom.Colonnade
  -- * Types
    Cell(..)
  , Resizable(..)
+  , Bureau(..)
+  , Arrangement(..)
+  , Pagination(..)
  -- * Table Encoders
  , basic
  , static
@ -27,8 +34,9 @@ module Reflex.Dom.Colonnade
  , dynamic
  , dynamicCapped
  , expandable
-  , expandableResizableTableless
+  -- , expandableResizableTableless
  , sectioned
+  , paginated
    -- * Cell Functions
  , cell
  , charCell
@ -37,6 +45,8 @@ module Reflex.Dom.Colonnade
  , lazyTextCell
  , builderCell
  , headedResizable
+    -- * Other Stuff
+  , defBureau
  ) where

 import Data.String (IsString(..))
@ -45,20 +55,24 @@ 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_)
+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,Fascia,Cornice)
+import Colonnade (Colonnade,Headed,Headless,Fascia,Cornice,Headedness(..))
 import Data.Monoid (Sum(..))
+import Data.Proxy
+import Control.Monad.Fix (MonadFix)
 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))
+  { cellAttrs :: !(Dynamic t (M.Map T.Text T.Text))
  , cellContents :: !(m b)
  } deriving (Functor)

@ -67,11 +81,100 @@ data Cell t m b = Cell
 data Resizable t h b = Resizable
  { resizableSize :: !(Dynamic t Int)
  , resizableContent :: !(h b)
-  } deriving (Foldable)
+  } deriving (Foldable, Functor)
+
+data Bureau t h a = Bureau
+  { bureauTable :: Dynamic t (Map Text Text)
+    -- ^ attributes of @\<table\>@
+  , bureauHead :: h (Dynamic t (Map Text Text), Dynamic t (Map Text Text))
+    -- ^ attributes of @\<thead\>@ and of the @\<tr\>@ inside of it.
+  , bureauBody :: Dynamic t (Map Text Text)
+  , bureauRow :: (a -> Dynamic t (Map Text Text))
+    -- ^ attributes of each @\<tr\>@, based on the element
+  }
+  -- , bureauHeadRow :: h (Dynamic t (Map Text Text))
+
+-- | Where the pagination goes relative to the table
+data Arrangement t
+  = ArrangementAbove
+  | ArrangementBeneath
+  | ArrangementFooter
+      (Dynamic t (Map Text Text))
+      (Dynamic t (Map Text Text))
+      (Dynamic t (Map Text Text))
+      -- ^ contains attributes of @\<tfoot\>@, its inner @\<tr\>@, and its inner @\<th\>@.
+
+-- | The argument to this function is an @Dynamic@ that carries
+--   the total number of pages that should be available. When
+--   this dynamic changes, it means that the rows backing the
+--   table have been changed. Typically, this should cause
+--   the @Dynamic@ in the return value to reset to 0. This
+--   returned @Dynamic@ represents the current page.
+newtype Pagination t m = Pagination { runPagination :: Dynamic t Int -> m (Dynamic t Int) }
+
+class (PostBuild t m, DomBuilder t m) => Cellular t m c | c -> m, c -> t where
+  cellularAttrs :: c b -> Dynamic t (Map Text Text)
+  cellularContents :: c b -> m b
+
+instance (PostBuild t m, DomBuilder t m) => Cellular t m (Cell t m) where
+  cellularAttrs = cellAttrs
+  cellularContents = cellContents
+
+instance (Reflex t, DomBuilder t m, PerformEvent t m, MonadHold t m, MonadFix m) => Cellular t (PostBuildT t m) (PostBuildT t m) where
+  cellularAttrs _ = pure M.empty
+  cellularContents = id
+  
+
+-- | This typeclass is provided to make using functions in this
+--   library more convenient. The methods could have been passed
+--   around in a dictionary instead, but there is only really one
+--   sensible implementation for each header type. The only
+--   law it should satisfy is:
+--
+--   > sizableSize (headednessPure Proxy x) == pure 1
+--
+--   Also, since the instances we are interested in preclude
+--   the use of a functional dependency, the typeclass is annoying
+--   to use. But, end users should never need to use it.
+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) => Sizable t h (Resizable t h) where
+  sizableSize = resizableSize
+  sizableCast _ (Resizable _ h) = h
+
+instance Reflex t => Sizable t Headed Headed where
+  sizableSize _ = pure 1
+  sizableCast _ = id
+
+instance Reflex t => Sizable t Headless Headless where
+  sizableSize _ = pure 1
+  sizableCast _ = id
+
+defBureau :: forall t h a. (Reflex t, Headedness h) => Bureau t h a
+defBureau = Bureau
+  { bureauTable = pure M.empty
+  , bureauHead = headednessPure (pure M.empty, pure M.empty)
+  , bureauBody = pure M.empty
+  , bureauRow = const (pure M.empty)
+  }

 elFromCell :: (DomBuilder t m, PostBuild t m) => T.Text -> Cell t m b -> m b
 elFromCell e (Cell attr m) = elDynAttr e attr m

+-- elFromCellular :: (Cellular t m c, PostBuild t m, DomBuilder t m)
+--   => T.Text -- name of the element, @th@ or @td@
+--   -> c b -- cellular value
+--   -> m b
+-- elFromCellular name c = elDynAttr name (cellularAttrs c) (cellularContents c)
+
 -- | Convenience function for creating a 'Cell' representing
 --   a @td@ or @th@ with no attributes.
 cell :: Reflex t => m b -> Cell t m b
@ -121,13 +224,13 @@ basic ::
 basic tableAttrs = static tableAttrs (Just (M.empty,M.empty)) mempty (const mempty)

 body :: (DomBuilder t m, PostBuild t m, Foldable f, Monoid e)
-  => M.Map T.Text T.Text
+  => Dynamic t (M.Map T.Text T.Text)
  -> (a -> Dynamic t (M.Map T.Text T.Text))
  -> Colonnade h a (Cell t m e)
  -> f a
  -> m e
 body bodyAttrs trAttrs colonnade collection =
-  elAttr "tbody" bodyAttrs (bodyRows trAttrs colonnade collection)
+  elDynAttr "tbody" bodyAttrs (bodyRows trAttrs colonnade collection)

 bodyRows :: (DomBuilder t m, PostBuild t m, Foldable f, Monoid e)
  => (a -> Dynamic t (M.Map T.Text T.Text))
@ -160,7 +263,7 @@ setColspanOrHide i m
  | otherwise = M.insert "colspan" (T.pack (show i)) m

 static ::
-  (DomBuilder t m, PostBuild t m, Foldable f, Foldable h, Monoid e)
+  (DomBuilder t m, PostBuild t m, Foldable f, Headedness h, Monoid e)
  => M.Map T.Text T.Text -- ^ @\<table\>@ tag attributes
  -> Maybe (M.Map T.Text T.Text, M.Map T.Text T.Text)
  -- ^ Attributes of @\<thead\>@ and its @\<tr\>@, pass 'Nothing' to omit @\<thead\>@
@ -174,10 +277,10 @@ static tableAttrs mheadAttrs bodyAttrs trAttrs colonnade collection =
    for_ mheadAttrs $ \(headAttrs,headTrAttrs) ->
      elAttr "thead" headAttrs . elAttr "tr" headTrAttrs $
        E.headerMonadicGeneral_ colonnade (elFromCell "th")
-    body bodyAttrs (pure . trAttrs) colonnade collection
+    body (pure bodyAttrs) (pure . trAttrs) colonnade collection

 staticTableless ::
-  (DomBuilder t m, PostBuild t m, Foldable f, Foldable h, Monoid e)
+  (DomBuilder t m, PostBuild t m, Foldable f, Headedness h, Monoid e)
  => Maybe (M.Map T.Text T.Text, M.Map T.Text T.Text)
  -- ^ Attributes of @\<thead\>@ and its @\<tr\>@, pass 'Nothing' to omit @\<thead\>@
  -> M.Map T.Text T.Text -- ^ @\<tbody\>@ tag attributes
@ -189,12 +292,12 @@ staticTableless mheadAttrs bodyAttrs trAttrs colonnade collection = do
  for_ mheadAttrs $ \(headAttrs,headTrAttrs) ->
    elAttr "thead" headAttrs . elAttr "tr" headTrAttrs $
      E.headerMonadicGeneral_ colonnade (elFromCell "th")
-  body bodyAttrs trAttrs colonnade collection
+  body (pure bodyAttrs) trAttrs colonnade collection

 -- | A table dividing into sections by @\<td\>@ elements that
 --   take up entire rows.
 sectioned :: 
-  (DomBuilder t m, PostBuild t m, Foldable f, Foldable h, Foldable g)
+  (DomBuilder t m, PostBuild t m, Foldable f, Headedness h, Foldable g)
  => M.Map T.Text T.Text -- ^ @\<table\>@ tag attributes
  -> Maybe (M.Map T.Text T.Text, M.Map T.Text T.Text)
  -- ^ Attributes of @\<thead\>@ and its @\<tr\>@, pass 'Nothing' to omit @\<thead\>@
@ -258,7 +361,7 @@ capped ::
 capped tableAttrs headAttrs bodyAttrs trAttrs fascia cornice collection =
  elAttr "table" tableAttrs $ do
    h <- encodeCorniceHead headAttrs fascia (E.annotate cornice)
-    b <- body bodyAttrs (pure . trAttrs) (E.discard cornice) collection
+    b <- body (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection
    return (h `mappend` b)

 -- | This is useful when you want to be able to toggle the visibility
@ -366,7 +469,7 @@ dynamicBody bodyAttrs trAttrs colonnade dynCollection =
      unWrappedApplicative . E.rowMonoidal colonnade (WrappedApplicative . elFromCell "td") $ a

 dynamic ::
-  (DomBuilder t m, PostBuild t m, Foldable f, Foldable h, Semigroup e, Monoid e)
+  (DomBuilder t m, PostBuild t m, Foldable f, Headedness h, Semigroup e, Monoid e)
  => Dynamic t (M.Map T.Text T.Text) -- ^ @\<table\>@ tag attributes
  -> Maybe (Dynamic t (M.Map T.Text T.Text), Dynamic t (M.Map T.Text T.Text))
  -- ^ Attributes of @\<thead\>@ and its @\<tr\>@, pass 'Nothing' to omit @\<thead\>@
@ -438,22 +541,121 @@ expandable tableAttrs tdExpandedAttrs as encoding@(E.Colonnade v) = do
        return e'
      widgetHold (return ()) e'

-expandableResizableTableless :: forall t m f a b. (MonadWidget t m, Foldable f)
-  => f a -- ^ Values
-  -> (Event t b -> m ())
-     -- ^ Encoding over additional content
-  -> Colonnade (Resizable t Headed) a (m (Event t (Maybe b)))
-     -- ^ Encoding into cells with events that can fire to create additional content under the row
+-- expandableResizableTableless :: forall t m f a b. (MonadWidget t m, Foldable f)
+--   => f a -- ^ Values
+--   -> (Event t b -> m ())
+--      -- ^ Encoding over additional content
+--   -> Colonnade (Resizable t Headed) a (m (Event t (Maybe b)))
+--      -- ^ Encoding into cells with events that can fire to create additional content under the row
+--   -> m ()
+-- expandableResizableTableless as expansion encoding@(E.Colonnade v) = do
+--   let vlen = coerceDynamic (foldMap (\(E.OneColonnade (Resizable sz _) _) -> coerceDynamic sz :: Dynamic t (Sum Int)) v) :: Dynamic t (Sum Int)
+--       totalSizeAttr = fmap (\i -> M.singleton "colspan" (T.pack (show i))) vlen
+--   _ <- el "thead" $ el "tr" $ E.headerMonadicGeneral_ encoding (el "th")
+--   el "tbody" $ forM_ as $ \a -> do
+--     x <- el "tr" $ E.rowMonadicWith [] (++) encoding (fmap (\k -> [k]) . el "td") a
+--     let e = leftmost x
+--     d <- holdDyn Nothing e
+--     elDynAttr "tr" (fmap (maybe (M.singleton "style" "display:none;") (const M.empty)) d) $ do
+--       elDynAttr "td" totalSizeAttr (expansion (fmapMaybe id e))
+
+data Visible a = Visible !Bool a
+
+paginated :: forall t b h m a c.
+     (Sizable t b h, Cellular t m c, Headedness b, MonadFix m, Functor h)
+  => Bureau t b a
+  -> Arrangement t
+  -> Pagination t m
+  -> Int -- ^ number of records on a page
+  -> a -- ^ An inhabitant of type @a@ only used for the cells in hidden rows.
+  -> Colonnade h (Dynamic t a) (c ())
+  -> Dynamic t (Vector a)
  -> m ()
-expandableResizableTableless as expansion encoding@(E.Colonnade v) = do
-  let vlen = coerceDynamic (foldMap (\(E.OneColonnade (Resizable sz _) _) -> coerceDynamic sz :: Dynamic t (Sum Int)) v) :: Dynamic t (Sum Int)
-      totalSizeAttr = fmap (\i -> M.singleton "colspan" (T.pack (show i))) vlen
-  _ <- el "thead" $ el "tr" $ E.headerMonadicGeneral_ encoding (el "th")
-  el "tbody" $ forM_ as $ \a -> do
-    x <- el "tr" $ E.rowMonadicWith [] (++) encoding (fmap (\k -> [k]) . el "td") a
-    let e = leftmost x
-    d <- holdDyn Nothing e
-    elDynAttr "tr" (fmap (maybe (M.singleton "style" "display:none;") (const M.empty)) d) $ do
-      elDynAttr "td" totalSizeAttr (expansion (fmapMaybe id e))
+paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) arrange (Pagination makePagination) pageSize aDef col vecD = do
+  let colLifted :: Colonnade h (Dynamic t (Visible a)) (c ())
+      colLifted = PF.lmap (fmap (\(Visible _ a) -> a)) col
+      -- colLifted = E.Colonnade (V.map (\(E.OneColonnade h f) -> E.OneColonnade h (\x -> maybe nothingContents f)) (E.getColonnade 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 ((`div` pageSize) . V.length) vecD
+      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
+      tableHeader theadAttrs colLifted
+      let vals = makeVals page
+      tableBody bodyAttrs trAttrsLifted colLifted vals
+      page <- elDynAttr "tfoot" tfootAttrs $ do
+        elDynAttr "tr" tfootTrAttrs $ do
+          elDynAttr "th" tfootThAttrs $ do
+            makePagination totalPages
+      return ()
+    _ -> error "Reflex.Dom.Colonnade: paginated: write this code"
+ 
+    
+tableHeader :: forall t b h c a m.
+     (Reflex t, Sizable t b h, Cellular t m c, Headedness b)
+  => b (Dynamic t (Map Text Text), Dynamic t (Map Text Text))
+  -> Colonnade h a (c ())
+  -> m ()
+tableHeader theadAttrsWrap col = case headednessExtractForall of
+  Nothing -> return ()
+  Just extractForall -> do
+    let (theadAttrs,trAttrs) = extract theadAttrsWrap
+    elDynAttr "thead" theadAttrs $ do
+      elDynAttr "tr" trAttrs $ do
+        headerMonadicGeneralSizable_ col (extract . sizableCast (Proxy :: Proxy t))
+    where
+    extract :: forall x. b x -> x
+    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))
+  -> Colonnade h a (c e)
+  -> f a
+  -> m e
+tableBody bodyAttrs trAttrs col collection =
+  elDynAttr "tbody" bodyAttrs $ foldlM (\m a -> do
+      e <- elDynAttr "tr" (trAttrs a) (rowSizable col a)
+      return (mappend m e)
+    ) mempty collection
+
+headerMonadicGeneralSizable_ :: (Sizable t b h, Cellular t m c)
+  => Colonnade h a (c ())
+  -> (h (c ()) -> c ())
+  -> m ()
+headerMonadicGeneralSizable_ (E.Colonnade v) extract = 
+  V.mapM_ go v
+  where
+  go x = do
+    let h = E.oneColonnadeHead x
+        c = extract h
+        attrs = zipDynWith insertSizeAttr (sizableSize h) (cellularAttrs c)
+    elDynAttr "th" attrs (cellularContents c)
+
+rowSizable :: (Sizable t b h, Cellular t m c, Monoid e)
+  => Colonnade h a (c e)
+  -> a
+  -> m e
+rowSizable (E.Colonnade v) a = V.foldM (\m oc -> do
+    let c = E.oneColonnadeEncode oc a
+    e <- elDynAttr "td" (cellularAttrs c) $ do
+      cellularContents c
+    return (mappend m e)
+  ) mempty v
+
+insertSizeAttr :: Int -> Map Text Text -> Map Text Text
+insertSizeAttr i m
+  | i < 1 = M.insertWith T.append "style" "display:none;" m
+  | otherwise = M.insert "colspan" (T.pack (show i)) m
+