{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module      : Text.Pandoc.Writers.Docx.Table
Copyright   : Copyright (C) 2012-2023 John MacFarlane
License     : GNU GPL, version 2 or above
Maintainer  : John MacFarlane <jgm@berkeley.edu>

Conversion of table blocks to docx.
-}
module Text.Pandoc.Writers.Docx.Table
  ( tableToOpenXML
  , rowToOpenXML
  , OOXMLRow (..)
  , OOXMLCell (..)
  , RowType (..)
  ) where

import Control.Monad.State.Strict ( modify, gets )
import Control.Monad ( unless , zipWithM )
import Control.Monad.Except ( throwError )
import Data.Array ( elems, (!), assocs, indices )
import Data.Text (Text)
import Text.Pandoc.Definition
    ( ColSpec,
      Caption(Caption),
      Format(Format),
      Attr,
      Block(Para, Plain),
      Inline(Str, Span, RawInline),
      Alignment(..),
      RowSpan(..),
      ColSpan(..),
      ColWidth(..) )
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Translations (translateTerm)
import Text.Pandoc.Writers.Docx.Types
    ( WS,
      WriterState(stNextTableNum, stInTable),
      WriterEnv(..),
      setFirstPara,
      pStyleM,
      withParaProp,
      withParaPropM )
import Control.Monad.Reader (asks)
import Text.Pandoc.Shared ( tshow, stringify )
import Text.Pandoc.Options (WriterOptions, isEnabled)
import Text.Pandoc.Extensions (Extension(Ext_native_numbering))
import Text.Pandoc.Error (PandocError(PandocSomeError))
import Text.Printf (printf)
import Text.Pandoc.Writers.GridTable
    ( rowArray,
      ColIndex,
      GridCell(..),
      Part(Part, partCellArray, partRowAttrs),
      RowIndex )
import Text.Pandoc.Writers.OOXML ( mknode )
import Text.Pandoc.XML.Light.Proc ( onlyElems )
import Text.Pandoc.XML.Light.Types
    ( Content(Elem), Element(elName), QName(qName) )
import qualified Data.Text as T
import qualified Text.Pandoc.Translations as Term
import qualified Text.Pandoc.Writers.GridTable as Grid

tableToOpenXML :: PandocMonad m
               => WriterOptions
               -> ([Block] -> WS m [Content])
               -> Grid.Table
               -> WS m [Content]
tableToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions
-> ([Block] -> WS m [Content]) -> Table -> WS m [Content]
tableToOpenXML WriterOptions
opts [Block] -> WS m [Content]
blocksToOpenXML Table
gridTable = do
  forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
  let (Grid.Table (Text
ident,[Text]
_,[(Text, Text)]
_) Caption
caption Array ColIndex ColSpec
colspecs RowHeadColumns
_rowheads Part
thead [Part]
tbodies Part
tfoot) =
        Table
gridTable
  let (Caption Maybe ShortCaption
_maybeShortCaption [Block]
captionBlocks) = Caption
caption
  Int
tablenum <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNextTableNum
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
captionBlocks) forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
st -> WriterState
st{ stNextTableNum :: Int
stNextTableNum = Int
tablenum forall a. Num a => a -> a -> a
+ Int
1 }
  let tableid :: Text
tableid = if Text -> Bool
T.null Text
ident
                   then Text
"table" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
tablenum
                   else Text
ident
  Text
tablename <- forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
Term.Table
  let captionStr :: Text
captionStr = forall a. Walkable Inline a => a -> Text
stringify [Block]
captionBlocks
  let aligns :: [Alignment]
aligns = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall i e. Array i e -> [e]
elems Array ColIndex ColSpec
colspecs
  [Content]
captionXml <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
captionBlocks
                then forall (m :: * -> *) a. Monad m => a -> m a
return []
                else forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Table Caption")
                     forall a b. (a -> b) -> a -> b
$ [Block] -> WS m [Content]
blocksToOpenXML
                     forall a b. (a -> b) -> a -> b
$ if forall a. HasSyntaxExtensions a => Extension -> a -> Bool
isEnabled Extension
Ext_native_numbering WriterOptions
opts
                          then Text -> Text -> Int -> [Block] -> [Block]
addLabel Text
tableid Text
tablename Int
tablenum [Block]
captionBlocks
                          else [Block]
captionBlocks
  -- We set "in table" after processing the caption, because we don't
  -- want the "Table Caption" style to be overwritten with "Compact".
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stInTable :: Bool
stInTable = Bool
True }
  [Element]
