{-# 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, translateTerm)
import Text.Pandoc.Writers.Docx.Types
import Text.Pandoc.Shared
import Text.Pandoc.Options (WriterOptions, isEnabled)
import Text.Pandoc.Extensions (Extension(Ext_native_numbering))
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.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 :: WriterOptions
-> ([Block] -> WS m [Content]) -> Table -> WS m [Content]
tableToOpenXML WriterOptions
opts [Block] -> WS m [Content]
blocksToOpenXML Table
gridTable = do
  WS m ()
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 <- (WriterState -> Int)
-> ReaderT WriterEnv (StateT WriterState m) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WriterState -> Int
stNextTableNum
  Bool -> WS m () -> WS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
captionBlocks) (WS m () -> WS m ()) -> WS m () -> WS m ()
forall a b. (a -> b) -> a -> b
$
    (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
st -> WriterState
st{ stNextTableNum :: Int
stNextTableNum = Int
tablenum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
  let tableid :: Text
tableid = if Text -> Bool
T.null Text
ident
                   then Text
"table" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
tablenum
                   else Text
ident
  Text
tablename <- Term -> ReaderT WriterEnv (StateT WriterState m) Text
forall (m :: * -> *). PandocMonad m => Term -> m Text
translateTerm Term
Term.Table
  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] -> WS m [Content]) -> [Block] -> WS m [Content]
forall a b. (a -> b) -> a -> b
$ if Extension -> WriterOptions -> Bool
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".
  (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 (Text, [Text], [(Text, Text)]) -> [RowIndex]
forall i e. Ix i => Array i e -> [i]
indices (Array RowIndex (Text, [Text], [(Text, Text)]) -> [RowIndex])
-> (Part -> Array RowIndex (Text, [Text], [(Text, Text)]))
-> Part
-> [RowIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Part -> Array RowIndex (Text, [Text], [(Text, Text)])
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 (Text, [Text], [(Text, Text)]) -> [RowIndex]
forall i e. Ix i => Array i e -> [i]
indices (Array RowIndex (Text, [Text], [(Text, Text)]) -> [RowIndex])
-> (Part -> Array RowIndex (Text, [Text], [(Text, Text)]))
-> Part
-> [RowIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Part -> Array RowIndex (Text, [Text], [(Text, Text)])
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]

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 Inline -> ShortCaption -> ShortCaption
forall a. a -> [a] -> [a]
: Inline
Space Inline -> ShortCaption -> ShortCaption
forall a. a -> [a] -> [a]
: ShortCaption
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
    (Plain ShortCaption
ils : [Block]
rest) -> ShortCaption -> Block
Plain (Inline
label Inline -> ShortCaption -> ShortCaption
forall a. a -> [a] -> [a]
: Inline
Space Inline -> ShortCaption -> ShortCaption
forall a. a -> [a] -> [a]
: ShortCaption
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
    [Block]
_ -> ShortCaption -> Block
Para [Inline
label] Block -> [Block] -> [Block]
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 Text -> Text -> Text
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"
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" \\* ARABIC \"><w:r><w:t>"
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
tablenum
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</w:t></w:r></w:fldSimple>"),
             Text -> Inline
Str Text
":"]

-- | 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 (Text, [Text], [(Text, Text)])
_ Array (RowIndex, ColIndex) GridCell
cellArray Array RowIndex (Text, [Text], [(Text, Text)])
_) =
  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 (Text, [Text], [(Text, Text)])
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 [(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 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 (Text, [Text], [(Text, Text)])
_ 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, (Text, [Text], [(Text, Text)])) -> OOXMLRow
mkRow (RowIndex
ridx, (Text, [Text], [(Text, Text)])
attr) = RowType
-> (Text, [Text], [(Text, Text)]) -> [OOXMLCell] -> OOXMLRow
OOXMLRow RowType
rowType (Text, [Text], [(Text, Text)])
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, (Text, [Text], [(Text, Text)])) -> OOXMLRow)
-> [(RowIndex, (Text, [Text], [(Text, Text)]))] -> [OOXMLRow]
forall a b. (a -> b) -> [a] -> [b]
map (RowIndex, (Text, [Text], [(Text, Text)])) -> OOXMLRow
mkRow ([(RowIndex, (Text, [Text], [(Text, Text)]))] -> [OOXMLRow])
-> [(RowIndex, (Text, [Text], [(Text, Text)]))] -> [OOXMLRow]
forall a b. (a -> b) -> a -> b
$ Array RowIndex (Text, [Text], [(Text, Text)])
-> [(RowIndex, (Text, [Text], [(Text, Text)]))]
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 :: ([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 <- (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 (Text, [Text], [(Text, Text)])
_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)] ()