diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,7 @@ +# Revision history for blaze-colonnade + +## 1.2.3.0 -- 2024-03-06 + +* Update package metadata. +* Remove `profunctors` dependency. +* Export `charCell` and `encodeCappedCellTable`. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,5 @@ +To run doctests, first make sure `doctest` is on the `PATH` (i.e. `cabal install doctest`), then run the following commands: + +``` +cabal repl --build-depends=QuickCheck,profunctors --with-ghc=doctest --repl-options="-fno-warn-orphans -Wno-x-partial" blaze-colonnade +``` diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/blaze-colonnade.cabal b/blaze-colonnade.cabal --- a/blaze-colonnade.cabal +++ b/blaze-colonnade.cabal @@ -1,48 +1,43 @@ -name: blaze-colonnade -version: 1.2.2.1 -synopsis: blaze-html backend for colonnade -description: +cabal-version: 3.0 +name: blaze-colonnade +version: 1.2.3.0 +synopsis: blaze-html backend for colonnade +description: This library provides a backend for using blaze-html with colonnade. It generates standard HTML tables with ``, ``, ``, ``, `
`, and ``. -homepage: https://github.com/andrewthad/colonnade#readme -license: BSD3 -license-file: LICENSE -author: Andrew Martin -maintainer: andrew.thaddeus@gmail.com -copyright: 2017 Andrew Martin -category: web -build-type: Simple -cabal-version: >=1.10 --- Note: There is a dependency on profunctors whose only --- purpose is to make doctest work correctly. Since this --- library transitively depends on profunctors anyway, --- this is not a big deal. +homepage: https://github.com/byteverse/blaze-colonnade +bug-reports: https://github.com/byteverse/blaze-colonnade/issues +license: BSD-3-Clause +license-file: LICENSE +author: Andrew Martin +maintainer: amartin@layer3com.com +copyright: 2017 Andrew Martin +category: web +build-type: Simple +extra-doc-files: + CHANGELOG.md + README.md -library - hs-source-dirs: src - exposed-modules: - Text.Blaze.Colonnade - build-depends: - base >= 4.8 && < 5 - , colonnade >= 1.1 && < 1.3 - , blaze-markup >= 0.7 && < 0.9 - , blaze-html >= 0.8 && < 0.10 - , profunctors >= 5.0 && < 5.5 - , text >= 1.2 && < 1.3 - default-language: Haskell2010 +tested-with: GHC ==9.4.8 || ==9.6.3 || ==9.8.1 -test-suite test - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Main.hs - build-depends: - base >= 4.7 && <= 5 - , colonnade - , doctest +common build-settings default-language: Haskell2010 + ghc-options: -Wall -Wunused-packages + build-depends: base >=4.8 && <5 +library + import: build-settings + ghc-options: -O2 + hs-source-dirs: src + exposed-modules: Text.Blaze.Colonnade + build-depends: + , blaze-html >=0.8 + , blaze-markup >=0.7 + , colonnade >=1.1 + , text >=1.2 + source-repository head type: git - location: https://github.com/andrewthad/colonnade + location: git://github.com/byteverse/blaze-colonnade.git 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 @@ -2,46 +2,52 @@ {-# 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 --- 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 (encodeHtmlTable mempty col rows) --- --- --- --- --- --- --- --- --- ---
GradeLetter
90-100A
80-89B
70-79C
+{- | 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 (encodeHtmlTable mempty col rows) + + + + + + + + + +
GradeLetter
90-100A
80-89B
70-79C
+-} module Text.Blaze.Colonnade ( -- * Apply - encodeHtmlTable + encodeCappedCellTable + , encodeHtmlTable , encodeCellTable , encodeTable , encodeCappedTable + -- * Cell -- $build - , Cell(..) + , Cell (..) + , charCell , htmlCell , stringCell , textCell , lazyTextCell , builderCell , htmlFromCell + -- * Interactive , printCompactHtml , printVeryCompactHtml + -- * Tutorial -- $setup @@ -49,217 +55,216 @@ -- $discussion ) where -import Text.Blaze (Attribute,(!)) -import Text.Blaze.Html (Html, toHtml) -import Colonnade (Colonnade,Headed,Headless,Fascia,Cornice) -import Data.Text (Text) +import Colonnade (Colonnade, Cornice, Fascia, Headed) +import qualified Colonnade.Encode as E import Control.Monad -import Data.Semigroup -import Data.Monoid hiding ((<>)) -import Data.Foldable -import Data.String (IsString(..)) -import Data.Maybe (listToMaybe) import Data.Char (isSpace) +import Data.Foldable import qualified Data.List as List +import Data.Maybe (listToMaybe) +import Data.String (IsString (..)) +import Data.Text (Text) +import qualified Data.Text.Lazy as LText +import qualified Data.Text.Lazy.Builder as TBuilder +import Text.Blaze (Attribute, (!)) +import Text.Blaze.Html (Html, toHtml) 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 E -import qualified Data.Text as Text -import qualified Data.Text.Lazy as LText -import qualified Data.Text.Lazy.Builder as TBuilder --- $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.Profunctor (Profunctor(lmap)) --- >>> import Colonnade (Colonnade,Headed,Headless,headed,cap,Fascia(..)) --- >>> import Text.Blaze.Html (Html, toHtml, toValue) --- >>> import qualified Text.Blaze.Html5 as H --- >>> data Department = Management | Sales | Engineering deriving (Show,Eq) --- >>> data Employee = Employee { name :: String, department :: Department, age :: Int } --- --- We define some employees that we will display in a table: --- --- >>> :{ --- let employees = --- [ Employee "Thaddeus" Sales 34 --- , Employee "Lucia" Engineering 33 --- , Employee "Pranav" Management 57 --- ] --- :} --- --- 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. --- --- >>> :{ --- let tableEmpA :: Colonnade Headed Employee Html --- tableEmpA = mconcat --- [ headed "Name" $ \emp -> case department emp of --- Engineering -> H.strong (toHtml (name emp)) --- _ -> toHtml (name emp) --- , headed "Age" (toHtml . show . age) --- ] --- :} --- --- The type signature of @tableEmpA@ is inferrable but is written --- out for clarity in this example. Additionally, note that the first --- argument to 'headed' is of type 'Html', so @OverloadedStrings@ is --- necessary for the above example to compile. To avoid using this extension, --- it is possible to instead use 'toHtml' to convert a 'String' to 'Html'. --- Let\'s continue: --- --- >>> let customAttrs = HA.class_ "stylish-table" <> HA.id "main-table" --- >>> printCompactHtml (encodeHtmlTable customAttrs tableEmpA employees) --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
NameAge
Thaddeus34
Lucia33
Pranav57
--- --- 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 --- 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 --- contain a single column indicating the department of each employ. Each --- cell will be assigned a class name based on the department. To start off, --- let\'s build a table that encodes departments: --- --- >>> :{ --- let tableDept :: Colonnade Headed Department Cell --- tableDept = mconcat --- [ headed "Dept." $ \d -> Cell --- (HA.class_ (toValue (map toLower (show d)))) --- (toHtml (show d)) --- ] --- :} --- --- 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 --- 'encodeCellTable' instead of 'encodeHtmlTable': --- --- >>> let twoDepts = [Sales,Management] --- >>> printVeryCompactHtml (encodeCellTable customAttrs tableDept twoDepts) --- --- --- --- --- --- --- --- ---
Dept.
Sales
Management
--- --- The attributes on the @\@ elements show up as they are expected to. --- Now, we take advantage of the @Profunctor@ instance of 'Colonnade' to allow --- this to work on @Employee@\'s instead: --- --- >>> :t lmap --- lmap :: Profunctor p => (a -> b) -> p b c -> p a c --- >>> let tableEmpB = lmap department tableDept --- >>> :t tableEmpB --- tableEmpB :: Colonnade Headed Employee Cell --- >>> printVeryCompactHtml (encodeCellTable customAttrs tableEmpB employees) --- --- --- --- --- --- --- --- --- ---
Dept.
Sales
Engineering
Management
--- --- 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 Employee Html --- >>> :t tableEmpB --- tableEmpB :: Colonnade Headed Employee Cell --- --- 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 = fmap htmlCell tableEmpA <> tableEmpB --- >>> :t tableEmpC --- tableEmpC :: Colonnade Headed Employee Cell --- >>> printCompactHtml (encodeCellTable customAttrs tableEmpC employees) --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
NameAgeDept.
Thaddeus34Sales
Lucia33Engineering
Pranav57Management
+{- $setup +We start with a few necessary imports and some example data +types: --- $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 --- that wrap this HTML content. +>>> :set -XOverloadedStrings +>>> import Data.Monoid (mconcat,(<>)) +>>> import Data.Char (toLower) +>>> import Data.Profunctor (Profunctor(lmap)) +>>> import Colonnade (Colonnade,Headed,Headless,headed,cap,Fascia(..)) +>>> import Text.Blaze.Html (Html, toHtml, toValue) +>>> import qualified Text.Blaze.Html5 as H +>>> data Department = Management | Sales | Engineering deriving (Show,Eq) +>>> data Employee = Employee { name :: String, department :: Department, age :: Int } --- | 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. +We define some employees that we will display in a table: + +>>> :{ +let employees = + [ Employee "Thaddeus" Sales 34 + , Employee "Lucia" Engineering 33 + , Employee "Pranav" Management 57 + ] +:} + +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. + +>>> :{ +let tableEmpA :: Colonnade Headed Employee Html + tableEmpA = mconcat + [ headed "Name" $ \emp -> case department emp of + Engineering -> H.strong (toHtml (name emp)) + _ -> toHtml (name emp) + , headed "Age" (toHtml . show . age) + ] +:} + +The type signature of @tableEmpA@ is inferrable but is written +out for clarity in this example. Additionally, note that the first +argument to 'headed' is of type 'Html', so @OverloadedStrings@ is +necessary for the above example to compile. To avoid using this extension, +it is possible to instead use 'toHtml' to convert a 'String' to 'Html'. +Let\'s continue: + +>>> let customAttrs = HA.class_ "stylish-table" <> HA.id "main-table" +>>> printCompactHtml (encodeHtmlTable customAttrs tableEmpA employees) + + + + + + + + + + + + + + + + + + + + + +
NameAge
Thaddeus34
Lucia33
Pranav57
+ +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 +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 +contain a single column indicating the department of each employ. Each +cell will be assigned a class name based on the department. To start off, +let\'s build a table that encodes departments: + +>>> :{ +let tableDept :: Colonnade Headed Department Cell + tableDept = mconcat + [ headed "Dept." $ \d -> Cell + (HA.class_ (toValue (map toLower (show d)))) + (toHtml (show d)) + ] +:} + +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 +'encodeCellTable' instead of 'encodeHtmlTable': + +>>> let twoDepts = [Sales,Management] +>>> printVeryCompactHtml (encodeCellTable customAttrs tableDept twoDepts) + + + + + + + + +
Dept.
Sales
Management
+ +The attributes on the @\@ elements show up as they are expected to. +Now, we take advantage of the @Profunctor@ instance of 'Colonnade' to allow +this to work on @Employee@\'s instead: + +>>> :t lmap +lmap :: Profunctor p => (a -> b) -> p b c -> p a c +>>> let tableEmpB = lmap department tableDept +>>> :t tableEmpB +tableEmpB :: Colonnade Headed Employee Cell +>>> printVeryCompactHtml (encodeCellTable customAttrs tableEmpB employees) + + + + + + + + + +
Dept.
Sales
Engineering
Management
+ +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 Employee Html +>>> :t tableEmpB +tableEmpB :: Colonnade Headed Employee Cell + +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 = fmap htmlCell tableEmpA <> tableEmpB +>>> :t tableEmpC +tableEmpC :: Colonnade Headed Employee Cell +>>> printCompactHtml (encodeCellTable 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 +that wrap this HTML content. +-} + +{- | 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 { cellAttribute :: !Attribute , cellHtml :: !Html @@ -299,180 +304,227 @@ builderCell :: TBuilder.Builder -> Cell 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 :: 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' - -> Attribute -- ^ Attributes of @\@ element - -> Colonnade h a c -- ^ How to encode data as a row - -> f a -- ^ Collection of data - -> Html +{- | 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 :: + forall h f a c. + (Foldable f, E.Headedness h) => + -- | Attributes of @\@ and its @\@, pass 'Nothing' to omit @\@ + h (Attribute, Attribute) -> + -- | Attributes of @\@ element + Attribute -> + -- | Attributes of each @\@ element + (a -> Attribute) -> + -- | Wrap content and convert to 'Html' + ((Html -> Html) -> c -> Html) -> + -- | Attributes of @\@ element + Attribute -> + -- | How to encode data as a row + Colonnade h a c -> + -- | Collection of data + f a -> + Html encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs = H.table ! tableAttrs $ do case E.headednessExtractForall of Nothing -> return mempty Just extractForall -> do - let (theadAttrs,theadTrAttrs) = extract mtheadAttrs + 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 + 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 + 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")) --- >>> printCompactHtml (encodeCappedCellTable mempty fascia cor [head employees]) --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
PersonalWork
NameAgeDept.
Thaddeus34Sales
- -encodeCappedCellTable :: Foldable f - => Attribute -- ^ Attributes of @\@ element - -> Fascia p Attribute -- ^ Attributes for @\@ elements in the @\@ - -> Cornice Headed p a Cell - -> f a -- ^ Collection of data - -> Html +{- | 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]) + + + + + + + + + + + + + + + + + + + +
PersonalWork
NameAgeDept.
Thaddeus34Sales
+-} +encodeCappedCellTable :: + (Foldable f) => + -- | Attributes of @\@ element + Attribute -> + -- | Attributes for @\@ elements in the @\@ + Fascia p Attribute -> + Cornice Headed p a Cell -> + -- | Collection of data + f a -> + 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 Headed p a c - -> f a -- ^ Collection of data - -> Html +{- | Encode a table with tiered header rows. This is the most general function + in this library for encoding a 'Cornice'. +-} +encodeCappedTable :: + (Foldable f) => + -- | Attributes of @\@ + Attribute -> + -- | Attributes of @\@ element + Attribute -> + -- | Attributes of each @\@ element in the @\@ + (a -> Attribute) -> + -- | Wrap content and convert to 'Html' + ((Html -> Html) -> c -> Html) -> + -- | Attributes of @\@ element + Attribute -> + -- | Attributes for @\@ elements in the @\@ + Fascia p Attribute -> + Cornice Headed p a c -> + -- | Collection of data + f a -> + Html encodeCappedTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs fascia cornice xs = do let colonnade = E.discard cornice annCornice = E.annotate cornice H.table ! tableAttrs $ do H.thead ! theadAttrs $ do - E.headersMonoidal + E.headersMonoidal (Just (fascia, \attrs theHtml -> H.tr ! attrs $ theHtml)) - [ ( \msz c -> case msz of + [ + ( \msz c -> case msz of Just sz -> wrapContent H.th c ! HA.colspan (H.toValue (show sz)) Nothing -> mempty , id ) ] annCornice - -- H.tr ! trAttrs $ do - -- E.headerMonoidalGeneral colonnade (wrapContent H.th) + -- H.tr ! trAttrs $ do + -- E.headerMonoidalGeneral colonnade (wrapContent H.th) encodeBody trAttrs wrapContent tbodyAttrs colonnade xs -encodeBody :: 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 :: + (Foldable f) => + -- | Attributes of each @\@ element + (a -> Attribute) -> + -- | Wrap content and convert to 'Html' + ((Html -> Html) -> c -> Html) -> + -- | Attributes of @\@ element + Attribute -> + -- | How to encode data as a row + Colonnade h a c -> + -- | Collection of data + f a -> + Html encodeBody trAttrs wrapContent tbodyAttrs colonnade xs = do H.tbody ! tbodyAttrs $ do forM_ xs $ \x -> do H.tr ! trAttrs x $ E.rowMonoidal colonnade (wrapContent H.td) x - --- | Encode a table. Table cells may have attributes --- applied to them. -encodeCellTable :: - Foldable f - => Attribute -- ^ Attributes of @\@ element - -> Colonnade Headed a Cell -- ^ How to encode data as columns - -> f a -- ^ Collection of data - -> Html -encodeCellTable = encodeTable - (E.headednessPure (mempty,mempty)) mempty (const mempty) htmlFromCell +{- | Encode a table. Table cells may have attributes + applied to them. +-} +encodeCellTable :: + (Foldable f) => + -- | Attributes of @\@ element + Attribute -> + -- | How to encode data as columns + Colonnade Headed a Cell -> + -- | Collection of data + f a -> + Html +encodeCellTable = + encodeTable + (E.headednessPure (mempty, mempty)) + mempty + (const mempty) + htmlFromCell --- | Encode a table. Table cell element do not have --- any attributes applied to them. -encodeHtmlTable :: - (Foldable f, E.Headedness h) - => Attribute -- ^ Attributes of @\@ element - -> Colonnade h a Html -- ^ How to encode data as columns - -> f a -- ^ Collection of data - -> Html -encodeHtmlTable = encodeTable - (E.headednessPure (mempty,mempty)) mempty (const mempty) ($) +{- | Encode a table. Table cell element do not have + any attributes applied to them. +-} +encodeHtmlTable :: + (Foldable f, E.Headedness h) => + -- | Attributes of @\@ element + Attribute -> + -- | How to encode data as columns + Colonnade h a Html -> + -- | Collection of data + f a -> + Html +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. +{- | 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 data St = St - { stContext :: [String] - , stTagStatus :: TagStatus - , stResult :: String -> String -- ^ difference list + { _stContext :: [String] + , _stTagStatus :: TagStatus + , stResult :: String -> String + -- ^ difference list } -data TagStatus - = TagStatusSomeTag +data TagStatus + = TagStatusSomeTag | TagStatusOpening (String -> String) - | TagStatusOpeningAttrs - | TagStatusNormal + | TagStatusOpeningAttrs + | TagStatusNormal | TagStatusClosing (String -> String) | TagStatusAfterTag removeWhitespaceAfterTag :: String -> String -> String -removeWhitespaceAfterTag chosenTag = +removeWhitespaceAfterTag chosenTag = either id (\st -> stResult st "") . foldlM (flip f) (St [] TagStatusNormal id) - where + where f :: Char -> St -> Either String St f c (St ctx status res) = case status of TagStatusNormal | c == '<' -> Right (St ctx TagStatusSomeTag likelyRes) - | isSpace c -> if Just chosenTag == listToMaybe ctx - then Right (St ctx TagStatusNormal res) -- drops the whitespace - else Right (St ctx TagStatusNormal likelyRes) + | isSpace c -> + if Just chosenTag == listToMaybe ctx + then Right (St ctx TagStatusNormal res) -- drops the whitespace + else Right (St ctx TagStatusNormal likelyRes) | otherwise -> Right (St ctx TagStatusNormal likelyRes) TagStatusSomeTag | c == '/' -> Right (St ctx (TagStatusClosing id) likelyRes) | c == '>' -> Left "unexpected >" | c == '<' -> Left "unexpected <" - | otherwise -> Right (St ctx (TagStatusOpening (c:)) likelyRes) + | otherwise -> Right (St ctx (TagStatusOpening (c :)) likelyRes) TagStatusOpening tag | c == '>' -> Right (St (tag "" : ctx) TagStatusAfterTag likelyRes) | isSpace c -> Right (St (tag "" : ctx) TagStatusOpeningAttrs likelyRes) - | otherwise -> Right (St ctx (TagStatusOpening (tag . (c:))) likelyRes) + | otherwise -> Right (St ctx (TagStatusOpening (tag . (c :))) likelyRes) TagStatusOpeningAttrs | c == '>' -> Right (St ctx TagStatusAfterTag likelyRes) | otherwise -> Right (St ctx TagStatusOpeningAttrs likelyRes) @@ -480,70 +532,74 @@ | c == '>' -> do otherTags <- case ctx of [] -> Left "closing tag without any opening tag" - closestTag : otherTags -> if closestTag == tag "" - then Right otherTags - else Left $ "closing tag <" ++ tag "" ++ "> did not match opening tag <" ++ closestTag ++ ">" + closestTag : otherTags -> + if closestTag == tag "" + then Right otherTags + else Left $ "closing tag <" ++ tag "" ++ "> did not match opening tag <" ++ closestTag ++ ">" Right (St otherTags TagStatusAfterTag likelyRes) - | otherwise -> Right (St ctx (TagStatusClosing (tag . (c:))) likelyRes) + | otherwise -> Right (St ctx (TagStatusClosing (tag . (c :))) likelyRes) TagStatusAfterTag | c == '<' -> Right (St ctx TagStatusSomeTag likelyRes) - | isSpace c -> if Just chosenTag == listToMaybe ctx - then Right (St ctx TagStatusAfterTag res) -- drops the whitespace - else Right (St ctx TagStatusNormal likelyRes) + | isSpace c -> + if Just chosenTag == listToMaybe ctx + then Right (St ctx TagStatusAfterTag res) -- drops the whitespace + else Right (St ctx TagStatusNormal likelyRes) | otherwise -> Right (St ctx TagStatusNormal likelyRes) - where + where likelyRes :: String -> String - likelyRes = res . (c:) + likelyRes = res . (c :) --- | 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. +{- | 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 +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. +{- | 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" - . Pretty.renderHtml +printVeryCompactHtml = + putStrLn + . List.dropWhileEnd (== '\n') + . removeWhitespaceAfterTag "td" + . removeWhitespaceAfterTag "th" + . removeWhitespaceAfterTag "strong" + . removeWhitespaceAfterTag "span" + . removeWhitespaceAfterTag "em" + . removeWhitespaceAfterTag "tr" + . Pretty.renderHtml +{- $discussion --- $discussion --- --- In this module, some of the functions for applying a 'Colonnade' to --- some values to build a table have roughly this type signature: --- --- > Foldable a => Colonnade Headedness Cell a -> f a -> Html --- --- 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 --- these functions to take a 'Colonnade' whose content is 'Html': --- --- > Foldable a => Colonnade Headedness Html a -> f a -> Html --- --- 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. +In this module, some of the functions for applying a 'Colonnade' to +some values to build a table have roughly this type signature: +> Foldable a => Colonnade Headedness Cell a -> f a -> Html +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 +these functions to take a 'Colonnade' whose content is 'Html': + +> Foldable a => Colonnade Headedness Html a -> f a -> Html + +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/test/Main.hs b/test/Main.hs deleted file mode 100644 --- a/test/Main.hs +++ /dev/null @@ -1,6 +0,0 @@ -import Test.DocTest - -main :: IO () -main = doctest - [ "src/Text/Blaze/Colonnade.hs" - ]