{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

{- | 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
  , encodeCellTableSized
  , encodeTable

    -- * Cell
    -- $build
  , Cell (..)
  , charCell
  , htmlCell
  , stringCell
  , textCell
  , lazyTextCell
  , builderCell
  , htmlFromCell
  , encodeBodySized
  , sectioned

    -- * Discussion
    -- $discussion
  ) where

#if MIN_VERSION_base(4,18,0)
#else
import Control.Applicative (liftA2)
#endif
import Colonnade (Colonnade)
import Control.Monad
import Data.Foldable
import Data.String (IsString (..))
import Data.Text (Text)
import Lucid hiding (for_)

import qualified Colonnade.Encode as E
import qualified Data.Text as T
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

{- $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
  { forall d. Cell d -> [Attribute]
cellAttribute :: ![Attribute]
  , forall d. Cell d -> Html d
cellHtml :: !(Html d)
  }

instance (d ~ ()) => IsString (Cell d) where
  fromString :: String -> Cell d
fromString = String -> Cell d
String -> Cell ()
stringCell

instance (Semigroup d) => Semigroup (Cell d) where
  Cell [Attribute]
a1 Html d
c1 <> :: Cell d -> Cell d -> Cell d
<> Cell [Attribute]
a2 Html d
c2 = [Attribute] -> Html d -> Cell d
forall d. [Attribute] -> Html d -> Cell d
Cell ([Attribute] -> [Attribute] -> [Attribute]
forall a. Monoid a => a -> a -> a
mappend [Attribute]
a1 [Attribute]
a2) ((d -> d -> d) -> Html d -> Html d -> Html d
forall a b c.
(a -> b -> c)
-> HtmlT Identity a -> HtmlT Identity b -> HtmlT Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 d -> d -> d
forall a. Semigroup a => a -> a -> a
(<>) Html d
c1 Html d
c2)

instance (Monoid d) => Monoid (Cell d) where
  mempty :: Cell d
mempty = [Attribute] -> Html d -> Cell d
forall d. [Attribute] -> Html d -> Cell d
Cell [Attribute]
forall a. Monoid a => a
mempty (d -> Html d
forall a. a -> HtmlT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return d
forall a. Monoid a => a
mempty)
  mappend :: Cell d -> Cell d -> Cell d
mappend = Cell d -> Cell d -> Cell d
forall a. Semigroup a => a -> a -> a
(<>)

-- | Create a 'Cell' from a 'Widget'
htmlCell :: Html d -> Cell d
htmlCell :: forall d. Html d -> Cell d
htmlCell = [Attribute] -> Html d -> Cell d
forall d. [Attribute] -> Html d -> Cell d
Cell [Attribute]
forall a. Monoid a => a
mempty

-- | Create a 'Cell' from a 'String'
stringCell :: String -> Cell ()
stringCell :: String -> Cell ()
stringCell = Html () -> Cell ()
forall d. Html d -> Cell d
htmlCell (Html () -> Cell ()) -> (String -> Html ()) -> String -> Cell ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Html ()
forall a. IsString a => String -> a
fromString

-- | Create a 'Cell' from a 'Char'
charCell :: Char -> Cell ()
charCell :: Char -> Cell ()
charCell = String -> Cell ()
stringCell (String -> Cell ()) -> (Char -> String) -> Char -> Cell ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Create a 'Cell' from a 'Text'
textCell :: Text -> Cell ()
textCell :: Text -> Cell ()
textCell = Html () -> Cell ()
forall d. Html d -> Cell d
htmlCell (Html () -> Cell ()) -> (Text -> Html ()) -> Text -> Cell ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml

-- | Create a 'Cell' from a lazy text
lazyTextCell :: LText.Text -> Cell ()
lazyTextCell :: Text -> Cell ()
lazyTextCell = Text -> Cell ()
textCell (Text -> Cell ()) -> (Text -> Text) -> Text -> Cell ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LText.toStrict

-- | Create a 'Cell' from a text builder
builderCell :: TBuilder.Builder -> Cell ()
builderCell :: Builder -> Cell ()
builderCell = Text -> Cell ()
lazyTextCell (Text -> Cell ()) -> (Builder -> Text) -> Builder -> Cell ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TBuilder.toLazyText

{- | Encode a table. Table cell element do not have
  any attributes applied to them.
-}
encodeHtmlTable ::
  (E.Headedness h, Foldable f, Monoid d) =>
  -- | Attributes of @\<table\>@ element
  [Attribute] ->
  -- | How to encode data as columns
  Colonnade h a (Html d) ->
  -- | Collection of data
  f a ->
  Html d
encodeHtmlTable :: forall (h :: * -> *) (f :: * -> *) d a.
(Headedness h, Foldable f, Monoid d) =>
[Attribute] -> Colonnade h a (Html d) -> f a -> Html d
encodeHtmlTable =
  h ([Attribute], [Attribute])
-> [Attribute]
-> (a -> [Attribute])
-> (([Attribute] -> Html d -> Html d) -> Html d -> Html d)
-> [Attribute]
-> Colonnade h a (Html d)
-> f a
-> Html d
forall (f :: * -> *) (h :: * -> *) a d c.
(Foldable f, Headedness h, Monoid d) =>
h ([Attribute], [Attribute])
-> [Attribute]
-> (a -> [Attribute])
-> (([Attribute] -> Html d -> Html d) -> c -> Html d)
-> [Attribute]
-> Colonnade h a c
-> f a
-> Html d
encodeTable
    (([Attribute], [Attribute]) -> h ([Attribute], [Attribute])
forall a. a -> h a
forall (h :: * -> *) a. Headedness h => a -> h a
E.headednessPure ([], []))
    [Attribute]
forall a. Monoid a => a
mempty
    ([Attribute] -> a -> [Attribute]
forall a b. a -> b -> a
const [Attribute]
forall a. Monoid a => a
mempty)
    (\[Attribute] -> Html d -> Html d
el -> [Attribute] -> Html d -> Html d
el [])

{- | Encode a table. Table cells may have attributes applied
  to them
-}
encodeCellTable ::
  (E.Headedness h, Foldable f, Monoid d) =>
  -- | Attributes of @\<table\>@ element
  [Attribute] ->
  -- | How to encode data as columns
  Colonnade h a (Cell d) ->
  -- | Collection of data
  f a ->
  Html d
encodeCellTable :: forall (h :: * -> *) (f :: * -> *) d a.
(Headedness h, Foldable f, Monoid d) =>
[Attribute] -> Colonnade h a (Cell d) -> f a -> Html d
encodeCellTable =
  h ([Attribute], [Attribute])
-> [Attribute]
-> (a -> [Attribute])
-> (([Attribute] -> Html d -> Html d) -> Cell d -> Html d)
-> [Attribute]
-> Colonnade h a (Cell d)
-> f a
-> Html d
forall (f :: * -> *) (h :: * -> *) a d c.
(Foldable f, Headedness h, Monoid d) =>
h ([Attribute], [Attribute])
-> [Attribute]
-> (a -> [Attribute])
-> (([Attribute] -> Html d -> Html d) -> c -> Html d)
-> [Attribute]
-> Colonnade h a c
-> f a
-> Html d
encodeTable
    (([Attribute], [Attribute]) -> h ([Attribute], [Attribute])
forall a. a -> h a
forall (h :: * -> *) a. Headedness h => a -> h a
E.headednessPure ([], []))
    [Attribute]
forall a. Monoid a => a
mempty
    ([Attribute] -> a -> [Attribute]
forall a b. a -> b -> a
const [Attribute]
forall a. Monoid a => a
mempty)
    ([Attribute] -> Html d -> Html d) -> Cell d -> Html d
forall d. ([Attribute] -> Html d -> Html d) -> Cell d -> Html d
htmlFromCell

encodeCellTableSized ::
  (E.Headedness h, Foldable f, Monoid d) =>
  -- | Attributes of @\<table\>@ element
  [Attribute] ->
  -- | How to encode data as columns
  Colonnade (E.Sized Int h) a (Cell d) ->
  -- | Collection of data
  f a ->
  Html ()
encodeCellTableSized :: forall (h :: * -> *) (f :: * -> *) d a.
(Headedness h, Foldable f, Monoid d) =>
[Attribute] -> Colonnade (Sized Int h) a (Cell d) -> f a -> Html ()
encodeCellTableSized =
  h ([Attribute], [Attribute])
-> [Attribute]
-> (a -> [Attribute])
-> (([Attribute] -> Html d -> Html d) -> Cell d -> Html d)
-> [Attribute]
-> Colonnade (Sized Int h) a (Cell d)
-> f a
-> Html ()
forall (f :: * -> *) (h :: * -> *) a d.
(Foldable f, Headedness h, Monoid d) =>
h ([Attribute], [Attribute])
-> [Attribute]
-> (a -> [Attribute])
-> (([Attribute] -> Html d -> Html d) -> Cell d -> Html d)
-> [Attribute]
-> Colonnade (Sized Int h) a (Cell d)
-> f a
-> Html ()
encodeTableSized
    (([Attribute], [Attribute]) -> h ([Attribute], [Attribute])
forall a. a -> h a
forall (h :: * -> *) a. Headedness h => a -> h a
E.headednessPure ([], []))
    [Attribute]
forall a. Monoid a => a
mempty
    ([Attribute] -> a -> [Attribute]
forall a b. a -> b -> a
const [Attribute]
forall a. Monoid a => a
mempty)
    ([Attribute] -> Html d -> Html d) -> Cell d -> Html d
forall d. ([Attribute] -> Html d -> Html d) -> Cell d -> Html d
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) =>
  -- | Attributes of @\<thead\>@ and its @\<tr\>@
  h ([Attribute], [Attribute]) ->
  -- | Attributes of @\<tbody\>@ element
  [Attribute] ->
  -- | Attributes of each @\<tr\>@ element
  (a -> [Attribute]) ->
  -- | Wrap content and convert to 'Html'
  (([Attribute] -> Html d -> Html d) -> c -> Html d) ->
  -- | Attributes of @\<table\>@ element
  [Attribute] ->
  -- | How to encode data as a row
  Colonnade h a c ->
  -- | Collection of data
  f a ->
  Html d
encodeTable :: forall (f :: * -> *) (h :: * -> *) a d c.
(Foldable f, Headedness h, Monoid d) =>
h ([Attribute], [Attribute])
-> [Attribute]
-> (a -> [Attribute])
-> (([Attribute] -> Html d -> Html d) -> c -> Html d)
-> [Attribute]
-> Colonnade h a c
-> f a
-> Html d
encodeTable h ([Attribute], [Attribute])
mtheadAttrs [Attribute]
tbodyAttrs a -> [Attribute]
trAttrs ([Attribute] -> HtmlT Identity d -> HtmlT Identity d)
-> c -> HtmlT Identity d
wrapContent [Attribute]
tableAttrs Colonnade h a c
colonnade f a
xs =
  [Attribute] -> HtmlT Identity d -> HtmlT Identity d
forall arg result. Term arg result => arg -> result
table_ [Attribute]
tableAttrs (HtmlT Identity d -> HtmlT Identity d)
-> HtmlT Identity d -> HtmlT Identity d
forall a b. (a -> b) -> a -> b
$ do
    d
d1 <- case Maybe (ExtractForall h)
forall (h :: * -> *). Headedness h => Maybe (ExtractForall h)
E.headednessExtractForall of
      Maybe (ExtractForall h)
Nothing -> d -> HtmlT Identity d
forall a. a -> HtmlT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return d
forall a. Monoid a => a
mempty
      Just ExtractForall h
extractForall -> do
        let ([Attribute]
theadAttrs, [Attribute]
theadTrAttrs) = h ([Attribute], [Attribute]) -> ([Attribute], [Attribute])
forall y. h y -> y
extract h ([Attribute], [Attribute])
mtheadAttrs
        [Attribute] -> HtmlT Identity d -> HtmlT Identity d
forall arg result. Term arg result => arg -> result
thead_ [Attribute]
theadAttrs (HtmlT Identity d -> HtmlT Identity d)
-> HtmlT Identity d -> HtmlT Identity d
forall a b. (a -> b) -> a -> b
$ [Attribute] -> HtmlT Identity d -> HtmlT Identity d
forall arg result. Term arg result => arg -> result
tr_ [Attribute]
theadTrAttrs (HtmlT Identity d -> HtmlT Identity d)
-> HtmlT Identity d -> HtmlT Identity d
forall a b. (a -> b) -> a -> b
$ do
          (OneColonnade h a c -> HtmlT Identity d)
-> Vector (OneColonnade h a c) -> HtmlT Identity d
forall (g :: * -> *) b a (m :: * -> *).
(Foldable g, Monoid b, Monad m) =>
(a -> m b) -> g a -> m b
foldlMapM' (([Attribute] -> HtmlT Identity d -> HtmlT Identity d)
-> c -> HtmlT Identity d
wrapContent [Attribute] -> HtmlT Identity d -> HtmlT Identity d
forall arg result. Term arg result => arg -> result
th_ (c -> HtmlT Identity d)
-> (OneColonnade h a c -> c)
-> OneColonnade h a c
-> HtmlT Identity d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h c -> c
forall y. h y -> y
extract (h c -> c)
-> (OneColonnade h a c -> h c) -> OneColonnade h a c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneColonnade h a c -> h c
forall (h :: * -> *) a c. OneColonnade h a c -> h c
E.oneColonnadeHead) (Colonnade h a c -> Vector (OneColonnade h a c)
forall (h :: * -> *) a c.
Colonnade h a c -> Vector (OneColonnade h a c)
E.getColonnade Colonnade h a c
colonnade)
       where
        extract :: forall y. h y -> y
        extract :: forall y. h y -> y
