diff --git a/blaze-colonnade.cabal b/blaze-colonnade.cabal --- a/blaze-colonnade.cabal +++ b/blaze-colonnade.cabal @@ -1,5 +1,5 @@ name: blaze-colonnade -version: 0.1 +version: 1.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/src/Text/Blaze/Colonnade.hs b/src/Text/Blaze/Colonnade.hs --- a/src/Text/Blaze/Colonnade.hs +++ b/src/Text/Blaze/Colonnade.hs @@ -11,7 +11,9 @@ -- >>> let rows = [("90-100",'A'),("80-89",'B'),("70-79",'C')] -- >>> printVeryCompactHtml (encodeHeadedHtmlTable mempty col rows) -- --- +-- +-- +-- -- -- -- @@ -25,6 +27,7 @@ , encodeHeadedCellTable , encodeHeadlessCellTable , encodeTable + , encodeCappedTable -- * Cell -- $build , Cell(..) @@ -33,11 +36,12 @@ , textCell , lazyTextCell , builderCell + , htmlFromCell -- * Interactive , printCompactHtml , printVeryCompactHtml -- * Tutorial - -- $example + -- $setup -- * Discussion -- $discussion @@ -45,7 +49,7 @@ import Text.Blaze (Attribute,(!)) import Text.Blaze.Html (Html, toHtml) -import Colonnade (Colonnade,Headed,Headless) +import Colonnade (Colonnade,Headed,Headless,Fascia,Cornice) import Data.Text (Text) import Control.Monad import Data.Monoid @@ -63,17 +67,16 @@ import qualified Data.Text.Lazy as LText import qualified Data.Text.Lazy.Builder as TBuilder --- $example +-- $setup -- We start with a few necessary imports and some example data -- types: -- -- >>> :set -XOverloadedStrings -- >>> import Data.Monoid (mconcat,(<>)) -- >>> import Data.Char (toLower) --- >>> import Data.Functor.Contravariant (Contravariant(contramap)) --- >>> import Colonnade (Colonnade,Headed,Headless,headed) +-- >>> import Data.Profunctor (Profunctor(lmap)) +-- >>> import Colonnade (Colonnade,Headed,Headless,headed,cap,Fascia(..)) -- >>> import Text.Blaze.Html (Html, toHtml, toValue) --- >>> import qualified Colonnade as C -- >>> import qualified Text.Blaze.Html5 as H -- >>> data Department = Management | Sales | Engineering deriving (Show,Eq) -- >>> data Employee = Employee { name :: String, department :: Department, age :: Int } @@ -93,7 +96,7 @@ -- engineers using a @\@ tag. -- -- >>> :{ --- let tableEmpA :: Colonnade Headed Html Employee +-- let tableEmpA :: Colonnade Headed Employee Html -- tableEmpA = mconcat -- [ headed "Name" $ \emp -> case department emp of -- Engineering -> H.strong (toHtml (name emp)) @@ -113,8 +116,10 @@ -- >>> printCompactHtml (encodeHeadedHtmlTable customAttrs tableEmpA employees) --
GradeLetter
GradeLetter
90-100A
80-89B
-- --- --- +-- +-- +-- +-- -- -- -- @@ -146,7 +151,7 @@ -- let\'s build a table that encodes departments: -- -- >>> :{ --- let tableDept :: Colonnade Headed Cell Department +-- let tableDept :: Colonnade Headed Department Cell -- tableDept = mconcat -- [ headed "Dept." $ \d -> Cell -- (HA.class_ (toValue (map toLower (show d)))) @@ -161,45 +166,35 @@ -- 'encodeHeadedCellTable' instead of 'encodeHeadedHtmlTable': -- -- >>> let twoDepts = [Sales,Management] --- >>> printCompactHtml (encodeHeadedCellTable customAttrs tableDept twoDepts) +-- >>> printVeryCompactHtml (encodeHeadedCellTable customAttrs tableDept twoDepts) --
NameAge
NameAge
-- --- +-- -- -- --- --- --- --- --- --- +-- +-- -- --
Dept.
Dept.
Sales
Management
Sales
Management
-- -- The attributes on the @\@ elements show up as they are expected to. --- Now, we take advantage of the @Contravariant@ instance of 'Colonnade' to allow +-- Now, we take advantage of the @Profunctor@ instance of 'Colonnade' to allow -- this to work on @Employee@\'s instead: -- --- >>> :t contramap --- contramap :: Contravariant f => (a -> b) -> f b -> f a --- >>> let tableEmpB = contramap department tableDept +-- >>> :t lmap +-- lmap :: Profunctor p => (a -> b) -> p b c -> p a c +-- >>> let tableEmpB = lmap department tableDept -- >>> :t tableEmpB --- tableEmpB :: Colonnade Headed Cell Employee --- >>> printCompactHtml (encodeHeadedCellTable customAttrs tableEmpB employees) +-- tableEmpB :: Colonnade Headed Employee Cell +-- >>> printVeryCompactHtml (encodeHeadedCellTable customAttrs tableEmpB employees) -- -- --- +-- -- -- --- --- --- --- --- --- --- --- --- +-- +-- +-- -- --
Dept.
Dept.
Sales
Engineering
Management
Sales
Engineering
Management
-- @@ -212,23 +207,25 @@ -- prevents a straightforward monoidal append: -- -- >>> :t tableEmpA --- tableEmpA :: Colonnade Headed Html Employee +-- tableEmpA :: Colonnade Headed Employee Html -- >>> :t tableEmpB --- tableEmpB :: Colonnade Headed Cell Employee +-- tableEmpB :: Colonnade Headed Employee Cell -- --- We can upcast the content type with 'Colonnade.mapContent'. +-- We can upcast the content type with 'fmap'. -- Monoidal append is then well-typed, and the resulting 'Colonnade' -- can be applied to the employees: -- --- >>> let tableEmpC = C.mapContent htmlCell tableEmpA <> tableEmpB +-- >>> let tableEmpC = fmap htmlCell tableEmpA <> tableEmpB -- >>> :t tableEmpC --- tableEmpC :: Colonnade Headed Cell Employee +-- tableEmpC :: Colonnade Headed Employee Cell -- >>> printCompactHtml (encodeHeadedCellTable customAttrs tableEmpC employees) -- -- --- --- --- +-- +-- +-- +-- +-- -- -- -- @@ -301,67 +298,139 @@ -- used to add attributes to the generated @\@ elements. encodeTable :: (Foldable f, Foldable h) - => Maybe Attribute -- ^ Attributes of @\@, pass 'Nothing' to omit @\@ + => Maybe (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' -> Attribute -- ^ Attributes of @\@ element - -> Colonnade h c a -- ^ How to encode data as a row + -> Colonnade h a c -- ^ How to encode data as a row -> f a -- ^ Collection of data -> Html encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs = H.table ! tableAttrs $ do - for_ mtheadAttrs $ \theadAttrs -> do - H.thead ! theadAttrs $ do + for_ mtheadAttrs $ \(theadAttrs,theadTrAttrs) -> do + H.thead ! theadAttrs $ H.tr ! theadTrAttrs $ do Encode.headerMonoidalGeneral colonnade (wrapContent H.th) - H.tbody ! tbodyAttrs $ do - forM_ xs $ \x -> do - H.tr ! trAttrs x $ Encode.rowMonoidal colonnade (wrapContent H.td) x + encodeBody trAttrs wrapContent tbodyAttrs colonnade xs +-- | 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")) +-- >>> printCompactHtml (encodeCappedCellTable mempty fascia cor [head employees]) +--
NameAgeDept.
NameAgeDept.
+-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +--
PersonalWork
NameAgeDept.
Thaddeus34Sales
+ +encodeCappedCellTable :: Foldable f + => Attribute -- ^ Attributes of @\@ element + -> Fascia p Attribute -- ^ Attributes for @\@ elements in the @\@ + -> Cornice p a Cell + -> f a -- ^ Collection of data + -> Html +encodeCappedCellTable = encodeCappedTable mempty mempty (const mempty) htmlFromCell + +-- | Encode a table with tiered header rows. This is the most general function +-- in this library for encoding a 'Cornice'. +-- +encodeCappedTable :: Foldable f + => Attribute -- ^ Attributes of @\@ + -> Attribute -- ^ Attributes of @\@ element + -> (a -> Attribute) -- ^ Attributes of each @\@ element in the @\@ + -> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html' + -> Attribute -- ^ Attributes of @\@ element + -> Fascia p Attribute -- ^ Attributes for @\@ elements in the @\@ + -> Cornice p a c + -> 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 + H.table ! tableAttrs $ do + H.thead ! theadAttrs $ do + Encode.headersMonoidal + (Just (fascia, \attrs theHtml -> H.tr ! attrs $ theHtml)) + [(\sz c -> wrapContent H.th c ! HA.colspan (H.toValue (show sz)),id)] + annCornice + -- H.tr ! trAttrs $ do + -- Encode.headerMonoidalGeneral colonnade (wrapContent H.th) + encodeBody trAttrs wrapContent tbodyAttrs colonnade xs + +encodeBody :: (Foldable h, Foldable f) + => (a -> Attribute) -- ^ Attributes of each @\@ element + -> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html' + -> Attribute -- ^ Attributes of @\@ element + -> Colonnade h a c -- ^ How to encode data as a row + -> f a -- ^ Collection of data + -> Html +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 + + -- | Encode a table with a header. Table cells may have attributes -- applied to them. encodeHeadedCellTable :: Foldable f => Attribute -- ^ Attributes of @\@ element - -> Colonnade Headed Cell a -- ^ How to encode data as columns + -> Colonnade Headed a Cell -- ^ How to encode data as columns -> f a -- ^ Collection of data -> Html encodeHeadedCellTable = encodeTable - (Just mempty) mempty (const mempty) htmlFromCell + (Just (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 Cell a -- ^ How to encode data as columns + -> 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 cells cannot have attributes --- applied to them. +-- | Encode a table with a header. Table cell element do not have +-- any attributes applied to them. encodeHeadedHtmlTable :: Foldable f => Attribute -- ^ Attributes of @\@ element - -> Colonnade Headed Html a -- ^ How to encode data as columns + -> Colonnade Headed a Html -- ^ How to encode data as columns -> f a -- ^ Collection of data -> Html encodeHeadedHtmlTable = encodeTable - (Just mempty) mempty (const mempty) ($) + (Just (mempty,mempty)) mempty (const mempty) ($) --- | Encode a table without a header. Table cells cannot have attributes --- applied to them. +-- | 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 Html a -- ^ How to encode data as columns + -> Colonnade Headless a Html -- ^ How to encode data as columns -> f a -- ^ Collection of data -> Html encodeHeadlessHtmlTable = encodeTable Nothing mempty (const mempty) ($) +-- | Convert a 'Cell' to 'Html' by wrapping the content with a tag +-- and applying the 'Cell' attributes to that tag. htmlFromCell :: (Html -> Html) -> Cell -> Html htmlFromCell f (Cell attr content) = f ! attr $ content @@ -448,7 +517,6 @@ . removeWhitespaceAfterTag "span" . removeWhitespaceAfterTag "em" . removeWhitespaceAfterTag "tr" - . removeWhitespaceAfterTag "thead" . Pretty.renderHtml