head' <- forall (m :: * -> *).
PandocMonad m =>
([Block] -> WS m [Content])
-> RowType -> [Alignment] -> Part -> WS m [Element]
cellGridToOpenXML [Block] -> WS m [Content]
blocksToOpenXML RowType
HeadRow [Alignment]
aligns Part
thead
  [[Element]]
bodies <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
([Block] -> WS m [Content])
-> RowType -> [Alignment] -> Part -> WS m [Element]
cellGridToOpenXML [Block] -> WS m [Content]
blocksToOpenXML RowType
BodyRow [Alignment]
aligns) [Part]
tbodies
  [Element]
foot' <- forall (m :: * -> *).
PandocMonad m =>
([Block] -> WS m [Content])
-> RowType -> [Alignment] -> Part -> WS m [Element]
cellGridToOpenXML [Block] -> WS m [Content]
blocksToOpenXML RowType
FootRow [Alignment]
aligns Part
tfoot

  let hasHeader :: Bool
hasHeader = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => Array i e -> [i]
indices forall b c a. (b -> c) -> (a -> b) -> a -> c
. Part -> Array RowIndex (Text, [Text], [(Text, Text)])
partRowAttrs forall a b. (a -> b) -> a -> b
$ Part
thead
  let hasFooter :: Bool
hasFooter = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => Array i e -> [i]
indices forall b c a. (b -> c) -> (a -> b) -> a -> c
. Part -> Array RowIndex (Text, [Text], [(Text, Text)])
partRowAttrs forall a b. (a -> b) -> a -> b
$ Part
tfoot
  -- for compatibility with Word <= 2007, we include a val with a bitmask
  -- 0×0020  Apply first row conditional formatting
  -- 0×0040  Apply last row conditional formatting
  -- 0×0080  Apply first column conditional formatting
  -- 0×0100  Apply last column conditional formatting
  -- 0×0200  Do not apply row banding conditional formatting
  -- 0×0400  Do not apply column banding conditional formattin
  let tblLookVal :: Int
tblLookVal = if Bool
hasHeader then (Int
0x20 :: Int) else Int
0
  let ([Element]
gridCols, [(Text, Text)]
tblWattr) = [ColSpec] -> ([Element], [(Text, Text)])
tableLayout (forall i e. Array i e -> [e]
elems Array ColIndex ColSpec
colspecs)
  Int
listLevel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envListLevel
  let indent :: Int
indent = (Int
listLevel forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
* Int
720
  let hasWidths :: Bool
hasWidths = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall a. Eq a => a -> a -> Bool
== ColWidth
ColWidthDefault) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Array ColIndex ColSpec
colspecs
  let tbl :: Element
tbl = forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tbl" []
        ( forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblPr" []
          ( forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblStyle" [(Text
"w:val",Text
"Table")] () forall a. a -> [a] -> [a]
:
            forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblW" [(Text, Text)]
tblWattr () forall a. a -> [a] -> [a]
:
            forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblLook" [(Text
"w:firstRow",if Bool
hasHeader then Text
"1" else Text
"0")
                               ,(Text
"w:lastRow",if Bool
hasFooter then Text
"1" else Text
"0")
                               ,(Text
"w:firstColumn",Text
"0")
                               ,(Text
"w:lastColumn",Text
"0")
                               ,(Text
"w:noHBand",Text
"0")
                               ,(Text
"w:noVBand",Text
"0")
                               ,(Text
"w:val", String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%04x" Int
tblLookVal)
                               ] () forall a. a -> [a] -> [a]
:
            forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:jc" [(Text
"w:val",Text
"start")] ()
            forall a. a -> [a] -> [a]
: [ forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblInd" [(Text
"w:w", forall a. Show a => a -> Text
tshow Int
indent),(Text
"w:type",Text
"dxa")] ()
                | Int
indent forall a. Ord a => a -> a -> Bool
> Int
0 ] forall a. [a] -> [a] -> [a]
++
            [ forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblLayout" [(Text
"w:type", Text
"fixed")] () | Bool
hasWidths ] forall a. [a] -> [a] -> [a]
++
            [ forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblCaption" [(Text
"w:val", Text
captionStr)] ()
            | Bool -> Bool
not (Text -> Bool
T.null Text
captionStr) ]
          )
          forall a. a -> [a] -> [a]
: forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblGrid" [] [Element]
gridCols
          forall a. a -> [a] -> [a]
: [Element]
head' forall a. [a] -> [a] -> [a]
++ forall a. Monoid a => [a] -> a
mconcat [[Element]]
bodies forall a. [a] -> [a] -> [a]
++ [Element]
foot'
        )
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stInTable :: Bool
stInTable = Bool
False }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Content]
captionXml forall a. [a] -> [a] -> [a]
++ [Element -> Content
Elem Element
tbl]

