finish improving docs

2017-02-07 09:51:05 -05:00 · 2017-02-07 09:51:05 -05:00 · 049e4d4e13
commit 049e4d4e13
parent 9d03776c03
2 changed files with 152 additions and 36 deletions
--- 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)
+-- <table>
+--     <thead><th>Grade</th><th>Letter</th></thead>
+--     <tbody>
+--         <tr><td>90-100</td><td>A</td></tr>
+--         <tr><td>80-89</td><td>B</td></tr>
+--         <tr><td>70-79</td><td>C</td></tr>
+--     </tbody>
+-- </table>
 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 @<strong>@ tag.
+-- engineers using a @\<strong\>@ 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)
 -- <table class="stylish-table" id="main-table">
 --     <thead>
 --         <th>Name</th>
@ -111,12 +132,12 @@ import qualified Data.Text.Lazy.Builder as TBuilder
 --     </tbody>
 -- </table>
 -- 
-- Excellent. As expected, Lucia\'s name is wrapped in a @<strong>@ tag 
+-- Excellent. As expected, Lucia\'s name is wrapped in a @\<strong\>@ 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 @<td>@ and @<th>@ elements. This library provides the 'Cell' type
+-- the @\<td\>@ and @\<th\>@ 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 @<th>@ or @<td>@. 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)
 -- <table class="stylish-table" id="main-table">
 --     <thead>
 --         <th>Dept.</th>
@ -152,15 +176,16 @@ import qualified Data.Text.Lazy.Builder as TBuilder
 --     </tbody>
 -- </table>
 -- 
-- We can take advantage of 'Colonnade'\'s 'Contravariant' instance to allow
-- this to work on 'Employee'\'s instead:
+-- The attributes on the @\<td\>@ 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)
 -- <table class="stylish-table" id="main-table">
 --     <thead>
 --         <th>Dept.</th>
@ -177,19 +202,66 @@ import qualified Data.Text.Lazy.Builder as TBuilder
 --         </tr>
 --     </tbody>
 -- </table>
-
+-- 
+-- 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 @\<td\>@.
+-- 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)
+-- <table class="stylish-table" id="main-table">
+--     <thead>
+--         <th>Name</th>
+--         <th>Age</th>
+--         <th>Dept.</th>
+--     </thead>
+--     <tbody>
+--         <tr>
+--             <td>Thaddeus</td>
+--             <td>34</td>
+--             <td class="sales">Sales</td>
+--         </tr>
+--         <tr>
+--             <td><strong>Lucia</strong></td>
+--             <td>33</td>
+--             <td class="engineering">Engineering</td>
+--         </tr>
+--         <tr>
+--             <td>Pranav</td>
+--             <td>57</td>
+--             <td class="management">Management</td>
+--         </tr>
+--     </tbody>
+-- </table>

 -- $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 @<td>@ or @<th>@ elements
+-- have attributes added to the @\<td\>@ or @\<th\>@ elements
 -- that wrap this HTML content.

-- | The attributes that will be applied to a @<td>@ and
--   the HTML content that will go inside it.
+-- | The attributes that will be applied to a @\<td\>@ 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 @<thead>@, pass 'Nothing' to omit @<thead>@
-  -> Attribute -- ^ Attributes of @<tbody>@ element
-  -> (a -> Attribute) -- ^ Attributes of each @<tr>@ element
+  => Maybe Attribute -- ^ Attributes of @\<thead\>@, pass 'Nothing' to omit @\<thead\>@
+  -> Attribute -- ^ Attributes of @\<tbody\>@ element
+  -> (a -> Attribute) -- ^ Attributes of each @\<tr\>@ element
  -> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html'
-  -> Attribute -- ^ Attributes of @<table>@ element
+  -> Attribute -- ^ Attributes of @\<table\>@ 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 @<table>@ element
+  => Attribute -- ^ Attributes of @\<table\>@ 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 @<table>@ element
+  => Attribute -- ^ Attributes of @\<table\>@ 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 @<table>@ element
+  => Attribute -- ^ Attributes of @\<table\>@ 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 @<table>@ element
+  => Attribute -- ^ Attributes of @\<table\>@ 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 @\<td\>@,
+--   @\<th\>@, 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
+--   @\<tr\>@ elements and @\<thead\>@ 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 @<th>@ and the row
-- content the child of a @<td>@. However, it is not possible
+-- When the 'Colonnade' content type is 'Html', then the header
+-- content is rendered as the child of a @\<th\>@ and the row
+-- content the child of a @\<td\>@. 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.
--- 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