From 2dea18bf684ed99b9963c3e4fe4f6b1e80a93575 Mon Sep 17 00:00:00 2001
From: Andrew Martin <andrew.thaddeus@gmail.com>
Date: Fri, 18 Nov 2016 08:58:13 -0500
Subject: [PATCH] Add definition table

---
 yesod-colonnade/src/Yesod/Colonnade.hs | 34 ++++++++++++++++++++------
 1 file changed, 27 insertions(+), 7 deletions(-)

diff --git a/yesod-colonnade/src/Yesod/Colonnade.hs b/yesod-colonnade/src/Yesod/Colonnade.hs
index 8838c0f..647812b 100644
--- a/yesod-colonnade/src/Yesod/Colonnade.hs
+++ b/yesod-colonnade/src/Yesod/Colonnade.hs
@@ -3,6 +3,8 @@
 
 module Yesod.Colonnade
   ( table
+  , tableHeadless
+  , definitionTable
   , listItems
   , Cell(..)
   , cell
@@ -54,23 +56,41 @@ anchorCell getRoute getContent a = cell $ do
 
 -- | 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 ())
+--   attributes with the data\'s attributes. 
+listItems :: 
+     (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
+  -> a
+     -- ^ The value to display
   -> WidgetT site IO ()
-listItems ulWrap combine enc xs =
-  forM_ xs $ ulWrap . Encoding.runBothMonadic_ enc
+listItems ulWrap combine enc =
+  ulWrap . Encoding.runBothMonadic_ enc
     (\(Cell ha hc) (Cell ba bc) ->
       li (ha ++ ba) (combine hc bc)
     )
 
+-- | A two-column table with the header content displayed in the
+--   first column and the data displayed in the second column. Note
+--   that the generated HTML table does not have a @thead@.
+definitionTable ::
+     [(Text,Text)]
+     -- ^ Attributes of @table@ element.
+  -> Encoding Headed (Cell site) a
+     -- ^ How to encode data as a row
+  -> a
+     -- ^ The value to display
+  -> WidgetT site IO ()
+definitionTable attrs enc a = tableEl attrs $ tbody [] $ 
+  Encoding.runBothMonadic_ enc
+    (\theKey theValue -> tr [] $ do
+      widgetFromCell td theKey
+      widgetFromCell td theValue
+    ) a
+
 -- | If you are using the bootstrap css framework, then you may want
 --   to call this with the first argument as:
 --