{-# 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(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
  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 a. [a] -> 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
captionBlocks
                then [Content] -> WS m [Content]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. [a] -> 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 a. [a] -> 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)
  Int
listLevel <- (WriterEnv -> Int) -> ReaderT WriterEnv (StateT WriterState m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WriterEnv -> Int
envListLevel
  let indent :: Int
indent = (Int
listLevel Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
720
  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:jc" [(Text
"w:val",Text
"start")] ()
            Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode Text
"w:tblInd" [(Text
"w:w", Int -> Text
forall a. Show a => a -> Text
tshow Int
indent),(Text
"w:type",Text
"dxa")] ()
                | Int
indent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ] [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 a. a -> ReaderT WriterEnv (StateT WriterState m) a
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]
: Text -> Inline
Str Text
": " 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]
: Text -> Inline
Str Text
": " 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>")]

-- | 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 a. [a] -> 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 b. Integral b => Double -> b
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 a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths) :: Int
    widthToTwips :: Double -> Int
widthToTwips Double
w = Double -> Int
forall b. Integral b => Double -> b
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 :: 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 [GridCell] -> Bool
forall a. [a] -> 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] -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Element]
forall a. Monoid a => a
mempty
  else RowType -> [Alignment] -> Part -> WS m [OOXMLRow]
forall (m :: * -> *).
PandocMonad m =>
RowType -> [Alignment] -> Part -> WS m [OOXMLRow]
partToRows RowType
rowType [Alignment]
aligns Part
part WS m [OOXMLRow]
-> ([OOXMLRow]
    -> ReaderT WriterEnv (StateT WriterState m) [Element])
-> ReaderT WriterEnv (StateT WriterState m) [Element]
forall a b.
ReaderT WriterEnv (StateT WriterState m) a
-> (a -> ReaderT WriterEnv (StateT WriterState m) b)
-> ReaderT WriterEnv (StateT WriterState m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
       (OOXMLRow -> ReaderT WriterEnv (StateT WriterState m) Element)
-> [OOXMLRow] -> ReaderT WriterEnv (StateT WriterState m) [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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)

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 ->
          PandocError -> WS m [OOXMLCell]
forall a. PandocError -> ReaderT WriterEnv (StateT WriterState m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> WS m [OOXMLCell])
-> PandocError -> WS m [OOXMLCell]
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
          [OOXMLCell] -> WS m [OOXMLCell]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
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 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' -> do
          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]
_) -> [OOXMLCell] -> WS m [OOXMLCell]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ColSpan -> OOXMLCell
OOXMLCellMerge ColSpan
colspan]
            GridCell
x -> String -> WS m [OOXMLCell]
forall a. HasCallStack => String -> a
error (String -> WS m [OOXMLCell]) -> String -> WS m [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] -> WS m [OOXMLCell]
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [OOXMLCell]
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 <- (Alignment
 -> (ColIndex, GridCell)
 -> ReaderT WriterEnv (StateT WriterState m) [OOXMLCell])
-> [Alignment]
-> [(ColIndex, GridCell)]
-> ReaderT WriterEnv (StateT WriterState m) [[OOXMLCell]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Alignment
align -> (ColIndex
 -> GridCell
 -> ReaderT WriterEnv (StateT WriterState m) [OOXMLCell])
-> (ColIndex, GridCell)
-> ReaderT WriterEnv (StateT WriterState m) [OOXMLCell]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((ColIndex
  -> GridCell
  -> ReaderT WriterEnv (StateT WriterState m) [OOXMLCell])
 -> (ColIndex, GridCell)
 -> ReaderT WriterEnv (StateT WriterState m) [OOXMLCell])
-> (ColIndex
    -> GridCell
    -> ReaderT WriterEnv (StateT WriterState m) [OOXMLCell])
-> (ColIndex, GridCell)
-> ReaderT WriterEnv (StateT WriterState m) [OOXMLCell]
forall a b. (a -> b) -> a -> b
$ Alignment
-> RowIndex
-> ColIndex
-> GridCell
-> ReaderT WriterEnv (StateT WriterState m) [OOXMLCell]
forall (m :: * -> *).
PandocMonad m =>
Alignment -> RowIndex -> ColIndex -> GridCell -> WS m [OOXMLCell]
toOOXMLCell Alignment
align RowIndex
ridx)
                        [Alignment]
aligns
                        (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 -> [(ColIndex, GridCell)])
-> Array (RowIndex, ColIndex) GridCell -> [(ColIndex, GridCell)]
forall a b. (a -> b) -> a -> b
$ Part -> Array (RowIndex, ColIndex) GridCell
partCellArray Part
part)
        OOXMLRow -> WS m OOXMLRow
forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (OOXMLRow -> WS m OOXMLRow) -> OOXMLRow -> WS m OOXMLRow
forall a b. (a -> b) -> a -> b
$ RowType
-> (Text, [Text], [(Text, Text)]) -> [OOXMLCell] -> OOXMLRow
OOXMLRow RowType
rowType (Text, [Text], [(Text, Text)])
attr ([OOXMLCell] -> OOXMLRow)
-> ([[OOXMLCell]] -> [OOXMLCell]) -> [[OOXMLCell]] -> OOXMLRow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[OOXMLCell]] -> [OOXMLCell]
forall a. Monoid a => [a] -> a
mconcat ([[OOXMLCell]] -> OOXMLRow) -> [[OOXMLCell]] -> OOXMLRow
forall a b. (a -> b) -> a -> b
$ [[OOXMLCell]]
cs
  ((RowIndex, (Text, [Text], [(Text, Text)]))
 -> ReaderT WriterEnv (StateT WriterState m) OOXMLRow)
-> [(RowIndex, (Text, [Text], [(Text, Text)]))] -> WS m [OOXMLRow]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (RowIndex, (Text, [Text], [(Text, Text)]))
-> ReaderT WriterEnv (StateT WriterState m) OOXMLRow
forall (m :: * -> *).
PandocMonad m =>
(RowIndex, (Text, [Text], [(Text, Text)])) -> WS m OOXMLRow
mkRow ([(RowIndex, (Text, [Text], [(Text, Text)]))] -> WS m [OOXMLRow])
-> [(RowIndex, (Text, [Text], [(Text, Text)]))] -> WS m [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 :: 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 <- (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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> ReaderT WriterEnv (StateT WriterState m) a
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 :: forall (m :: * -> *).
PandocMonad m =>
([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 a. a -> ReaderT WriterEnv (StateT WriterState m) a
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 a. a -> ReaderT WriterEnv (StateT WriterState m) a
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 a. [a] -> 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)] ()