extract = ExtractForall h -> forall y. h y -> y
forall (h :: * -> *). ExtractForall h -> forall a. h a -> a
E.runExtractForall ExtractForall h
extractForall
    d
d2 <- (a -> [Attribute])
-> (([Attribute] -> HtmlT Identity d -> HtmlT Identity d)
    -> c -> HtmlT Identity d)
-> [Attribute]
-> Colonnade h a c
-> f a
-> HtmlT Identity d
forall (f :: * -> *) d a c (h :: * -> *).
(Foldable f, Monoid d) =>
(a -> [Attribute])
-> (([Attribute] -> Html d -> Html d) -> c -> Html d)
-> [Attribute]
-> Colonnade h a c
-> f a
-> Html d
encodeBody a -> [Attribute]
trAttrs ([Attribute] -> HtmlT Identity d -> HtmlT Identity d)
-> c -> HtmlT Identity d
wrapContent [Attribute]
tbodyAttrs Colonnade h a c
colonnade f a
xs
    d -> HtmlT Identity d
forall a. a -> HtmlT Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> d -> d
forall a. Monoid a => a -> a -> a
mappend d
d1 d
d2)

encodeBody ::
  (Foldable f, Monoid d) =>
  -- | Attributes of each @\<tr\>@ element
  (a -> [Attribute]) ->
  -- | Wrap content and convert to 'Html'
  (([Attribute] -> Html d -> Html d) -> c -> Html d) ->
  -- | Attributes of @\<tbody\>@ element
  [Attribute] ->
  -- | How to encode data as a row
  Colonnade h a c ->
  -- | Collection of data
  f a ->
  Html d
