{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module      : Text.Pandoc.Writers.Docx.Table
Copyright   : Copyright (C) 2012-2021 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
  ) where

import Control.Monad.State.Strict
import Data.Array
import Data.Text (Text)
import Text.Pandoc.Definition
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Writers.Docx.Types
import Text.Pandoc.Shared
import Text.Printf (printf)
import Text.Pandoc.Writers.GridTable hiding (Table)
import Text.Pandoc.Writers.OOXML
import Text.Pandoc.XML.Light as XML hiding (Attr)
import qualified Data.Text as T
import qualified Text.Pandoc.Writers.GridTable as Grid

tableToOpenXML :: PandocMonad m
               => ([Block] -> WS m [Content])
               -> Grid.Table
               -> WS m [Content]
tableToOpenXML :: ([Block] -> WS m [Content]) -> Table -> WS m [Content]
tableToOpenXML [Block] -> WS m [Content]
blocksToOpenXML Table
gridTable = do
  WS m ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
  let (Grid.Table Attr
_attr 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
  let captionStr :: Text
captionStr = [Block] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Block]
captionBlocks
  let aligns :: [Alignment]
aligns = (ColSpec -> Alignment) -> [ColSpec] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map ColSpec -> Alignment
forall a b. (a, b) -> a
fst ([ColSpec] -> [Alignment]) -> [ColSpec] -> [Alignment]
forall a b. (a -> b) -> a -> b
$ Array ColIndex ColSpec -> [ColSpec]
forall i e. Array i e -> [e]
elems Array ColIndex ColSpec
colspecs
  [Content]
captionXml <- if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
captionBlocks
                then [Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                else WS m Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
WS m Element -> WS m a -> WS m a
withParaPropM (ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Table Caption")
                     (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Block] -> WS m [Content]
blocksToOpenXML [Block]
captionBlocks
  -- We set "in table" after processing the caption, because we don't
  -- want the "Table Caption" style to be overwritten with "Compact".
  (WriterState -> WriterState) -> WS m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> WS m ())
-> (WriterState -> WriterState) -> WS m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stInTable :: Bool
stInTable = Bool
True }
  [Element]
head' <- ([Block] -> WS m [Content])
-> RowType -> [Alignment] -> Part -> WS m [Element]
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 <- (Part -> WS m [Element])
-> [Part] -> ReaderT WriterEnv (StateT WriterState m) [[Element]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Block] -> WS m [Content])
-> RowType -> [Alignment] -> Part -> WS m [Element]
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' <- ([Block] -> WS m [Content])
-> RowType -> [Alignment] -> Part -> WS m [Element]
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 (Bool -> Bool) -> (Part -> Bool) -> Part -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RowIndex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([RowIndex] -> Bool) -> (Part -> [RowIndex]) -> Part -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array RowIndex Attr -> [RowIndex]
forall i e. Ix i => Array i e -> [i]
indices (Array RowIndex Attr -> [RowIndex])
-> (Part -> Array RowIndex Attr) -> Part -> [RowIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Part -> Array RowIndex Attr
partRowAttrs (Part -> Bool) -> Part -> Bool
forall a b. (a -> b) -> a -> b
$ Part
thead
  let hasFooter :: Bool
hasFooter = Bool -> Bool
not (Bool -> Bool) -> (Part -> Bool) -> Part -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RowIndex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([RowIndex] -> Bool) -> (Part -> [RowIndex]) -> Part -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array RowIndex Attr -> [RowIndex]
forall i e. Ix i => Array i e -> [i]
indices (Array RowIndex Attr -> [RowIndex])
-> (Part -> Array RowIndex Attr) -> Part -> [RowIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Part -> Array RowIndex Attr
partRowAttrs (Part -> Bool) -> Part -> Bool
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 (Array ColIndex ColSpec -> [ColSpec]
forall i e. Array i e -> [e]
elems Array ColIndex ColSpec
colspecs)
  let tbl :: Element
tbl = Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tbl" []
        ( Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblPr" []
          ( Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblStyle" [(Text
"w:val",Text
"Table")] () Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
            Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblW" [(Text, Text)]
tblWattr () Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
            Text -> [(Text, Text)] -> () -> Element
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 (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%04x" Int
tblLookVal)
                               ] () Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
            [ Text -> [(Text, Text)] -> () -> Element
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) ]
          )
          Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblGrid" [] [Element]
