mirror of
https://github.com/byteverse/colonnade.git
synced 2024-10-26 08:03:25 +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
|
||||
, lucid >= 2.9 && < 3.0
|
||||
, text >= 1.2 && < 1.3
|
||||
, vector >= 0.10 && < 0.13
|
||||
default-language: Haskell2010
|
||||
|
||||
source-repository head
|
||||
|
@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | Build HTML tables using @lucid@ and @colonnade@. It is
|
||||
-- recommended that users read the documentation for @colonnade@ first,
|
||||
@ -13,6 +14,7 @@ module Lucid.Colonnade
|
||||
( -- * Apply
|
||||
encodeHtmlTable
|
||||
, encodeCellTable
|
||||
, encodeCellTableSized
|
||||
, encodeTable
|
||||
-- * Cell
|
||||
-- $build
|
||||
@ -23,6 +25,8 @@ module Lucid.Colonnade
|
||||
, lazyTextCell
|
||||
, builderCell
|
||||
, htmlFromCell
|
||||
, encodeBodySized
|
||||
, sectioned
|
||||
-- * Discussion
|
||||
-- $discussion
|
||||
) where
|
||||
@ -37,12 +41,15 @@ import Data.String (IsString(..))
|
||||
import Data.Maybe (listToMaybe)
|
||||
import Data.Char (isSpace)
|
||||
import Control.Applicative (liftA2)
|
||||
import Lucid
|
||||
import Lucid hiding (for_)
|
||||
import qualified Colonnade as Col
|
||||
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
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.Text as T
|
||||
|
||||
-- $build
|
||||
--
|
||||
@ -116,6 +123,15 @@ encodeCellTable ::
|
||||
encodeCellTable = encodeTable
|
||||
(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
|
||||
-- is seldom needed by users. One of the arguments provided is
|
||||
-- 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
|
||||
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' f xs = foldr f' pure xs mempty
|
||||
where
|
||||
@ -194,4 +266,27 @@ htmlFromCell f (Cell attr content) = f attr content
|
||||
-- situation, it is necessary to introduce 'Cell', which includes
|
||||
-- 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