git.iko.soy/typeable/pandoc
on master help sign in
Docx reader: add simple comment functionality.

This adds simple track-changes comment parsing to the docx reader. It is turned on with `--track-changes=all`. All comments are converted to inlines, which can list some information. In the future a warning will be added for comments with formatting that seems like it will be excessively denatured. Note that comments can extend across blocks. For that reason there are two spans: `comment-start` and `comment-end`. `comment-start` will contain the comment. `comment-end` will always be empty. The two will be associated by a numeric id.

commit8bb739f7ff353722981fe442ae0c137910604850 authorJesse Rosenthal <jrosenthal@jhu.edu> dateWed 22 Jun 2016, 13:49 (10 years ago) parentcbc2c15
2 files changed+73−1
compare with master
unifiedsplit
src/Text/Pandoc/Readers/Docx.hs+16 src/Text/Pandoc/Readers/Docx/Parse.hs+57−1
src/Text/Pandoc/Readers/Docx.hs+16
@@ -339,6 +339,22 @@ parPartToInlines (Deletion _ author date runs) = do
339339 ils <- smushInlines <$> mapM runToInlines runs
340340 let attr = ("", ["deletion"], [("author", author), ("date", date)])
341341 return $ spanWith attr ils
342+parPartToInlines (CommentStart cmtId author date bodyParts) = do
343+ opts <- asks docxOptions
344+ case readerTrackChanges opts of
345+ AllChanges -> do
346+ blks <- smushBlocks <$> mapM bodyPartToBlocks bodyParts
347+ let ils = fromList $ blocksToInlines $ toList blks
348+ attr = ("", ["comment-start"], [("id", cmtId), ("author", author), ("date", date)])
349+ return $ spanWith attr ils
350+ _ -> return mempty
351+parPartToInlines (CommentEnd cmtId) = do
352+ opts <- asks docxOptions
353+ case readerTrackChanges opts of
354+ AllChanges -> do
355+ let attr = ("", ["comment-end"], [("id", cmtId)])
356+ return $ spanWith attr mempty
357+ _ -> return mempty
342358parPartToInlines (BookMark _ anchor) | anchor `elem` dummyAnchors =
343359 return mempty
344360parPartToInlines (BookMark _ anchor) =
src/Text/Pandoc/Readers/Docx/Parse.hs+57−1
@@ -73,6 +73,7 @@ import Text.Pandoc.Readers.Docx.Util
7373import Data.Char (readLitChar, ord, chr, isDigit)
7474
7575data ReaderEnv = ReaderEnv { envNotes :: Notes
76+ , envComments :: Comments
7677 , envNumbering :: Numbering
7778 , envRelationships :: [Relationship]
7879 , envMedia :: Media
@@ -160,6 +161,9 @@ data Notes = Notes NameSpaces
160161 (Maybe (M.Map String Element))
161162 deriving Show
162163
164+data Comments = Comments NameSpaces (M.Map String Element)
165+ deriving Show
166+
163167data ParIndentation = ParIndentation { leftParIndent :: Maybe Integer
164168 , rightParIndent :: Maybe Integer
165169 , hangingParIndent :: Maybe Integer}
@@ -210,6 +214,8 @@ type Extent = Maybe (Double, Double)
210214data ParPart = PlainRun Run
211215 | Insertion ChangeId Author ChangeDate [Run]
212216 | Deletion ChangeId Author ChangeDate [Run]
217+ | CommentStart CommentId Author CommentDate [BodyPart]
218+ | CommentEnd CommentId
213219 | BookMark BookMarkId Anchor
214220 | InternalHyperLink Anchor [Run]
215221 | ExternalHyperLink URL [Run]
@@ -259,8 +265,10 @@ type URL = String
259265type BookMarkId = String
260266type RelId = String
261267type ChangeId = String
268+type CommentId = String
262269type Author = String
263270type ChangeDate = String
271+type CommentDate = String
264272
265273archiveToDocx :: Archive -> Either DocxError Docx
266274archiveToDocx archive = fst <$> archiveToDocxWithWarnings archive
@@ -268,12 +276,13 @@ archiveToDocx archive = fst <$> archiveToDocxWithWarnings archive
268276archiveToDocxWithWarnings :: Archive -> Either DocxError (Docx, [String])
269277archiveToDocxWithWarnings archive = do
270278 let notes = archiveToNotes archive
279+ comments = archiveToComments archive
271280 numbering = archiveToNumbering archive
272281 rels = archiveToRelationships archive
273282 media = archiveToMedia archive
274283 (styles, parstyles) = archiveToStyles archive
275284 rEnv =
276− ReaderEnv notes numbering rels media Nothing styles parstyles InDocument
285+ ReaderEnv notes comments numbering rels media Nothing styles parstyles InDocument
277286 rState = ReaderState { stateWarnings = [] }
278287 (eitherDoc, st) = runD (archiveToDocument archive) rEnv rState
279288 case eitherDoc of
@@ -384,6 +393,20 @@ archiveToNotes zf =
384393 in
385394 Notes ns fn en
386395
396+archiveToComments :: Archive -> Comments
397+archiveToComments zf =
398+ let cmtsElem = findEntryByPath "word/comments.xml" zf
399+ >>= (parseXMLDoc . UTF8.toStringLazy . fromEntry)
400+ cmts_namespaces = case cmtsElem of
401+ Just e -> elemToNameSpaces e
402+ Nothing -> []
403+ cmts = (elemToComments cmts_namespaces) <$> cmtsElem
404+ in
405+ case cmts of
406+ Just c -> Comments cmts_namespaces c
407+ Nothing -> Comments cmts_namespaces M.empty
408+
409+
387410filePathToRelType :: FilePath -> Maybe DocumentLocation
388411filePathToRelType "word/_rels/document.xml.rels" = Just InDocument
389412filePathToRelType "word/_rels/footnotes.xml.rels" = Just InFootnote
@@ -504,6 +527,18 @@ elemToNotes ns notetype element
504527 Just $ M.fromList $ pairs
505528elemToNotes _ _ _ = Nothing
506529
530+elemToComments :: NameSpaces -> Element -> M.Map String Element
531+elemToComments ns element
532+ | isElem ns "w" "comments" element =
533+ let pairs = mapMaybe
534+ (\e -> findAttr (elemName ns "w" "id") e >>=
535+ (\a -> Just (a, e)))
536+ (findChildren (elemName ns "w" "comment") element)
537+ in
538+ M.fromList $ pairs
539+elemToComments _ _ = M.empty
540+
541+
507542---------------------------------------------
508543---------------------------------------------
509544
@@ -696,11 +731,32 @@ elemToParPart ns element
696731 , Just anchor <- findAttr (elemName ns "w" "anchor") element = do
697732 runs <- mapD (elemToRun ns) (elChildren element)
698733 return $ InternalHyperLink anchor runs
734+elemToParPart ns element
735+ | isElem ns "w" "commentRangeStart" element
736+ , Just cmtId <- findAttr (elemName ns "w" "id") element = do
737+ (Comments _ commentMap) <- asks envComments
738+ case M.lookup cmtId commentMap of
739+ Just cmtElem -> elemToCommentStart ns cmtElem
740+ Nothing -> throwError WrongElem
741+elemToParPart ns element
742+ | isElem ns "w" "commentRangeEnd" element
743+ , Just cmtId <- findAttr (elemName ns "w" "id") element =
744+ return $ CommentEnd cmtId
699745elemToParPart ns element
700746 | isElem ns "m" "oMath" element =
701747 (eitherToD $ readOMML $ showElement element) >>= (return . PlainOMath)
702748elemToParPart _ _ = throwError WrongElem
703749
750+elemToCommentStart :: NameSpaces -> Element -> D ParPart
751+elemToCommentStart ns element
752+ | isElem ns "w" "comment" element
753+ , Just cmtId <- findAttr (elemName ns "w" "id") element
754+ , Just cmtAuthor <- findAttr (elemName ns "w" "author") element
755+ , Just cmtDate <- findAttr (elemName ns "w" "date") element = do
756+ bps <- mapD (elemToBodyPart ns) (elChildren element)
757+ return $ CommentStart cmtId cmtAuthor cmtDate bps
758+elemToCommentStart _ _ = throwError WrongElem
759+
704760lookupFootnote :: String -> Notes -> Maybe Element
705761lookupFootnote s (Notes _ fns _) = fns >>= (M.lookup s)
706762