gridCols
          Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
head' [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [[Element]] -> [Element]
forall a. Monoid a => [a] -> a
mconcat [[Element]]
bodies [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ [Element]
foot'
        )
  (WriterState -> WriterState) -> WS m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WriterState -> WriterState) -> WS m ())
-> (WriterState -> WriterState) -> WS m ()
forall a b. (a -> b) -> a -> b
$ \WriterState
s -> WriterState
s { stInTable :: Bool
stInTable = Bool
False }
  [Content] -> WS m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Content] -> WS m [Content]) -> [Content] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ [Content]
captionXml [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Element -> Content
Elem Element
tbl]

-- | 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 = [ColSpec] -> Int
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 = (ColSpec -> Double) -> [ColSpec] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (ColWidth -> Double
getWidth (ColWidth -> Double) -> (ColSpec -> ColWidth) -> ColSpec -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColSpec -> ColWidth
forall a b. (a, b) -> b
snd) [ColSpec]
specs
    rowwidth :: Int
rowwidth  = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
fullrow Double -> Double -> Double
forall a. Num a => a -> a -> a
* [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths) :: Int
    widthToTwips :: Double -> Int
widthToTwips Double
w = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
textwidth Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w)   :: Int
    mkGridCol :: Double -> Element
mkGridCol Double
w = Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:gridCol" [(Text
"w:w", Int -> Text
forall a. Show a => a -> Text
tshow (Double -> Int
widthToTwips Double
w))] ()
  in if (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0) [Double]
widths
     then ( Int -> Element -> [Element]
forall a. Int -> a -> [a]
replicate Int
ncols (Element -> [Element]) -> Element -> [Element]
forall a b. (a -> b) -> a -> b
$ Double -> Element
mkGridCol (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ncols)
          , [ (Text
"w:type", Text
"auto"), (Text
"w:w", Text
"0")])
     else ( (Double -> Element) -> [Double] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Element
mkGridCol [Double]
widths
          , [ (Text
"w:type", Text
"pct"), (Text
"w:w", Int -> Text
forall a. Show a => a -> Text
tshow Int
rowwidth) ])

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

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

data OOXMLRow = OOXMLRow RowType Attr [OOXMLCell]

partToRows :: RowType -> [Alignment] -> Part -> [OOXMLRow]
partToRows :: RowType -> [Alignment] -> Part -> [OOXMLRow]
partToRows RowType
rowType [Alignment]
aligns Part
part =
  let
    toOOXMLCell :: Alignment -> RowIndex -> ColIndex -> GridCell -> [OOXMLCell]
    toOOXMLCell :: Alignment -> RowIndex -> ColIndex -> GridCell -> [OOXMLCell]
toOOXMLCell Alignment
columnAlign RowIndex
ridx ColIndex
cidx = \case
      ContentCell Attr
attr Alignment
align RowSpan
rowspan ColSpan
colspan [Block]
blocks ->
        -- Respect non-default, cell specific alignment.
        let align' :: Alignment
align' = case Alignment
align of
              Alignment
AlignDefault -> Alignment
columnAlign
              Alignment
_            -> Alignment
align
        in [Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> OOXMLCell
OOXMLCell Attr
attr Alignment
align' RowSpan
rowspan ColSpan
colspan [Block]
blocks]
      ContinuationCell idx' :: (RowIndex, ColIndex)
