{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-- | Build HTML tables using @lucid@ and @colonnade@. It is
-- recommended that users read the documentation for @colonnade@ first,
-- since this library builds on the abstractions introduced there.
-- Also, look at the docs for @blaze-colonnade@. These two
-- libraries are similar, but blaze offers an HTML pretty printer
-- which makes it possible to doctest examples. Since lucid
-- does not offer such facilities, examples are omitted here.
module Lucid.Colonnade
( -- * Apply
encodeHtmlTable
, encodeCellTable
, encodeTable
-- * Cell
-- $build
, Cell(..)
, htmlCell
, stringCell
, textCell
, lazyTextCell
, builderCell
, htmlFromCell
-- * Discussion
-- $discussion
) where
import Colonnade (Colonnade,Headed,Headless,Fascia,Cornice)
import Data.Text (Text)
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 Control.Applicative (liftA2)
import Lucid
import qualified Data.List as List
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
-- $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
-- that wrap this HTML content.
-- | 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 d = Cell
{ cellAttribute :: ![Attribute]
, cellHtml :: !(Html d)
}
instance (d ~ ()) => IsString (Cell d) where
fromString = stringCell
instance Semigroup d => Semigroup (Cell d) where
Cell a1 c1 <> Cell a2 c2 = Cell (mappend a1 a2) (liftA2 (<>) c1 c2)
instance Monoid d => Monoid (Cell d) where
mempty = Cell mempty (return mempty)
mappend (Cell a1 c1) (Cell a2 c2) = Cell (mappend a1 a2) (liftA2 mappend c1 c2)
-- | Create a 'Cell' from a 'Widget'
htmlCell :: Html d -> Cell d
htmlCell = Cell mempty
-- | Create a 'Cell' from a 'String'
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
-- | Create a 'Cell' from a lazy text
lazyTextCell :: LText.Text -> Cell ()
lazyTextCell = textCell . LText.toStrict
-- | Create a 'Cell' from a text builder
builderCell :: TBuilder.Builder -> Cell ()
builderCell = lazyTextCell . TBuilder.toLazyText
-- | Encode a table. Table cell element do not have
-- any attributes applied to them.
encodeHtmlTable ::
(E.Headedness h, Foldable f, Monoid d)
=> [Attribute] -- ^ Attributes of @\<table\>@ element
-> Colonnade h a (Html d) -- ^ How to encode data as columns
-> f a -- ^ Collection of data
-> Html d
encodeHtmlTable = encodeTable
(E.headednessPure ([],[])) mempty (const mempty) (\el -> el [])
-- | Encode a table. Table cells may have attributes applied
-- to them
encodeCellTable ::
(E.Headedness h, Foldable f, Monoid d)
=> [Attribute] -- ^ Attributes of @\<table\>@ element
-> Colonnade h a (Cell d) -- ^ How to encode data as columns
-> f a -- ^ Collection of data
-> Html d
encodeCellTable = encodeTable
(E.headednessPure ([],[])) mempty (const mempty) htmlFromCell
-- | 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 @\<tr\>@ elements.
-- The elements of type @d@ produced by generating html are
-- strictly combined with their monoidal append function.
-- However, this type is nearly always @()@.
encodeTable :: forall f h a d c.
(Foldable f, E.Headedness h, Monoid d)
=> h ([Attribute],[Attribute]) -- ^ Attributes of @\<thead\>@ and its @\<tr\>@
-> [Attribute] -- ^ Attributes of @\<tbody\>@ element
-> (a -> [Attribute]) -- ^ Attributes of each @\<tr\>@ element
-> (([Attribute] -> Html d -> Html d) -> c -> Html d) -- ^ Wrap content and convert to 'Html'
-> [Attribute] -- ^ Attributes of @\<table\>@ element
-> Colonnade h a c -- ^ How to encode data as a row
-> f a -- ^ Collection of data
-> Html d
encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs =
table_ tableAttrs $ do
d1 <- case E.headednessExtractForall of
Nothing -> return mempty
Just extractForall -> do
let (theadAttrs,theadTrAttrs) = extract mtheadAttrs
thead_ theadAttrs $ tr_ theadTrAttrs $ do
foldlMapM' (wrapContent th_ . extract . E.oneColonnadeHead) (E.getColonnade colonnade)
where
extract :: forall y. h y -> y
extract = E.runExtractForall extractForall
d2 <- encodeBody trAttrs wrapContent tbodyAttrs colonnade xs
return (mappend d1 d2)
encodeBody :: (Foldable f, Monoid d)
=> (a -> [Attribute]) -- ^ Attributes of each @\<tr\>@ element
-> (([Attribute] -> Html d -> Html d) -> c -> Html d) -- ^ Wrap content and convert to 'Html'
-> [Attribute] -- ^ Attributes of @\<tbody\>@ element
-> Colonnade h a c -- ^ How to encode data as a row
-> f a -- ^ Collection of data
-> Html d
encodeBody trAttrs wrapContent tbodyAttrs colonnade xs = do
tbody_ tbodyAttrs $ do
flip foldlMapM' xs $ \x -> do
tr_ (trAttrs x) $ E.rowMonadic colonnade (wrapContent td_) x
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
f' :: a -> (b -> m b) -> b -> m b
f' x k bl = do
br <- f x
let !b = mappend bl br
k b
-- | Convert a 'Cell' to 'Html' by wrapping the content with a tag
-- and applying the 'Cell' attributes to that tag.
htmlFromCell :: ([Attribute] -> Html d -> Html d) -> Cell d -> Html d
htmlFromCell f (Cell attr content) = f attr content
-- $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 a (Cell d) -> f a -> Html d
--
-- The 'Colonnade' content type is 'Cell', but the content
-- type of the result is 'Html'. It may not be immidiately clear why
-- this is 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 a (Html d) -> f a -> Html d
--
-- 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.