{-# LANGUAGE OverloadedStrings #-}

module Text.LaTeX.Packages.TabularX
 ( -- * tabularx package
   tabularxp
   -- * tabularx commands
 , tabularx
 ) where

import Text.LaTeX.Base.Syntax (LaTeX(TeXEnv, TeXRaw), TeXArg(FixArg, OptArg))
import Text.LaTeX.Base.Class (LaTeXC, liftL)
import Text.LaTeX.Base.Render (render, renderAppend)
import Text.LaTeX.Base.Types (PackageName, Pos, TableSpec, Measure)

-- | tabularx package. Use it to import it like this:
--
-- > usepackage [] tabularxp
tabularxp :: PackageName
tabularxp :: PackageName
tabularxp = PackageName
"tabularx"

-- | The 'tabularx' environment takes the same arguments as tabular*,
-- but modifies the widths of certain columns, rather than the inter
-- column space, to set a table with the requested total width. The
-- columns that may stretch are marked with the new token X in the
-- preamble argument.
--
tabularx :: LaTeXC l =>
            Measure      -- ^ Width of the whole tabular.
         -> Maybe Pos   -- ^ This optional parameter can be used to specify the vertical position of the table.
                        --   Defaulted to 'Center'.
         -> [TableSpec] -- ^ Table specification of columns and vertical lines.
         -> l           -- ^ Table content. See '&', 'lnbk', 'hline' and 'cline'.
         -> l           -- ^ Resulting table syntax.
tabularx :: forall l. LaTeXC l => Measure -> Maybe Pos -> [TableSpec] -> l -> l
tabularx Measure
width Maybe Pos
maybePos [TableSpec]
ts =
  forall l. LaTeXC l => (LaTeX -> LaTeX) -> l -> l
liftL forall a b. (a -> b) -> a -> b
$ PackageName -> [TeXArg] -> LaTeX -> LaTeX
TeXEnv PackageName
"tabularx" [TeXArg]
args
  where
    width' :: TeXArg
width' = LaTeX -> TeXArg
FixArg forall a b. (a -> b) -> a -> b
$ Text -> LaTeX
TeXRaw forall a b. (a -> b) -> a -> b
$ forall a. Render a => a -> Text
render Measure
width
    ts' :: TeXArg
ts' = LaTeX -> TeXArg
FixArg forall a b. (a -> b) -> a -> b
$ Text -> LaTeX
TeXRaw forall a b. (a -> b) -> a -> b
$ forall a. Render a => [a] -> Text
renderAppend [TableSpec]
ts
    args :: [TeXArg]
args = case Maybe Pos
maybePos of
             Maybe Pos
Nothing -> [TeXArg
width', TeXArg
ts']
             Just Pos
p -> [TeXArg
width', TeXArg
p', TeXArg
ts']
               where
                 p' :: TeXArg
p' = LaTeX -> TeXArg
OptArg forall a b. (a -> b) -> a -> b
$ Text -> LaTeX
TeXRaw forall a b. (a -> b) -> a -> b
$ forall a. Render a => a -> Text
render Pos
p