idx'@(RowIndex
ridx',ColIndex
cidx') | RowIndex
ridx RowIndex -> RowIndex -> Bool
forall a. Eq a => a -> a -> Bool
/= RowIndex
ridx', ColIndex
cidx ColIndex -> ColIndex -> Bool
forall a. Eq a => a -> a -> Bool
== ColIndex
cidx' ->
        case (Part -> Array (RowIndex, ColIndex) GridCell
partCellArray Part
part)Array (RowIndex, ColIndex) GridCell
-> (RowIndex, ColIndex) -> GridCell
forall i e. Ix i => Array i e -> i -> e
!(RowIndex, ColIndex)
idx' of
          (ContentCell Attr
_ Alignment
_ RowSpan
_ ColSpan
colspan [Block]
_) -> [ColSpan -> OOXMLCell
OOXMLCellMerge ColSpan
colspan]
          GridCell
x -> String -> [OOXMLCell]
forall a. HasCallStack => String -> a
error (String -> [OOXMLCell]) -> String -> [OOXMLCell]
forall a b. (a -> b) -> a -> b
$ String
"Content cell expected, got, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ GridCell -> String
forall a. Show a => a -> String
show GridCell
x String -> String -> String
forall a. [a] -> [a] -> [a]
++
                       String
" at index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (RowIndex, ColIndex) -> String
forall a. Show a => a -> String
show (RowIndex, ColIndex)
idx'
      GridCell
_ -> [OOXMLCell]
forall a. Monoid a => a
mempty
    mkRow :: (RowIndex, Attr) -> OOXMLRow
    mkRow :: (RowIndex, Attr) -> OOXMLRow
mkRow (RowIndex
ridx, Attr
attr) = RowType -> Attr -> [OOXMLCell] -> OOXMLRow
OOXMLRow RowType
rowType Attr
attr
                       ([OOXMLCell] -> OOXMLRow)
-> (Array (RowIndex, ColIndex) GridCell -> [OOXMLCell])
-> Array (RowIndex, ColIndex) GridCell
-> OOXMLRow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[OOXMLCell]] -> [OOXMLCell]
forall a. Monoid a => [a] -> a
mconcat
                       ([[OOXMLCell]] -> [OOXMLCell])
-> (Array (RowIndex, ColIndex) GridCell -> [[OOXMLCell]])
-> Array (RowIndex, ColIndex) GridCell
-> [OOXMLCell]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alignment -> (ColIndex, GridCell) -> [OOXMLCell])
-> [Alignment] -> [(ColIndex, GridCell)] -> [[OOXMLCell]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Alignment
align -> (ColIndex -> GridCell -> [OOXMLCell])
-> (ColIndex, GridCell) -> [OOXMLCell]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((ColIndex -> GridCell -> [OOXMLCell])
 -> (ColIndex, GridCell) -> [OOXMLCell])
-> (ColIndex -> GridCell -> [OOXMLCell])
-> (ColIndex, GridCell)
-> [OOXMLCell]
forall a b. (a -> b) -> a -> b
$ Alignment -> RowIndex -> ColIndex -> GridCell -> [OOXMLCell]
toOOXMLCell Alignment
align RowIndex
ridx)
                                 [Alignment]
aligns
                       ([(ColIndex, GridCell)] -> [[OOXMLCell]])