addLabel :: Text -> Text -> Int -> [Block] -> [Block]
addLabel :: Text -> Text -> Int -> [Block] -> [Block]
addLabel Text
tableid Text
tablename Int
tablenum [Block]
bs =
  case [Block]
bs of
    (Para ShortCaption
ils : [Block]
rest)  -> ShortCaption -> Block
Para (Inline
label forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
": " forall a. a -> [a] -> [a]
: ShortCaption
ils) forall a. a -> [a] -> [a]
: [Block]
rest
    (Plain ShortCaption
ils : [Block]
rest) -> ShortCaption -> Block
Plain (Inline
label forall a. a -> [a] -> [a]
: Text -> Inline
Str Text
": " forall a. a -> [a] -> [a]
: ShortCaption
ils) forall a. a -> [a] -> [a]
: [Block]
rest
    [Block]
_ -> ShortCaption -> Block
Para [Inline
label] forall a. a -> [a] -> [a]
: [Block]
bs
 where
  label :: Inline
label = (Text, [Text], [(Text, Text)]) -> ShortCaption -> Inline
Span (Text
tableid,[],[])
            [Text -> Inline
Str (Text
tablename forall a. Semigroup a => a -> a -> a
<> Text
"\160"),
             Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"openxml")
               (Text
"<w:fldSimple w:instr=\"SEQ Table"
               forall a. Semigroup a => a -> a -> a
<> Text
" \\* ARABIC \"><w:r><w:t>"
               forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow Int
tablenum
               forall a. Semigroup a => a -> a -> a
<> Text
"</w:t></w:r></w:fldSimple>")]

-- | Parts of a table
data RowType = HeadRow | BodyRow | FootRow

alignmentToString :: Alignment -> Text
alignmentToString :: Alignment -> Text
alignmentToString = \case
  Alignment
AlignLeft    -> Text
"left"
  Alignment
AlignRight   -> Text
"right"
  Alignment
AlignCenter  -> Text
"center"
  Alignment
AlignDefault -> Text
"left"

tableLayout :: [ColSpec] -> ([Element], [(Text, Text)])
tableLayout :: [ColSpec] -> ([Element], [(Text, Text)])
tableLayout [ColSpec]
specs =
  let
    textwidth :: Double
textwidth = Double
7920  -- 5.5 in in twips       (1 twip == 1/20 pt)
    fullrow :: Double
fullrow   = Double
5000  -- 100% specified in pct (1 pct  == 1/50th of a percent)
    ncols :: Int
ncols = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColSpec]
specs
    getWidth :: ColWidth -> Double
getWidth = \case
      ColWidth Double
n -> Double
n
      ColWidth
_          -> Double
0
    widths :: [Double]
widths = forall a b. (a -> b) -> [a] -> [b]
map (ColWidth -> Double
getWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [ColSpec]
specs
    rowwidth :: Int
rowwidth  = forall a b. (RealFrac a, Integral b) => a -> b
round (Double
fullrow forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths) :: Int
    widthToTwips :: Double -> Int
widthToTwips Double
w = forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
textwidth forall a. Num a => a -> a -> a
* Double
w)   :: Int
    mkGridCol :: Double -> Element
mkGridCol Double
w = forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:gridCol" [(Text
"w:w", forall a. Show a => a -> Text
tshow (Double -> Int
widthToTwips Double
w))] ()
  in if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths
     then ( forall a. Int -> a -> [a]
replicate Int
ncols forall a b. (a -> b) -> a -> b
$ Double -> Element
mkGridCol (Double
1.0 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ncols)
          , [ (Text
"w:type", Text
"auto"), (Text
"w:w", Text
"0")])
     else ( forall a b. (a -> b) -> [a] -> [b]
map Double -> Element
mkGridCol [Double]
widths
          , [ (Text
"w:type", Text
"pct"), (Text
"w:w", forall a. Show a => a -> Text
tshow Int
rowwidth) ])

cellGridToOpenXML :: PandocMonad m
                  => ([Block] -> WS m [Content])
                  -> RowType
                  -> [Alignment]
                  -> Part
                  -> WS m [Element]
cellGridToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
([Block] -> WS m [Content])
-> RowType -> [Alignment] -> Part -> WS m [Element]
cellGridToOpenXML [Block] -> WS m [Content]
blocksToOpenXML RowType
rowType [Alignment]
aligns part :: Part
part@(Part (Text, [Text], [(Text, Text)])
_ Array (RowIndex, ColIndex) GridCell
cellArray Array RowIndex (Text, [Text], [(Text, Text)])
_) =
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall i e. Array i e -> [e]
elems Array (RowIndex, ColIndex) GridCell
cellArray)
  then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  else forall (m :: * -> *).
