more small changes

colonnade/src/Colonnade/Encoding.hs

@@ -26,6 +26,14 @@ runRow :: (c1 -> c2) -> Encoding f c1 a -> a -> Vector c2
 runRow g (Encoding v) a = flip Vector.map v $
   \(OneEncoding _ encode) -> g (encode a)
 
+runBothMonadic_ :: Monad m
+  => Encoding Headed content a
+  -> (content -> content -> m b)
+  -> a
+  -> m ()
+runBothMonadic_ (Encoding v) g a =
+  forM_ v $ \(OneEncoding (Headed h) encode) -> g h (encode a)
+
 runRowMonadic :: (Monad m, Monoid b)
               => Encoding f content a
               -> (content -> m b)
@@ -35,6 +43,14 @@ runRowMonadic (Encoding v) g a =
   flip Internal.foldlMapM v
   $ \e -> g (oneEncodingEncode e a)
 
+runRowMonadic_ :: Monad m
+  => Encoding f content a
+  -> (content -> m b)
+  -> a
+  -> m ()
+runRowMonadic_ (Encoding v) g a =
+  forM_ v $ \e -> g (oneEncodingEncode e a)
+
 runRowMonadicWith :: (Monad m)
               => b
               -> (b -> b -> b)

yesod-colonnade/src/Yesod/Colonnade.hs

@@ -3,12 +3,17 @@
 
 module Yesod.Colonnade
   ( table
+  , listItems
+  , Cell(..)
+  , cell
+  , textCell
   ) where
 
 import Yesod.Core
 import Colonnade.Types
 import Data.Text (Text)
 import Control.Monad
+import Data.String (IsString(..))
 import qualified Colonnade.Encoding as Encoding
 
 data Cell site = Cell
@@ -16,12 +21,38 @@ data Cell site = Cell
   , cellContents :: !(WidgetT site IO ())
   }
 
+instance IsString (Cell site) where
+  fromString = Cell [] . fromString
+
 cell :: WidgetT site IO () -> Cell site
 cell = Cell []
 
 textCell :: Text -> Cell site
 textCell = cell . toWidget . toHtml
 
+-- | This determines the attributes that are added
+--   to the individual @li@s by concatenating the header\'s
+--   attributes with the data\'s attributes.
+listItems :: Foldable f
+  => (WidgetT site IO () -> WidgetT site IO ())
+     -- ^ Wrapper for items, often @ul@
+  -> (WidgetT site IO () -> WidgetT site IO () -> WidgetT site IO ())
+     -- ^ Combines header with data
+  -> Encoding Headed (Cell site) a
+     -- ^ How to encode data as a row
+  -> f a
+     -- ^ Rows of data
+  -> WidgetT site IO ()
+listItems ulWrap combine enc xs =
+  forM_ xs $ ulWrap . Encoding.runBothMonadic_ enc
+    (\(Cell ha hc) (Cell ba bc) ->
+      li (ha ++ ba) (combine hc bc)
+    )
+
+-- | If you are using the bootstrap css framework, then you may want
+--   to call this with the first argument as:
+--
+--   > table [("class","table table-striped")] ...
 table :: Foldable f
   => [(Text,Text)] -- ^ Attributes of @table@ element
   -> Encoding Headed (Cell site) a -- ^ How to encode data as a row
@@ -53,7 +84,8 @@ widgetFromCell ::
 widgetFromCell f (Cell attrs contents) =
   f attrs contents
 
-tr,tbody,thead,tableEl,td,th :: [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()
+tr,tbody,thead,tableEl,td,th,ul,li ::
+  [(Text,Text)] -> WidgetT site IO () -> WidgetT site IO ()
 tableEl str b = [whamlet|
   <table *{str}>^{b}
 |]
@@ -72,4 +104,10 @@ th str b = [whamlet|
 td str b = [whamlet|
   <td *{str}>^{b}
 |]
+ul str b = [whamlet|
+  <ul *{str}>^{b}
+|]
+li str b = [whamlet|
+  <li *{str}>^{b}
+|]