-> (Array (RowIndex, ColIndex) GridCell -> [(ColIndex, GridCell)])
-> Array (RowIndex, ColIndex) GridCell
-> [[OOXMLCell]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array ColIndex GridCell -> [(ColIndex, GridCell)]
forall i e. Ix i => Array i e -> [(i, e)]
assocs
                       (Array ColIndex GridCell -> [(ColIndex, GridCell)])
-> (Array (RowIndex, ColIndex) GridCell -> Array ColIndex GridCell)
-> Array (RowIndex, ColIndex) GridCell
-> [(ColIndex, GridCell)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowIndex
-> Array (RowIndex, ColIndex) GridCell -> Array ColIndex GridCell
rowArray RowIndex
ridx
                       (Array (RowIndex, ColIndex) GridCell -> OOXMLRow)
-> Array (RowIndex, ColIndex) GridCell -> OOXMLRow
forall a b. (a -> b) -> a -> b
$ Part -> Array (RowIndex, ColIndex) GridCell
partCellArray Part
part
  in ((RowIndex, Attr) -> OOXMLRow) -> [(RowIndex, Attr)] -> [OOXMLRow]
forall a b. (a -> b) -> [a] -> [b]
map (RowIndex, Attr) -> OOXMLRow
mkRow ([(RowIndex, Attr)] -> [OOXMLRow])
-> [(RowIndex, Attr)] -> [OOXMLRow]
forall a b. (a -> b) -> a -> b
$ Array RowIndex Attr -> [(RowIndex, Attr)]
forall i e. Ix i => Array i e -> [(i, e)]
assocs (Part -> Array RowIndex Attr
partRowAttrs Part
part)

rowToOpenXML :: PandocMonad m
             => ([Block] -> WS m [Content])
             -> OOXMLRow
             -> WS m Element
rowToOpenXML :: ([Block] -> WS m [Content]) -> OOXMLRow -> WS m Element
rowToOpenXML [Block] -> WS m [Content]
blocksToOpenXML (OOXMLRow RowType
rowType Attr
_attr [OOXMLCell]
cells) = do
  [Element]
xmlcells <- (OOXMLCell -> WS m Element)
-> [OOXMLCell]
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Block] -> WS m [Content]) -> OOXMLCell -> WS m Element
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 -> (Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:trPr" []
                    [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblHeader" [(Text
"w:val", Text
"true")] ()] Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:)
        RowType
BodyRow -> [Element] -> [Element]
forall a. a -> a
id
        RowType
FootRow -> [Element] -> [Element]
forall a. a -> a
id
  Element -> WS m Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> WS m Element) -> Element -> WS m Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Element] -> Element
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 :: ([Block] -> WS m [Content]) -> OOXMLCell -> WS m Element
ooxmlCellToOpenXML [Block] -> WS m [Content]
blocksToOpenXML = \case
  OOXMLCellMerge (ColSpan Int
colspan) -> do
    Element -> WS m Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> WS m Element) -> Element -> WS m Element
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tc" []
      [ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tcPr" [] [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:gridSpan" [(Text
"w:val", Int -> Text
forall a. Show a => a -> Text
tshow Int
colspan)] ()
                           , Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:vMerge"   [(Text
"w:val", Text
"continue")] () ]
      , Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" [] [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:pPr" [] ()]]
  OOXMLCell Attr
_attr Alignment
align RowSpan
rowspan (ColSpan Int
colspan) [Block]
contents -> do
    Element
compactStyle <- ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM ParaStyleName
"Compact"
    [Content]
es <- Element -> WS m [Content] -> WS m [Content]
forall (m :: * -> *) a.
PandocMonad m =>
Element -> WS m a -> WS m a
withParaProp (Alignment -> Element
alignmentFor Alignment
align) (WS m [Content] -> WS m [Content])
-> WS m [Content] -> WS m [Content]
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.
    Element -> WS m Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> WS m Element)
-> ([Content] -> Element) -> [Content] -> WS m Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [(Text, Text)] -> [Content] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tc" [] ([Content] -> WS m Element) -> [Content] -> WS m Element
forall a b. (a -> b) -> a -> b
$
      Element -> Content
Elem
       (Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tcPr" [] ([ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:gridSpan" [(Text
"w:val", Int -> Text
forall a. Show a => a -> Text
tshow Int
colspan)] ()
                            | Int
colspan Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
                            [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:vMerge" [(Text
"w:val", Text
"restart")] ()
                            | RowSpan
rowspan RowSpan -> RowSpan -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> RowSpan
RowSpan Int
1 ])) Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:
      if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
contents
      then [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" [] [Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:pPr" [] [Element
compactStyle]]]
      else case [Element] -> [Element]
forall a. [a] -> [a]
reverse ([Content] -> [Element]
onlyElems [Content]
es) of
             Element
b:Element
e:[Element]
_ | QName -> Text
qName (Element -> QName
elName Element
b) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"bookmarkEnd"  -- y tho?
                   , QName -> Text
qName (Element -> QName
elName Element
e) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"p" -> [Content]
es
             Element
e:[Element]
_   | QName -> Text
qName (Element -> QName
elName Element
e) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"p" -> [Content]
es
             [Element]
_ -> [Content]
es [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:p" [] ()]

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