encodeBody :: forall (f :: * -> *) d a c (h :: * -> *).
(Foldable f, Monoid d) =>
(a -> [Attribute])
-> (([Attribute] -> Html d -> Html d) -> c -> Html d)
-> [Attribute]
-> Colonnade h a c
-> f a
-> Html d
encodeBody a -> [Attribute]
trAttrs ([Attribute] -> HtmlT Identity d -> HtmlT Identity d)
-> c -> HtmlT Identity d
wrapContent [Attribute]
tbodyAttrs Colonnade h a c
colonnade f a
xs = do
  [Attribute] -> HtmlT Identity d -> HtmlT Identity d
forall arg result. Term arg result => arg -> result
tbody_ [Attribute]
tbodyAttrs (HtmlT Identity d -> HtmlT Identity d)
-> HtmlT Identity d -> HtmlT Identity d
forall a b. (a -> b) -> a -> b
$ do
    ((a -> HtmlT Identity d) -> f a -> HtmlT Identity d)
-> f a -> (a -> HtmlT Identity d) -> HtmlT Identity d
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> HtmlT Identity d) -> f a -> HtmlT Identity d
forall (g :: * -> *) b a (m :: * -> *).
(Foldable g, Monoid b, Monad m) =>
(a -> m b) -> g a -> m b
foldlMapM' f a
xs ((a -> HtmlT Identity d) -> HtmlT Identity d)
-> (a -> HtmlT Identity d) -> HtmlT Identity d
forall a b. (a -> b) -> a -> b
$ \a
x -> do
      [Attribute] -> HtmlT Identity d -> HtmlT Identity d