PandocMonad m =>
RowType -> [Alignment] -> Part -> WS m [OOXMLRow]
partToRows RowType
rowType [Alignment]
aligns Part
part forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
       forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
([Block] -> WS m [Content]) -> OOXMLRow -> WS m Element
rowToOpenXML [Block] -> WS m [Content]
blocksToOpenXML)

data OOXMLCell
  = OOXMLCell Attr Alignment RowSpan ColSpan [Block]
  | OOXMLCellMerge ColSpan

data OOXMLRow = OOXMLRow RowType Attr [OOXMLCell]

partToRows :: PandocMonad m
           => RowType -> [Alignment] -> Part -> WS m [OOXMLRow]
partToRows :: forall (m :: * -> *).
PandocMonad m =>
RowType -> [Alignment] -> Part -> WS m [OOXMLRow]
partToRows RowType
rowType [Alignment]
aligns Part
part = do
  let toOOXMLCell :: PandocMonad m =>
        Alignment -> RowIndex -> ColIndex -> GridCell -> WS m [OOXMLCell]
      toOOXMLCell :: forall (m :: * -> *).
PandocMonad m =>
Alignment -> RowIndex -> ColIndex -> GridCell -> WS m [OOXMLCell]
toOOXMLCell Alignment
columnAlign RowIndex
ridx ColIndex
cidx = \case
        GridCell
UnassignedCell ->
          forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocSomeError Text
"Encountered unassigned table cell"
        ContentCell (Text, [Text], [(Text, Text)])
attr Alignment
align RowSpan
rowspan ColSpan
colspan [Block]
blocks -> do
          -- Respect non-default, cell specific alignment.
          let align' :: Alignment
align' = case Alignment
align of
                Alignment
AlignDefault -> Alignment
columnAlign
                Alignment
_            -> Alignment
align
          forall (m :: * -> *) a. Monad m => a -> m a
return [(Text, [Text], [(Text, Text)])
-> Alignment -> RowSpan -> ColSpan -> [Block] -> OOXMLCell
OOXMLCell (Text, [Text], [(Text, Text)])
attr Alignment
align' RowSpan
rowspan ColSpan
colspan [Block]
blocks]
        ContinuationCell idx' :: (RowIndex, ColIndex)
idx'@(RowIndex
ridx',ColIndex
cidx') | RowIndex
ridx forall a. Eq a => a -> a -> Bool
/= RowIndex
ridx', ColIndex
cidx forall a. Eq a => a -> a -> Bool
== ColIndex
cidx' -> do
          case (Part -> Array (RowIndex, ColIndex) GridCell
partCellArray Part
part)forall i e. Ix i => Array i e -> i -> e
!(RowIndex, ColIndex)
idx' of
            (ContentCell (Text, [Text], [(Text, Text)])
_ Alignment
_ RowSpan
_ ColSpan
colspan [Block]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return [ColSpan -> OOXMLCell
OOXMLCellMerge ColSpan
colspan]
            GridCell
x -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Content cell expected, got, " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show GridCell
x forall a. [a] -> [a] -> [a]
++
                         String
" at index " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (RowIndex, ColIndex)
idx'
        GridCell
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
  let mkRow :: PandocMonad m => (RowIndex, Attr) -> WS m OOXMLRow
      mkRow :: forall (m :: * -> *).
PandocMonad m =>
(RowIndex, (Text, [Text], [(Text, Text)])) -> WS m OOXMLRow
mkRow (RowIndex
ridx, (Text, [Text], [(Text, Text)])
attr) = do
        [[OOXMLCell]]
cs <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Alignment
align -> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
Alignment -> RowIndex -> ColIndex -> GridCell -> WS m [OOXMLCell]
toOOXMLCell Alignment
align RowIndex
ridx)
                        [Alignment]
aligns
                        (forall i e. Ix i => Array i e -> [(i, e)]
assocs forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowIndex
-> Array (RowIndex, ColIndex) GridCell -> Array ColIndex GridCell
rowArray RowIndex
ridx forall a b. (a -> b) -> a -> b
$ Part -> Array (RowIndex, ColIndex) GridCell
partCellArray Part
part)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ RowType
-> (Text, [Text], [(Text, Text)]) -> [OOXMLCell] -> OOXMLRow
OOXMLRow RowType
rowType (Text, [Text], [(Text, Text)])
attr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [[OOXMLCell]]
cs
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
(RowIndex, (Text, [Text], [(Text, Text)])) -> WS m OOXMLRow
mkRow forall a b. (a -> b) -> a -> b
$ forall i e. Ix i => Array i e -> [(i, e)]
assocs (Part -> Array RowIndex (Text, [Text], [(Text, Text)])
partRowAttrs Part
part)

