    {-# LANGUAGE LambdaCase          #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {- |
    Module      : Text.Pandoc.Writers.Docx.Table
    Copyright   : Copyright (C) 2012-2024 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 Data.Maybe (catMaybes, fromMaybe)
    import Text.Pandoc.Definition
        ( ColSpec,
          Caption(Caption),
          Format(Format),
          Attr,
          Block(Para, Plain),
          Inline(Str, Span, RawInline),
          Alignment(..),
          RowSpan(..),
          ColSpan(..),
          ColWidth(..) )
    import Text.Pandoc.Class.PandocMonad (PandocMonad)
    import Text.Pandoc.Translations (translateTerm)
    import Text.Pandoc.Writers.Docx.Types
        ( WS,
          WriterState(stNextTableNum, stInTable),
          WriterEnv(..),
          setFirstPara,
          pStyleM,
          withParaProp,
          withParaPropM )
    import Control.Monad.Reader (asks)
    import Text.Pandoc.Shared ( tshow, stringify )
    import Text.Pandoc.Options (WriterOptions(..), isEnabled, CaptionPosition(..))
    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)]
    tableAttr) 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
      tablenum <- (WriterState -> Int)
    -> ReaderT WriterEnv (StateT WriterState m) Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WriterState -> Int
    stNextTableNum
      unless (null captionBlocks) $
        modify $ \WriterState
    st -> WriterState
    st{ stNextTableNum = tablenum + 1 }
      let 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
      tablename <- translateTerm Term.Table
      let captionStr = [Block] -> Text
    forall a. Walkable Inline a => a -> Text
    stringify [Block]
    captionBlocks
      let 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
      captionXml <- if null captionBlocks
                    then return []
                    else withParaPropM (pStyleM "Table Caption")
                         $ blocksToOpenXML
                         $ if isEnabled Ext_native_numbering opts
                              then addLabel tableid tablename tablenum captionBlocks
                              else captionBlocks
      -- We set "in table" after processing the caption, because we don't
      -- want the "Table Caption" style to be overwritten with "Compact".
      modify $ \WriterState
    s -> WriterState
    s { stInTable = True }
      head' <- cellGridToOpenXML blocksToOpenXML HeadRow aligns thead
      bodies <- mapM (cellGridToOpenXML blocksToOpenXML BodyRow aligns) tbodies
      foot' <- cellGridToOpenXML blocksToOpenXML FootRow aligns tfoot

      let 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 -> 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 = if Bool
    hasHeader then (Int
    0x20 :: Int) else Int
    0
      let (gridCols, tblWattr) = tableLayout (elems colspecs)
      listLevel <- asks envListLevel
      let tblStyle =  Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "Table" (Text -> [(Text, Text)] -> Maybe Text
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    "custom-style" [(Text, Text)]
    tableAttr)
      let 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 hasWidths = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ (ColSpec -> Bool) -> Array ColIndex ColSpec -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ((ColWidth -> ColWidth -> Bool
    forall a. Eq a => a -> a -> Bool
    == ColWidth
    ColWidthDefault) (ColWidth -> Bool) -> (ColSpec -> ColWidth) -> ColSpec -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ColSpec -> ColWidth
    forall a b. (a, b) -> b
    snd) Array ColIndex ColSpec
    colspecs
      let 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
    tblStyle)] (),
                  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:jc" [(Text
    "w:val",Text
    "left")] () | 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: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:tblLayout" [(Text
    "w:type", Text
    "fixed")] () | Bool
    hasWidths ] [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'
            )
      modify $ \WriterState
    s -> WriterState
    s { stInTable = False }
      return $
        case writerTableCaptionPosition opts of
          CaptionPosition
    CaptionAbove -> [Content]
    captionXml [Content] -> [Content] -> [Content]
    forall a. [a] -> [a] -> [a]
    ++ [Element -> Content
    Elem Element
    tbl]
          CaptionPosition
    CaptionBelow -> Element -> Content
    Elem Element
    tbl Content -> [Content] -> [Content]
    forall a. a -> [a] -> [a]
    : [Content]
    captionXml

    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
    ""

    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
    >>=
           ([Maybe Element] -> [Element])
    -> ReaderT WriterEnv (StateT WriterState m) [Maybe Element]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall a b.
    (a -> b)
    -> ReaderT WriterEnv (StateT WriterState m) a
    -> ReaderT WriterEnv (StateT WriterState m) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Maybe Element] -> [Element]
    forall a. [Maybe a] -> [a]
    catMaybes (ReaderT WriterEnv (StateT WriterState m) [Maybe Element]
     -> ReaderT WriterEnv (StateT WriterState m) [Element])
    -> ([OOXMLRow]
        -> ReaderT WriterEnv (StateT WriterState m) [Maybe Element])
    -> [OOXMLRow]
    -> ReaderT WriterEnv (StateT WriterState m) [Element]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (OOXMLRow
     -> ReaderT WriterEnv (StateT WriterState m) (Maybe Element))
    -> [OOXMLRow]
    -> ReaderT WriterEnv (StateT WriterState m) [Maybe 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) (Maybe Element)
    forall (m :: * -> *).
    PandocMonad m =>
    ([Block] -> WS m [Content]) -> OOXMLRow -> WS m (Maybe 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
            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)
            return $ OOXMLRow rowType attr . mconcat $ cs
      ((RowIndex, (Text, [Text], [(Text, Text)]))
     -> ReaderT WriterEnv (StateT WriterState m) OOXMLRow)
    -> [(RowIndex, (Text, [Text], [(Text, Text)]))]
    -> ReaderT WriterEnv (StateT WriterState 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)]))]
     -> ReaderT WriterEnv (StateT WriterState m) [OOXMLRow])
    -> [(RowIndex, (Text, [Text], [(Text, Text)]))]
    -> ReaderT WriterEnv (StateT WriterState 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 (Maybe Element)
    rowToOpenXML :: forall (m :: * -> *).
    PandocMonad m =>
    ([Block] -> WS m [Content]) -> OOXMLRow -> WS m (Maybe Element)
    rowToOpenXML [Block] -> WS m [Content]
    blocksToOpenXML (OOXMLRow RowType
    rowType (Text, [Text], [(Text, Text)])
    _attr [OOXMLCell]
    cells)
      | [OOXMLCell] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [OOXMLCell]
    cells = Maybe Element
    -> ReaderT WriterEnv (StateT WriterState m) (Maybe Element)
    forall a. a -> ReaderT WriterEnv (StateT WriterState m) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Element
    forall a. Maybe a
    Nothing
      | Bool
    otherwise = do
        xmlcells <- (OOXMLCell -> ReaderT WriterEnv (StateT WriterState 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 -> ReaderT WriterEnv (StateT WriterState m) Element
    forall (m :: * -> *).
    PandocMonad m =>
    ([Block] -> WS m [Content]) -> OOXMLCell -> WS m Element
    ooxmlCellToOpenXML [Block] -> WS m [Content]
    blocksToOpenXML) [OOXMLCell]
    cells
        let 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
    "on")] ()] 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
        return $ Just $ mknode "w:tr" [] (addTrPr 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
        compactStyle <- ParaStyleName -> WS m Element
    forall (m :: * -> *).
    PandocMonad m =>
    ParaStyleName -> WS m Element
    pStyleM ParaStyleName
    "Compact"
        es <- maybe id withParaProp (alignmentFor align) $ blocksToOpenXML 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.
        return . mknode "w:tc" [] $
          Elem
           (mknode "w:tcPr" [] ([ mknode "w:gridSpan" [("w:val", tshow colspan)] ()
                                | colspan > 1] ++
                                [ mknode "w:vMerge" [("w:val", "restart")] ()
                                | rowspan > RowSpan 1 ])) :
          if null contents
          then [Elem $ mknode "w:p" [] [mknode "w:pPr" [] [compactStyle]]]
          else case reverse (onlyElems 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 -> Maybe Element
    alignmentFor :: Alignment -> Maybe Element
    alignmentFor Alignment
    AlignDefault = Maybe Element
    forall a. Maybe a
    Nothing
    alignmentFor Alignment
    al = Element -> Maybe Element
    forall a. a -> Maybe a
    Just (Element -> Maybe Element) -> Element -> Maybe Element
    forall a b. (a -> b) -> a -> b
    $ 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)] ()