forall arg result. Term arg result => arg -> result
tr_ (a -> [Attribute]
trAttrs a
x) (HtmlT Identity d -> HtmlT Identity d)
-> HtmlT Identity d -> HtmlT Identity d
forall a b. (a -> b) -> a -> b
$ Colonnade h a c -> (c -> HtmlT Identity d) -> a -> HtmlT Identity d
forall (m :: * -> *) b (f :: * -> *) a c.
(Monad m, Monoid b) =>
Colonnade f a c -> (c -> m b) -> a -> m b
E.rowMonadic Colonnade h a c
colonnade (([Attribute] -> HtmlT Identity d -> HtmlT Identity d)
-> c -> HtmlT Identity d
wrapContent [Attribute] -> HtmlT Identity d -> HtmlT Identity d
forall arg result. Term arg result => arg -> result
td_) a
x

encodeBodySized ::
  (Foldable f, Monoid d) =>
  (a -> [Attribute]) ->
  [Attribute] ->
  Colonnade (E.Sized Int h) a (Cell d) ->
  f a ->
  Html ()
encodeBodySized :: forall (f :: * -> *) d a (h :: * -> *).
(Foldable f, Monoid d) =>
(a -> [Attribute])
-> [Attribute]
-> Colonnade (Sized Int h) a (Cell d)
-> f a
-> Html ()
encodeBodySized a -> [Attribute]
trAttrs [Attribute]
tbodyAttrs Colonnade (Sized Int h) a (Cell d)
colonnade f a
collection = [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
tbody_ [Attribute]
tbodyAttrs (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
  f a -> (a -> Html ()) -> Html ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
collection ((a -> Html ()) -> Html ()) -> (a -> Html ()) -> Html ()
forall a b. (a -> b) -> a -> b
$ \a
a -> [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
tr_ (a -> [Attribute]
trAttrs a
a) (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
    Colonnade (Sized Int h) a (Cell d)
-> (Sized Int h (Cell d) -> Cell d -> Html ()) -> a -> Html ()
forall m (h :: * -> *) a c.
Monoid m =>
Colonnade h a c -> (h c -> c -> m) -> a -> m
E.rowMonoidalHeader
      Colonnade (Sized Int h) a (Cell d)
colonnade
      ( \(E.Sized Int
sz h (Cell d)
_) (Cell [Attribute]
cattr Html d
content) ->
          Html d -> Html ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Html d -> Html ()) -> Html d -> Html ()
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html d -> Html d
forall arg result. Term arg result => arg -> result
td_ (Int -> [Attribute] -> [Attribute]
setColspanOrHide Int
sz [Attribute]
cattr) Html d
content
      )
      a
a

encodeTableSized ::
  forall f h a d.
  (Foldable f, E.Headedness h, Monoid d) =>
  -- | Attributes of @\<thead\>@ and its @\<tr\>@
  h ([Attribute], [Attribute]) ->
  -- | Attributes of @\<tbody\>@ element
  [Attribute] ->
  -- | Attributes of each @\<tr\>@ element
  (a -> [Attribute]) ->
  -- | Wrap content and convert to 'Html'
  (([Attribute] -> Html d -> Html d) -> (Cell d) -> Html d) ->
  -- | Attributes of @\<table\>@ element
  [Attribute] ->
  -- | How to encode data as a row
  Colonnade (E.Sized Int h) a (Cell d) ->
  -- | Collection of data
  f a ->
  Html ()
encodeTableSized :: forall (f :: * -> *) (h :: * -> *) a d.
(Foldable f, Headedness h, Monoid d) =>
h ([Attribute], [Attribute])
-> [Attribute]
-> (a -> [Attribute])
-> (([Attribute] -> Html d -> Html d) -> Cell d -> Html d)
-> [Attribute]
-> Colonnade (Sized Int h) a (Cell d)
-> f a
-> Html ()
encodeTableSized h ([Attribute], [Attribute])
mtheadAttrs [Attribute]
tbodyAttrs a -> [Attribute]
trAttrs ([Attribute] -> Html d -> Html d) -> Cell d -> Html d
wrapContent [Attribute]
tableAttrs Colonnade (Sized Int h) a (Cell d)
colonnade f a
xs =
  [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
table_ [Attribute]
tableAttrs (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
    ()
_ <- case Maybe (ExtractForall h)
forall (h :: * -> *). Headedness h => Maybe (ExtractForall h)
E.headednessExtractForall of
      Maybe (ExtractForall h)
Nothing -> () -> Html ()
forall a. a -> HtmlT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall a. Monoid a => a
mempty
      Just ExtractForall h
extractForall -> do
        let ([Attribute]
theadAttrs, [Attribute]
theadTrAttrs) = h ([Attribute], [Attribute]) -> ([Attribute], [Attribute])
forall y. h y -> y
extract h ([Attribute], [Attribute])
mtheadAttrs
        [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
thead_ [Attribute]
theadAttrs (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
tr_ [Attribute]
theadTrAttrs (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
          (OneColonnade (Sized Int h) a (Cell d) -> Html d)
-> Vector (OneColonnade (Sized Int h) a (Cell d)) -> Html ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
            ( ([Attribute] -> Html d -> Html d) -> Cell d -> Html d
wrapContent [Attribute] -> Html d -> Html d
forall arg result. Term arg result => arg -> result
th_
                (Cell d -> Html d)
-> (OneColonnade (Sized Int h) a (Cell d) -> Cell d)
-> OneColonnade (Sized Int h) a (Cell d)
-> Html d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h (Cell d) -> Cell d
forall y. h y -> y
extract
                (h (Cell d) -> Cell d)
-> (OneColonnade (Sized Int h) a (Cell d) -> h (Cell d))
-> OneColonnade (Sized Int h) a (Cell d)
-> Cell d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( \(E.Sized Int
i h (Cell d)
h) -> case Maybe (h (Cell d) -> Cell d)
forall a. Maybe (h a -> a)
forall (h :: * -> *) a. Headedness h => Maybe (h a -> a)
E.headednessExtract of
                      Just h (Cell d) -> Cell d
f ->
                        let (Cell [Attribute]
attrs Html d
content) = h (Cell d) -> Cell d
f h (Cell d)
h
                         in Cell d -> h (Cell d)
forall a. a -> h a
forall (h :: * -> *) a. Headedness h => a -> h a
E.headednessPure (Cell d -> h (Cell d)) -> Cell d -> h (Cell d)
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Html d -> Cell d
forall d. [Attribute] -> Html d -> Cell d
Cell (Int -> [Attribute] -> [Attribute]
setColspanOrHide Int
i [Attribute]
attrs) Html d
content
                      Maybe (h (Cell d) -> Cell d)
Nothing -> Cell d -> h (Cell d)
forall a. a -> h a
forall (h :: * -> *) a. Headedness h => a -> h a
E.headednessPure Cell d
forall a. Monoid a => a
mempty
                      -- (E.Headed (Cell attrs content)) -> E.Headed $ Cell (setColspanOrHide i attrs) content
                      -- E.Headless -> E.Headless
                  )
                (Sized Int h (Cell d) -> h (Cell d))
-> (OneColonnade (Sized Int h) a (Cell d) -> Sized Int h (Cell d))
-> OneColonnade (Sized Int h) a (Cell d)
-> h (Cell d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneColonnade (Sized Int h) a (Cell d) -> Sized Int h (Cell d)
forall (h :: * -> *) a c. OneColonnade h a c -> h c
E.oneColonnadeHead
            )
            (Colonnade (Sized Int h) a (Cell d)
-> Vector (OneColonnade (Sized Int h) a (Cell d))
forall (h :: * -> *) a c.
Colonnade h a c -> Vector (OneColonnade h a c)
E.getColonnade Colonnade (Sized Int h) a (Cell d)
colonnade)
       where
        extract :: forall y. h y -> y
        extract :: forall y. h y -> y
extract = ExtractForall h -> forall y. h y -> y
forall (h :: * -> *). ExtractForall h -> forall a. h a -> a
E.runExtractForall ExtractForall h
extractForall
    (a -> [Attribute])
-> [Attribute]
-> Colonnade (Sized Int h) a (Cell d)
-> f a
-> Html ()
forall (f :: * -> *) d a (h :: * -> *).
(Foldable f, Monoid d) =>
(a -> [Attribute])
-> [Attribute]
-> Colonnade (Sized Int h) a (Cell d)
-> f a
-> Html ()
encodeBodySized a -> [Attribute]
trAttrs [Attribute]
tbodyAttrs Colonnade (Sized Int h) a (Cell d)
colonnade f a
xs

setColspanOrHide :: Int -> [Attribute] -> [Attribute]
setColspanOrHide :: Int -> [Attribute] -> [Attribute]
setColspanOrHide Int
i [Attribute]
attrs
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = Text -> Attribute
forall arg result. TermRaw arg result => arg -> result
style_ Text
"display:none;" Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: [Attribute]
attrs
  | Bool
otherwise = Text -> Attribute
colspan_ (String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
i)) Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: [Attribute]
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' a -> m b
f g a
xs = (a -> (b -> m b) -> b -> m b) -> (b -> m b) -> g a -> b -> m b
forall a b. (a -> b -> b) -> b -> g a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (b -> m b) -> b -> m b
f' b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure g a
xs b
forall a. Monoid a => a
mempty
 where
  f' :: a -> (b -> m b) -> b -> m b
  f' :: a -> (b -> m b) -> b -> m b
f' a
x b -> m b
k b
bl = do
    b
br <- a -> m b
f a
x
    let !b :: b
b = b -> b -> b
forall a. Monoid a => a -> a -> a
mappend b
bl b
br
    b -> m b
k b
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 :: forall d. ([Attribute] -> Html d -> Html d) -> Cell d -> Html d
htmlFromCell [Attribute] -> Html d -> Html d
f (Cell [Attribute]
attr Html d
content) = [Attribute] -> Html d -> Html d
f [Attribute]
attr Html d
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.
-}

sectioned ::
  (Foldable f, E.Headedness h, Foldable g, Monoid c) =>
  -- | @\<table\>@ tag attributes
  [Attribute] ->
  -- | Attributes of @\<thead\>@ and its @\<tr\>@, pass 'Nothing' to omit @\<thead\>@
  Maybe ([Attribute], [Attribute]) ->
  -- | @\<tbody\>@ tag attributes
  [Attribute] ->
  -- | @\<tr\>@ tag attributes for data rows
  (a -> [Attribute]) ->
  -- | Section divider encoding strategy
  (b -> Cell c) ->
  -- | Data encoding strategy
  Colonnade h a (Cell c) ->
  -- | Collection of data
  f (b, g a) ->
  Html ()
sectioned :: forall (f :: * -> *) (h :: * -> *) (g :: * -> *) c a b.
(Foldable f, Headedness h, Foldable g, Monoid c) =>
[Attribute]
-> Maybe ([Attribute], [Attribute])
-> [Attribute]
-> (a -> [Attribute])
-> (b -> Cell c)
-> Colonnade h a (Cell c)
-> f (b, g a)
-> Html ()
sectioned [Attribute]
tableAttrs Maybe ([Attribute], [Attribute])
mheadAttrs [Attribute]
bodyAttrs a -> [Attribute]
trAttrs b -> Cell c
dividerContent colonnade :: Colonnade h a (Cell c)
colonnade@(E.Colonnade Vector (OneColonnade h a (Cell c))
v) f (b, g a)
collection = do
  let vlen :: Int
vlen = Vector (OneColonnade h a (Cell c)) -> Int
forall a. Vector a -> Int
V.length Vector (OneColonnade h a (Cell c))
v
  [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
table_ [Attribute]
tableAttrs (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe ([Attribute], [Attribute])
-> (([Attribute], [Attribute]) -> Html ()) -> Html ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe ([Attribute], [Attribute])
mheadAttrs ((([Attribute], [Attribute]) -> Html ()) -> Html ())
-> (([Attribute], [Attribute]) -> Html ()) -> Html ()
forall a b. (a -> b) -> a -> b
$ \([Attribute]
headAttrs, [Attribute]
headTrAttrs) ->
      [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
thead_ [Attribute]
headAttrs (Html () -> Html ()) -> (Html () -> Html ()) -> Html () -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
tr_ [Attribute]
headTrAttrs (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
        Colonnade h a (Cell c) -> (Cell c -> Html c) -> Html ()
forall (m :: * -> *) (h :: * -> *) a c b.
(Monad m, Headedness h) =>
Colonnade h a c -> (c -> m b) -> m ()
E.headerMonadicGeneral_ Colonnade h a (Cell c)
colonnade (([Attribute] -> Html c -> Html c) -> Cell c -> Html c
forall d. ([Attribute] -> Html d -> Html d) -> Cell d -> Html d
htmlFromCell [Attribute] -> Html c -> Html c
forall arg result. Term arg result => arg -> result
th_)
    [Attribute] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
tbody_ [Attribute]
bodyAttrs (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$ f (b, g a) -> ((b, g a) -> Html ()) -> Html ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f (b, g a)
collection (((b, g a) -> Html ()) -> Html ())
-> ((b, g a) -> Html ()) -> Html ()
forall a b. (a -> b) -> a -> b
$ \(b
b, g a
as) -> do
      let Cell [Attribute]
attrs Html c
contents = b -> Cell c
dividerContent b
b
      c
_ <- [Attribute] -> Html c -> Html c
forall arg result. Term arg result => arg -> result
tr_ [] (Html c -> Html c) -> Html c -> Html c
forall a b. (a -> b) -> a -> b
$ do
        [Attribute] -> Html c -> Html c
forall arg result. Term arg result => arg -> result
td_ ((Text -> Attribute
colspan_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
vlen)) Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: [Attribute]
attrs) Html c
contents
      ((a -> Html c) -> g a -> Html ())
-> g a -> (a -> Html c) -> Html ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Html c) -> g a -> Html ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ g a
as ((a -> Html c) -> Html ()) -> (a -> Html c) -> Html ()
forall a b. (a -> b) -> a -> b
$ \a
a -> do
        [Attribute] -> Html c -> Html c
forall arg result. Term arg result => arg -> result
tr_ (a -> [Attribute]
trAttrs a
a) (Html c -> Html c) -> Html c -> Html c
forall a b. (a -> b) -> a -> b
$ Colonnade h a (Cell c) -> (Cell c -> Html c) -> a -> Html c
forall (m :: * -> *) b (f :: * -> *) a c.
(Monad m, Monoid b) =>
Colonnade f a c -> (c -> m b) -> a -> m b
E.rowMonadic Colonnade h a (Cell c)
colonnade (([Attribute] -> Html c -> Html c) -> Cell c -> Html c
forall d. ([Attribute] -> Html d -> Html d) -> Cell d -> Html d
htmlFromCell [Attribute] -> Html c -> Html c
forall arg result. Term arg result => arg -> result
td_) a
a