rowToOpenXML :: PandocMonad m
             => ([Block] -> WS m [Content])
             -> OOXMLRow
             -> WS m Element
rowToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
([Block] -> WS m [Content]) -> OOXMLRow -> WS m Element
rowToOpenXML [Block] -> WS m [Content]
blocksToOpenXML (OOXMLRow RowType
rowType (Text, [Text], [(Text, Text)])
_attr [OOXMLCell]
cells) = do
  [Element]
xmlcells <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
([Block] -> WS m [Content]) -> OOXMLCell -> WS m Element
ooxmlCellToOpenXML [Block] -> WS m [Content]
blocksToOpenXML) [OOXMLCell]
cells
  let addTrPr :: [Element] -> [Element]
addTrPr = case RowType
rowType of
        RowType
HeadRow -> (forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:trPr" []
                    [forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblHeader" [(Text
"w:val", Text
"true")] ()] forall a. a -> [a] -> [a]
:)
        RowType
BodyRow -> forall a. a -> a
id
        RowType
FootRow -> forall a. a -> a
id
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tr" [] ([Element] -> [Element]
addTrPr [Element]
xmlcells)

ooxmlCellToOpenXML :: PandocMonad m
                   => ([Block] -> WS m [Content])
                   -> OOXMLCell
                   -> WS m Element
ooxmlCellToOpenXML :: forall (m :: * -> *).
PandocMonad m =>
([Block] -> WS m [Content]) -> OOXMLCell -> WS m Element
ooxmlCellToOpenXML [Block] -> WS m [Content]
blocksToOpenXML = \case
  OOXMLCellMerge (ColSpan Int
colspan) -> do
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tc" []
      [ forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tcPr" [] [ forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:gridSpan" [(Text
"w:val", forall a. Show a => a -> Text
tshow Int
colspan)] ()
                           , forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:vMerge"   [(Text
"w:val", Text
"continue")] () ]
      , forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" [] [forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:pPr" [] ()]]
  OOXMLCell (Text, [Text], [(Text, Text)])
_attr Alignment
align RowSpan
rowspan (ColSpan Int
colspan) [Block]
contents -> do
    Element
compactStyle <- forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Compact"
    [Content]
es <- forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withParaProp (Alignment -> Element
alignmentFor Alignment
align) forall a b. (a -> b) -> a -> b
$ [Block] -> WS m [Content]
blocksToOpenXML [Block]
contents
    -- Table cells require a <w:p> element, even an empty one!
    -- Not in the spec but in Word 2007, 2010. See #4953. And
    -- apparently the last element must be a <w:p>, see #6983.
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tc" [] forall a b. (a -> b) -> a -> b
$
      Element -> Content
Elem
       (forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tcPr" [] ([ forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:gridSpan" [(Text
"w:val", forall a. Show a => a -> Text
tshow Int
colspan)] ()
                            | Int
colspan forall a. Ord a => a -> a -> Bool
> Int
1] forall a. [a] -> [a] -> [a]
++
                            [ forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:vMerge" [(Text
"w:val", Text
"restart")] ()
                            | RowSpan
rowspan forall a. Ord a => a -> a -> Bool
> Int -> RowSpan
RowSpan Int
1 ])) forall a. a -> [a] -> [a]
:
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
contents
      then [Element -> Content
Elem forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" [] [forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:pPr" [] [Element
compactStyle]]]
      else case forall a. [a] -> [a]
reverse ([Content] -> [Element]
onlyElems [Content]
es) of
             Element
b:Element
e:[Element]
_ | QName -> Text
qName (Element -> QName
elName Element
b) forall a. Eq a => a -> a -> Bool
== Text
"bookmarkEnd"  -- y tho?
                   , QName -> Text
qName (Element -> QName
elName Element
e) forall a. Eq a => a -> a -> Bool
== Text
"p" -> [Content]
es
             Element
e:[Element]
_   | QName -> Text
qName (Element -> QName
elName Element
e) forall a. Eq a => a -> a -> Bool
== Text
"p" -> [Content]
es
             [Element]
_ -> [Content]
es forall a. [a] -> [a] -> [a]
++ [Element -> Content
Elem forall a b. (a -> b) -> a -> b
$ forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" [] ()]

alignmentFor :: Alignment -> Element
alignmentFor :: Alignment -> Element
alignmentFor Alignment
al = forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:jc" [(Text
"w:val",Alignment -> Text
alignmentToString Alignment
al)] ()