@@ -1,4 +1,4 @@
1−{-# LANGUAGE PatternGuards #-}
1+{-# LANGUAGE PatternGuards, OverloadedStrings #-}
22
33{-
44Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
@@ -77,14 +77,14 @@ module Text.Pandoc.Readers.Docx
7777import Codec.Archive.Zip
7878import Text.Pandoc.Definition
7979import Text.Pandoc.Options
80−import Text.Pandoc.Builder (text, toList)
80+import Text.Pandoc.Builder
8181import Text.Pandoc.Walk
8282import Text.Pandoc.Readers.Docx.Parse
8383import Text.Pandoc.Readers.Docx.Lists
8484import Text.Pandoc.Readers.Docx.Reducible
8585import Text.Pandoc.Shared
8686import Text.Pandoc.MediaBag (insertMedia, MediaBag)
87−import Data.Maybe (mapMaybe)
87+import Data.Maybe (isJust)
8888import Data.List (delete, stripPrefix, (\\), intersect)
8989import Data.Monoid
9090import Text.TeXMath (writeTeX)
@@ -94,6 +94,7 @@ import qualified Data.Map as M
9494import Control.Monad.Reader
9595import Control.Monad.State
9696import Control.Applicative ((<$>))
97+import Data.Sequence (ViewL(..), viewl)
9798
9899readDocx :: ReaderOptions
99100 -> B.ByteString
@@ -106,13 +107,13 @@ readDocx opts bytes =
106107
107108data DState = DState { docxAnchorMap :: M.Map String String
108109 , docxMediaBag :: MediaBag
109− , docxDropCap :: [Inline]
110+ , docxDropCap :: Inlines
110111 }
111112
112113instance Default DState where
113114 def = DState { docxAnchorMap = M.empty
114115 , docxMediaBag = mempty
115− , docxDropCap = []
116+ , docxDropCap = mempty
116117 }
117118
118119data DEnv = DEnv { docxOptions :: ReaderOptions
@@ -126,9 +127,6 @@ type DocxContext = ReaderT DEnv (State DState)
126127evalDocxContext :: DocxContext a -> DEnv -> DState -> a
127128evalDocxContext ctx env st = evalState (runReaderT ctx env) st
128129
129−concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
130−concatMapM f xs = liftM concat (mapM f xs)
131−
132130-- This is empty, but we put it in for future-proofing.
133131spansToKeep :: [String]
134132spansToKeep = []
@@ -174,7 +172,7 @@ bodyPartsToMeta' (bp : bps)
174172 f (MetaInlines ils) (MetaBlocks blks) = MetaBlocks ((Para ils) : blks)
175173 f m (MetaList mv) = MetaList (m : mv)
176174 f m n = MetaList [m, n]
177− return $ M.insertWith f metaField (MetaInlines inlines) remaining
175+ return $ M.insertWith f metaField (MetaInlines (toList inlines)) remaining
178176bodyPartsToMeta' (_ : bps) = bodyPartsToMeta' bps
179177
180178bodyPartsToMeta :: [BodyPart] -> DocxContext Meta
@@ -195,98 +193,14 @@ fixAuthors (MetaBlocks blks) =
195193 g _ = MetaInlines []
196194fixAuthors mv = mv
197195
198−runStyleToContainers :: RunStyle -> [Container Inline]
199−runStyleToContainers rPr =
200− let spanClassToContainers :: String -> [Container Inline]
201− spanClassToContainers s | s `elem` codeSpans =
202− [Container $ (\ils -> Code ("", [], []) (concatMap ilToCode ils))]
203− spanClassToContainers s | s `elem` spansToKeep =
204− [Container $ Span ("", [s], [])]
205− spanClassToContainers _ = []
206−
207− classContainers = case rStyle rPr of
208− Nothing -> []
209− Just s -> spanClassToContainers s
210−
211− resolveFmt :: Bool -> Maybe Bool -> Bool
212− resolveFmt _ (Just True) = True
213− resolveFmt _ (Just False) = False
214− resolveFmt bool Nothing = bool
215−
216− formatters = map Container $ mapMaybe id
217− [ if resolveFmt
218− (rStyle rPr `elem` [Just "Strong", Just "Bold"])
219− (isBold rPr)
220− then (Just Strong)
221− else Nothing
222− , if resolveFmt
223− (rStyle rPr `elem` [Just"Emphasis", Just "Italic"])
224− (isItalic rPr)
225− then (Just Emph)
226− else Nothing
227− , if resolveFmt False (isSmallCaps rPr)
228− then (Just SmallCaps)
229− else Nothing
230− , if resolveFmt False (isStrike rPr)
231− then (Just Strikeout)
232− else Nothing
233− , if isSuperScript rPr then (Just Superscript) else Nothing
234− , if isSubScript rPr then (Just Subscript) else Nothing
235− , rUnderline rPr >>=
236− (\f -> if f == "single" then (Just Emph) else Nothing)
237− ]
238− in
239− classContainers ++ formatters
240−
241−parStyleToContainers :: ParagraphStyle -> [Container Block]
242−parStyleToContainers pPr | (c:cs) <- pStyle pPr, Just n <- isHeaderClass c =
243− [Container $ \_ -> Header n ("", delete ("Heading" ++ show n) cs, []) []]
244−parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` divsToKeep =
245− let pPr' = pPr { pStyle = cs }
246− in
247− (Container $ Div ("", [c], [])) : (parStyleToContainers pPr')
248−parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` codeDivs =
249− -- This is a bit of a cludge. We make the codeblock from the raw
250− -- parparts in bodyPartToBlocks. But we need something to match against.
251− let pPr' = pPr { pStyle = cs }
252− in
253− (Container $ \_ -> CodeBlock ("", [], []) "") : (parStyleToContainers pPr')
254−parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` listParagraphDivs =
255− let pPr' = pPr { pStyle = cs, indentation = Nothing}
256− in
257− (Container $ Div ("", [c], [])) : (parStyleToContainers pPr')
258−
259−parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` blockQuoteDivs =
260− let pPr' = pPr { pStyle = cs \\ blockQuoteDivs }
261− in
262− (Container BlockQuote) : (parStyleToContainers pPr')
263−parStyleToContainers pPr | (_:cs) <- pStyle pPr =
264− let pPr' = pPr { pStyle = cs}
265− in
266− parStyleToContainers pPr'
267−parStyleToContainers pPr | null (pStyle pPr),
268− Just left <- indentation pPr >>= leftParIndent,
269− Just hang <- indentation pPr >>= hangingParIndent =
270− let pPr' = pPr { indentation = Nothing }
271− in
272− case (left - hang) > 0 of
273− True -> (Container BlockQuote) : (parStyleToContainers pPr')
274− False -> parStyleToContainers pPr'
275−parStyleToContainers pPr | null (pStyle pPr),
276− Just left <- indentation pPr >>= leftParIndent =
277− let pPr' = pPr { indentation = Nothing }
278− in
279− case left > 0 of
280− True -> (Container BlockQuote) : (parStyleToContainers pPr')
281− False -> parStyleToContainers pPr'
282−parStyleToContainers _ = []
283−
284−
285−strToInlines :: String -> [Inline]
286−strToInlines = toList . text
287−
288−codeSpans :: [String]
289−codeSpans = ["VerbatimChar"]
196+codeStyles :: [String]
197+codeStyles = ["VerbatimChar"]
198+
199+strongStyles :: [String]
200+strongStyles = ["Strong", "Bold"]
201+
202+emphStyles :: [String]
203+emphStyles = ["Emphasis", "Italic"]
290204
291205blockQuoteDivs :: [String]
292206blockQuoteDivs = ["Quote", "BlockQuote", "BlockQuotation"]
@@ -294,10 +208,10 @@ blockQuoteDivs = ["Quote", "BlockQuote", "BlockQuotation"]
294208codeDivs :: [String]
295209codeDivs = ["SourceCode"]
296210
297−runElemToInlines :: RunElem -> [Inline]
298−runElemToInlines (TextRun s) = strToInlines s
299−runElemToInlines (LnBrk) = [LineBreak]
300−runElemToInlines (Tab) = [Space]
211+runElemToInlines :: RunElem -> Inlines
212+runElemToInlines (TextRun s) = text s
213+runElemToInlines (LnBrk) = linebreak
214+runElemToInlines (Tab) = space
301215
302216runElemToString :: RunElem -> String
303217runElemToString (TextRun s) = s
@@ -317,57 +231,84 @@ parPartToString (InternalHyperLink _ runs) = concatMap runToString runs
317231parPartToString (ExternalHyperLink _ runs) = concatMap runToString runs
318232parPartToString _ = ""
319233
320−
321−inlineCodeContainer :: Container Inline -> Bool
322−inlineCodeContainer (Container f) = case f [] of
323− Code _ "" -> True
324− _ -> False
325−inlineCodeContainer _ = False
326−
327−
328−runToInlines :: Run -> DocxContext [Inline]
234+runStyleToTransform :: RunStyle -> (Inlines -> Inlines)
235+runStyleToTransform rPr
236+ | Just s <- rStyle rPr
237+ , s `elem` spansToKeep =
238+ let rPr' = rPr{rStyle = Nothing}
239+ in
240+ (spanWith ("", [s], [])) . (runStyleToTransform rPr')
241+ | Just s <- rStyle rPr
242+ , s `elem` emphStyles =
243+ let rPr' = rPr{rStyle = Nothing, isItalic = Nothing}
244+ in
245+ case isItalic rPr' of
246+ Just False -> runStyleToTransform rPr'
247+ _ -> emph . (runStyleToTransform rPr')
248+ | Just s <- rStyle rPr
249+ , s `elem` strongStyles =
250+ let rPr' = rPr{rStyle = Nothing, isBold = Nothing}
251+ in
252+ case isItalic rPr' of
253+ Just False -> runStyleToTransform rPr'
254+ _ -> strong . (runStyleToTransform rPr')
255+ | Just True <- isItalic rPr =
256+ emph . (runStyleToTransform rPr {isItalic = Nothing})
257+ | Just True <- isBold rPr =
258+ strong . (runStyleToTransform rPr {isBold = Nothing})
259+ | Just True <- isSmallCaps rPr =
260+ smallcaps . (runStyleToTransform rPr {isSmallCaps = Nothing})
261+ | Just True <- isStrike rPr =
262+ strikeout . (runStyleToTransform rPr {isStrike = Nothing})
263+ | isSuperScript rPr =
264+ superscript . (runStyleToTransform rPr {isSuperScript = False})
265+ | isSubScript rPr =
266+ subscript . (runStyleToTransform rPr {isSubScript = False})
267+ | Just "single" <- rUnderline rPr =
268+ emph . (runStyleToTransform rPr {rUnderline = Nothing})
269+ | otherwise = id
270+
271+runToInlines :: Run -> DocxContext Inlines
329272runToInlines (Run rs runElems)
330− | any inlineCodeContainer (runStyleToContainers rs) =
331− return $
332− rebuild (runStyleToContainers rs) $ [Str $ runElemsToString runElems]
333− | otherwise =
334− return $
335− rebuild (runStyleToContainers rs) (concatMap runElemToInlines runElems)
336−runToInlines (Footnote bps) =
337− concatMapM bodyPartToBlocks bps >>= (\blks -> return [Note blks])
338−runToInlines (Endnote bps) =
339− concatMapM bodyPartToBlocks bps >>= (\blks -> return [Note blks])
273+ | Just s <- rStyle rs
274+ , s `elem` codeStyles =
275+ return $ code $ runElemsToString runElems
276+ | otherwise = do
277+ let ils = concatReduce (map runElemToInlines runElems)
278+ return $ (runStyleToTransform rs) ils
279+runToInlines (Footnote bps) = do
280+ blksList <- concatReduce <$> (mapM bodyPartToBlocks bps)
281+ return $ note blksList
282+runToInlines (Endnote bps) = do
283+ blksList <- concatReduce <$> (mapM bodyPartToBlocks bps)
284+ return $ note blksList
340285runToInlines (InlineDrawing fp bs) = do
341286 mediaBag <- gets docxMediaBag
342287 modify $ \s -> s { docxMediaBag = insertMedia fp Nothing bs mediaBag }
343− return [Image [] (fp, "")]
344−
345−
288+ return $ image fp "" ""
346289
347−
348−parPartToInlines :: ParPart -> DocxContext [Inline]
290+parPartToInlines :: ParPart -> DocxContext Inlines
349291parPartToInlines (PlainRun r) = runToInlines r
350292parPartToInlines (Insertion _ author date runs) = do
351293 opts <- asks docxOptions
352294 case readerTrackChanges opts of
353− AcceptChanges -> concatMapM runToInlines runs >>= return
354− RejectChanges -> return []
295+ AcceptChanges -> concatReduce <$> mapM runToInlines runs
296+ RejectChanges -> return mempty
355297 AllChanges -> do
356− ils <- (concatMapM runToInlines runs)
357− return [Span
358− ("", ["insertion"], [("author", author), ("date", date)])
359− ils]
298+ ils <- concatReduce <$> mapM runToInlines runs
299+ let attr = ("", ["insertion"], [("author", author), ("date", date)])
300+ return $ spanWith attr ils
360301parPartToInlines (Deletion _ author date runs) = do
361302 opts <- asks docxOptions
362303 case readerTrackChanges opts of
363− AcceptChanges -> return []
364− RejectChanges -> concatMapM runToInlines runs >>= return
304+ AcceptChanges -> return mempty
305+ RejectChanges -> concatReduce <$> mapM runToInlines runs
365306 AllChanges -> do
366− ils <- concatMapM runToInlines runs
367− return [Span
368− ("", ["deletion"], [("author", author), ("date", date)])
369− ils]
370−parPartToInlines (BookMark _ anchor) | anchor `elem` dummyAnchors = return []
307+ ils <- concatReduce <$> mapM runToInlines runs
308+ let attr = ("", ["deletion"], [("author", author), ("date", date)])
309+ return $ spanWith attr ils
310+parPartToInlines (BookMark _ anchor) | anchor `elem` dummyAnchors =
311+ return mempty
371312parPartToInlines (BookMark _ anchor) =
372313 -- We record these, so we can make sure not to overwrite
373314 -- user-defined anchor links with header auto ids.
@@ -390,20 +331,19 @@ parPartToInlines (BookMark _ anchor) =
390331 else anchor
391332 unless inHdrBool
392333 (modify $ \s -> s { docxAnchorMap = M.insert anchor newAnchor anchorMap})
393− return [Span (newAnchor, ["anchor"], []) []]
334+ return $ spanWith (newAnchor, ["anchor"], []) mempty
394335parPartToInlines (Drawing fp bs) = do
395336 mediaBag <- gets docxMediaBag
396337 modify $ \s -> s { docxMediaBag = insertMedia fp Nothing bs mediaBag }
397− return [Image [] (fp, "")]
338+ return $ image fp "" ""
398339parPartToInlines (InternalHyperLink anchor runs) = do
399− ils <- concatMapM runToInlines runs
400− return [Link ils ('#' : anchor, "")]
340+ ils <- concatReduce <$> mapM runToInlines runs
341+ return $ link ('#' : anchor) "" ils
401342parPartToInlines (ExternalHyperLink target runs) = do
402− ils <- concatMapM runToInlines runs
403− return [Link ils (target, "")]
343+ ils <- concatReduce <$> mapM runToInlines runs
344+ return $ link target "" ils
404345parPartToInlines (PlainOMath exps) = do
405− return [Math InlineMath (writeTeX exps)]
406−
346+ return $ math $ writeTeX exps
407347
408348isAnchorSpan :: Inline -> Bool
409349isAnchorSpan (Span (_, classes, kvs) ils) =
@@ -415,50 +355,43 @@ isAnchorSpan _ = False
415355dummyAnchors :: [String]
416356dummyAnchors = ["_GoBack"]
417357
418−makeHeaderAnchor :: Block -> DocxContext Block
358+makeHeaderAnchor :: Blocks -> DocxContext Blocks
359+makeHeaderAnchor bs = case viewl $ unMany bs of
360+ (x :< xs) -> do
361+ x' <- (makeHeaderAnchor' x)
362+ xs' <- (makeHeaderAnchor $ Many xs)
363+ return $ (singleton x') <> xs'
364+ EmptyL -> return mempty
365+
366+makeHeaderAnchor' :: Block -> DocxContext Block
419367-- If there is an anchor already there (an anchor span in the header,
420368-- to be exact), we rename and associate the new id with the old one.
421−makeHeaderAnchor (Header n (_, classes, kvs) ils)
422− | xs <- filter isAnchorSpan ils
423− , idents <- filter (\i -> notElem i dummyAnchors) $
424− map (\(Span (ident, _, _) _) -> ident) xs
425− , not $ null idents =
426− do
427− hdrIDMap <- gets docxAnchorMap
428− let newIdent = uniqueIdent ils (M.elems hdrIDMap)
429− newMap = M.fromList $ map (\i -> (i, newIdent)) idents
430− modify $ \s -> s {docxAnchorMap = M.union newMap hdrIDMap}
431− return $ Header n (newIdent, classes, kvs) (ils \\ xs)
369+makeHeaderAnchor' (Header n (_, classes, kvs) ils)
370+ | (c:cs) <- filter isAnchorSpan ils
371+ , (Span (ident, ["anchor"], _) _) <- c = do
372+ hdrIDMap <- gets docxAnchorMap
373+ let newIdent = uniqueIdent ils (M.elems hdrIDMap)
374+ modify $ \s -> s {docxAnchorMap = M.insert ident newIdent hdrIDMap}
375+ return $ Header n (newIdent, classes, kvs) (ils \\ (c:cs))
432376-- Otherwise we just give it a name, and register that name (associate
433377-- it with itself.)
434−makeHeaderAnchor (Header n (_, classes, kvs) ils) =
378+makeHeaderAnchor' (Header n (_, classes, kvs) ils) =
435379 do
436380 hdrIDMap <- gets docxAnchorMap
437381 let newIdent = uniqueIdent ils (M.elems hdrIDMap)
438382 modify $ \s -> s {docxAnchorMap = M.insert newIdent newIdent hdrIDMap}
439383 return $ Header n (newIdent, classes, kvs) ils
440−makeHeaderAnchor blk = return blk
384+makeHeaderAnchor' blk = return blk
441385
386+parPartsToInlines :: [ParPart] -> DocxContext Inlines
387+parPartsToInlines parparts = concatReduce <$> mapM parPartToInlines parparts
442388
443−parPartsToInlines :: [ParPart] -> DocxContext [Inline]
444−parPartsToInlines parparts = do
445− ils <- concatMapM parPartToInlines parparts
446− return $ reduceList $ ils
389+cellToBlocks :: Cell -> DocxContext Blocks
390+cellToBlocks (Cell bps) = concatReduce <$> mapM bodyPartToBlocks bps
447391
448−cellToBlocks :: Cell -> DocxContext [Block]
449−cellToBlocks (Cell bps) = concatMapM bodyPartToBlocks bps
450−
451−rowToBlocksList :: Row -> DocxContext [[Block]]
392+rowToBlocksList :: Row -> DocxContext [Blocks]
452393rowToBlocksList (Row cells) = mapM cellToBlocks cells
453394
454−isBlockCodeContainer :: Container Block -> Bool
455−isBlockCodeContainer (Container f) | CodeBlock _ _ <- f [] = True
456−isBlockCodeContainer _ = False
457−
458−isHeaderContainer :: Container Block -> Bool
459−isHeaderContainer (Container f) | Header _ _ _ <- f [] = True
460−isHeaderContainer _ = False
461−
462395trimLineBreaks :: [Inline] -> [Inline]
463396trimLineBreaks [] = []
464397trimLineBreaks (LineBreak : ils) = trimLineBreaks ils
@@ -466,38 +399,70 @@ trimLineBreaks ils
466399 | (LineBreak : ils') <- reverse ils = trimLineBreaks (reverse ils')
467400trimLineBreaks ils = ils
468401
469−bodyPartToBlocks :: BodyPart -> DocxContext [Block]
470−bodyPartToBlocks (Paragraph pPr parparts)
471− | any isBlockCodeContainer (parStyleToContainers pPr) =
472− let
473− otherConts = filter (not . isBlockCodeContainer) (parStyleToContainers pPr)
402+parStyleToTransform :: ParagraphStyle -> (Blocks -> Blocks)
403+parStyleToTransform pPr
404+ | (c:cs) <- pStyle pPr
405+ , c `elem` divsToKeep =
406+ let pPr' = pPr { pStyle = cs }
474407 in
475− return $
476− rebuild
477− otherConts
478− [CodeBlock ("", [], []) (concatMap parPartToString parparts)]
408+ (divWith ("", [c], [])) . (parStyleToTransform pPr')
409+ | (c:cs) <- pStyle pPr,
410+ c `elem` listParagraphDivs =
411+ let pPr' = pPr { pStyle = cs, indentation = Nothing}
412+ in
413+ (divWith ("", [c], [])) . (parStyleToTransform pPr')
414+ | (c:cs) <- pStyle pPr
415+ , c `elem` blockQuoteDivs =
416+ let pPr' = pPr { pStyle = cs \\ blockQuoteDivs }
417+ in
418+ blockQuote . (parStyleToTransform pPr')
419+ | (_:cs) <- pStyle pPr =
420+ let pPr' = pPr { pStyle = cs}
421+ in
422+ parStyleToTransform pPr'
423+ | null (pStyle pPr)
424+ , Just left <- indentation pPr >>= leftParIndent
425+ , Just hang <- indentation pPr >>= hangingParIndent =
426+ let pPr' = pPr { indentation = Nothing }
427+ in
428+ case (left - hang) > 0 of
429+ True -> blockQuote . (parStyleToTransform pPr')
430+ False -> parStyleToTransform pPr'
431+ | null (pStyle pPr),
432+ Just left <- indentation pPr >>= leftParIndent =
433+ let pPr' = pPr { indentation = Nothing }
434+ in
435+ case left > 0 of
436+ True -> blockQuote . (parStyleToTransform pPr')
437+ False -> parStyleToTransform pPr'
438+parStyleToTransform _ = id
439+
440+bodyPartToBlocks :: BodyPart -> DocxContext Blocks
479441bodyPartToBlocks (Paragraph pPr parparts)
480− | any isHeaderContainer (parStyleToContainers pPr) = do
481− ils <- (trimLineBreaks . normalizeSpaces) <$>
482− local (\s -> s{docxInHeaderBlock = True})
442+ | not $ null $ codeDivs `intersect` (pStyle pPr) =
443+ return
444+ $ parStyleToTransform pPr
445+ $ codeBlock
446+ $ concatMap parPartToString parparts
447+ | (c : cs) <- filter (isJust . isHeaderClass) $ pStyle pPr
448+ , Just n <- isHeaderClass c = do
449+ ils <- local (\s-> s{docxInHeaderBlock=True}) $
483450 (parPartsToInlines parparts)
484− let (Container hdrFun) = head $ filter isHeaderContainer (parStyleToContainers pPr)
485− Header n attr _ = hdrFun []
486− hdr <- makeHeaderAnchor $ Header n attr ils
487− return [hdr]
488−bodyPartToBlocks (Paragraph pPr parparts) = do
489− ils <- parPartsToInlines parparts >>= (return . normalizeSpaces)
490− dropIls <- gets docxDropCap
491− let ils' = concatR dropIls ils
492− if dropCap pPr
493− then do modify $ \s -> s { docxDropCap = ils' }
494− return []
495− else do modify $ \s -> s { docxDropCap = [] }
496− return $ case ils' of
497− [] -> []
498− _ -> rebuild
499− (parStyleToContainers pPr)
500− [Para $ ils']
451+
452+ makeHeaderAnchor $
453+ headerWith ("", delete ("Heading" ++ show n) cs, []) n ils
454+ | otherwise = do
455+ ils <- parPartsToInlines parparts >>=
456+ (return . fromList . trimLineBreaks . normalizeSpaces . toList)
457+ dropIls <- gets docxDropCap
458+ let ils' = dropIls <> ils
459+ if dropCap pPr
460+ then do modify $ \s -> s { docxDropCap = ils' }
461+ return mempty
462+ else do modify $ \s -> s { docxDropCap = mempty }
463+ return $ case isNull ils' of
464+ True -> mempty
465+ _ -> parStyleToTransform pPr $ para ils'
501466bodyPartToBlocks (ListItem pPr numId lvl levelInfo parparts) = do
502467 let
503468 kvs = case levelInfo of
@@ -514,11 +479,11 @@ bodyPartToBlocks (ListItem pPr numId lvl levelInfo parparts) = do
514479 , ("text", txt)
515480 ]
516481 blks <- bodyPartToBlocks (Paragraph pPr parparts)
517− return $ [Div ("", ["list-item"], kvs) blks]
482+ return $ divWith ("", ["list-item"], kvs) blks
518483bodyPartToBlocks (Tbl _ _ _ []) =
519− return [Para []]
484+ return $ para mempty
520485bodyPartToBlocks (Tbl cap _ look (r:rs)) = do
521− let caption = strToInlines cap
486+ let caption = text cap
522487 (hdr, rows) = case firstRowFormatting look of
523488 True -> (Just r, rs)
524489 False -> (Nothing, r:rs)
@@ -540,29 +505,37 @@ bodyPartToBlocks (Tbl cap _ look (r:rs)) = do
540505 alignments = replicate size AlignDefault
541506 widths = replicate size 0 :: [Double]
542507
543− return [Table caption alignments widths hdrCells cells]
508+ return $ table caption (zip alignments widths) hdrCells cells
544509bodyPartToBlocks (OMathPara e) = do
545− return [Para [Math DisplayMath (writeTeX e)]]
510+ return $ para $ displayMath (writeTeX e)
546511
547512
548513-- replace targets with generated anchors.
549−rewriteLink :: Inline -> DocxContext Inline
550−rewriteLink l@(Link ils ('#':target, title)) = do
514+rewriteLink' :: Inline -> DocxContext Inline
515+rewriteLink' l@(Link ils ('#':target, title)) = do
551516 anchorMap <- gets docxAnchorMap
552517 return $ case M.lookup target anchorMap of
553518 Just newTarget -> (Link ils ('#':newTarget, title))
554519 Nothing -> l
555−rewriteLink il = return il
520+rewriteLink' il = return il
521+
522+rewriteLink :: Blocks -> DocxContext Blocks
523+rewriteLink ils = case viewl $ unMany ils of
524+ (x :< xs) -> do
525+ x' <- walkM rewriteLink' x
526+ xs' <- rewriteLink $ Many xs
527+ return $ (singleton x') <> xs'
528+ EmptyL -> return ils
556529
557530bodyToOutput :: Body -> DocxContext (Meta, [Block], MediaBag)
558531bodyToOutput (Body bps) = do
559532 let (metabps, blkbps) = sepBodyParts bps
560533 meta <- bodyPartsToMeta metabps
561− blks <- concatMapM bodyPartToBlocks blkbps >>=
562− walkM rewriteLink
534+ blks <- concatReduce <$> mapM bodyPartToBlocks blkbps
535+ blks' <- rewriteLink blks
563536 mediaBag <- gets docxMediaBag
564537 return $ (meta,
565− blocksToDefinitions $ blocksToBullets $ blks,
538+ blocksToDefinitions $ blocksToBullets $ toList blks',
566539 mediaBag)
567540
568541docxToOutput :: ReaderOptions -> Docx -> (Meta, [Block], MediaBag)
@@ -570,12 +543,6 @@ docxToOutput opts (Docx (Document _ body)) =
570543 let dEnv = def { docxOptions = opts} in
571544 evalDocxContext (bodyToOutput body) dEnv def
572545
573−
574−ilToCode :: Inline -> String
575−ilToCode (Str s) = s
576−ilToCode Space = " "
577−ilToCode _ = ""
578−
579546isHeaderClass :: String -> Maybe Int
580547isHeaderClass s | Just s' <- stripPrefix "Heading" s =
581548 case reads s' :: [(Int, String)] of