@ 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)
--
--
-- | Dept. |
@@ -152,15 +176,16 @@ import qualified Data.Text.Lazy.Builder as TBuilder
--
--
--
--- 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)
--
--
-- | Dept. |
@@ -177,19 +202,66 @@ import qualified Data.Text.Lazy.Builder as TBuilder
--
--
--
-
+--
+-- 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)
+--
+--
+-- | Name |
+-- Age |
+-- Dept. |
+--
+--
+--
+-- | Thaddeus |
+-- 34 |
+-- Sales |
+--
+--
+-- | Lucia |
+-- 33 |
+-- Engineering |
+--
+--
+-- | Pranav |
+-- 57 |
+-- Management |
+--
+--
+--
-- $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
|