From 032ba8dd0c235c47df1148f9bfa91dc277a09216 Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Wed, 22 Jun 2016 15:39:37 -0400
Subject: Docx reader: Add warning for advanced comment formatting.

We can't guarantee we'll convert every comment correctly, though we'll
do the best we can. This warns if the comment includes something other
than Para or Plain.
---
 src/Text/Pandoc/Readers/Docx.hs | 20 ++++++++++++++++++--
 1 file changed, 18 insertions(+), 2 deletions(-)

(limited to 'src/Text/Pandoc')

diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index 313610783..2bc17c069 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -139,6 +139,11 @@ type DocxContext = ExceptT PandocError (ReaderT DEnv (State DState))
 evalDocxContext :: DocxContext a -> DEnv -> DState -> Either PandocError a
 evalDocxContext ctx env st = flip evalState st . flip runReaderT env . runExceptT $ ctx
 
+addDocxWarning :: String -> DocxContext ()
+addDocxWarning msg = do
+  warnings <- gets docxWarnings
+  modify $ \s -> s {docxWarnings = msg : warnings}
+
 -- This is empty, but we put it in for future-proofing.
 spansToKeep :: [String]
 spansToKeep = []
@@ -321,6 +326,17 @@ extentToAttr (Just (w, h)) =
     showDim d = show (d / 914400) ++ "in"
 extentToAttr _ = nullAttr
 
+blocksToInlinesWarn :: String -> Blocks -> DocxContext Inlines
+blocksToInlinesWarn cmtId blks = do
+  let blkList = toList blks
+      notParaOrPlain :: Block -> Bool
+      notParaOrPlain (Para _) = False
+      notParaOrPlain (Plain _) = False
+      notParaOrPlain _ = True
+  when (not $ null $ filter notParaOrPlain blkList)
+    (addDocxWarning $ "Docx comment " ++ cmtId ++ " will not retain formatting")
+  return $ fromList $ blocksToInlines blkList
+
 parPartToInlines :: ParPart -> DocxContext Inlines
 parPartToInlines (PlainRun r) = runToInlines r
 parPartToInlines (Insertion _ author date runs) = do
@@ -346,8 +362,8 @@ parPartToInlines (CommentStart cmtId author date bodyParts) = do
   case readerTrackChanges opts of
     AllChanges -> do
       blks <- smushBlocks <$> mapM bodyPartToBlocks bodyParts
-      let ils = fromList $ blocksToInlines $ toList blks
-          attr = ("", ["comment-start"], [("id", cmtId), ("author", author), ("date", date)])
+      ils <- blocksToInlinesWarn cmtId blks
+      let attr = ("", ["comment-start"], [("id", cmtId), ("author", author), ("date", date)])
       return $ spanWith attr ils
     _ -> return mempty
 parPartToInlines (CommentEnd cmtId) = do
-- 
cgit v1.2.3