{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
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
(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
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>")]
data RowType = HeadRow | BodyRow |
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
fullrow :: Double
fullrow = 5000
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 ->
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
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"
, 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)] ()