{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- |
Module      : Text.Pandoc.Writers.Docx.Table
Copyright   : Copyright (C) 2012-2022 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 opts :: WriterOptions
opts blocksToOpenXML :: [Block] -> WS m [Content]
blocksToOpenXML gridTable :: Table
gridTable = do
  WS m ()
forall (m :: * -> *). PandocMonad m => WS m ()
setFirstPara
  let (Grid.Table (ident :: Text
ident,_,_) caption :: Caption
caption colspecs :: Array ColIndex ColSpec
colspecs _rowheads :: RowHeadColumns
_rowheads thead :: Part
thead tbodies :: [Part]
tbodies tfoot :: Part
tfoot) =
        Table
gridTable
  let (Caption _maybeShortCaption :: Maybe ShortCaption
_maybeShortCaption captionBlocks :: [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
$ \st :: WriterState
st -> WriterState
st{ stNextTableNum :: Int
stNextTableNum = Int
tablenum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 }
  let tableid :: Text
tableid = if Text -> Bool
T.null Text
ident
                   then "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 "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
$ \s :: 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 (0x20 :: Int) else 0
  let (gridCols :: [Element]
gridCols, tblWattr :: [(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 "w:tbl" []
        ( Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:tblPr" []
          ( Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:tblStyle" [("w:val","Table")] () Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:
            Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "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 "w:tblLook" [("w:firstRow",if Bool
hasHeader then "1" else "0")
                               ,("w:lastRow",if Bool
hasFooter then "1" else "0")
                               ,("w:firstColumn","0")
                               ,("w:lastColumn","0")
                               ,("w:noHBand","0")
                               ,("w:noVBand","0")
                               ,("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 "%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 "w:tblCaption" [("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 "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
$ \s :: 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 tableid :: Text
tableid tablename :: Text
tablename tablenum :: Int
tablenum bs :: [Block]
bs =
  case [Block]
bs of
    (Para ils :: ShortCaption
ils : rest :: [Block]
rest)  -> ShortCaption -> Block
Para (Inline
label Inline -> ShortCaption -> ShortCaption
forall a. a -> [a] -> [a]
: Text -> Inline
Str ": " Inline -> ShortCaption -> ShortCaption
forall a. a -> [a] -> [a]
: ShortCaption
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
    (Plain ils :: ShortCaption
ils : rest :: [Block]
rest) -> ShortCaption -> Block
Plain (Inline
label Inline -> ShortCaption -> ShortCaption
forall a. a -> [a] -> [a]
: Text -> Inline
Str ": " Inline -> ShortCaption -> ShortCaption
forall a. a -> [a] -> [a]
: ShortCaption
ils) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
    _ -> ShortCaption -> Block
Para [Inline
label] Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs
 where
  label :: Inline
label = Attr -> ShortCaption -> Inline
Span (Text
tableid,[],[])
            [Text -> Inline
Str (Text
tablename Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\160"),
             Format -> Text -> Inline
RawInline (Text -> Format
Format "openxml")
               ("<w:fldSimple w:instr=\"SEQ Table"
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " \\* 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
<> "</w:t></w:r></w:fldSimple>")]

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

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

tableLayout :: [ColSpec] -> ([Element], [(Text, Text)])
tableLayout :: [ColSpec] -> ([Element], [(Text, Text)])
tableLayout specs :: [ColSpec]
specs =
  let
    textwidth :: Double
textwidth = 7920  -- 5.5 in in twips       (1 twip == 1/20 pt)
    fullrow :: Double
fullrow   = 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 n :: Double
n -> Double
n
      _          -> 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 w :: 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 w :: Double
w = Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:gridCol" [("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
== 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 (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)
          , [ ("w:type", "auto"), ("w:w", "0")])
     else ( (Double -> Element) -> [Double] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Element
mkGridCol [Double]
widths
          , [ ("w:type", "pct"), ("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 blocksToOpenXML :: [Block] -> WS m [Content]
blocksToOpenXML rowType :: RowType
rowType aligns :: [Alignment]
aligns part :: Part
part@(Part _ cellArray :: Array (RowIndex, ColIndex) GridCell
cellArray _) =
  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
rowType aligns :: [Alignment]
aligns part :: Part
part =
  let
    toOOXMLCell :: Alignment -> RowIndex -> ColIndex -> GridCell -> [OOXMLCell]
    toOOXMLCell :: Alignment -> RowIndex -> ColIndex -> GridCell -> [OOXMLCell]
toOOXMLCell columnAlign :: Alignment
columnAlign ridx :: RowIndex
ridx cidx :: ColIndex
cidx = \case
      ContentCell attr :: Attr
attr align :: Alignment
align rowspan :: RowSpan
rowspan colspan :: ColSpan
colspan blocks :: [Block]
blocks ->
        -- Respect non-default, cell specific alignment.
        let align' :: Alignment
align' = case Alignment
align of
              AlignDefault -> Alignment
columnAlign
              _            -> 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'@(ridx' :: RowIndex
ridx',cidx' :: 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 _ _ _ colspan :: ColSpan
colspan _) -> [ColSpan -> OOXMLCell
OOXMLCellMerge ColSpan
colspan]
          x :: GridCell
x -> String -> [OOXMLCell]
forall a. HasCallStack => String -> a
error (String -> [OOXMLCell]) -> String -> [OOXMLCell]
forall a b. (a -> b) -> a -> b
$ "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]
++
                       " at index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (RowIndex, ColIndex) -> String
forall a. Show a => a -> String
show (RowIndex, ColIndex)
idx'
      _ -> [OOXMLCell]
forall a. Monoid a => a
mempty
    mkRow :: (RowIndex, Attr) -> OOXMLRow
    mkRow :: (RowIndex, Attr) -> OOXMLRow
mkRow (ridx :: RowIndex
ridx, attr :: 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 (\align :: 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 blocksToOpenXML :: [Block] -> WS m [Content]
blocksToOpenXML (OOXMLRow rowType :: RowType
rowType _attr :: Attr
_attr cells :: [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
        HeadRow -> (Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:trPr" []
                    [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:tblHeader" [("w:val", "true")] ()] Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:)
        BodyRow -> [Element] -> [Element]
forall a. a -> a
id
        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 "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 blocksToOpenXML :: [Block] -> WS m [Content]
blocksToOpenXML = \case
  OOXMLCellMerge (ColSpan 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 "w:tc" []
      [ Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:tcPr" [] [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:gridSpan" [("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 "w:vMerge"   [("w:val", "continue")] () ]
      , Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:p" [] [Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:pPr" [] ()]]
  OOXMLCell _attr :: Attr
_attr align :: Alignment
align rowspan :: RowSpan
rowspan (ColSpan colspan :: Int
colspan) contents :: [Block]
contents -> do
    Element
compactStyle <- ParaStyleName -> WS m Element
forall (m :: * -> *).
PandocMonad m =>
ParaStyleName -> WS m Element
pStyleM "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 "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 "w:tcPr" [] ([ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:gridSpan" [("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
> 1] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
                            [ Text -> [(Text, Text)] -> () -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:vMerge" [("w:val", "restart")] ()
                            | RowSpan
rowspan RowSpan -> RowSpan -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> RowSpan
RowSpan 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 "w:p" [] [Text -> [(Text, Text)] -> [Element] -> Element
forall t. Node t => Text -> [(Text, Text)] -> t -> Element
mknode "w:pPr" [] [Element
compactStyle]]]
      else case [Element] -> [Element]
forall a. [a] -> [a]
reverse ([Content] -> [Element]
onlyElems [Content]
es) of
             b :: Element
b:e :: Element
e:_ | QName -> Text
qName (Element -> QName
elName Element
b) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "bookmarkEnd"  -- y tho?
                   , QName -> Text
qName (Element -> QName
elName Element
e) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "p" -> [Content]
es
             e :: Element
e:_   | QName -> Text
qName (Element -> QName
elName Element
e) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "p" -> [Content]
es
             _ -> [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 "w:p" [] ()]

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