From 049e4d4e13b939a0186dd1a52aa7b605c9c2ab42 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Tue, 7 Feb 2017 09:51:05 -0500 Subject: [PATCH] finish improving docs --- blaze-colonnade/src/Text/Blaze/Colonnade.hs | 163 ++++++++++++++++---- colonnade/src/Colonnade.hs | 25 ++- 2 files changed, 152 insertions(+), 36 deletions(-) diff --git a/blaze-colonnade/src/Text/Blaze/Colonnade.hs b/blaze-colonnade/src/Text/Blaze/Colonnade.hs index ef3e41d..b1a6cb4 100644 --- a/blaze-colonnade/src/Text/Blaze/Colonnade.hs +++ b/blaze-colonnade/src/Text/Blaze/Colonnade.hs @@ -1,8 +1,25 @@ --- | Build HTML tables using @blaze-html@ and @colonnade@. +-- | 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 +-- recommended that users read the documentation for @colonnade@ first, +-- since this library builds on the abstractions introduced there. +-- A concise example of this library\'s use: +-- +-- >>> :set -XOverloadedStrings +-- >>> :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) +-- +-- +-- +-- +-- +-- +-- +--
GradeLetter
90-100A
80-89B
70-79C
module Text.Blaze.Colonnade - ( -- * Example - -- $example - -- * Apply + ( -- * Apply encodeHeadedHtmlTable , encodeHeadlessHtmlTable , encodeHeadedCellTable @@ -17,7 +34,11 @@ module Text.Blaze.Colonnade , lazyTextCell , builderCell -- * Interactive - , prettyPrintTable + , printCompactHtml + , printVeryCompactHtml + -- * Tutorial + -- $example + -- * Discussion -- $discussion ) where @@ -69,7 +90,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- -- Let's build a table that displays the name and the age -- of an employee. Additionally, we will emphasize the names of --- engineers using a @@ tag. +-- engineers using a @\@ tag. -- -- >>> :{ -- let tableEmpA :: Colonnade Headed Html Employee @@ -89,7 +110,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- Let\'s continue: -- -- >>> let customAttrs = HA.class_ "stylish-table" <> HA.id "main-table" --- >>> prettyPrintTable (encodeHeadedHtmlTable customAttrs tableEmpA employees) +-- >>> printCompactHtml (encodeHeadedHtmlTable customAttrs tableEmpA employees) -- -- -- @@ -111,12 +132,12 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- --
Name
-- --- Excellent. As expected, Lucia\'s name is wrapped in a @@ tag +-- Excellent. As expected, Lucia\'s name is wrapped in a @\@ tag -- since she is an engineer. -- -- One limitation of using 'Html' as the content -- type of a 'Colonnade' is that we are unable to add attributes to --- the @@ and @@ elements. This library provides the 'Cell' type +-- the @\@ and @\@ elements. This library provides the 'Cell' type -- to work around this problem. A 'Cell' is just 'Html' content and a set -- of attributes to be applied to its parent @@ or @@. To illustrate -- how its use, another employee table will be built. This table will @@ -133,11 +154,14 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- ] -- :} -- --- We can try it out on a list of departments. We need to use +-- Again, @OverloadedStrings@ plays a role, this time allowing the +-- 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': -- -- >>> let twoDepts = [Sales,Management] --- >>> prettyPrintTable (encodeHeadedCellTable customAttrs tableDept twoDepts) +-- >>> printCompactHtml (encodeHeadedCellTable customAttrs tableDept twoDepts) -- -- -- @@ -152,15 +176,16 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- --
Dept.
-- --- We can take advantage of 'Colonnade'\'s 'Contravariant' instance to allow --- this to work on 'Employee'\'s instead: +-- The attributes on the @\@ elements show up as they are expected to. +-- Now, we take advantage of the @Contravariant@ 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 tableEmpB -- tableEmpB :: Colonnade Headed Cell Employee --- >>> prettyPrintTable (encodeHeadedCellTable customAttrs tableEmpB employees) +-- >>> printCompactHtml (encodeHeadedCellTable customAttrs tableEmpB employees) -- -- -- @@ -177,19 +202,66 @@ import qualified Data.Text.Lazy.Builder as TBuilder -- -- --
Dept.
- +-- +-- This table shows the department of each of our three employees, additionally +-- making a lowercased version of the department into a class name for the @\@. +-- This table is nice for illustrative purposes, but it does not provide all the +-- information that we have about the employees. If we combine it with the +-- earlier table we wrote, we can present everything in the table. One small +-- roadblock is that the types of @tableEmpA@ and @tableEmpB@ do not match, which +-- prevents a straightforward monoidal append: +-- +-- >>> :t tableEmpA +-- tableEmpA :: Colonnade Headed Html Employee +-- >>> :t tableEmpB +-- tableEmpB :: Colonnade Headed Cell Employee +-- +-- We can upcast the content type with 'Colonnade.mapContent'. +-- Monoidal append is then well-typed, and the resulting 'Colonnade' +-- can be applied to the employees: +-- +-- >>> let tableEmpC = C.mapContent htmlCell tableEmpA <> tableEmpB +-- >>> :t tableEmpC +-- tableEmpC :: Colonnade Headed Cell Employee +-- >>> printCompactHtml (encodeHeadedCellTable customAttrs tableEmpC employees) +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +-- +--
NameAgeDept.
Thaddeus34Sales
Lucia33Engineering
Pranav57Management
-- $build -- -- The 'Cell' type is used to build a 'Colonnade' that -- has 'Html' content inside table cells and may optionally --- have attributes added to the @@ or @@ elements +-- have attributes added to the @\@ or @\@ elements -- that wrap this HTML content. --- | The attributes that will be applied to a @@ and --- the HTML content that will go inside it. +-- | The attributes that will be applied to a @\@ and +-- the HTML content that will go inside it. When using +-- this type, remember that 'Attribute', defined in @blaze-markup@, +-- is actually a collection of attributes, not a single attribute. data Cell = Cell - { cellAttributes :: !Attribute + { cellAttribute :: !Attribute , cellHtml :: !Html } @@ -208,6 +280,10 @@ htmlCell = Cell mempty stringCell :: String -> Cell stringCell = htmlCell . fromString +-- | Create a 'Cell' from a 'Char' +charCell :: Char -> Cell +charCell = stringCell . pure + -- | Create a 'Cell' from a 'Text' textCell :: Text -> Cell textCell = htmlCell . toHtml @@ -222,11 +298,11 @@ builderCell = lazyTextCell . TBuilder.toLazyText encodeTable :: (Foldable f, Foldable h) - => Maybe Attribute -- ^ Attributes of @@, pass 'Nothing' to omit @@ - -> Attribute -- ^ Attributes of @@ element - -> (a -> Attribute) -- ^ Attributes of each @@ element + => Maybe Attribute -- ^ Attributes of @\@, 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 + -> Attribute -- ^ Attributes of @\@ element -> Colonnade h c a -- ^ How to encode data as a row -> f a -- ^ Collection of data -> Html @@ -241,7 +317,7 @@ encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs = encodeHeadedCellTable :: Foldable f - => Attribute -- ^ Attributes of @
@ element + => Attribute -- ^ Attributes of @\@ element -> Colonnade Headed Cell a -- ^ How to encode data as columns -> f a -- ^ Collection of data -> Html @@ -250,7 +326,7 @@ encodeHeadedCellTable = encodeTable encodeHeadlessCellTable :: Foldable f - => Attribute -- ^ Attributes of @
@ element + => Attribute -- ^ Attributes of @\@ element -> Colonnade Headless Cell a -- ^ How to encode data as columns -> f a -- ^ Collection of data -> Html @@ -259,7 +335,7 @@ encodeHeadlessCellTable = encodeTable encodeHeadedHtmlTable :: Foldable f - => Attribute -- ^ Attributes of @
@ element + => Attribute -- ^ Attributes of @\@ element -> Colonnade Headed Html a -- ^ How to encode data as columns -> f a -- ^ Collection of data -> Html @@ -268,7 +344,7 @@ encodeHeadedHtmlTable = encodeTable encodeHeadlessHtmlTable :: Foldable f - => Attribute -- ^ Attributes of @
@ element + => Attribute -- ^ Attributes of @\@ element -> Colonnade Headless Html a -- ^ How to encode data as columns -> f a -- ^ Collection of data -> Html @@ -335,12 +411,33 @@ removeWhitespaceAfterTag chosenTag = likelyRes :: String -> String likelyRes = res . (c:) -prettyPrintTable :: Html -> IO () -prettyPrintTable = putStrLn +-- | Pretty print an HTML table, stripping whitespace from inside @\@, +-- @\@, and common inline tags. The implementation is inefficient and is +-- incorrect in many corner cases. It is only provided to reduce the line +-- count of the HTML printed by GHCi examples in this module\'s documentation. +-- Use of this function is discouraged. +printCompactHtml :: Html -> IO () +printCompactHtml = putStrLn . List.dropWhileEnd (== '\n') . removeWhitespaceAfterTag "td" . removeWhitespaceAfterTag "th" . removeWhitespaceAfterTag "strong" + . removeWhitespaceAfterTag "span" + . removeWhitespaceAfterTag "em" + . Pretty.renderHtml + +-- | Similar to 'printCompactHtml'. Additionally strips all whitespace inside +-- @\@ elements and @\@ elements. +printVeryCompactHtml :: Html -> IO () +printVeryCompactHtml = putStrLn + . List.dropWhileEnd (== '\n') + . removeWhitespaceAfterTag "td" + . removeWhitespaceAfterTag "th" + . removeWhitespaceAfterTag "strong" + . removeWhitespaceAfterTag "span" + . removeWhitespaceAfterTag "em" + . removeWhitespaceAfterTag "tr" + . removeWhitespaceAfterTag "thead" . Pretty.renderHtml @@ -351,7 +448,7 @@ prettyPrintTable = putStrLn -- -- > Foldable a => Colonnade Headedness Cell a -> f a -> Html -- --- The 'Colonnade'\'s content type is 'Cell', but the content +-- The 'Colonnade' content type is 'Cell', but the content -- type of the result is 'Html'. It may not be immidiately clear why -- this is useful done. Another strategy, which this library also -- uses, is to write @@ -359,9 +456,9 @@ prettyPrintTable = putStrLn -- -- > Foldable a => Colonnade Headedness Html a -> f a -> Html -- --- When the 'Colonnade'\'s content type is 'Html', then the header --- content is rendered as the child of a @
@ and the row --- content the child of a @@. However, it is not possible +-- When the 'Colonnade' content type is 'Html', then the header +-- content is rendered as the child of a @\@ and the row +-- content the child of a @\@. However, it is not possible -- to add attributes to these parent elements. To accomodate this -- situation, it is necessary to introduce 'Cell', which includes -- the possibility of attributes on the parent node. diff --git a/colonnade/src/Colonnade.hs b/colonnade/src/Colonnade.hs index 96a72e9..f824e97 100644 --- a/colonnade/src/Colonnade.hs +++ b/colonnade/src/Colonnade.hs @@ -16,6 +16,7 @@ module Colonnade , columns , bool , replaceWhen + , modifyWhen , mapContent -- * Ascii Table , ascii @@ -180,10 +181,28 @@ bool :: -> Colonnade f c a bool h p onTrue onFalse = singleton h (Data.Bool.bool <$> onFalse <*> onTrue <*> p) -replaceWhen :: - c - -> (a -> Bool) +-- | Modify the contents of cells in rows whose values satisfy the +-- given predicate. Header content is unaffected. With an HTML backend, +-- this can be used to strikethrough the contents of cells with data that is +-- considered invalid. +modifyWhen :: + (c -> c) -- ^ Content change + -> (a -> Bool) -- ^ Row predicate + -> Colonnade f c a -- ^ Original 'Colonnade' -> Colonnade f c a +modifyWhen changeContent p (Colonnade v) = Colonnade + ( Vector.map + (\(OneColonnade h encode) -> OneColonnade h $ \a -> + if p a then changeContent (encode a) else encode a + ) v + ) + +-- | Replace the contents of cells in rows whose values satisfy the +-- given predicate. Header content is unaffected. +replaceWhen :: + c -- ^ New content + -> (a -> Bool) -- ^ Row predicate + -> Colonnade f c a -- ^ Original 'Colonnade' -> Colonnade f c a replaceWhen newContent p (Colonnade v) = Colonnade ( Vector.map