mirror of
https://github.com/byteverse/colonnade.git
synced 2024-09-11 06:45:41 +03:00
update blaze-colonnade to work agree with how everything else uses Headedness
This commit is contained in:
parent
63a5242d07
commit
e80f7cdd83
@ -1,5 +1,5 @@
|
|||||||
name: blaze-colonnade
|
name: blaze-colonnade
|
||||||
version: 1.1.1
|
version: 1.2.0
|
||||||
synopsis: Helper functions for using blaze-html with colonnade
|
synopsis: Helper functions for using blaze-html with colonnade
|
||||||
description: Blaze HTML and colonnade
|
description: Blaze HTML and colonnade
|
||||||
homepage: https://github.com/andrewthad/colonnade#readme
|
homepage: https://github.com/andrewthad/colonnade#readme
|
||||||
|
@ -1,3 +1,6 @@
|
|||||||
|
{-# LANGUAGE RankNTypes #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
-- | Build HTML tables using @blaze-html@ and @colonnade@. The bottom
|
-- | Build HTML tables using @blaze-html@ and @colonnade@. The bottom
|
||||||
-- of this page has a tutorial that walks through a full example,
|
-- of this page has a tutorial that walks through a full example,
|
||||||
-- illustrating how to meet typical needs with this library. It is
|
-- illustrating how to meet typical needs with this library. It is
|
||||||
@ -9,7 +12,7 @@
|
|||||||
-- >>> :module + Colonnade Text.Blaze.Html Text.Blaze.Colonnade
|
-- >>> :module + Colonnade Text.Blaze.Html Text.Blaze.Colonnade
|
||||||
-- >>> let col = headed "Grade" (toHtml . fst) <> headed "Letter" (toHtml . snd)
|
-- >>> let col = headed "Grade" (toHtml . fst) <> headed "Letter" (toHtml . snd)
|
||||||
-- >>> let rows = [("90-100",'A'),("80-89",'B'),("70-79",'C')]
|
-- >>> let rows = [("90-100",'A'),("80-89",'B'),("70-79",'C')]
|
||||||
-- >>> printVeryCompactHtml (encodeHeadedHtmlTable mempty col rows)
|
-- >>> printVeryCompactHtml (encodeHtmlTable mempty col rows)
|
||||||
-- <table>
|
-- <table>
|
||||||
-- <thead>
|
-- <thead>
|
||||||
-- <tr><th>Grade</th><th>Letter</th></tr>
|
-- <tr><th>Grade</th><th>Letter</th></tr>
|
||||||
@ -22,10 +25,8 @@
|
|||||||
-- </table>
|
-- </table>
|
||||||
module Text.Blaze.Colonnade
|
module Text.Blaze.Colonnade
|
||||||
( -- * Apply
|
( -- * Apply
|
||||||
encodeHeadedHtmlTable
|
encodeHtmlTable
|
||||||
, encodeHeadlessHtmlTable
|
, encodeCellTable
|
||||||
, encodeHeadedCellTable
|
|
||||||
, encodeHeadlessCellTable
|
|
||||||
, encodeTable
|
, encodeTable
|
||||||
, encodeCappedTable
|
, encodeCappedTable
|
||||||
-- * Cell
|
-- * Cell
|
||||||
@ -62,7 +63,7 @@ import qualified Text.Blaze.Html.Renderer.Pretty as Pretty
|
|||||||
import qualified Text.Blaze as Blaze
|
import qualified Text.Blaze as Blaze
|
||||||
import qualified Text.Blaze.Html5 as H
|
import qualified Text.Blaze.Html5 as H
|
||||||
import qualified Text.Blaze.Html5.Attributes as HA
|
import qualified Text.Blaze.Html5.Attributes as HA
|
||||||
import qualified Colonnade.Encode as Encode
|
import qualified Colonnade.Encode as E
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
import qualified Data.Text.Lazy as LText
|
import qualified Data.Text.Lazy as LText
|
||||||
import qualified Data.Text.Lazy.Builder as TBuilder
|
import qualified Data.Text.Lazy.Builder as TBuilder
|
||||||
@ -113,7 +114,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder
|
|||||||
-- Let\'s continue:
|
-- Let\'s continue:
|
||||||
--
|
--
|
||||||
-- >>> let customAttrs = HA.class_ "stylish-table" <> HA.id "main-table"
|
-- >>> let customAttrs = HA.class_ "stylish-table" <> HA.id "main-table"
|
||||||
-- >>> printCompactHtml (encodeHeadedHtmlTable customAttrs tableEmpA employees)
|
-- >>> printCompactHtml (encodeHtmlTable customAttrs tableEmpA employees)
|
||||||
-- <table class="stylish-table" id="main-table">
|
-- <table class="stylish-table" id="main-table">
|
||||||
-- <thead>
|
-- <thead>
|
||||||
-- <tr>
|
-- <tr>
|
||||||
@ -163,10 +164,10 @@ import qualified Data.Text.Lazy.Builder as TBuilder
|
|||||||
-- literal @"Dept."@ to be accepted as a value of type 'Cell'. To avoid
|
-- literal @"Dept."@ to be accepted as a value of type 'Cell'. To avoid
|
||||||
-- this extension, 'stringCell' could be used to upcast the 'String'.
|
-- this extension, 'stringCell' could be used to upcast the 'String'.
|
||||||
-- To try out our 'Colonnade' on a list of departments, we need to use
|
-- To try out our 'Colonnade' on a list of departments, we need to use
|
||||||
-- 'encodeHeadedCellTable' instead of 'encodeHeadedHtmlTable':
|
-- 'encodeCellTable' instead of 'encodeHtmlTable':
|
||||||
--
|
--
|
||||||
-- >>> let twoDepts = [Sales,Management]
|
-- >>> let twoDepts = [Sales,Management]
|
||||||
-- >>> printVeryCompactHtml (encodeHeadedCellTable customAttrs tableDept twoDepts)
|
-- >>> printVeryCompactHtml (encodeCellTable customAttrs tableDept twoDepts)
|
||||||
-- <table class="stylish-table" id="main-table">
|
-- <table class="stylish-table" id="main-table">
|
||||||
-- <thead>
|
-- <thead>
|
||||||
-- <tr><th>Dept.</th></tr>
|
-- <tr><th>Dept.</th></tr>
|
||||||
@ -186,7 +187,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder
|
|||||||
-- >>> let tableEmpB = lmap department tableDept
|
-- >>> let tableEmpB = lmap department tableDept
|
||||||
-- >>> :t tableEmpB
|
-- >>> :t tableEmpB
|
||||||
-- tableEmpB :: Colonnade Headed Employee Cell
|
-- tableEmpB :: Colonnade Headed Employee Cell
|
||||||
-- >>> printVeryCompactHtml (encodeHeadedCellTable customAttrs tableEmpB employees)
|
-- >>> printVeryCompactHtml (encodeCellTable customAttrs tableEmpB employees)
|
||||||
-- <table class="stylish-table" id="main-table">
|
-- <table class="stylish-table" id="main-table">
|
||||||
-- <thead>
|
-- <thead>
|
||||||
-- <tr><th>Dept.</th></tr>
|
-- <tr><th>Dept.</th></tr>
|
||||||
@ -218,7 +219,7 @@ import qualified Data.Text.Lazy.Builder as TBuilder
|
|||||||
-- >>> let tableEmpC = fmap htmlCell tableEmpA <> tableEmpB
|
-- >>> let tableEmpC = fmap htmlCell tableEmpA <> tableEmpB
|
||||||
-- >>> :t tableEmpC
|
-- >>> :t tableEmpC
|
||||||
-- tableEmpC :: Colonnade Headed Employee Cell
|
-- tableEmpC :: Colonnade Headed Employee Cell
|
||||||
-- >>> printCompactHtml (encodeHeadedCellTable customAttrs tableEmpC employees)
|
-- >>> printCompactHtml (encodeCellTable customAttrs tableEmpC employees)
|
||||||
-- <table class="stylish-table" id="main-table">
|
-- <table class="stylish-table" id="main-table">
|
||||||
-- <thead>
|
-- <thead>
|
||||||
-- <tr>
|
-- <tr>
|
||||||
@ -296,9 +297,8 @@ builderCell = lazyTextCell . TBuilder.toLazyText
|
|||||||
-- | Encode a table. This handles a very general case and
|
-- | Encode a table. This handles a very general case and
|
||||||
-- is seldom needed by users. One of the arguments provided is
|
-- is seldom needed by users. One of the arguments provided is
|
||||||
-- used to add attributes to the generated @\<tr\>@ elements.
|
-- used to add attributes to the generated @\<tr\>@ elements.
|
||||||
encodeTable ::
|
encodeTable :: forall h f a c. (Foldable f, E.Headedness h)
|
||||||
(Foldable f, Foldable h)
|
=> h (Attribute,Attribute) -- ^ Attributes of @\<thead\>@ and its @\<tr\>@, pass 'Nothing' to omit @\<thead\>@
|
||||||
=> Maybe (Attribute,Attribute) -- ^ Attributes of @\<thead\>@ and its @\<tr\>@, pass 'Nothing' to omit @\<thead\>@
|
|
||||||
-> Attribute -- ^ Attributes of @\<tbody\>@ element
|
-> Attribute -- ^ Attributes of @\<tbody\>@ element
|
||||||
-> (a -> Attribute) -- ^ Attributes of each @\<tr\>@ element
|
-> (a -> Attribute) -- ^ Attributes of each @\<tr\>@ element
|
||||||
-> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html'
|
-> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html'
|
||||||
@ -308,11 +308,27 @@ encodeTable ::
|
|||||||
-> Html
|
-> Html
|
||||||
encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs =
|
encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs =
|
||||||
H.table ! tableAttrs $ do
|
H.table ! tableAttrs $ do
|
||||||
for_ mtheadAttrs $ \(theadAttrs,theadTrAttrs) -> do
|
case E.headednessExtractForall of
|
||||||
H.thead ! theadAttrs $ H.tr ! theadTrAttrs $ do
|
Nothing -> return mempty
|
||||||
Encode.headerMonoidalGeneral colonnade (wrapContent H.th)
|
Just extractForall -> do
|
||||||
|
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
|
||||||
|
extract :: forall y. h y -> y
|
||||||
|
extract = E.runExtractForall extractForall
|
||||||
encodeBody trAttrs wrapContent tbodyAttrs colonnade xs
|
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
|
||||||
|
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.
|
-- | Encode a table with tiered header rows.
|
||||||
-- >>> let cor = mconcat [cap "Personal" (fmap htmlCell tableEmpA), cap "Work" tableEmpB]
|
-- >>> let cor = mconcat [cap "Personal" (fmap htmlCell tableEmpA), cap "Work" tableEmpB]
|
||||||
-- >>> let fascia = FasciaCap (HA.class_ "category") (FasciaBase (HA.class_ "subcategory"))
|
-- >>> let fascia = FasciaCap (HA.class_ "category") (FasciaBase (HA.class_ "subcategory"))
|
||||||
@ -360,11 +376,11 @@ encodeCappedTable :: Foldable f
|
|||||||
-> f a -- ^ Collection of data
|
-> f a -- ^ Collection of data
|
||||||
-> Html
|
-> Html
|
||||||
encodeCappedTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs fascia cornice xs = do
|
encodeCappedTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs fascia cornice xs = do
|
||||||
let colonnade = Encode.discard cornice
|
let colonnade = E.discard cornice
|
||||||
annCornice = Encode.annotate cornice
|
annCornice = E.annotate cornice
|
||||||
H.table ! tableAttrs $ do
|
H.table ! tableAttrs $ do
|
||||||
H.thead ! theadAttrs $ do
|
H.thead ! theadAttrs $ do
|
||||||
Encode.headersMonoidal
|
E.headersMonoidal
|
||||||
(Just (fascia, \attrs theHtml -> H.tr ! attrs $ theHtml))
|
(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))
|
Just sz -> wrapContent H.th c ! HA.colspan (H.toValue (show sz))
|
||||||
@ -374,10 +390,10 @@ encodeCappedTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs fascia co
|
|||||||
]
|
]
|
||||||
annCornice
|
annCornice
|
||||||
-- H.tr ! trAttrs $ do
|
-- H.tr ! trAttrs $ do
|
||||||
-- Encode.headerMonoidalGeneral colonnade (wrapContent H.th)
|
-- E.headerMonoidalGeneral colonnade (wrapContent H.th)
|
||||||
encodeBody trAttrs wrapContent tbodyAttrs colonnade xs
|
encodeBody trAttrs wrapContent tbodyAttrs colonnade xs
|
||||||
|
|
||||||
encodeBody :: (Foldable h, Foldable f)
|
encodeBody :: Foldable f
|
||||||
=> (a -> Attribute) -- ^ Attributes of each @\<tr\>@ element
|
=> (a -> Attribute) -- ^ Attributes of each @\<tr\>@ element
|
||||||
-> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html'
|
-> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html'
|
||||||
-> Attribute -- ^ Attributes of @\<tbody\>@ element
|
-> Attribute -- ^ Attributes of @\<tbody\>@ element
|
||||||
@ -387,52 +403,30 @@ encodeBody :: (Foldable h, Foldable f)
|
|||||||
encodeBody trAttrs wrapContent tbodyAttrs colonnade xs = do
|
encodeBody trAttrs wrapContent tbodyAttrs colonnade xs = do
|
||||||
H.tbody ! tbodyAttrs $ do
|
H.tbody ! tbodyAttrs $ do
|
||||||
forM_ xs $ \x -> do
|
forM_ xs $ \x -> do
|
||||||
H.tr ! trAttrs x $ Encode.rowMonoidal colonnade (wrapContent H.td) x
|
H.tr ! trAttrs x $ E.rowMonoidal colonnade (wrapContent H.td) x
|
||||||
|
|
||||||
|
|
||||||
-- | Encode a table with a header. Table cells may have attributes
|
-- | Encode a table. Table cells may have attributes
|
||||||
-- applied to them.
|
-- applied to them.
|
||||||
encodeHeadedCellTable ::
|
encodeCellTable ::
|
||||||
Foldable f
|
Foldable f
|
||||||
=> Attribute -- ^ Attributes of @\<table\>@ element
|
=> Attribute -- ^ Attributes of @\<table\>@ element
|
||||||
-> Colonnade Headed a Cell -- ^ How to encode data as columns
|
-> Colonnade Headed a Cell -- ^ How to encode data as columns
|
||||||
-> f a -- ^ Collection of data
|
-> f a -- ^ Collection of data
|
||||||
-> Html
|
-> Html
|
||||||
encodeHeadedCellTable = encodeTable
|
encodeCellTable = encodeTable
|
||||||
(Just (mempty,mempty)) mempty (const mempty) htmlFromCell
|
(E.headednessPure (mempty,mempty)) mempty (const mempty) htmlFromCell
|
||||||
|
|
||||||
-- | Encode a table without a header. Table cells may have attributes
|
-- | Encode a table. Table cell element do not have
|
||||||
-- applied to them.
|
|
||||||
encodeHeadlessCellTable ::
|
|
||||||
Foldable f
|
|
||||||
=> Attribute -- ^ Attributes of @\<table\>@ element
|
|
||||||
-> Colonnade Headless a Cell -- ^ How to encode data as columns
|
|
||||||
-> f a -- ^ Collection of data
|
|
||||||
-> Html
|
|
||||||
encodeHeadlessCellTable = encodeTable
|
|
||||||
Nothing mempty (const mempty) htmlFromCell
|
|
||||||
|
|
||||||
-- | Encode a table with a header. Table cell element do not have
|
|
||||||
-- any attributes applied to them.
|
-- any attributes applied to them.
|
||||||
encodeHeadedHtmlTable ::
|
encodeHtmlTable ::
|
||||||
Foldable f
|
(Foldable f, E.Headedness h)
|
||||||
=> Attribute -- ^ Attributes of @\<table\>@ element
|
=> Attribute -- ^ Attributes of @\<table\>@ element
|
||||||
-> Colonnade Headed a Html -- ^ How to encode data as columns
|
-> Colonnade h a Html -- ^ How to encode data as columns
|
||||||
-> f a -- ^ Collection of data
|
-> f a -- ^ Collection of data
|
||||||
-> Html
|
-> Html
|
||||||
encodeHeadedHtmlTable = encodeTable
|
encodeHtmlTable = encodeTable
|
||||||
(Just (mempty,mempty)) mempty (const mempty) ($)
|
(E.headednessPure (mempty,mempty)) mempty (const mempty) ($)
|
||||||
|
|
||||||
-- | Encode a table without a header. Table cells do not have
|
|
||||||
-- any attributes applied to them.
|
|
||||||
encodeHeadlessHtmlTable ::
|
|
||||||
Foldable f
|
|
||||||
=> Attribute -- ^ Attributes of @\<table\>@ element
|
|
||||||
-> Colonnade Headless a Html -- ^ How to encode data as columns
|
|
||||||
-> f a -- ^ Collection of data
|
|
||||||
-> Html
|
|
||||||
encodeHeadlessHtmlTable = encodeTable
|
|
||||||
Nothing mempty (const mempty) ($)
|
|
||||||
|
|
||||||
-- | Convert a 'Cell' to 'Html' by wrapping the content with a tag
|
-- | Convert a 'Cell' to 'Html' by wrapping the content with a tag
|
||||||
-- and applying the 'Cell' attributes to that tag.
|
-- and applying the 'Cell' attributes to that tag.
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
resolver: lts-8.0
|
resolver: lts-10.4
|
||||||
packages:
|
packages:
|
||||||
- 'colonnade'
|
- 'colonnade'
|
||||||
- 'yesod-colonnade'
|
- 'yesod-colonnade'
|
||||||
|
@ -15,10 +15,8 @@ module Yesod.Colonnade
|
|||||||
, anchorCell
|
, anchorCell
|
||||||
, anchorWidget
|
, anchorWidget
|
||||||
-- * Apply
|
-- * Apply
|
||||||
, encodeHeadedWidgetTable
|
, encodeWidgetTable
|
||||||
, encodeHeadlessWidgetTable
|
, encodeCellTable
|
||||||
, encodeHeadedCellTable
|
|
||||||
, encodeHeadlessCellTable
|
|
||||||
, encodeDefinitionTable
|
, encodeDefinitionTable
|
||||||
, encodeListItems
|
, encodeListItems
|
||||||
) where
|
) where
|
||||||
@ -126,41 +124,27 @@ encodeDefinitionTable attrs enc a = table_ attrs $ tbody_ mempty $
|
|||||||
widgetFromCell td_ theValue
|
widgetFromCell td_ theValue
|
||||||
) a
|
) a
|
||||||
|
|
||||||
-- | If you are using the bootstrap css framework, then you may want
|
-- | Encode an html table with attributes on the table cells.
|
||||||
|
-- If you are using the bootstrap css framework, then you may want
|
||||||
-- to call this with the first argument as:
|
-- to call this with the first argument as:
|
||||||
--
|
--
|
||||||
-- > encodeHeadedCellTable (HA.class_ "table table-striped") ...
|
-- > encodeCellTable (HA.class_ "table table-striped") ...
|
||||||
encodeHeadedCellTable :: Foldable f
|
encodeCellTable :: (Foldable f, E.Headedness h)
|
||||||
=> Attribute -- ^ Attributes of @table@ element
|
=> Attribute -- ^ Attributes of @table@ element
|
||||||
-> Colonnade Headed a (Cell site) -- ^ How to encode data as a row
|
-> Colonnade h a (Cell site) -- ^ How to encode data as a row
|
||||||
-> f a -- ^ Rows of data
|
-> f a -- ^ Rows of data
|
||||||
-> WidgetT site IO ()
|
-> WidgetT site IO ()
|
||||||
encodeHeadedCellTable = encodeTable
|
encodeCellTable = encodeTable
|
||||||
(E.Headed mempty) mempty (const mempty) widgetFromCell
|
(E.headednessPure mempty) mempty (const mempty) widgetFromCell
|
||||||
|
|
||||||
encodeHeadlessCellTable :: Foldable f
|
-- | Encode an html table.
|
||||||
=> Attribute -- ^ Attributes of @table@ element
|
encodeWidgetTable :: (Foldable f, E.Headedness h)
|
||||||
-> Colonnade Headless a (Cell site) -- ^ How to encode data as columns
|
|
||||||
-> f a -- ^ Rows of data
|
|
||||||
-> WidgetT site IO ()
|
|
||||||
encodeHeadlessCellTable = encodeTable
|
|
||||||
E.Headless mempty (const mempty) widgetFromCell
|
|
||||||
|
|
||||||
encodeHeadedWidgetTable :: Foldable f
|
|
||||||
=> Attribute -- ^ Attributes of @table@ element
|
|
||||||
-> Colonnade Headed a (WidgetT site IO ()) -- ^ How to encode data as columns
|
|
||||||
-> f a -- ^ Rows of data
|
|
||||||
-> WidgetT site IO ()
|
|
||||||
encodeHeadedWidgetTable = encodeTable
|
|
||||||
(E.Headed mempty) mempty (const mempty) ($ mempty)
|
|
||||||
|
|
||||||
encodeHeadlessWidgetTable :: Foldable f
|
|
||||||
=> Attribute -- ^ Attributes of @\<table\>@ element
|
=> Attribute -- ^ Attributes of @\<table\>@ element
|
||||||
-> Colonnade Headless a (WidgetT site IO ()) -- ^ How to encode data as columns
|
-> Colonnade h a (WidgetT site IO ()) -- ^ How to encode data as columns
|
||||||
-> f a -- ^ Rows of data
|
-> f a -- ^ Rows of data
|
||||||
-> WidgetT site IO ()
|
-> WidgetT site IO ()
|
||||||
encodeHeadlessWidgetTable = encodeTable
|
encodeWidgetTable = encodeTable
|
||||||
E.Headless mempty (const mempty) ($ mempty)
|
(E.headednessPure mempty) mempty (const mempty) ($ mempty)
|
||||||
|
|
||||||
-- | Encode a table. This handles a very general case and
|
-- | Encode a table. This handles a very general case and
|
||||||
-- is seldom needed by users. One of the arguments provided is
|
-- is seldom needed by users. One of the arguments provided is
|
||||||
|
Loading…
Reference in New Issue
Block a user