{-# LANGUAGE OverloadedStrings #-}

-- | An extension to the standard LaTeX tabular environment which
-- provides a construction for table cells that span more than one row
-- of the table.

module Text.LaTeX.Packages.Multirow
 ( multirowp
 , BigStrutsCount(..)
 , multirow
 ) where

import qualified Data.Semigroup as SG ((<>))
import Data.Maybe (catMaybes)
import Text.LaTeX.Base.Syntax (LaTeX(TeXComm), TeXArg(FixArg, OptArg))
import Text.LaTeX.Base.Class (LaTeXC, liftL)
import Text.LaTeX.Base.Types (PackageName, Pos, Measure)
import Text.LaTeX.Base.Render (Render, render, rendertex)

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

-- | Type of bigstruts count. It is mainly used if you’ve used the
-- bigstrut package. It is the total number of uses of bigstruts
-- within rows being spanned in a multirow.
data BigStrutsCount
  = BigStruts Int          -- ^ Normal bigstruts
  | BigStrutsTop Int       -- ^ Bigstruts in the top row
  | BigStrutsBottom Int    -- ^ Bigstruts in the bottom row
  | BigStrutsTopBottom Int -- ^ Bigstruts in the top and bottom rows
  deriving (Int -> BigStrutsCount -> ShowS
[BigStrutsCount] -> ShowS
BigStrutsCount -> PackageName
forall a.
(Int -> a -> ShowS)
-> (a -> PackageName) -> ([a] -> ShowS) -> Show a
showList :: [BigStrutsCount] -> ShowS
$cshowList :: [BigStrutsCount] -> ShowS
show :: BigStrutsCount -> PackageName
$cshow :: BigStrutsCount -> PackageName
showsPrec :: Int -> BigStrutsCount -> ShowS
$cshowsPrec :: Int -> BigStrutsCount -> ShowS
Show)

instance Render BigStrutsCount where
  render :: BigStrutsCount -> Text
render (BigStruts Int
n)          = forall a. Render a => a -> Text
render Int
n
  render (BigStrutsTop Int
n)       = Text
"t" forall a. Semigroup a => a -> a -> a
SG.<> forall a. Render a => a -> Text
render Int
n
  render (BigStrutsBottom Int
n)    = Text
"b" forall a. Semigroup a => a -> a -> a
SG.<> forall a. Render a => a -> Text
render Int
n
  render (BigStrutsTopBottom Int
n) = Text
"tb" forall a. Semigroup a => a -> a -> a
SG.<> forall a. Render a => a -> Text
render Int
n

-- | 'multirow' sets a piece of text in a tabular or similar
-- environment, spanning multiple rows.

multirow :: LaTeXC l =>
            Maybe Pos            -- ^ Optional vertical positioning of the text in the multirow block
         -> Double               -- ^ Number of rows to span
         -> Maybe BigStrutsCount -- ^ Optinal total number of uses of bigstrut within the rows being spanned
         -> Measure              -- ^ Width to which the text is to be set
         -> Maybe Measure        -- ^ Optinal length used to raise or lower the text
         -> l                    -- ^ Actual text of the construct
         -> l
multirow :: forall l.
LaTeXC l =>
Maybe Pos
-> Double
-> Maybe BigStrutsCount
-> Measure
-> Maybe Measure
-> l
-> l
multirow Maybe Pos
mVPos Double
nrows Maybe BigStrutsCount
mBigstruts Measure
width Maybe Measure
mVMove =
  forall l. LaTeXC l => (LaTeX -> LaTeX) -> l -> l
liftL (\LaTeX
l ->
           PackageName -> [TeXArg] -> LaTeX
TeXComm PackageName
"multirow" forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes  [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LaTeX -> TeXArg
OptArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a l. (Render a, LaTeXC l) => a -> l
rendertex) Maybe Pos
mVPos
                                           , forall a. a -> Maybe a
Just (LaTeX -> TeXArg
FixArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a l. (Render a, LaTeXC l) => a -> l
rendertex forall a b. (a -> b) -> a -> b
$ Double
nrows)
                                           , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LaTeX -> TeXArg
OptArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a l. (Render a, LaTeXC l) => a -> l
rendertex) Maybe BigStrutsCount
mBigstruts
                                           , forall a. a -> Maybe a
Just (LaTeX -> TeXArg
FixArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a l. (Render a, LaTeXC l) => a -> l
rendertex forall a b. (a -> b) -> a -> b
$ Measure
width)
                                           , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LaTeX -> TeXArg
OptArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a l. (Render a, LaTeXC l) => a -> l
rendertex) Maybe Measure
mVMove
                                           , forall a. a -> Maybe a
Just (LaTeX -> TeXArg
FixArg LaTeX
l)
                                           ]
        )