mirror of
https://github.com/byteverse/colonnade.git
synced 2024-09-11 06:45:41 +03:00
Merge branch 'master' of github.com:andrewthad/colonnade
This commit is contained in:
commit
28b33fee2d
@ -21,6 +21,7 @@ library
|
|||||||
, colonnade >= 1.1.1 && < 1.3
|
, colonnade >= 1.1.1 && < 1.3
|
||||||
, lucid >= 2.9 && < 3.0
|
, lucid >= 2.9 && < 3.0
|
||||||
, text >= 1.2 && < 1.3
|
, text >= 1.2 && < 1.3
|
||||||
|
, vector >= 0.10 && < 0.13
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
|
@ -1,6 +1,7 @@
|
|||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
-- | Build HTML tables using @lucid@ and @colonnade@. It is
|
-- | Build HTML tables using @lucid@ and @colonnade@. It is
|
||||||
-- recommended that users read the documentation for @colonnade@ first,
|
-- recommended that users read the documentation for @colonnade@ first,
|
||||||
@ -13,6 +14,7 @@ module Lucid.Colonnade
|
|||||||
( -- * Apply
|
( -- * Apply
|
||||||
encodeHtmlTable
|
encodeHtmlTable
|
||||||
, encodeCellTable
|
, encodeCellTable
|
||||||
|
, encodeCellTableSized
|
||||||
, encodeTable
|
, encodeTable
|
||||||
-- * Cell
|
-- * Cell
|
||||||
-- $build
|
-- $build
|
||||||
@ -23,6 +25,8 @@ module Lucid.Colonnade
|
|||||||
, lazyTextCell
|
, lazyTextCell
|
||||||
, builderCell
|
, builderCell
|
||||||
, htmlFromCell
|
, htmlFromCell
|
||||||
|
, encodeBodySized
|
||||||
|
, sectioned
|
||||||
-- * Discussion
|
-- * Discussion
|
||||||
-- $discussion
|
-- $discussion
|
||||||
) where
|
) where
|
||||||
@ -37,12 +41,15 @@ import Data.String (IsString(..))
|
|||||||
import Data.Maybe (listToMaybe)
|
import Data.Maybe (listToMaybe)
|
||||||
import Data.Char (isSpace)
|
import Data.Char (isSpace)
|
||||||
import Control.Applicative (liftA2)
|
import Control.Applicative (liftA2)
|
||||||
import Lucid
|
import Lucid hiding (for_)
|
||||||
|
import qualified Colonnade as Col
|
||||||
import qualified Data.List as List
|
import qualified Data.List as List
|
||||||
import qualified Colonnade.Encode as E
|
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
|
||||||
|
import qualified Data.Vector as V
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
-- $build
|
-- $build
|
||||||
--
|
--
|
||||||
@ -116,6 +123,15 @@ encodeCellTable ::
|
|||||||
encodeCellTable = encodeTable
|
encodeCellTable = encodeTable
|
||||||
(E.headednessPure ([],[])) mempty (const mempty) htmlFromCell
|
(E.headednessPure ([],[])) mempty (const mempty) htmlFromCell
|
||||||
|
|
||||||
|
encodeCellTableSized ::
|
||||||
|
(E.Headedness h, Foldable f, Monoid d)
|
||||||
|
=> [Attribute] -- ^ Attributes of @\<table\>@ element
|
||||||
|
-> Colonnade (E.Sized Int h) a (Cell d) -- ^ How to encode data as columns
|
||||||
|
-> f a -- ^ Collection of data
|
||||||
|
-> Html ()
|
||||||
|
encodeCellTableSized = encodeTableSized
|
||||||
|
(E.headednessPure ([],[])) mempty (const mempty) htmlFromCell
|
||||||
|
|
||||||
-- | 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.
|
||||||
@ -158,6 +174,62 @@ encodeBody trAttrs wrapContent tbodyAttrs colonnade xs = do
|
|||||||
flip foldlMapM' xs $ \x -> do
|
flip foldlMapM' xs $ \x -> do
|
||||||
tr_ (trAttrs x) $ E.rowMonadic colonnade (wrapContent td_) x
|
tr_ (trAttrs x) $ E.rowMonadic colonnade (wrapContent td_) x
|
||||||
|
|
||||||
|
encodeBodySized ::
|
||||||
|
(Foldable f, Monoid d)
|
||||||
|
=> (a -> [Attribute])
|
||||||
|
-> [Attribute]
|
||||||
|
-> Colonnade (E.Sized Int h) a (Cell d)
|
||||||
|
-> f a
|
||||||
|
-> Html ()
|
||||||
|
encodeBodySized trAttrs tbodyAttrs colonnade collection = tbody_ tbodyAttrs $ do
|
||||||
|
for_ collection $ \a -> tr_ (trAttrs a) $ do
|
||||||
|
E.rowMonoidalHeader
|
||||||
|
colonnade
|
||||||
|
(\(E.Sized sz _) (Cell cattr content) ->
|
||||||
|
void $ td_ (setColspanOrHide sz cattr) content
|
||||||
|
)
|
||||||
|
a
|
||||||
|
|
||||||
|
encodeTableSized :: 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) -> (Cell d) -> Html d) -- ^ Wrap content and convert to 'Html'
|
||||||
|
-> [Attribute] -- ^ Attributes of @\<table\>@ element
|
||||||
|
-> Colonnade (E.Sized Int h) a (Cell d) -- ^ How to encode data as a row
|
||||||
|
-> f a -- ^ Collection of data
|
||||||
|
-> Html ()
|
||||||
|
encodeTableSized mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs =
|
||||||
|
table_ tableAttrs $ do
|
||||||
|
d1 <- case E.headednessExtractForall of
|
||||||
|
Nothing -> pure mempty
|
||||||
|
Just extractForall -> do
|
||||||
|
let (theadAttrs,theadTrAttrs) = extract mtheadAttrs
|
||||||
|
thead_ theadAttrs $ tr_ theadTrAttrs $ do
|
||||||
|
traverse_
|
||||||
|
(wrapContent th_ . extract .
|
||||||
|
(\(E.Sized i h) -> case E.headednessExtract of
|
||||||
|
Just f ->
|
||||||
|
let (Cell attrs content) = f h
|
||||||
|
in E.headednessPure $ Cell (setColspanOrHide i attrs) content
|
||||||
|
Nothing -> E.headednessPure mempty
|
||||||
|
-- (E.Headed (Cell attrs content)) -> E.Headed $ Cell (setColspanOrHide i attrs) content
|
||||||
|
-- E.Headless -> E.Headless
|
||||||
|
)
|
||||||
|
. E.oneColonnadeHead
|
||||||
|
)
|
||||||
|
(E.getColonnade colonnade)
|
||||||
|
where
|
||||||
|
extract :: forall y. h y -> y
|
||||||
|
extract = E.runExtractForall extractForall
|
||||||
|
encodeBodySized trAttrs tbodyAttrs colonnade xs
|
||||||
|
|
||||||
|
setColspanOrHide :: Int -> [Attribute] -> [Attribute]
|
||||||
|
setColspanOrHide i attrs
|
||||||
|
| i < 1 = style_ "display:none;" : attrs
|
||||||
|
| otherwise = colspan_ (Text.pack (show i)) : attrs
|
||||||
|
|
||||||
foldlMapM' :: forall g b a m. (Foldable g, Monoid b, Monad m) => (a -> m b) -> g a -> m b
|
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
|
foldlMapM' f xs = foldr f' pure xs mempty
|
||||||
where
|
where
|
||||||
@ -194,4 +266,27 @@ htmlFromCell f (Cell attr content) = f attr content
|
|||||||
-- situation, it is necessary to introduce 'Cell', which includes
|
-- situation, it is necessary to introduce 'Cell', which includes
|
||||||
-- the possibility of attributes on the parent node.
|
-- the possibility of attributes on the parent node.
|
||||||
|
|
||||||
|
sectioned ::
|
||||||
|
(Foldable f, E.Headedness h, Foldable g, Monoid c)
|
||||||
|
=> [Attribute] -- ^ @\<table\>@ tag attributes
|
||||||
|
-> Maybe ([Attribute], [Attribute])
|
||||||
|
-- ^ Attributes of @\<thead\>@ and its @\<tr\>@, pass 'Nothing' to omit @\<thead\>@
|
||||||
|
-> [Attribute] -- ^ @\<tbody\>@ tag attributes
|
||||||
|
-> (a -> [Attribute]) -- ^ @\<tr\>@ tag attributes for data rows
|
||||||
|
-> (b -> Cell c) -- ^ Section divider encoding strategy
|
||||||
|
-> Colonnade h a (Cell c) -- ^ Data encoding strategy
|
||||||
|
-> f (b, g a) -- ^ Collection of data
|
||||||
|
-> Html ()
|
||||||
|
sectioned tableAttrs mheadAttrs bodyAttrs trAttrs dividerContent colonnade@(E.Colonnade v) collection = do
|
||||||
|
let vlen = V.length v
|
||||||
|
table_ tableAttrs $ do
|
||||||
|
for_ mheadAttrs $ \(headAttrs,headTrAttrs) ->
|
||||||
|
thead_ headAttrs . tr_ headTrAttrs $
|
||||||
|
E.headerMonadicGeneral_ colonnade (htmlFromCell th_)
|
||||||
|
tbody_ bodyAttrs $ for_ collection $ \(b,as) -> do
|
||||||
|
let Cell attrs contents = dividerContent b
|
||||||
|
tr_ [] $ do
|
||||||
|
td_ ((colspan_ $ T.pack (show vlen)): attrs) contents
|
||||||
|
flip traverse_ as $ \a -> do
|
||||||
|
tr_ (trAttrs a) $ E.rowMonadic colonnade (htmlFromCell td_) a
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user