diff --git a/blaze-colonnade/blaze-colonnade.cabal b/blaze-colonnade/blaze-colonnade.cabal
index 2602abf..e6d96cb 100644
--- a/blaze-colonnade/blaze-colonnade.cabal
+++ b/blaze-colonnade/blaze-colonnade.cabal
@@ -1,5 +1,5 @@
name: blaze-colonnade
-version: 1.1.1
+version: 1.2.0
synopsis: Helper functions for using blaze-html with colonnade
description: Blaze HTML and colonnade
homepage: https://github.com/andrewthad/colonnade#readme
diff --git a/blaze-colonnade/src/Text/Blaze/Colonnade.hs b/blaze-colonnade/src/Text/Blaze/Colonnade.hs
index 9398f43..fa70e3b 100644
--- a/blaze-colonnade/src/Text/Blaze/Colonnade.hs
+++ b/blaze-colonnade/src/Text/Blaze/Colonnade.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
-- | Build HTML tables using @blaze-html@ and @colonnade@. The bottom
-- of this page has a tutorial that walks through a full example,
-- illustrating how to meet typical needs with this library. It is
@@ -9,7 +12,7 @@
-- >>> :module + Colonnade Text.Blaze.Html Text.Blaze.Colonnade
-- >>> let col = headed "Grade" (toHtml . fst) <> headed "Letter" (toHtml . snd)
-- >>> let rows = [("90-100",'A'),("80-89",'B'),("70-79",'C')]
--- >>> printVeryCompactHtml (encodeHeadedHtmlTable mempty col rows)
+-- >>> printVeryCompactHtml (encodeHtmlTable mempty col rows)
--
--
-- Grade | Letter |
@@ -22,10 +25,8 @@
--
module Text.Blaze.Colonnade
( -- * Apply
- encodeHeadedHtmlTable
- , encodeHeadlessHtmlTable
- , encodeHeadedCellTable
- , encodeHeadlessCellTable
+ encodeHtmlTable
+ , encodeCellTable
, encodeTable
, encodeCappedTable
-- * Cell
@@ -62,7 +63,7 @@ import qualified Text.Blaze.Html.Renderer.Pretty as Pretty
import qualified Text.Blaze as Blaze
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as HA
-import qualified Colonnade.Encode as Encode
+import qualified Colonnade.Encode as E
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.Builder as TBuilder
@@ -113,7 +114,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder
-- Let\'s continue:
--
-- >>> let customAttrs = HA.class_ "stylish-table" <> HA.id "main-table"
--- >>> printCompactHtml (encodeHeadedHtmlTable customAttrs tableEmpA employees)
+-- >>> printCompactHtml (encodeHtmlTable customAttrs tableEmpA employees)
--
--
--
@@ -163,10 +164,10 @@ import qualified Data.Text.Lazy.Builder as TBuilder
-- literal @"Dept."@ to be accepted as a value of type 'Cell'. To avoid
-- this extension, 'stringCell' could be used to upcast the 'String'.
-- To try out our 'Colonnade' on a list of departments, we need to use
--- 'encodeHeadedCellTable' instead of 'encodeHeadedHtmlTable':
+-- 'encodeCellTable' instead of 'encodeHtmlTable':
--
-- >>> let twoDepts = [Sales,Management]
--- >>> printVeryCompactHtml (encodeHeadedCellTable customAttrs tableDept twoDepts)
+-- >>> printVeryCompactHtml (encodeCellTable customAttrs tableDept twoDepts)
--
--
-- Dept. |
@@ -186,7 +187,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder
-- >>> let tableEmpB = lmap department tableDept
-- >>> :t tableEmpB
-- tableEmpB :: Colonnade Headed Employee Cell
--- >>> printVeryCompactHtml (encodeHeadedCellTable customAttrs tableEmpB employees)
+-- >>> printVeryCompactHtml (encodeCellTable customAttrs tableEmpB employees)
--
--
-- Dept. |
@@ -218,7 +219,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder
-- >>> let tableEmpC = fmap htmlCell tableEmpA <> tableEmpB
-- >>> :t tableEmpC
-- tableEmpC :: Colonnade Headed Employee Cell
--- >>> printCompactHtml (encodeHeadedCellTable customAttrs tableEmpC employees)
+-- >>> printCompactHtml (encodeCellTable customAttrs tableEmpC employees)
--
--
--
@@ -296,9 +297,8 @@ builderCell = lazyTextCell . TBuilder.toLazyText
-- | 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 @\
@ elements.
-encodeTable ::
- (Foldable f, Foldable h)
- => Maybe (Attribute,Attribute) -- ^ Attributes of @\@ and its @\@, pass 'Nothing' to omit @\@
+encodeTable :: forall h f a c. (Foldable f, E.Headedness h)
+ => h (Attribute,Attribute) -- ^ Attributes of @\@ and its @\@, pass 'Nothing' to omit @\@
-> Attribute -- ^ Attributes of @\
@ element
-> (a -> Attribute) -- ^ Attributes of each @\@ element
-> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html'
@@ -308,11 +308,27 @@ encodeTable ::
-> Html
encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs =
H.table ! tableAttrs $ do
- for_ mtheadAttrs $ \(theadAttrs,theadTrAttrs) -> do
- H.thead ! theadAttrs $ H.tr ! theadTrAttrs $ do
- Encode.headerMonoidalGeneral colonnade (wrapContent H.th)
+ case E.headednessExtractForall of
+ Nothing -> return mempty
+ Just extractForall -> do
+ let (theadAttrs,theadTrAttrs) = extract mtheadAttrs
+ H.thead ! theadAttrs $ H.tr ! theadTrAttrs $ do
+ -- E.headerMonoidalGeneral colonnade (wrapContent H.th)
+ foldlMapM' (wrapContent H.th . extract . E.oneColonnadeHead) (E.getColonnade colonnade)
+ where
+ extract :: forall y. h y -> y
+ extract = E.runExtractForall extractForall
encodeBody trAttrs wrapContent tbodyAttrs colonnade xs
+foldlMapM' :: forall g b a m. (Foldable g, Monoid b, Monad m) => (a -> m b) -> g a -> m b
+foldlMapM' f xs = foldr f' pure xs mempty
+ where
+ f' :: a -> (b -> m b) -> b -> m b
+ f' x k bl = do
+ br <- f x
+ let !b = mappend bl br
+ k b
+
-- | Encode a table with tiered header rows.
-- >>> let cor = mconcat [cap "Personal" (fmap htmlCell tableEmpA), cap "Work" tableEmpB]
-- >>> let fascia = FasciaCap (HA.class_ "category") (FasciaBase (HA.class_ "subcategory"))
@@ -360,11 +376,11 @@ encodeCappedTable :: Foldable f
-> f a -- ^ Collection of data
-> Html
encodeCappedTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs fascia cornice xs = do
- let colonnade = Encode.discard cornice
- annCornice = Encode.annotate cornice
+ let colonnade = E.discard cornice
+ annCornice = E.annotate cornice
H.table ! tableAttrs $ do
H.thead ! theadAttrs $ do
- Encode.headersMonoidal
+ E.headersMonoidal
(Just (fascia, \attrs theHtml -> H.tr ! attrs $ theHtml))
[ ( \msz c -> case msz of
Just sz -> wrapContent H.th c ! HA.colspan (H.toValue (show sz))
@@ -374,10 +390,10 @@ encodeCappedTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs fascia co
]
annCornice
-- H.tr ! trAttrs $ do
- -- Encode.headerMonoidalGeneral colonnade (wrapContent H.th)
+ -- E.headerMonoidalGeneral colonnade (wrapContent H.th)
encodeBody trAttrs wrapContent tbodyAttrs colonnade xs
-encodeBody :: (Foldable h, Foldable f)
+encodeBody :: Foldable f
=> (a -> Attribute) -- ^ Attributes of each @\
@ element
-> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html'
-> Attribute -- ^ Attributes of @\
@ element
@@ -387,52 +403,30 @@ encodeBody :: (Foldable h, Foldable f)
encodeBody trAttrs wrapContent tbodyAttrs colonnade xs = do
H.tbody ! tbodyAttrs $ do
forM_ xs $ \x -> do
- H.tr ! trAttrs x $ Encode.rowMonoidal colonnade (wrapContent H.td) x
+ H.tr ! trAttrs x $ E.rowMonoidal colonnade (wrapContent H.td) x
--- | Encode a table with a header. Table cells may have attributes
+-- | Encode a table. Table cells may have attributes
-- applied to them.
-encodeHeadedCellTable ::
+encodeCellTable ::
Foldable f
=> Attribute -- ^ Attributes of @\@ element
-> Colonnade Headed a Cell -- ^ How to encode data as columns
-> f a -- ^ Collection of data
-> Html
-encodeHeadedCellTable = encodeTable
- (Just (mempty,mempty)) mempty (const mempty) htmlFromCell
+encodeCellTable = encodeTable
+ (E.headednessPure (mempty,mempty)) mempty (const mempty) htmlFromCell
--- | Encode a table without a header. Table cells may have attributes
--- applied to them.
-encodeHeadlessCellTable ::
- Foldable f
- => Attribute -- ^ Attributes of @\@ element
- -> Colonnade Headless a Cell -- ^ How to encode data as columns
- -> f a -- ^ Collection of data
- -> Html
-encodeHeadlessCellTable = encodeTable
- Nothing mempty (const mempty) htmlFromCell
-
--- | Encode a table with a header. Table cell element do not have
+-- | Encode a table. Table cell element do not have
-- any attributes applied to them.
-encodeHeadedHtmlTable ::
- Foldable f
+encodeHtmlTable ::
+ (Foldable f, E.Headedness h)
=> Attribute -- ^ Attributes of @\@ element
- -> Colonnade Headed a Html -- ^ How to encode data as columns
+ -> Colonnade h a Html -- ^ How to encode data as columns
-> f a -- ^ Collection of data
-> Html
-encodeHeadedHtmlTable = encodeTable
- (Just (mempty,mempty)) mempty (const mempty) ($)
-
--- | Encode a table without a header. Table cells do not have
--- any attributes applied to them.
-encodeHeadlessHtmlTable ::
- Foldable f
- => Attribute -- ^ Attributes of @\@ element
- -> Colonnade Headless a Html -- ^ How to encode data as columns
- -> f a -- ^ Collection of data
- -> Html
-encodeHeadlessHtmlTable = encodeTable
- Nothing mempty (const mempty) ($)
+encodeHtmlTable = encodeTable
+ (E.headednessPure (mempty,mempty)) mempty (const mempty) ($)
-- | Convert a 'Cell' to 'Html' by wrapping the content with a tag
-- and applying the 'Cell' attributes to that tag.
diff --git a/stack.yaml b/stack.yaml
index e9b0485..05765d9 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-8.0
+resolver: lts-10.4
packages:
- 'colonnade'
- 'yesod-colonnade'
diff --git a/yesod-colonnade/src/Yesod/Colonnade.hs b/yesod-colonnade/src/Yesod/Colonnade.hs
index 845bb22..4b7ea4e 100644
--- a/yesod-colonnade/src/Yesod/Colonnade.hs
+++ b/yesod-colonnade/src/Yesod/Colonnade.hs
@@ -15,10 +15,8 @@ module Yesod.Colonnade
, anchorCell
, anchorWidget
-- * Apply
- , encodeHeadedWidgetTable
- , encodeHeadlessWidgetTable
- , encodeHeadedCellTable
- , encodeHeadlessCellTable
+ , encodeWidgetTable
+ , encodeCellTable
, encodeDefinitionTable
, encodeListItems
) where
@@ -126,41 +124,27 @@ encodeDefinitionTable attrs enc a = table_ attrs $ tbody_ mempty $
widgetFromCell td_ theValue
) a
--- | If you are using the bootstrap css framework, then you may want
+-- | Encode an html table with attributes on the table cells.
+-- If you are using the bootstrap css framework, then you may want
-- to call this with the first argument as:
--
--- > encodeHeadedCellTable (HA.class_ "table table-striped") ...
-encodeHeadedCellTable :: Foldable f
+-- > encodeCellTable (HA.class_ "table table-striped") ...
+encodeCellTable :: (Foldable f, E.Headedness h)
=> Attribute -- ^ Attributes of @table@ element
- -> Colonnade Headed a (Cell site) -- ^ How to encode data as a row
+ -> Colonnade h a (Cell site) -- ^ How to encode data as a row
-> f a -- ^ Rows of data
-> WidgetT site IO ()
-encodeHeadedCellTable = encodeTable
- (E.Headed mempty) mempty (const mempty) widgetFromCell
+encodeCellTable = encodeTable
+ (E.headednessPure mempty) mempty (const mempty) widgetFromCell
-encodeHeadlessCellTable :: Foldable f
- => Attribute -- ^ Attributes of @table@ element
- -> Colonnade Headless a (Cell site) -- ^ How to encode data as columns
- -> f a -- ^ Rows of data
- -> WidgetT site IO ()
-encodeHeadlessCellTable = encodeTable
- E.Headless mempty (const mempty) widgetFromCell
-
-encodeHeadedWidgetTable :: Foldable f
- => Attribute -- ^ Attributes of @table@ element
- -> Colonnade Headed a (WidgetT site IO ()) -- ^ How to encode data as columns
- -> f a -- ^ Rows of data
- -> WidgetT site IO ()
-encodeHeadedWidgetTable = encodeTable
- (E.Headed mempty) mempty (const mempty) ($ mempty)
-
-encodeHeadlessWidgetTable :: Foldable f
+-- | Encode an html table.
+encodeWidgetTable :: (Foldable f, E.Headedness h)
=> Attribute -- ^ Attributes of @\@ element
- -> Colonnade Headless a (WidgetT site IO ()) -- ^ How to encode data as columns
+ -> Colonnade h a (WidgetT site IO ()) -- ^ How to encode data as columns
-> f a -- ^ Rows of data
-> WidgetT site IO ()
-encodeHeadlessWidgetTable = encodeTable
- E.Headless mempty (const mempty) ($ mempty)
+encodeWidgetTable = encodeTable
+ (E.headednessPure mempty) 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